gram.c

把fortran语言编的程序转为c语言编的程序, 运行环境linux

/* # line 311 "gram.in" */
{ if(parstate==OUTSIDE || procclass==CLMAIN
			|| procclass==CLBLOCK)
				execerr("misplaced entry statement", CNULL);
		  entrypt(CLENTRY, 0, (ftnint) 0, yypvt[-1].extval, yypvt[-0].chval);
		} break;
case 18:
/* # line 319 "gram.in" */
{ newproc(); } break;
case 19:
/* # line 323 "gram.in" */
{ yyval.extval = newentry(yypvt[-0].namval, 1); } break;
case 20:
/* # line 327 "gram.in" */
{ yyval.namval = mkname(token); } break;
case 21:
/* # line 330 "gram.in" */
{ yyval.extval = NULL; } break;
case 29:
/* # line 348 "gram.in" */
{ yyval.chval = 0; } break;
case 30:
/* # line 350 "gram.in" */
{ NO66(" () argument list");
		  yyval.chval = 0; } break;
case 31:
/* # line 353 "gram.in" */
{yyval.chval = yypvt[-1].chval; } break;
case 32:
/* # line 357 "gram.in" */
{ yyval.chval = (yypvt[-0].namval ? mkchain((char *)yypvt[-0].namval,CHNULL) : CHNULL ); } break;
case 33:
/* # line 359 "gram.in" */
{ if(yypvt[-0].namval) yypvt[-2].chval = yyval.chval = mkchain((char *)yypvt[-0].namval, yypvt[-2].chval); } break;
case 34:
/* # line 363 "gram.in" */
{ if(yypvt[-0].namval->vstg!=STGUNKNOWN && yypvt[-0].namval->vstg!=STGARG)
			dclerr("name declared as argument after use", yypvt[-0].namval);
		  yypvt[-0].namval->vstg = STGARG;
		} break;
case 35:
/* # line 368 "gram.in" */
{ NO66("altenate return argument");

/* substars   means that '*'ed formal parameters should be replaced.
   This is used to specify alternate return labels; in theory, only
   parameter slots which have '*' should accept the statement labels.
   This compiler chooses to ignore the '*'s in the formal declaration, and
   always return the proper value anyway.

   This variable is only referred to in   proc.c   */

		  yyval.namval = 0;  substars = YES; } break;
case 36:
/* # line 384 "gram.in" */
{
		char *s;
		s = copyn(toklen+1, token);
		s[toklen] = '\0';
		yyval.charpval = s;
		} break;
case 45:
/* # line 400 "gram.in" */
{ NO66("SAVE statement");
		  saveall = YES; } break;
case 46:
/* # line 403 "gram.in" */
{ NO66("SAVE statement"); } break;
case 47:
/* # line 405 "gram.in" */
{ fmtstmt(thislabel); setfmt(thislabel); } break;
case 48:
/* # line 407 "gram.in" */
{ NO66("PARAMETER statement"); } break;
case 49:
/* # line 411 "gram.in" */
{ settype(yypvt[-4].namval, yypvt[-6].ival, yypvt[-0].lval);
		  if(ndim>0) setbound(yypvt[-4].namval,ndim,dims);
		} break;
case 50:
/* # line 415 "gram.in" */
{ settype(yypvt[-2].namval, yypvt[-4].ival, yypvt[-0].lval);
		  if(ndim>0) setbound(yypvt[-2].namval,ndim,dims);
		} break;
case 51:
/* # line 419 "gram.in" */
{ if (new_dcl == 2) {
			err("attempt to give DATA in type-declaration");
			new_dcl = 1;
			}
		} break;
case 52:
/* # line 426 "gram.in" */
{ new_dcl = 2; } break;
case 53:
/* # line 429 "gram.in" */
{ varleng = yypvt[-0].lval; } break;
case 54:
/* # line 433 "gram.in" */
{ varleng = (yypvt[-0].ival<0 || ONEOF(yypvt[-0].ival,M(TYLOGICAL)|M(TYLONG))
				? 0 : typesize[yypvt[-0].ival]);
		  vartype = yypvt[-0].ival; } break;
case 55:
/* # line 438 "gram.in" */
{ yyval.ival = TYLONG; } break;
case 56:
/* # line 439 "gram.in" */
{ yyval.ival = tyreal; } break;
case 57:
/* # line 440 "gram.in" */
{ ++complex_seen; yyval.ival = tycomplex; } break;
case 58:
/* # line 441 "gram.in" */
{ yyval.ival = TYDREAL; } break;
case 59:
/* # line 442 "gram.in" */
{ ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); yyval.ival = TYDCOMPLEX; } break;
case 60:
/* # line 443 "gram.in" */
{ yyval.ival = TYLOGICAL; } break;
case 61:
/* # line 444 "gram.in" */
{ NO66("CHARACTER statement"); yyval.ival = TYCHAR; } break;
case 62:
/* # line 445 "gram.in" */
{ yyval.ival = TYUNKNOWN; } break;
case 63:
/* # line 446 "gram.in" */
{ yyval.ival = TYUNKNOWN; } break;
case 64:
/* # line 447 "gram.in" */
{ NOEXT("AUTOMATIC statement"); yyval.ival = - STGAUTO; } break;
case 65:
/* # line 448 "gram.in" */
{ NOEXT("STATIC statement"); yyval.ival = - STGBSS; } break;
case 66:
/* # line 449 "gram.in" */
{ yyval.ival = TYINT1; } break;
case 67:
/* # line 453 "gram.in" */
{ yyval.lval = varleng; } break;
case 68:
/* # line 455 "gram.in" */
{
		expptr p;
		p = yypvt[-1].expval;
		NO66("length specification *n");
		if( ! ISICON(p) || p->constblock.Const.ci <= 0 )
			{
			yyval.lval = 0;
			dclerr("length must be a positive integer constant",
				NPNULL);
			}
		else {
			if (vartype == TYCHAR)
				yyval.lval = p->constblock.Const.ci;
			else switch((int)p->constblock.Const.ci) {
				case 1:	yyval.lval = 1; break;
				case 2: yyval.lval = typesize[TYSHORT];	break;
				case 4: yyval.lval = typesize[TYLONG];	break;
				case 8: yyval.lval = typesize[TYDREAL];	break;
				case 16: yyval.lval = typesize[TYDCOMPLEX]; break;
				default:
					dclerr("invalid length",NPNULL);
					yyval.lval = varleng;
				}
			}
		} break;
case 69:
/* # line 481 "gram.in" */
{ NO66("length specification *(*)"); yyval.lval = -1; } break;
case 70:
/* # line 485 "gram.in" */
{ incomm( yyval.extval = comblock("") , yypvt[-0].namval ); } break;
case 71:
/* # line 487 "gram.in" */
{ yyval.extval = yypvt[-1].extval;  incomm(yypvt[-1].extval, yypvt[-0].namval); } break;
case 72:
/* # line 489 "gram.in" */
{ yyval.extval = yypvt[-2].extval;  incomm(yypvt[-2].extval, yypvt[-0].namval); } break;
case 73:
/* # line 491 "gram.in" */
{ incomm(yypvt[-2].extval, yypvt[-0].namval); } break;
case 74:
/* # line 495 "gram.in" */
{ yyval.extval = comblock(""); } break;
case 75:
/* # line 497 "gram.in" */
{ yyval.extval = comblock(token); } break;
case 76:
/* # line 501 "gram.in" */
{ setext(yypvt[-0].namval); } break;
case 77:
/* # line 503 "gram.in" */
{ setext(yypvt[-0].namval); } break;
case 78:
/* # line 507 "gram.in" */
{ NO66("INTRINSIC statement"); setintr(yypvt[-0].namval); } break;
case 79:
/* # line 509 "gram.in" */
{ setintr(yypvt[-0].namval); } break;
case 82:
/* # line 517 "gram.in" */
{
		struct Equivblock *p;
		if(nequiv >= maxequiv)
			many("equivalences", 'q', maxequiv);
		p  =  & eqvclass[nequiv++];
		p->eqvinit = NO;
		p->eqvbottom = 0;
		p->eqvtop = 0;
		p->equivs = yypvt[-1].eqvval;
		} break;
case 83:
/* # line 530 "gram.in" */
{ yyval.eqvval=ALLOC(Eqvchain);
		  yyval.eqvval->eqvitem.eqvlhs = (struct Primblock *)yypvt[-0].expval;
		} break;
case 84:
/* # line 534 "gram.in" */
{ yyval.eqvval=ALLOC(Eqvchain);
		  yyval.eqvval->eqvitem.eqvlhs = (struct Primblock *) yypvt[-0].expval;
		  yyval.eqvval->eqvnextp = yypvt[-2].eqvval;
		} break;
case 87:
/* # line 545 "gram.in" */
{ if(parstate == OUTSIDE)
			{
			newproc();
			startproc(ESNULL, CLMAIN);
			}
		  if(parstate < INDATA)
			{
			enddcl();
			parstate = INDATA;
			datagripe = 1;
			}
		} break;
case 88:
/* # line 560 "gram.in" */
{ ftnint junk;
		  if(nextdata(&junk) != NULL)
			err("too few initializers");
		  frdata(yypvt[-4].chval);
		  frrpl();
		} break;
case 89:
/* # line 568 "gram.in" */
{ frchain(&datastack); curdtp = 0; } break;
case 90:
/* # line 570 "gram.in" */
{ pop_datastack(); } break;
case 91:
/* # line 572 "gram.in" */
{ toomanyinit = NO; } break;
case 94:
/* # line 577 "gram.in" */
{ dataval(ENULL, yypvt[-0].expval); } break;
case 95:
/* # line 579 "gram.in" */
{ dataval(yypvt[-2].expval, yypvt[-0].expval); } break;
case 97:
/* # line 584 "gram.in" */
{ if( yypvt[-1].ival==OPMINUS && ISCONST(yypvt[-0].expval) )
			consnegop((Constp)yypvt[-0].expval);
		  yyval.expval = yypvt[-0].expval;
		} break;
case 101:
/* # line 596 "gram.in" */
{ int k;
		  yypvt[-0].namval->vsave = YES;
		  k = yypvt[-0].namval->vstg;
		if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
			dclerr("can only save static variables", yypvt[-0].namval);
		} break;
case 105:
/* # line 610 "gram.in" */
{ if(yypvt[-2].namval->vclass == CLUNKNOWN)
			make_param((struct Paramblock *)yypvt[-2].namval, yypvt[-0].expval);
		  else dclerr("cannot make into parameter", yypvt[-2].namval);
		} break;
case 106:
/* # line 617 "gram.in" */
{ if(ndim>0) setbound(yypvt[-1].namval, ndim, dims); } break;
case 107:
/* # line 621 "gram.in" */
{ Namep np;
		  np = ( (struct Primblock *) yypvt[-0].expval) -> namep;
		  vardcl(np);
		  if(np->vstg == STGCOMMON)
			extsymtab[np->vardesc.varno].extinit = YES;
		  else if(np->vstg==STGEQUIV)
			eqvclass[np->vardesc.varno].eqvinit = YES;
		  else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
			dclerr("inconsistent storage classes", np);
		  yyval.chval = mkchain((char *)yypvt[-0].expval, CHNULL);
		} break;
case 108:
/* # line 633 "gram.in" */
{ chainp p; struct Impldoblock *q;
		pop_datastack();
		q = ALLOC(Impldoblock);
		q->tag = TIMPLDO;
		(q->varnp = (Namep) (yypvt[-1].chval->datap))->vimpldovar = 1;
		p = yypvt[-1].chval->nextp;
		if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
		if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
		if(p)  { q->impstep = (expptr)(p->datap); }
		frchain( & (yypvt[-1].chval) );
		yyval.chval = mkchain((char *)q, CHNULL);
		q->datalist = hookup(yypvt[-3].chval, yyval.chval);
		} break;
case 109:
/* # line 649 "gram.in" */
{ if (!datastack)
			curdtp = 0;
		  datastack = mkchain((char *)curdtp, datastack);
		  curdtp = yypvt[-0].chval; curdtelt = 0;
		  } break;
case 110:
/* # line 655 "gram.in" */
{ yyval.chval = hookup(yypvt[-2].chval, yypvt[-0].chval); } break;
case 111:
/* # line 659 "gram.in" */
{ ndim = 0; } break;
case 113:
/* # line 663 "gram.in" */
{ ndim = 0; } break;
case 116:
/* # line 668 "gram.in" */
{
		  if(ndim == maxdim)
			err("too many dimensions");
		  else if(ndim < maxdim)
			{ dims[ndim].lb = 0;
			  dims[ndim].ub = yypvt[-0].expval;
			}
		  ++ndim;
		} break;
case 117:
/* # line 678 "gram.in" */
{
		  if(ndim == maxdim)
			err("too many dimensions");
		  else if(ndim < maxdim)
			{ dims[ndim].lb = yypvt[-2].expval;
			  dims[ndim].ub = yypvt[-0].expval;
			}
		  ++ndim;
		} break;
case 118:
/* # line 690 "gram.in" */
{ yyval.expval = 0; } break;
case 120:
/* # line 695 "gram.in" */
{ nstars = 1; labarray[0] = yypvt[-0].labval; } break;
case 121:
/* # line 697 "gram.in" */
{ if(nstars < maxlablist)  labarray[nstars++] = yypvt[-0].labval; } break;
case 122:
/* # line 701 "gram.in" */
{ yyval.labval = execlab( convci(toklen, token) ); } break;
case 123:
/* # line 705 "gram.in" */
{ NO66("IMPLICIT statement"); } break;
case 126:
/* # line 711 "gram.in" */
{ if (vartype != TYUNKNOWN)
			dclerr("-- expected letter range",NPNULL);
		  setimpl(vartype, varleng, 'a', 'z'); } break;
case 127:
/* # line 716 "gram.in" */
{ needkwd = 1; } break;
case 131:
/* # line 725 "gram.in" */
{ setimpl(vartype, varleng, yypvt[-0].ival, yypvt[-0].ival); } break;
case 132:
/* # line 727 "gram.in" */
{ setimpl(vartype, varleng, yypvt[-2].ival, yypvt[-0].ival); } break;
case 133:
/* # line 731 "gram.in" */
{ if(toklen!=1 || token[0]<'a' || token[0]>'z')
			{
			dclerr("implicit item must be single letter", NPNULL);
			yyval.ival = 0;
			}
		  else yyval.ival = token[0];
		} break;
case 136:
/* # line 745 "gram.in" */
{
		if(yypvt[-2].namval->vclass == CLUNKNOWN)
			{
			yypvt[-2].namval->vclass = CLNAMELIST;
			yypvt[-2].namval->vtype = TYINT;
			yypvt[-2].namval->vstg = STGBSS;
			yypvt[-2].namval->varxptr.namelist = yypvt[-0].chval;
			yypvt[-2].namval->vardesc.varno = ++lastvarno;
			}
		else dclerr("cannot be a namelist name", yypvt[-2].namval);
		} break;
case 137:
/* # line 759 "gram.in" */
{ yyval.chval = mkchain((char *)yypvt[-0].namval, CHNULL); } break;
case 138:
/* # line 761 "gram.in" */
{ yyval.chval = hookup(yypvt[-2].chval, mkchain((char *)yypvt[-0].namval, CHNULL)); } break;
case 139:
/* # line 765 "gram.in" */
{ switch(parstate)
			{
			case OUTSIDE:	newproc();
					startproc(ESNULL, CLMAIN);
			case INSIDE:	parstate = INDCL;
			case INDCL:	break;

			case INDATA:
				if (datagripe) {
					errstr(
				"Statement order error: declaration after DATA",
						CNULL);
					datagripe = 0;
					}
				break;

			default:
				dclerr("declaration among executables", NPNULL);
			}
		} break;
case 140:
/* # line 787 "gram.in" */
{ yyval.chval = 0; } break;
case 141:
/* # line 789 "gram.in" */
{ yyval.chval = revchain(yypvt[-0].chval); } break;
case 142:
/* # line 793 "gram.in" */
{ yyval.chval = mkchain((char *)yypvt[-0].expval, CHNULL); } break;
case 143:
/* # line 795 "gram.in" */
{ yyval.chval = mkchain((char *)yypvt[-0].expval, yypvt[-2].chval); } break;
case 145:
/* # line 800 "gram.in" */
{ yyval.expval = yypvt[-1].expval; if (yyval.expval->tag == TPRIM)
					yyval.expval->primblock.parenused = 1; } break;
case 149:
/* # line 808 "gram.in" */
{ yyval.expval = mkexpr(yypvt[-1].ival, yypvt[-2].expval, yypvt[-0].expval); } break;
case 150:
/* # line 810 "gram.in" */
{ yyval.expval = mkexpr(OPSTAR, yypvt[-2].expval, yypvt[-0].expval); } break;
case 151:
/* # line 812 "gram.in" */
{ yyval.expval = mkexpr(OPSLASH, yypvt[-2].expval, yypvt[-0].expval); } break;
case 152:
/* # line 814 "gram.in" */
{ yyval.expval = mkexpr(OPPOWER, yypvt[-2].expval, yypvt[-0].expval); } break;