![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to print.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 41BSD / cmd / efl|
Return to print.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / efl |
1.1 root 1: #include "defs"
2:
3: char *ops[ ] = { "", "+", "-", "*", "/", "**",
4: ".not. ", " .and. ", ".andand.", ".oror.", " .or. ",
5: " .eq. ", " .lt. ", " .gt. ", " .le. ", " .ge. ", " .ne. ",
6: "(", ")", " = ", ", " };
7:
8: int opprecs[ ] = { 0, 7, 7, 8, 8, 9, 5, 4, 4, 3, 3,
9: 6, 6, 6, 6, 6, 6, 10, 10, 1, 0 };
10:
11: char *qualops[ ] = { "", "->", ".", " of ", " sub " };
12:
13:
14: char *classes[ ] = { "", "arg ", "valarg ", "static ", "auto ",
15: "common ", "mos ", "external ", "statement function " };
16:
17: char *precs[ ] = { "", "long " };
18:
19: char *types[ ] = { "", "integer ", "real ", "double precision ", "logical ",
20: "complex ", "char ", "type " };
21:
22: char *ftntypes[] = { "integer ", "real ", "logical ", "complex ",
23: "double precision ", 0, 0 };
24:
25:
26: char *langs[] = { "pfort", "ratfor", "efl"};
27:
28:
29: propts()
30: {
31: fprintf(diagfile, "Options: ");
32: fprintf(diagfile, "%s ", langs[langopt]);
33: fprintf(diagfile, "%s ", (dbgopt ? "debug" : "ndebug") );
34: fprintf(diagfile, "%s ", (dotsopt? "dotson" : "dotsoff") );
35: fprintf(diagfile, "\n");
36: }
37:
38:
39:
40:
41: prexpr(e)
42: ptr e;
43: {
44: if(e) prexp1(e, 0,0,0);
45: }
46:
47:
48:
49:
50:
51: prexp1(e, prec, subt, leftside)
52: register ptr e;
53: int prec, subt, leftside;
54: {
55: ptr p, q;
56: int prec1, needpar;
57:
58: needpar = 0;
59:
60: switch(e->tag)
61: {
62: case TERROR:
63: break;
64:
65: case TCONST:
66: TEST fprintf(diagfile, "%s", e->leftp);
67: if(e->rightp)
68: putzcon(e);
69: else
70: putconst(e->vtype, e->leftp);
71: break;
72:
73: case TFTNBLOCK:
74: putname(e);
75: break;
76:
77: case TNAME:
78: if(e->sthead == 0) fatal("name without entry");
79: TEST fprintf(diagfile, "%s", e->sthead->namep);
80: putname(e);
81: if(e->vsubs)
82: prexp1(e->vsubs, 0,0,0);
83: break;
84:
85: case TTEMP:
86: TEST fprintf(diagfile, "(fakename %o)", e);
87: putname(e);
88: break;
89:
90: case TLIST:
91: if(e->leftp == 0) break;
92: TEST fprintf(diagfile, "( ");
93: putic(ICOP, OPLPAR);
94: for(p=e->leftp ; p!=0 ; p = p->nextp)
95: {
96: prexp1(p->datap, 0,0,0);
97: if(p->nextp)
98: {
99: TEST fprintf(diagfile, " , ");
100: putic(ICOP, OPCOMMA);
101: }
102: }
103: TEST fprintf(diagfile, " )");
104: putic(ICOP, OPRPAR);
105: break;
106:
107: case TSTFUNCT:
108: fprintf(diagfile, "statement function ");
109: prexp1(e->leftp, 0,0,0);
110: TEST fprintf(diagfile, " = ");
111: putic(ICOP, OPEQUALS);
112: prexp1(e->rightp, 0,0,0);
113: break;
114:
115: case TAROP:
116: if(e->subtype==OPSTAR && e->leftp->tag!=TCONST && e->rightp->tag==TCONST)
117: {
118: q = e->leftp;
119: e->leftp = e->rightp;
120: e->rightp = q;
121: }
122: case TLOGOP:
123: prec1 = opprecs[e->subtype];
124: goto print;
125: case TNOTOP:
126: prec1 = 5;
127: if(prec > 1) /* force parens */
128: needpar = 1;
129: goto print;
130: case TNEGOP:
131: if(prec > 1) /* force parens */
132: needpar = 1;
133: prec1 = 8;
134: goto print;
135: case TASGNOP:
136: prec1 = 1;
137: goto print;
138: case TRELOP:
139: prec1 = 6;
140: goto print;
141: case TCALL:
142: prec1 = 10;
143: goto print;
144: case TREPOP:
145: prec1 = 2;
146: goto print;
147:
148: print:
149: if(prec1 < prec )
150: needpar = 1;
151: else if(prec1 == prec)
152: if(e->needpar)
153: needpar = 1;
154: else if(subt == e->subtype)
155: needpar |= ! (e->tag==TLOGOP || leftside || subt==0
156: || subt==OPPLUS || subt==OPSTAR);
157: else needpar |= ! (leftside || subt==OPPLUS || subt==OPSTAR);
158:
159: if(needpar)
160: {
161: putic(ICOP,OPLPAR);
162: TEST fprintf(diagfile, "(");
163: }
164:
165: if(e->rightp != 0)
166: {
167: prexp1(e->leftp, prec1, e->subtype, 1);
168: switch(e->tag) {
169: case TASGNOP:
170: TEST fprintf(diagfile, "=");
171: putic(ICOP, OPEQUALS);
172: if(e->subtype != 0)
173: prexp1(e->leftp, prec1, 0, 1);
174:
175: case TAROP:
176: case TNEGOP:
177: case TLOGOP:
178: case TNOTOP:
179: case TRELOP:
180: if(e->subtype)
181: {
182: TEST fprintf(diagfile, " %s ", ops[e->subtype]);
183: putic(ICOP, e->subtype);
184: }
185: break;
186:
187: case TCALL:
188: TEST fprintf(diagfile, " %s ", qualops[e->subtype]);
189: break;
190:
191: case TREPOP:
192: TEST fprintf(diagfile, "$");
193: break;
194: }
195:
196: prexp1(e->rightp, prec1,e->subtype, 0);
197: }
198: else { /* e->rightp == 0 */
199: TEST fprintf(diagfile, " %s ", ops[e->subtype]);
200: putic(ICOP, e->subtype);
201: prexp1(e->leftp, prec1,e->subtype, 0);
202: }
203: if(needpar)
204: {
205: putic(ICOP, OPRPAR);
206: TEST fprintf(diagfile, ")");
207: }
208: break;
209:
210: default:
211: badtag("prexp1", e->tag);
212: break;
213: }
214: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.