Commit | Line | Data |
---|---|---|
0d57d6f5 TL |
1 | #include "defs" |
2 | #if OUTPUT==BINARY | |
3 | # include "scjdefs" | |
4 | #endif | |
5 | ||
6 | /* | |
7 | PDP11-780/VAX - SPECIFIC PRINTING ROUTINES | |
8 | */ | |
9 | ||
10 | static char textline[50]; | |
11 | int maxregvar = MAXREGVAR; | |
12 | int regnum[] = { 11, 10, 9, 8, 7, 6 } ; | |
13 | static int regmask[] = { 0, 0x800, 0xc00, 0xe00, 0xf00, 0xf80, 0xfc0 }; | |
14 | ||
15 | ||
16 | ||
17 | ||
18 | prsave() | |
19 | { | |
20 | int proflab; | |
21 | p2pass( sprintf(textline, "\t.word\t0x%x", regmask[highregvar]) ); /* register variable mask */ | |
22 | if(profileflag) | |
23 | { | |
24 | proflab = newlabel(); | |
25 | fprintf(asmfile, "L%d:\t.space\t4\n", proflab); | |
26 | p2pass( sprintf(textline, "\tmovab\tL%d,r0", proflab) ); | |
27 | p2pass( sprintf(textline, "\tjsb\tmcount") ); | |
28 | } | |
29 | p2pass( sprintf(textline, "\tsubl2\t$.F%d,sp", procno) ); | |
30 | } | |
31 | ||
32 | ||
33 | ||
34 | goret(type) | |
35 | int type; | |
36 | { | |
37 | p2pass( sprintf(textline, "\tret") ); | |
38 | } | |
39 | ||
40 | ||
41 | ||
42 | ||
43 | /* | |
44 | * move argument slot arg1 (relative to ap) | |
45 | * to slot arg2 (relative to ARGREG) | |
46 | */ | |
47 | ||
48 | mvarg(type, arg1, arg2) | |
49 | int type, arg1, arg2; | |
50 | { | |
51 | p2pass( sprintf(textline, "\tmovl\t%d(ap),%d(fp)", arg1+ARGOFFSET, arg2+argloc) ); | |
52 | } | |
53 | ||
54 | ||
55 | ||
56 | ||
57 | prlabel(fp, k) | |
58 | FILEP fp; | |
59 | int k; | |
60 | { | |
61 | fprintf(fp, "L%d:\n", k); | |
62 | } | |
63 | ||
64 | ||
65 | ||
66 | prconi(fp, type, n) | |
67 | FILEP fp; | |
68 | int type; | |
69 | ftnint n; | |
70 | { | |
71 | fprintf(fp, "\t%s\t%ld\n", (type==TYSHORT ? ".word" : ".long"), n); | |
72 | } | |
73 | ||
74 | ||
75 | ||
76 | prcona(fp, a) | |
77 | FILEP fp; | |
78 | ftnint a; | |
79 | { | |
80 | fprintf(fp, "\t.long\tL%ld\n", a); | |
81 | } | |
82 | ||
83 | ||
84 | ||
85 | #ifndef vax | |
86 | prconr(fp, type, x) | |
87 | FILEP fp; | |
88 | int type; | |
89 | float x; | |
90 | { | |
91 | fprintf(fp, "\t%s\t0f%e\n", (type==TYREAL ? ".float" : ".double"), x); | |
92 | } | |
93 | #endif | |
94 | ||
95 | #ifdef vax | |
96 | prconr(fp, type, x) | |
97 | FILEP fp; | |
98 | int type; | |
99 | double x; | |
100 | { | |
101 | long int *n; | |
102 | n = &x; /* nonportable cheat */ | |
103 | if(type == TYREAL) | |
104 | fprintf(fp, "\t.long\t0x%X\n", n[0]); | |
105 | else | |
106 | fprintf(fp, "\t.long\t0x%X,0x%X\n", n[0], n[1]); | |
107 | } | |
108 | #endif | |
109 | ||
110 | ||
111 | ||
112 | ||
113 | ||
114 | ||
115 | ||
116 | preven(k) | |
117 | int k; | |
118 | { | |
119 | register int lg; | |
120 | ||
121 | if(k > 4) | |
122 | lg = 3; | |
123 | else if(k > 2) | |
124 | lg = 2; | |
125 | else if(k > 1) | |
126 | lg = 1; | |
127 | else | |
128 | return; | |
129 | fprintf(asmfile, "\t.align\t%d\n", lg); | |
130 | } | |
131 | ||
132 | ||
133 | ||
134 | vaxgoto(index, nlab, labs) | |
135 | expptr index; | |
136 | register int nlab; | |
137 | struct labelblock *labs[]; | |
138 | { | |
139 | register int i; | |
140 | register int arrlab; | |
141 | ||
142 | putforce(TYINT, index); | |
143 | p2pass( sprintf(textline, "\tcasel\tr0,$1,$%d", nlab-1) ); | |
144 | p2pass( sprintf(textline, "L%d:", arrlab = newlabel() ) ); | |
145 | for(i = 0; i< nlab ; ++i) | |
146 | p2pass( sprintf(textline, "\t.word\tL%d-L%d", labs[i]->labelno, arrlab) ); | |
147 | } | |
148 | ||
149 | ||
150 | prarif(p, neg, zer, pos) | |
151 | ptr p; | |
152 | int neg, zer, pos; | |
153 | { | |
154 | putforce(p->vtype, p); | |
155 | if( ISINT(p->vtype) ) | |
156 | p2pass( sprintf(textline, "\ttstl\tr0") ); | |
157 | else | |
158 | p2pass( sprintf(textline, "\ttstd\tr0") ); | |
159 | p2pass( sprintf(textline, "\tjlss\tL%d", neg) ); | |
160 | p2pass( sprintf(textline, "\tjeql\tL%d", zer) ); | |
161 | p2pass( sprintf(textline, "\tjbr\tL%d", pos) ); | |
162 | } | |
163 | ||
164 | ||
165 | ||
166 | ||
167 | char *memname(stg, mem) | |
168 | int stg, mem; | |
169 | { | |
170 | static char s[20]; | |
171 | ||
172 | switch(stg) | |
173 | { | |
174 | case STGCOMMON: | |
175 | case STGEXT: | |
176 | sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) ); | |
177 | break; | |
178 | ||
179 | case STGBSS: | |
180 | case STGINIT: | |
181 | sprintf(s, "v.%d", mem); | |
182 | break; | |
183 | ||
184 | case STGCONST: | |
185 | sprintf(s, "L%d", mem); | |
186 | break; | |
187 | ||
188 | case STGEQUIV: | |
189 | sprintf(s, "q.%d", mem); | |
190 | break; | |
191 | ||
192 | default: | |
193 | fatal1("memname: invalid vstg %d", stg); | |
194 | } | |
195 | return(s); | |
196 | } | |
197 | ||
198 | ||
199 | ||
200 | ||
201 | prlocvar(s, len) | |
202 | char *s; | |
203 | ftnint len; | |
204 | { | |
205 | fprintf(asmfile, "\t.lcomm\t%s,%ld\n", s, len); | |
206 | } | |
207 | ||
208 | ||
209 | ||
210 | prext(name, leng, init) | |
211 | char *name; | |
212 | ftnint leng; | |
213 | int init; | |
214 | { | |
215 | if(leng == 0) | |
216 | fprintf(asmfile, "\t.globl\t_%s\n", name); | |
217 | else | |
218 | fprintf(asmfile, "\t.comm\t_%s,%ld\n", name, leng); | |
219 | } | |
220 | ||
221 | ||
222 | ||
223 | ||
224 | ||
225 | prendproc() | |
226 | { | |
227 | } | |
228 | ||
229 | ||
230 | ||
231 | ||
232 | prtail() | |
233 | { | |
234 | } | |
235 | ||
236 | ||
237 | ||
238 | ||
239 | ||
240 | prolog(ep, argvec) | |
241 | struct entrypoint *ep; | |
242 | struct addrblock *argvec; | |
243 | { | |
244 | int i, argslot, proflab; | |
245 | int size; | |
246 | register chainp p; | |
247 | register struct nameblock *q; | |
248 | register struct dimblock *dp; | |
249 | expptr tp; | |
250 | ||
251 | if(procclass == CLMAIN) | |
252 | p2pass( "_MAIN__:" ); | |
253 | if(ep->entryname) | |
254 | p2pass( sprintf(textline, "_%s:", varstr(XL, ep->entryname->extname)) ); | |
255 | if(procclass == CLBLOCK) | |
256 | return; | |
257 | prsave(); | |
258 | if(argvec) | |
259 | { | |
260 | argloc = argvec->memoffset->const.ci; | |
261 | if(proctype == TYCHAR) | |
262 | { | |
263 | mvarg(TYADDR, 0, chslot); | |
264 | mvarg(TYLENG, SZADDR, chlgslot); | |
265 | argslot = SZADDR + SZLENG; | |
266 | } | |
267 | else if( ISCOMPLEX(proctype) ) | |
268 | { | |
269 | mvarg(TYADDR, 0, cxslot); | |
270 | argslot = SZADDR; | |
271 | } | |
272 | else | |
273 | argslot = 0; | |
274 | ||
275 | for(p = ep->arglist ; p ; p =p->nextp) | |
276 | { | |
277 | q = p->datap; | |
278 | mvarg(TYADDR, argslot, q->vardesc.varno); | |
279 | argslot += SZADDR; | |
280 | } | |
281 | for(p = ep->arglist ; p ; p = p->nextp) | |
282 | { | |
283 | q = p->datap; | |
284 | if(q->vtype==TYCHAR || q->vclass==CLPROC) | |
285 | { | |
286 | if(q->vleng && q->vleng->tag!=TCONST) | |
287 | mvarg(TYLENG, argslot, q->vleng->vardesc.varno); | |
288 | argslot += SZLENG; | |
289 | } | |
290 | } | |
291 | p2pass( sprintf(textline, "\taddl3\t$%d,fp,ap", argloc-ARGOFFSET) ); | |
292 | } | |
293 | ||
294 | for(p = ep->arglist ; p ; p = p->nextp) | |
295 | { | |
296 | q = p->datap; | |
297 | if(dp = q->vdim) | |
298 | { | |
299 | for(i = 0 ; i < dp->ndim ; ++i) | |
300 | if(dp->dims[i].dimexpr) | |
301 | puteq( fixtype(cpexpr(dp->dims[i].dimsize)), | |
302 | fixtype(cpexpr(dp->dims[i].dimexpr))); | |
303 | size = typesize[ q->vtype ]; | |
304 | /* on VAX, get more efficient subscripting if subscripts | |
305 | have zero-base, so fudge the argument pointers for arrays. | |
306 | Not done if array bounds are being checked. | |
307 | */ | |
308 | if(dp->basexpr) | |
309 | { | |
310 | puteq( cpexpr(fixtype(dp->baseoffset)), | |
311 | cpexpr(fixtype(dp->basexpr))); | |
312 | if(! checksubs) | |
313 | { | |
314 | putforce(TYINT, | |
315 | fixtype( mkexpr(OPSTAR, ICON(size), | |
316 | cpexpr(dp->baseoffset)) )); | |
317 | p2pass( sprintf(textline, "\tsubl2\tr0,%d(ap)", | |
318 | p->datap->vardesc.varno + ARGOFFSET) ); | |
319 | } | |
320 | } | |
321 | else if(!checksubs && dp->baseoffset->const.ci!=0) | |
322 | p2pass( sprintf(textline, "\tsubl2\t$%ld,%d(ap)", | |
323 | dp->baseoffset->const.ci * size, | |
324 | p->datap->vardesc.varno + ARGOFFSET) ); | |
325 | } | |
326 | } | |
327 | ||
328 | if(typeaddr) | |
329 | puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) ); | |
330 | putgoto(ep->entrylabel); | |
331 | } | |
332 | ||
333 | ||
334 | ||
335 | ||
336 | prhead(fp) | |
337 | FILEP fp; | |
338 | { | |
339 | #if FAMILY==SCJ | |
340 | # if OUTPUT == BINARY | |
341 | p2triple(P2LBRACKET, ARGREG-highregvar, procno); | |
342 | p2word( (long) (BITSPERCHAR*autoleng) ); | |
343 | p2flush(); | |
344 | # else | |
345 | fprintf(fp, "[%02d\t%06ld\t%02d\t\n", procno, | |
346 | BITSPERCHAR*autoleng, ARGREG-highregvar); | |
347 | # endif | |
348 | #endif | |
349 | } | |
350 | ||
351 | ||
352 | ||
353 | prdbginfo() | |
354 | { | |
355 | } |