|
|
1.1 root 1: expr: lhs
2: { if(((struct headbits *)$1)->tag == TCALL)
3: $1 = funcinv($1);
4: if(((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vtype==TYUNDEFINED && ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vext==0)
5: impldecl($1);
6: else if(((struct headbits *)$1)->tag==TNAME && ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vdcldone==0
7: && ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vext==0 && !inbound)
8: dclit($1);
9: if(((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vtype==TYFIELD)
10: $$ = extrfield($1);
11: }
12: | CONST
13: | logcon
14: { $$ = mkconst(TYLOG, ($1 == TRUE ? ".true." : ".false.") ); }
15: | specs parexprs
16: { $$ = typexpr($1,$2); }
17: | sizeof
18: | lengthof
19: | parexprs
20: { if( !ininit && ((struct headbits *)$1)->tag== TLIST)
21: $$ = compconst($1);
22: else ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->needpar = 1; }
23: | expr ADDOP expr
24: { $$ = mknode(TAROP,$2,$1,$3); }
25: | expr MULTOP expr
26: { $$ = mknode(TAROP,$2,$1,$3); }
27: | expr POWER expr
28: { $$ = mknode(TAROP,$2,$1,$3); }
29: | ADDOP expr %prec MULTOP
30: { if($1==OPMINUS)
31: $$ = mknode(TNEGOP,OPMINUS, $2, PNULL);
32: else $$ = $2; }
33: | DOUBLEADDOP lhs %prec MULTOP
34: { $$ = mknode(TASGNOP,$1,$2,mkint(1)); }
35: | expr RELOP expr
36: { $$ = mknode(TRELOP,$2,$1,$3); }
37: | expr OR expr
38: { $$ = mknode(TLOGOP,$2,$1,$3); }
39: | expr AND expr
40: { $$ = mknode(TLOGOP,$2,$1,$3); }
41: | NOT expr
42: { $$ = mknode(TNOTOP,$1,$2,PNULL); }
43: | lhs ASGNOP expr
44: { if(((struct headbits *)$1)->tag == TCALL)
45: {
46: exprerr("may not assign to a function", CNULL);
47: $$ = errnode();
48: }
49: else
50: $$ = mknode(TASGNOP,$2,$1,$3);
51: }
52: | expr REPOP expr
53: { $$ = mknode(TREPOP,0,$1,$3); }
54: | iostat
55: | error
56: { $$ = errnode(); }
57: ;
58:
59: lhs: lhs1
60: { if(((struct headbits *)$1)->tag==TNAME && ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vdcldone==0 &&
61: ((struct exprblock /*|| struct varblock */ *)$1)->vsubs==0 && ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vext==0 && !inbound)
62: dclit($1);
63: }
64: ;
65:
66: lhs1: lhsname
67: | lhsname parexprs
68: {
69: if(((struct headbits *)$2)->tag!=TLIST)
70: $2 = mknode(TLIST,0, mkchain($2,CHNULL), PNULL);
71: if(((struct exprblock /*|| struct varblock */ *)$1)->vdim)
72: {
73: if(((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vdcldone==0 && ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vext==0)
74: dclit($1);
75: $$ = (int *)subscript($1,$2);
76: }
77: else $$ = mkcall($1,$2);
78: }
79: | lhs QUALOP NAME
80: { $$ = strucelt($1,$3); }
81: | lhs QUALOP NAME parexprs
82: { if(((struct headbits *)$4)->tag != TLIST)
83: $4 = mknode(TLIST,0, mkchain($4,CHNULL), PNULL);
84: $$ = (int *)subscript(strucelt($1,$3), $4);
85: }
86: | lhs ARROW STRUCTNAME
87: { $$ = mkarrow($1,$3); }
88: ;
89:
90: lhsname: NAME
91: { if(((struct stentry *)$1)->varp == 0) mkvar($1);
92: if(inbound)
93: ((struct varblock *)((struct stentry *)$1)->varp)->vadjdim = 1;
94: if(((struct headbits *)$1)->tag == TLABEL)
95: {
96: laberr("attempt to use label as name",((struct stentry *)((struct stentry *)$1)->varp)->namep);
97: $$ = errnode();
98: }
99: else
100: $$ = cpexpr(((struct stentry *)$1)->varp);
101: }
102: ;
103:
104: parexprs: LPAR RPAR
105: { $$ = mknode(TLIST, 0, PNULL, PNULL); }
106: | LPAR expr RPAR
107: { $$ = $2; }
108: | LPAR exprlist RPAR
109: { $$ = mknode(TLIST,0,$2,PNULL); }
110: ;
111:
112: exprlist: expr COMMA expr
113: { $$ = (int *)mkchain($1, mkchain($3, CHNULL) ); }
114: | exprlist COMMA expr
115: { hookup($1, mkchain($3,CHNULL) ); }
116: ;
117:
118: sizeof: SIZEOF LPAR expr RPAR
119: { $$ = esizeof(((struct iostblock /*|| struct exprblock|| struct varblock */ *)$3)->vtype, ((struct exprblock /*|| struct varblock */ *)$3)->vtypep, ((struct exprblock /*|| struct varblock */ *)$3)->vdim);
120: frexpr($3); }
121: | SIZEOF LPAR specs RPAR
122: { if(((struct atblock *)$3)->attype==TYREAL && ((struct atblock *)$3)->atprec)
123: ((struct atblock *)$3)->attype = TYLREAL;
124: $$ = esizeof(((struct atblock *)$3)->attype, ((struct atblock *)$3)->attypep, ((struct atblock *)$3)->atdim);
125: cfree($3);
126: }
127: | SIZEOF LPAR CHARACTER RPAR
128: { $$ = mkint(tailor.ftnsize[FTNINT]/tailor.ftnchwd); }
129: ;
130:
131: lengthof: LENGTHOF LPAR expr RPAR
132: { $$ = elenof(((struct iostblock /*|| struct exprblock|| struct varblock */ *)$3)->vtype, ((struct exprblock /*|| struct varblock */ *)$3)->vtypep, ((struct exprblock /*|| struct varblock */ *)$3)->vdim);
133: frexpr($3); }
134: | LENGTHOF LPAR specs RPAR
135: { $$ = elenof(((struct atblock *)$3)->attype, ((struct atblock *)$3)->attypep, ((struct atblock *)$3)->atdim);
136: cfree($3);
137: }
138: | LENGTHOF LPAR CHARACTER RPAR
139: { $$ = mkint(1); }
140: ;
141:
142: logcon: logval
143: | QUALOP logval QUALOP
144: { $$ = $2; }
145: ;
146:
147: logval: TRUE
148: | FALSE
149: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.