Return to gram.head CVS log

Up to [Research Unix] / researchv10no / cmd / f2c

Annotation of researchv10no/cmd/f2c/gram.head, revision 1.1

1.1     ! root        1: /****************************************************************
        !             2: Copyright 1990, 1993 by AT&T Bell Laboratories, Bellcore.
        !             3: 
        !             4: Permission to use, copy, modify, and distribute this software
        !             5: and its documentation for any purpose and without fee is hereby
        !             6: granted, provided that the above copyright notice appear in all
        !             7: copies and that both that the copyright notice and this
        !             8: permission notice and warranty disclaimer appear in supporting
        !             9: documentation, and that the names of AT&T Bell Laboratories or
        !            10: Bellcore or any of their entities not be used in advertising or
        !            11: publicity pertaining to distribution of the software without
        !            12: specific, written prior permission.
        !            13: 
        !            14: AT&T and Bellcore disclaim all warranties with regard to this
        !            15: software, including all implied warranties of merchantability
        !            16: and fitness.  In no event shall AT&T or Bellcore be liable for
        !            17: any special, indirect or consequential damages or any damages
        !            18: whatsoever resulting from loss of use, data or profits, whether
        !            19: in an action of contract, negligence or other tortious action,
        !            20: arising out of or in connection with the use or performance of
        !            21: this software.
        !            22: ****************************************************************/
        !            23: 
        !            24: %{
        !            25: #include "defs.h"
        !            26: #include "p1defs.h"
        !            27: 
        !            28: static int nstars;                     /* Number of labels in an
        !            29:                                           alternate return CALL */
        !            30: static int datagripe;
        !            31: static int ndim;
        !            32: static int vartype;
        !            33: int new_dcl;
        !            34: static ftnint varleng;
        !            35: static struct Dims dims[MAXDIM+1];
        !            36: extern struct Labelblock **labarray;   /* Labels in an alternate
        !            37:                                                   return CALL */
        !            38: extern int maxlablist;
        !            39: 
        !            40: /* The next two variables are used to verify that each statement might be reached
        !            41:    during runtime.   lastwasbranch   is tested only in the defintion of the
        !            42:    stat:   nonterminal. */
        !            43: 
        !            44: int lastwasbranch = NO;
        !            45: static int thiswasbranch = NO;
        !            46: extern ftnint yystno;
        !            47: extern flag intonly;
        !            48: static chainp datastack;
        !            49: extern long laststfcn, thisstno;
        !            50: extern int can_include;        /* for netlib */
        !            51: 
        !            52: ftnint convci();
        !            53: Addrp nextdata();
        !            54: expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon();
        !            55: expptr mkcxcon();
        !            56: struct Listblock *mklist();
        !            57: struct Listblock *mklist();
        !            58: struct Impldoblock *mkiodo();
        !            59: Extsym *comblock();
        !            60: #define ESNULL (Extsym *)0
        !            61: #define NPNULL (Namep)0
        !            62: #define LBNULL (struct Listblock *)0
        !            63: extern void freetemps(), make_param();
        !            64: 
        !            65:  static void
        !            66: pop_datastack() {
        !            67:        chainp d0 = datastack;
        !            68:        if (d0->datap)
        !            69:                curdtp = (chainp)d0->datap;
        !            70:        datastack = d0->nextp;
        !            71:        d0->nextp = 0;
        !            72:        frchain(&d0);
        !            73:        }
        !            74: 
        !            75: %}
        !            76: 
        !            77: /* Specify precedences and associativities. */
        !            78: 
        !            79: %union {
        !            80:        int ival;
        !            81:        ftnint lval;
        !            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:        Extsym *extval;
        !            90:        }
        !            91: 
        !            92: %left SCOMMA
        !            93: %nonassoc SCOLON
        !            94: %right SEQUALS
        !            95: %left SEQV SNEQV
        !            96: %left SOR
        !            97: %left SAND
        !            98: %left SNOT
        !            99: %nonassoc SLT SGT SLE SGE SEQ SNE
        !           100: %left SCONCAT
        !           101: %left SPLUS SMINUS
        !           102: %left SSTAR SSLASH
        !           103: %right SPOWER
        !           104: 
        !           105: %start program
        !           106: %type <labval> thislabel label assignlabel
        !           107: %type <tagval> other inelt
        !           108: %type <ival> type typespec typename dcl letter addop relop stop nameeq
        !           109: %type <lval> lengspec
        !           110: %type <charpval> filename
        !           111: %type <chval> datavar datavarlist namelistlist funarglist funargs
        !           112: %type <chval> dospec dospecw
        !           113: %type <chval> callarglist arglist args exprlist inlist outlist out2 substring
        !           114: %type <namval> name arg call var
        !           115: %type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr
        !           116: %type <expval> ubound simple value callarg complex_const simple_const bit_const
        !           117: %type <extval> common comblock entryname progname
        !           118: %type <eqvval> equivlist
        !           119: 
        !           120: %%
        !           121: 
        !           122: program:
        !           123:        | program stat SEOS
        !           124:        ;
        !           125: 
        !           126: stat:    thislabel  entry
        !           127:                {
        !           128: /* stat:   is the nonterminal for Fortran statements */
        !           129: 
        !           130:                  lastwasbranch = NO; }
        !           131:        | thislabel  spec
        !           132:        | thislabel  exec
        !           133:                { /* forbid further statement function definitions... */
        !           134:                  if (parstate == INDATA && laststfcn != thisstno)
        !           135:                        parstate = INEXEC;
        !           136:                  thisstno++;
        !           137:                  if($1 && ($1->labelno==dorange))
        !           138:                        enddo($1->labelno);
        !           139:                  if(lastwasbranch && thislabel==NULL)
        !           140:                        warn("statement cannot be reached");
        !           141:                  lastwasbranch = thiswasbranch;
        !           142:                  thiswasbranch = NO;
        !           143:                  if($1)
        !           144:                        {
        !           145:                        if($1->labtype == LABFORMAT)
        !           146:                                err("label already that of a format");
        !           147:                        else
        !           148:                                $1->labtype = LABEXEC;
        !           149:                        }
        !           150:                  freetemps();
        !           151:                }
        !           152:        | thislabel SINCLUDE filename
        !           153:                { if (can_include)
        !           154:                        doinclude( $3 );
        !           155:                  else {
        !           156:                        fprintf(diagfile, "Cannot open file %s\n", $3);
        !           157:                        done(1);
        !           158:                        }
        !           159:                }
        !           160:        | thislabel  SEND  end_spec
        !           161:                { if ($1)
        !           162:                        lastwasbranch = NO;
        !           163:                  endproc(); /* lastwasbranch = NO; -- set in endproc() */
        !           164:                }
        !           165:        | thislabel SUNKNOWN
        !           166:                { extern void unclassifiable();
        !           167:                  unclassifiable();
        !           168: 
        !           169: /* flline flushes the current line, ignoring the rest of the text there */
        !           170: 
        !           171:                  flline(); };
        !           172:        | error
        !           173:                { flline();  needkwd = NO;  inioctl = NO;
        !           174:                  yyerrok; yyclearin; }
        !           175:        ;
        !           176: 
        !           177: thislabel:  SLABEL
        !           178:                {
        !           179:                if(yystno != 0)
        !           180:                        {
        !           181:                        $$ = thislabel =  mklabel(yystno);
        !           182:                        if( ! headerdone ) {
        !           183:                                if (procclass == CLUNKNOWN)
        !           184:                                        procclass = CLMAIN;
        !           185:                                puthead(CNULL, procclass);
        !           186:                                }
        !           187:                        if(thislabel->labdefined)
        !           188:                                execerr("label %s already defined",
        !           189:                                        convic(thislabel->stateno) );
        !           190:                        else    {
        !           191:                                if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel
        !           192:                                    && thislabel->labtype!=LABFORMAT)
        !           193:                                        warn1("there is a branch to label %s from outside block",
        !           194:                                              convic( (ftnint) (thislabel->stateno) ) );
        !           195:                                thislabel->blklevel = blklevel;
        !           196:                                thislabel->labdefined = YES;
        !           197:                                if(thislabel->labtype != LABFORMAT)
        !           198:                                        p1_label((long)(thislabel - labeltab));
        !           199:                                }
        !           200:                        }
        !           201:                else    $$ = thislabel = NULL;
        !           202:                }
        !           203:        ;
        !           204: 
        !           205: entry:   SPROGRAM new_proc progname
        !           206:                   {startproc($3, CLMAIN); }
        !           207:        | SPROGRAM new_proc progname progarglist
        !           208:                   {    warn("ignoring arguments to main program");
        !           209:                        /* hashclear(); */
        !           210:                        startproc($3, CLMAIN); }
        !           211:        | SBLOCK new_proc progname
        !           212:                { if($3) NO66("named BLOCKDATA");
        !           213:                  startproc($3, CLBLOCK); }
        !           214:        | SSUBROUTINE new_proc entryname arglist
        !           215:                { entrypt(CLPROC, TYSUBR, (ftnint) 0,  $3, $4); }
        !           216:        | SFUNCTION new_proc entryname arglist
        !           217:                { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); }
        !           218:        | type SFUNCTION new_proc entryname arglist
        !           219:                { entrypt(CLPROC, $1, varleng, $4, $5); }
        !           220:        | SENTRY entryname arglist
        !           221:                 { if(parstate==OUTSIDE || procclass==CLMAIN
        !           222:                        || procclass==CLBLOCK)
        !           223:                                execerr("misplaced entry statement", CNULL);
        !           224:                  entrypt(CLENTRY, 0, (ftnint) 0, $2, $3);
        !           225:                }
        !           226:        ;
        !           227: 
        !           228: new_proc:
        !           229:                { newproc(); }
        !           230:        ;
        !           231: 
        !           232: entryname:  name
        !           233:                { $$ = newentry($1, 1); }
        !           234:        ;
        !           235: 
        !           236: name:    SNAME
        !           237:                { $$ = mkname(token); }
        !           238:        ;
        !           239: 
        !           240: progname:              { $$ = NULL; }
        !           241:        | entryname
        !           242:        ;
        !           243: 
        !           244: progarglist:
        !           245:          SLPAR SRPAR
        !           246:        | SLPAR progargs SRPAR
        !           247:        ;
        !           248: 
        !           249: progargs: progarg
        !           250:        | progargs SCOMMA progarg
        !           251:        ;
        !           252: 
        !           253: progarg:  SNAME
        !           254:        | SNAME SEQUALS SNAME
        !           255:        ;
        !           256: 
        !           257: arglist:
        !           258:                { $$ = 0; }
        !           259:        | SLPAR SRPAR
        !           260:                { NO66(" () argument list");
        !           261:                  $$ = 0; }
        !           262:        | SLPAR args SRPAR
        !           263:                {$$ = $2; }
        !           264:        ;
        !           265: 
        !           266: args:    arg
        !           267:                { $$ = ($1 ? mkchain((char *)$1,CHNULL) : CHNULL ); }
        !           268:        | args SCOMMA arg
        !           269:                { if($3) $1 = $$ = mkchain((char *)$3, $1); }
        !           270:        ;
        !           271: 
        !           272: arg:     name
        !           273:                { if($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG)
        !           274:                        dclerr("name declared as argument after use", $1);
        !           275:                  $1->vstg = STGARG;
        !           276:                }
        !           277:        | SSTAR
        !           278:                { NO66("altenate return argument");
        !           279: 
        !           280: /* substars   means that '*'ed formal parameters should be replaced.
        !           281:    This is used to specify alternate return labels; in theory, only
        !           282:    parameter slots which have '*' should accept the statement labels.
        !           283:    This compiler chooses to ignore the '*'s in the formal declaration, and
        !           284:    always return the proper value anyway.
        !           285: 
        !           286:    This variable is only referred to in   proc.c   */
        !           287: 
        !           288:                  $$ = 0;  substars = YES; }
        !           289:        ;
        !           290: 
        !           291: 
        !           292: 
        !           293: filename:   SHOLLERITH
        !           294:                {
        !           295:                char *s;
        !           296:                s = copyn(toklen+1, token);
        !           297:                s[toklen] = '\0';
        !           298:                $$ = s;
        !           299:                }
        !           300:        ;

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