Return to gram.head CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1

Annotation of cci/usr/src/usr.bin/f77/f77pass1/gram.head, revision 1.1

1.1     ! root        1: /*
        !             2:  * Copyright (c) 1980 Regents of the University of California.
        !             3:  * All rights reserved.  The Berkeley software License Agreement
        !             4:  * specifies the terms and conditions for redistribution.
        !             5:  *
        !             6:  *     @(#)gram.head   5.1 (Berkeley) 6/7/85
        !             7:  */
        !             8: 
        !             9: /*
        !            10:  * gram.head
        !            11:  *
        !            12:  * First part of the f77 grammar, f77 compiler pass 1.
        !            13:  *
        !            14:  * University of Utah CS Dept modification history:
        !            15:  *
        !            16:  * $Log:       gram.head,v $
        !            17: Revision 1.2  86/02/12  15:28:20  rcs
        !            18: 4.3 F77. C. Keating.
        !            19: 
        !            20:  * Revision 3.2  84/11/06  17:40:52  donn
        !            21:  * Fixed bug with redundant labels causing errors when they appear on (e.g.)
        !            22:  * PROGRAM statements.
        !            23:  * 
        !            24:  * Revision 3.1  84/10/13  00:22:16  donn
        !            25:  * Merged Jerry Berkman's version into mine.
        !            26:  * 
        !            27:  * Revision 2.2  84/08/04  21:13:02  donn
        !            28:  * Moved some code out of gram.head into gram.exec in accordance with
        !            29:  * Jerry Berkman's fixes to make ASSIGNs work right.
        !            30:  * 
        !            31:  * Revision 2.1  84/07/19  12:03:20  donn
        !            32:  * Changed comment headers for UofU.
        !            33:  * 
        !            34:  * Revision 1.2  84/03/23  22:43:06  donn
        !            35:  * The subroutine argument temporary fixes from Bob Corbett didn't take into
        !            36:  * account the fact that the code generator collects all the assignments to
        !            37:  * temporaries at the start of a statement -- hence the temporaries need to
        !            38:  * be initialized once per statement instead of once per call.
        !            39:  * 
        !            40:  */
        !            41: 
        !            42: %{
        !            43: #      include "defs.h"
        !            44: #      include "data.h"
        !            45: 
        !            46: #ifdef SDB
        !            47: #      include <a.out.h>
        !            48: 
        !            49: #      ifndef N_SO
        !            50: #              include <stab.h>
        !            51: #      endif
        !            52: #endif
        !            53: 
        !            54: static int equivlisterr;
        !            55: static int do_name_err;
        !            56: static int nstars;
        !            57: static int ndim;
        !            58: static int vartype;
        !            59: static ftnint varleng;
        !            60: static struct { expptr lb, ub; } dims[MAXDIM+1];
        !            61: static struct Labelblock *labarray[MAXLABLIST];
        !            62: static int lastwasbranch = NO;
        !            63: static int thiswasbranch = NO;
        !            64: extern ftnint yystno;
        !            65: extern flag intonly;
        !            66: 
        !            67: ftnint convci();
        !            68: double convcd();
        !            69: expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon();
        !            70: expptr mkcxcon();
        !            71: struct Listblock *mklist();
        !            72: struct Listblock *mklist();
        !            73: struct Impldoblock *mkiodo();
        !            74: struct Extsym *comblock();
        !            75: 
        !            76: %}
        !            77: 
        !            78: /* Specify precedences and associativities. */
        !            79: 
        !            80: %union {
        !            81:        int ival;
        !            82:        char *charpval;
        !            83:        chainp chval;
        !            84:        tagptr tagval;
        !            85:        expptr expval;
        !            86:        struct Labelblock *labval;
        !            87:        struct Nameblock *namval;
        !            88:        struct Eqvchain *eqvval;
        !            89:        struct Extsym *extval;
        !            90:        union  Vexpr *vexpval;
        !            91:        struct ValList *drvals;
        !            92:        struct Vlist *dvals;
        !            93:        union  Delt *deltp;
        !            94:        struct Rpair *rpairp;
        !            95:        struct Elist *elistp;
        !            96:        }
        !            97: 
        !            98: %left SCOMMA
        !            99: %nonassoc SCOLON
        !           100: %right SEQUALS
        !           101: %left SEQV SNEQV
        !           102: %left SOR
        !           103: %left SAND
        !           104: %left SNOT
        !           105: %nonassoc SLT SGT SLE SGE SEQ SNE
        !           106: %left SCONCAT
        !           107: %left SPLUS SMINUS
        !           108: %left SSTAR SSLASH
        !           109: %right SPOWER
        !           110: 
        !           111: %start program
        !           112: %type <labval> thislabel label assignlabel
        !           113: %type <tagval> other inelt
        !           114: %type <ival> lengspec type typespec typename dcl letter addop relop stop nameeq
        !           115: %type <charpval> filename
        !           116: %type <chval> namelistlist funarglist funargs dospec
        !           117: %type <chval> callarglist arglist args exprlist inlist outlist out2 substring
        !           118: %type <namval> name arg call var entryname progname
        !           119: %type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr
        !           120: %type <expval> ubound callarg complex_const simple_const 
        !           121: %type <extval> common comblock
        !           122: %type <eqvval> equivlist
        !           123: %type <expval> datavalue real_const unsignedreal bit_const
        !           124: %type <vexpval> unsignedint int_const
        !           125: %type <vexpval> dataname
        !           126: %type <vexpval> iconprimary iconfactor iconterm iconexpr opticonexpr
        !           127: %type <drvals> datarval datarvals
        !           128: %type <dvals>  iconexprlist datasubs
        !           129: %type <deltp>  dataelt dataimplieddo datalval
        !           130: %type <rpairp> datarange
        !           131: %type <elistp> dlist datalvals
        !           132: 
        !           133: %%
        !           134: 
        !           135: program:
        !           136:        | program stat SEOS
        !           137:        ;
        !           138: 
        !           139: stat:    thislabel  entry
        !           140:                { lastwasbranch = NO; }
        !           141:        | thislabel  spec
        !           142:        | thislabel  exec
        !           143:                { if($1 && ($1->labelno==dorange))
        !           144:                        enddo($1->labelno);
        !           145:                  if(lastwasbranch && thislabel==NULL)
        !           146:                        warn("statement cannot be reached");
        !           147:                  lastwasbranch = thiswasbranch;
        !           148:                  thiswasbranch = NO;
        !           149:                  if($1)
        !           150:                        {
        !           151:                        if($1->labtype == LABFORMAT)
        !           152:                                err("label already that of a format");
        !           153:                        else
        !           154:                                $1->labtype = LABEXEC;
        !           155:                        }
        !           156:                  if(!optimflag)
        !           157:                        {
        !           158:                        argtemplist = hookup(argtemplist, activearglist);
        !           159:                        activearglist = CHNULL;
        !           160:                        }
        !           161:                }
        !           162:        | thislabel SINCLUDE filename
        !           163:                { doinclude( $3 ); }
        !           164:        | thislabel  SEND  end_spec
        !           165:                { lastwasbranch = NO;  endproc(); }
        !           166:        | thislabel SUNKNOWN
        !           167:                { execerr("unclassifiable statement", CNULL);  flline(); };
        !           168:        | error
        !           169:                { flline();  needkwd = NO;  inioctl = NO; 
        !           170:                  yyerrok; yyclearin; }
        !           171:        ;
        !           172: 
        !           173: thislabel:  SLABEL
        !           174:                {
        !           175: #ifdef SDB
        !           176:                if( sdbflag )
        !           177:                        {
        !           178:                        linenostab(lineno);
        !           179:                        }
        !           180: #endif
        !           181: 
        !           182:                if(yystno != 0)
        !           183:                        {
        !           184:                        $$ = thislabel =  mklabel(yystno);
        !           185:                        if(thislabel->labdefined)
        !           186:                                execerr("label %s already defined",
        !           187:                                        convic(thislabel->stateno) );
        !           188:                        else    {
        !           189:                                if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
        !           190:                                    && thislabel->labtype!=LABFORMAT)
        !           191:                                        warn1("there is a branch to label %s from outside block",
        !           192:                                              convic( (ftnint) (thislabel->stateno) ) );
        !           193:                                thislabel->blklevel = blklevel;
        !           194:                                thislabel->labdefined = YES;
        !           195:                                }
        !           196:                        }
        !           197:                else    $$ = thislabel = NULL;
        !           198:                }
        !           199:        ;
        !           200: 
        !           201: entry:   SPROGRAM new_proc progname
        !           202:                   {startproc($3, CLMAIN); }
        !           203:        | SBLOCK new_proc progname
        !           204:                { if($3) NO66("named BLOCKDATA");
        !           205:                  startproc($3, CLBLOCK); }
        !           206:        | SSUBROUTINE new_proc entryname arglist
        !           207:                { entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
        !           208:        | SFUNCTION new_proc entryname arglist
        !           209:                { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
        !           210:        | type SFUNCTION new_proc entryname arglist
        !           211:                { entrypt(CLPROC, $1, varleng, $4, $5); }
        !           212:        | SENTRY entryname arglist
        !           213:                { if(parstate==OUTSIDE || procclass==CLMAIN
        !           214:                        || procclass==CLBLOCK)
        !           215:                                execerr("misplaced entry statement", CNULL);
        !           216:                        entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
        !           217:                }
        !           218:        ;
        !           219: 
        !           220: new_proc:
        !           221:                { newproc(); }
        !           222:        ;
        !           223: 
        !           224: entryname:  name
        !           225:        ;
        !           226: 
        !           227: name:    SNAME
        !           228:                { $$ = mkname(toklen, token); }
        !           229:        ;
        !           230: 
        !           231: progname:              { $$ = NULL; }
        !           232:        | entryname
        !           233:        ;
        !           234: 
        !           235: arglist:
        !           236:                { $$ = 0; }
        !           237:        | SLPAR SRPAR
        !           238:                { NO66(" () argument list");
        !           239:                  $$ = 0; }
        !           240:        | SLPAR args SRPAR
        !           241:                {$$ = $2; }
        !           242:        ;
        !           243: 
        !           244: args:    arg
        !           245:                { $$ = ($1 ? mkchain($1,CHNULL) : CHNULL ); }
        !           246:        | args SCOMMA arg
        !           247:                { if($3) $1 = $$ = hookup($1, mkchain($3,CHNULL)); }
        !           248:        ;
        !           249: 
        !           250: arg:     name
        !           251:                { if(($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG)
        !           252:                                || ($1->vclass == CLPARAM) ) {
        !           253:                        dclerr("name declared as argument after use", $1);
        !           254:                        $$ = NULL;
        !           255:                  } else
        !           256:                        $1->vstg = STGARG;
        !           257:                }
        !           258:        | SSTAR
        !           259:                { NO66("altenate return argument");
        !           260:                  $$ = 0;  substars = YES; }
        !           261:        ;
        !           262: 
        !           263: 
        !           264: 
        !           265: filename:   SHOLLERITH
        !           266:                {
        !           267:                char *s;
        !           268:                s = copyn(toklen+1, token);
        !           269:                s[toklen] = '\0';
        !           270:                $$ = s;
        !           271:                }
        !           272:        ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.