Commit | Line | Data |
---|---|---|
eb5ad1d2 F |
1 | /* |
2 | * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH | |
3 | * JOHNSON AND RITCHIE FAMILIES OF SECOND PASSES | |
4 | */ | |
5 | ||
6 | #include "defs" | |
7 | ||
8 | #if FAMILY == SCJ | |
9 | # include "scjdefs" | |
10 | #else | |
11 | # include "dmrdefs" | |
12 | #endif | |
13 | ||
14 | /* | |
15 | char *ops [ ] = | |
16 | { | |
17 | "??", "+", "-", "*", "/", "**", "-", | |
18 | "OR", "AND", "EQV", "NEQV", "NOT", | |
19 | "CONCAT", | |
20 | "<", "==", ">", "<=", "!=", ">=", | |
21 | " of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ", | |
22 | " , ", " ? ", " : " | |
23 | " abs ", " min ", " max ", " addr ", " indirect ", | |
24 | " bitor ", " bitand ", " bitxor ", " bitnot ", " >> ", | |
25 | }; | |
26 | */ | |
27 | ||
28 | int ops2 [ ] = | |
29 | { | |
30 | P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG, | |
31 | P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT, | |
32 | P2BAD, | |
33 | P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE, | |
34 | P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD, | |
35 | P2COMOP, P2QUEST, P2COLON, | |
36 | P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, | |
37 | P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT | |
38 | }; | |
39 | ||
40 | ||
41 | int types2 [ ] = | |
42 | { | |
43 | P2BAD, P2INT|P2PTR, P2SHORT, P2LONG, P2REAL, P2DREAL, | |
44 | #if TARGET == INTERDATA | |
45 | P2BAD, P2BAD, P2LONG, P2CHAR, P2INT, P2BAD | |
46 | #else | |
47 | P2REAL, P2DREAL, P2LONG, P2CHAR, P2INT, P2BAD | |
48 | #endif | |
49 | }; | |
50 | ||
51 | ||
52 | setlog() | |
53 | { | |
54 | types2[TYLOGICAL] = types2[tylogical]; | |
55 | } | |
56 | ||
57 | ||
58 | putex1(p) | |
59 | expptr p; | |
60 | { | |
61 | putx( fixtype(p) ); | |
62 | templist = hookup(templist, holdtemps); | |
63 | holdtemps = NULL; | |
64 | } | |
65 | ||
66 | ||
67 | ||
68 | ||
69 | ||
70 | putassign(lp, rp) | |
71 | expptr lp, rp; | |
72 | { | |
73 | putx( fixexpr( mkexpr(OPASSIGN, lp, rp) )); | |
74 | } | |
75 | ||
76 | ||
77 | ||
78 | ||
79 | puteq(lp, rp) | |
80 | expptr lp, rp; | |
81 | { | |
82 | putexpr( mkexpr(OPASSIGN, lp, rp) ); | |
83 | } | |
84 | ||
85 | ||
86 | ||
87 | ||
88 | /* put code for a *= b */ | |
89 | ||
90 | putsteq(a, b) | |
91 | expptr a, b; | |
92 | { | |
93 | putx( fixexpr( mkexpr(OPSTAREQ, cpexpr(a), cpexpr(b)) )); | |
94 | } | |
95 | ||
96 | ||
97 | ||
98 | ||
99 | ||
100 | struct addrblock *realpart(p) | |
101 | register struct addrblock *p; | |
102 | { | |
103 | register struct addrblock *q; | |
104 | ||
105 | q = cpexpr(p); | |
106 | if( ISCOMPLEX(p->vtype) ) | |
107 | q->vtype += (TYREAL-TYCOMPLEX); | |
108 | return(q); | |
109 | } | |
110 | ||
111 | ||
112 | ||
113 | ||
114 | struct addrblock *imagpart(p) | |
115 | register struct addrblock *p; | |
116 | { | |
117 | register struct addrblock *q; | |
118 | struct constblock *mkrealcon(); | |
119 | ||
120 | if( ISCOMPLEX(p->vtype) ) | |
121 | { | |
122 | q = cpexpr(p); | |
123 | q->vtype += (TYREAL-TYCOMPLEX); | |
124 | q->memoffset = mkexpr(OPPLUS, q->memoffset, ICON(typesize[q->vtype])); | |
125 | } | |
126 | else | |
127 | q = mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , 0.0); | |
128 | return(q); | |
129 | } | |
130 | \f | |
131 | struct addrblock *putconst(p) | |
132 | register struct constblock *p; | |
133 | { | |
134 | register struct addrblock *q; | |
135 | struct literal *litp, *lastlit; | |
136 | int i, k, type; | |
137 | int litflavor; | |
138 | ||
139 | if( ! ISCONST(p) ) | |
140 | fatal1("putconst: bad tag %d", p->tag); | |
141 | ||
142 | q = ALLOC(addrblock); | |
143 | q->tag = TADDR; | |
144 | type = p->vtype; | |
145 | q->vtype = ( type==TYADDR ? TYINT : type ); | |
146 | q->vleng = cpexpr(p->vleng); | |
147 | q->vstg = STGCONST; | |
148 | q->memno = newlabel(); | |
149 | q->memoffset = ICON(0); | |
150 | ||
151 | /* check for value in literal pool, and update pool if necessary */ | |
152 | ||
153 | switch(type = p->vtype) | |
154 | { | |
155 | case TYCHAR: | |
156 | if(p->vleng->const.ci > XL) | |
157 | break; /* too long for literal table */ | |
158 | litflavor = 1; | |
159 | goto loop; | |
160 | ||
161 | case TYREAL: | |
162 | case TYDREAL: | |
163 | litflavor = 2; | |
164 | goto loop; | |
165 | ||
166 | case TYLOGICAL: | |
167 | type = tylogical; | |
168 | case TYSHORT: | |
169 | case TYLONG: | |
170 | litflavor = 3; | |
171 | ||
172 | loop: | |
173 | lastlit = litpool + nliterals; | |
174 | for(litp = litpool ; litp<lastlit ; ++litp) | |
175 | if(type == litp->littype) switch(litflavor) | |
176 | { | |
177 | case 1: | |
178 | if(p->vleng->const.ci != litp->litval.litcval.litclen) | |
179 | break; | |
180 | if(! eqn( (int) p->vleng->const.ci, p->const.ccp, | |
181 | litp->litval.litcval.litcstr) ) | |
182 | break; | |
183 | ||
184 | ret: | |
185 | q->memno = litp->litnum; | |
186 | frexpr(p); | |
187 | return(q); | |
188 | ||
189 | case 2: | |
190 | if(p->const.cd[0] == litp->litval.litdval) | |
191 | goto ret; | |
192 | break; | |
193 | ||
194 | case 3: | |
195 | if(p->const.ci == litp->litval.litival) | |
196 | goto ret; | |
197 | break; | |
198 | } | |
199 | if(nliterals < MAXLITERALS) | |
200 | { | |
201 | ++nliterals; | |
202 | litp->littype = type; | |
203 | litp->litnum = q->memno; | |
204 | switch(litflavor) | |
205 | { | |
206 | case 1: | |
207 | litp->litval.litcval.litclen = p->vleng->const.ci; | |
208 | cpn( (int) litp->litval.litcval.litclen, | |
209 | p->const.ccp, | |
210 | litp->litval.litcval.litcstr); | |
211 | break; | |
212 | ||
213 | case 2: | |
214 | litp->litval.litdval = p->const.cd[0]; | |
215 | break; | |
216 | ||
217 | case 3: | |
218 | litp->litval.litival = p->const.ci; | |
219 | break; | |
220 | } | |
221 | } | |
222 | default: | |
223 | break; | |
224 | } | |
225 | ||
226 | preven(typealign[ type==TYCHAR ? TYLONG : type ]); | |
227 | prlabel(asmfile, q->memno); | |
228 | ||
229 | k = 1; | |
230 | switch(type) | |
231 | { | |
232 | case TYLOGICAL: | |
233 | case TYSHORT: | |
234 | case TYLONG: | |
235 | prconi(asmfile, type, p->const.ci); | |
236 | break; | |
237 | ||
238 | case TYCOMPLEX: | |
239 | k = 2; | |
240 | case TYREAL: | |
241 | type = TYREAL; | |
242 | goto flpt; | |
243 | ||
244 | case TYDCOMPLEX: | |
245 | k = 2; | |
246 | case TYDREAL: | |
247 | type = TYDREAL; | |
248 | ||
249 | flpt: | |
250 | for(i = 0 ; i < k ; ++i) | |
251 | prconr(asmfile, type, p->const.cd[i]); | |
252 | break; | |
253 | ||
254 | case TYCHAR: | |
255 | putstr(asmfile, p->const.ccp, p->vleng->const.ci); | |
256 | break; | |
257 | ||
258 | case TYADDR: | |
259 | prcona(asmfile, p->const.ci); | |
260 | break; | |
261 | ||
262 | default: | |
263 | fatal1("putconst: bad type %d", p->vtype); | |
264 | } | |
265 | ||
266 | frexpr(p); | |
267 | return( q ); | |
268 | } | |
269 | \f | |
270 | /* | |
271 | * put out a character string constant. begin every one on | |
272 | * a long integer boundary, and pad with nulls | |
273 | */ | |
274 | putstr(fp, s, n) | |
275 | FILEP fp; | |
276 | char *s; | |
277 | ftnint n; | |
278 | { | |
279 | int b[SZSHORT]; | |
280 | int i; | |
281 | ||
282 | i = 0; | |
283 | while(--n >= 0) | |
284 | { | |
285 | b[i++] = *s++; | |
286 | if(i == SZSHORT) | |
287 | { | |
288 | prchars(fp, b); | |
289 | i = 0; | |
290 | } | |
291 | } | |
292 | ||
293 | while(i < SZSHORT) | |
294 | b[i++] = '\0'; | |
295 | prchars(fp, b); | |
296 | } |