1*47957Sbostic/*- 2*47957Sbostic * Copyright (c) 1980 The Regents of the University of California. 3*47957Sbostic * All rights reserved. 422824Smckusick * 5*47957Sbostic * %sccs.include.proprietary.c% 6*47957Sbostic * 7*47957Sbostic * @(#)gram.exec 5.3 (Berkeley) 04/12/91 822824Smckusick */ 922824Smckusick 1022824Smckusick/* 1122824Smckusick * gram.exec 1222824Smckusick * 1322824Smckusick * Grammar for executable statements, f77 compiler pass 1, 4.2 BSD. 1422824Smckusick * 1522824Smckusick * University of Utah CS Dept modification history: 1622824Smckusick * 1722824Smckusick * $Log: gram.exec,v $ 1825738Sdonn * Revision 5.2 85/12/18 20:17:38 donn 1925738Sdonn * Modified end_spec to insist on parser state INEXEC after seeing an 2025738Sdonn * executable statement. This allows us to limit statement functions to 2125738Sdonn * parser state INDATA. 2225738Sdonn * 2325738Sdonn * Revision 5.1 85/08/10 03:47:22 donn 2425738Sdonn * 4.3 alpha 2525738Sdonn * 2622824Smckusick * Revision 3.1 84/10/13 00:36:41 donn 2722824Smckusick * Installed Jerry Berkman's version; preserved comment header. 2822824Smckusick * 2922824Smckusick * Revision 1.3 84/08/06 18:38:43 donn 3022824Smckusick * Fixed a bug in Jerry Berkman's label fixes which caused the same label to 3122824Smckusick * be generated twice for some types of logical IF statements. 3222824Smckusick * 3322824Smckusick * Revision 1.2 84/08/04 21:09:57 donn 3422824Smckusick * Added fixes from Jerry Berkman to allow proper ASSIGNS from format 3522824Smckusick * statement numbers. 3622824Smckusick * 3722824Smckusick */ 3822824Smckusick 3922824Smckusickexec: iffable 4022824Smckusick | SDO end_spec intonlyon label intonlyoff opt_comma dospec 4122824Smckusick { 4222824Smckusick if( !do_name_err ) { 4322824Smckusick if($4->labdefined) 4422824Smckusick execerr("no backward DO loops", CNULL); 4522824Smckusick $4->blklevel = blklevel+1; 4622824Smckusick exdo($4->labelno, $7); 4722824Smckusick } 4822824Smckusick } 4922824Smckusick | logif iffable 5022824Smckusick { exendif(); thiswasbranch = NO; } 5122824Smckusick | logif STHEN 5222824Smckusick | SELSEIF end_spec SLPAR expr SRPAR STHEN 5322824Smckusick { exelif($4); lastwasbranch = NO; } 5422824Smckusick | SELSE end_spec 5522824Smckusick { exelse(); lastwasbranch = NO; } 5622824Smckusick | SENDIF end_spec 5722824Smckusick { exendif(); lastwasbranch = NO; } 5822824Smckusick ; 5922824Smckusick 6022824Smckusicklogif: SLOGIF end_spec SLPAR expr SRPAR 6122824Smckusick { exif($4); } 6222824Smckusick ; 6322824Smckusick 6422824Smckusickdospec: name SEQUALS exprlist 6522824Smckusick { if( $1->vclass != CLPARAM ) { 6622824Smckusick $$ = mkchain($1, $3); 6722824Smckusick do_name_err = 0; 6822824Smckusick } else { 6922824Smckusick err("symbolic constant not allowed as DO variable"); 7022824Smckusick do_name_err = 1; 7122824Smckusick } 7222824Smckusick } 7322824Smckusick ; 7422824Smckusick 7522824Smckusickiffable: let lhs SEQUALS expr 7622824Smckusick { exequals($2, $4); } 7722824Smckusick | SASSIGN end_spec assignlabel STO name 7822824Smckusick { if( $5->vclass != CLPARAM ) { 7922824Smckusick exassign($5, $3); 8022824Smckusick } else { 8122824Smckusick err("can only assign to a variable"); 8222824Smckusick } 8322824Smckusick } 8422824Smckusick | SCONTINUE end_spec 8522824Smckusick | goto 8622824Smckusick | io 8722824Smckusick { inioctl = NO; } 8822824Smckusick | SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label 8922824Smckusick { exarif($4, $6, $8, $10); thiswasbranch = YES; } 9022824Smckusick | call 9122824Smckusick { excall($1, PNULL, 0, labarray); } 9222824Smckusick | call SLPAR SRPAR 9322824Smckusick { excall($1, PNULL, 0, labarray); } 9422824Smckusick | call SLPAR callarglist SRPAR 9522824Smckusick { if(nstars < MAXLABLIST) 9622824Smckusick excall($1, mklist($3), nstars, labarray); 9722824Smckusick else 9822824Smckusick err("too many alternate returns"); 9922824Smckusick } 10022824Smckusick | SRETURN end_spec opt_expr 10122824Smckusick { exreturn($3); thiswasbranch = YES; } 10222824Smckusick | stop end_spec opt_expr 10322824Smckusick { exstop($1, $3); thiswasbranch = $1; } 10422824Smckusick ; 10522824Smckusick 10622824Smckusickassignlabel: SICON 10722824Smckusick { $$ = mklabel( convci(toklen, token) ); } 10822824Smckusick ; 10922824Smckusick 11022824Smckusicklet: SLET 11122824Smckusick { if(parstate == OUTSIDE) 11222824Smckusick { 11322824Smckusick newproc(); 11422824Smckusick startproc(PNULL, CLMAIN); 11522824Smckusick } 11622824Smckusick if( yystno != 0 && thislabel->labtype != LABFORMAT) 11722824Smckusick if (optimflag) 11822824Smckusick optbuff (SKLABEL, 0, thislabel->labelno, 1); 11922824Smckusick else 12022824Smckusick putlabel(thislabel->labelno); 12122824Smckusick } 12222824Smckusick ; 12322824Smckusick 12422824Smckusickgoto: SGOTO end_spec label 12522824Smckusick { exgoto($3); thiswasbranch = YES; } 12622824Smckusick | SASGOTO end_spec name 12722824Smckusick { if( $3->vclass != CLPARAM ) { 12822824Smckusick exasgoto($3); thiswasbranch = YES; 12922824Smckusick } else { 13022824Smckusick err("must go to label or assigned variable"); 13122824Smckusick } 13222824Smckusick } 13322824Smckusick | SASGOTO end_spec name opt_comma SLPAR labellist SRPAR 13422824Smckusick { if( $3->vclass != CLPARAM ) { 13522824Smckusick exasgoto($3); thiswasbranch = YES; 13622824Smckusick } else { 13722824Smckusick err("must go to label or assigned variable"); 13822824Smckusick } 13922824Smckusick } 14022824Smckusick | SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr 14122824Smckusick { if(nstars < MAXLABLIST) 14222824Smckusick if (optimflag) 14322824Smckusick optbuff (SKCMGOTO, fixtype($7), nstars, labarray); 14422824Smckusick else 14522824Smckusick putcmgo (fixtype($7), nstars, labarray); 14622824Smckusick else 14722824Smckusick err("computed GOTO list too long"); 14822824Smckusick } 14922824Smckusick ; 15022824Smckusick 15122824Smckusickopt_comma: 15222824Smckusick | SCOMMA 15322824Smckusick ; 15422824Smckusick 15522824Smckusickcall: SCALL end_spec name 15622824Smckusick { nstars = 0; $$ = $3; } 15722824Smckusick ; 15822824Smckusick 15922824Smckusickcallarglist: callarg 16022824Smckusick { $$ = ($1 ? mkchain($1,CHNULL) : CHNULL); } 16122824Smckusick | callarglist SCOMMA callarg 16222824Smckusick { if($3) 16322824Smckusick if($1) $$ = hookup($1, mkchain($3,CHNULL)); 16422824Smckusick else $$ = mkchain($3,CHNULL); 16522824Smckusick else 16622824Smckusick $$ = $1; 16722824Smckusick } 16822824Smckusick ; 16922824Smckusick 17022824Smckusickcallarg: expr 17122824Smckusick | SSTAR label 17222824Smckusick { if(nstars<MAXLABLIST) labarray[nstars++] = $2; $$ = 0; } 17322824Smckusick ; 17422824Smckusick 17522824Smckusickstop: SPAUSE 17622824Smckusick { $$ = 0; } 17722824Smckusick | SSTOP 17822824Smckusick { $$ = 1; } 17922824Smckusick ; 18022824Smckusick 18122824Smckusickexprlist: expr 18222824Smckusick { $$ = mkchain($1, CHNULL); } 18322824Smckusick | exprlist SCOMMA expr 18422824Smckusick { $$ = hookup($1, mkchain($3,CHNULL) ); } 18522824Smckusick ; 18622824Smckusick 18722824Smckusickend_spec: 18822824Smckusick { if(parstate == OUTSIDE) 18922824Smckusick { 19022824Smckusick newproc(); 19122824Smckusick startproc(PNULL, CLMAIN); 19222824Smckusick } 19322824Smckusick if(parstate < INDATA) enddcl(); 19425738Sdonn parstate = INEXEC; 19522824Smckusick if( yystno != 0 && thislabel->labtype != LABFORMAT) 19622824Smckusick if (optimflag) 19722824Smckusick optbuff (SKLABEL, 0, thislabel->labelno, 1); 19822824Smckusick else 19922824Smckusick putlabel(thislabel->labelno); 20022824Smckusick yystno = 0; 20122824Smckusick } 20222824Smckusick ; 20322824Smckusick 20422824Smckusickintonlyon: 20522824Smckusick { intonly = YES; } 20622824Smckusick ; 20722824Smckusick 20822824Smckusickintonlyoff: 20922824Smckusick { intonly = NO; } 21022824Smckusick ; 211