|
|
1.1 root 1: #include "defs"
2:
3: #ifdef SDB
4: # include <a.out.h>
5: extern int types2[];
6: # ifndef N_SO
7: # include <stab.h>
8: # endif
9: #endif
10:
11: #include "pccdefs"
12:
13: /*
14: VAX-11/780 - SPECIFIC ROUTINES
15: */
16:
17:
18: int maxregvar = MAXREGVAR;
19: int regnum[] = { 11, 10, 9, 8, 7, 6 } ;
20: static int regmask[] = { 0, 0x800, 0xc00, 0xe00, 0xf00, 0xf80, 0xfc0 };
21:
22:
23:
24: ftnint intcon[14] =
25: { 2, 2, 2, 2,
26: 15, 31, 24, 56,
27: -128, -128, 127, 127,
28: 32767, 2147483647 };
29:
30: #if HERE == VAX
31: /* then put in constants in octal */
32: long realcon[6][2] =
33: {
34: { 0200, 0 },
35: { 0200, 0 },
36: { 037777677777, 0 },
37: { 037777677777, 037777777777 },
38: { 032200, 0 },
39: { 022200, 0 }
40: };
41: #else
42: double realcon[6] =
43: {
44: 2.9387358771e-39,
45: 2.938735877055718800e-39
46: 1.7014117332e+38,
47: 1.701411834604692250e+38
48: 5.960464e-8,
49: 1.38777878078144567e-17,
50: };
51: #endif
52:
53:
54:
55:
56: prsave(proflab)
57: int proflab;
58: {
59: if(profileflag)
60: {
61: fprintf(asmfile, "L%d:\t.space\t4\n", proflab);
62: p2pi("\tmovab\tL%d,r0", proflab);
63: p2pass("\tjsb\tmcount");
64: }
65: p2pi("\tsubl2\t$LF%d,sp", procno);
66: }
67:
68:
69:
70: goret(type)
71: int type;
72: {
73: p2pass("\tret");
74: }
75:
76:
77:
78:
79: /*
80: * move argument slot arg1 (relative to ap)
81: * to slot arg2 (relative to ARGREG)
82: */
83:
84: mvarg(type, arg1, arg2)
85: int type, arg1, arg2;
86: {
87: p2pij("\tmovl\t%d(ap),%d(fp)", arg1+ARGOFFSET, arg2+argloc);
88: }
89:
90:
91:
92:
93: prlabel(fp, k)
94: FILEP fp;
95: int k;
96: {
97: fprintf(fp, "L%d:\n", k);
98: }
99:
100:
101:
102: prconi(fp, type, n)
103: FILEP fp;
104: int type;
105: ftnint n;
106: {
107: fprintf(fp, "\t%s\t%ld\n", (type==TYSHORT ? ".word" : ".long"), n);
108: }
109:
110:
111:
112: prcona(fp, a)
113: FILEP fp;
114: ftnint a;
115: {
116: fprintf(fp, "\t.long\tL%ld\n", a);
117: }
118:
119:
120:
121: #ifndef vax
122: prconr(fp, type, x)
123: FILEP fp;
124: int type;
125: float x;
126: {
127: fprintf(fp, "\t%s\t0f%e\n", (type==TYREAL ? ".float" : ".double"), x);
128: }
129: #endif
130:
131: #ifdef vax
132: prconr(fp, type, x)
133: FILEP fp;
134: int type;
135: double x;
136: {
137: /* non-portable cheat to preserve bit patterns */
138: union { double xd; long int xl[2]; } cheat;
139: cheat.xd = x;
140: if(type == TYREAL)
141: fprintf(fp, "\t.long\t0x%X\n", cheat.xl[0]);
142: else
143: fprintf(fp, "\t.long\t0x%X,0x%X\n", cheat.xl[0], cheat.xl[1]);
144: }
145: #endif
146:
147:
148:
149: praddr(fp, stg, varno, offset)
150: FILE *fp;
151: int stg, varno;
152: ftnint offset;
153: {
154: char *memname();
155:
156: if(stg == STGNULL)
157: fprintf(fp, "\t.long\t0\n");
158: else
159: {
160: fprintf(fp, "\t.long\t%s", memname(stg,varno));
161: if(offset)
162: fprintf(fp, "+%ld", offset);
163: fprintf(fp, "\n");
164: }
165: }
166:
167:
168:
169:
170: preven(k)
171: int k;
172: {
173: register int lg;
174:
175: if(k > 4)
176: lg = 3;
177: else if(k > 2)
178: lg = 2;
179: else if(k > 1)
180: lg = 1;
181: else
182: return;
183: fprintf(asmfile, "\t.align\t%d\n", lg);
184: }
185:
186:
187:
188: vaxgoto(index, nlab, labs)
189: expptr index;
190: register int nlab;
191: struct Labelblock *labs[];
192: {
193: register int i;
194: register int arrlab;
195:
196: putforce(TYINT, index);
197: p2pi("\tcasel\tr0,$1,$%d", nlab-1);
198: p2pi("L%d:", arrlab = newlabel() );
199: for(i = 0; i< nlab ; ++i)
200: if( labs[i] )
201: p2pij("\t.word\tL%d-L%d", labs[i]->labelno, arrlab);
202: }
203:
204:
205: prarif(p, neg, zer, pos)
206: expptr p;
207: int neg, zer, pos;
208: {
209: putforce(p->headblock.vtype, p);
210: if( ISINT(p->headblock.vtype) )
211: p2pass("\ttstl\tr0");
212: else
213: p2pass("\ttstd\tr0");
214: p2pi("\tjlss\tL%d", neg);
215: p2pi("\tjeql\tL%d", zer);
216: p2pi("\tjbr\tL%d", pos);
217: }
218:
219:
220:
221:
222: char *memname(stg, mem)
223: int stg, mem;
224: {
225: static char s[20];
226:
227: switch(stg)
228: {
229: case STGCOMMON:
230: case STGEXT:
231: sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) );
232: break;
233:
234: case STGBSS:
235: case STGINIT:
236: sprintf(s, "v.%d", mem);
237: break;
238:
239: case STGCONST:
240: sprintf(s, "L%d", mem);
241: break;
242:
243: case STGEQUIV:
244: sprintf(s, "q.%d", mem+eqvstart);
245: break;
246:
247: default:
248: badstg("memname", stg);
249: }
250: return(s);
251: }
252:
253:
254:
255:
256: prlocvar(s, len)
257: char *s;
258: ftnint len;
259: {
260: fprintf(asmfile, "\t.lcomm\t%s,%ld\n", s, len);
261: }
262:
263:
264:
265: prext(name, leng, init)
266: char *name;
267: ftnint leng;
268: int init;
269: {
270: if(leng == 0)
271: fprintf(asmfile, "\t.globl\t_%s\n", name);
272: else
273: fprintf(asmfile, "\t.comm\t_%s,%ld\n", name, leng);
274: }
275:
276:
277:
278:
279:
280: prendproc()
281: {
282: }
283:
284:
285:
286:
287: prtail()
288: {
289: }
290:
291:
292:
293:
294:
295: prolog(ep, argvec)
296: struct Entrypoint *ep;
297: Addrp argvec;
298: {
299: int i, argslot, proflab;
300: int size;
301: register chainp p;
302: register Namep q;
303: register struct Dimblock *dp;
304: expptr tp;
305:
306: p2pass("\t.align\t1");
307:
308:
309: if(procclass == CLMAIN) {
310: if(fudgelabel)
311: {
312: if(ep->entryname) {
313: p2ps("_%s:", varstr(XL, ep->entryname->extname));
314: p2pi("\t.word\tLWM%d", procno);
315: }
316: putlabel(fudgelabel);
317: fudgelabel = 0;
318: fprintf(asmfile, "\t.set\tLWM%d,0x%x\n",
319: procno, regmask[highregvar]);
320: }
321: else
322: {
323: p2pass( "_MAIN__:" );
324: if(ep->entryname == NULL)
325: p2pi("\t.word\tLWM%d", procno);
326: }
327:
328: } else if(ep->entryname)
329: if(fudgelabel)
330: {
331: putlabel(fudgelabel);
332: fudgelabel = 0;
333: fprintf(asmfile, "\t.set\tLWM%d,0x%x\n",
334: procno, regmask[highregvar]);
335: }
336: else
337: {
338: p2ps("_%s:", varstr(XL, ep->entryname->extname));
339: p2pi("\t.word\tLWM%d", procno);
340: prsave(newlabel());
341: }
342:
343: if(procclass == CLBLOCK)
344: return;
345: if(argvec)
346: {
347: argloc = argvec->memoffset->constblock.const.ci + SZINT;
348: /* first slot holds count */
349: if(proctype == TYCHAR)
350: {
351: mvarg(TYADDR, 0, chslot);
352: mvarg(TYLENG, SZADDR, chlgslot);
353: argslot = SZADDR + SZLENG;
354: }
355: else if( ISCOMPLEX(proctype) )
356: {
357: mvarg(TYADDR, 0, cxslot);
358: argslot = SZADDR;
359: }
360: else
361: argslot = 0;
362:
363: for(p = ep->arglist ; p ; p =p->nextp)
364: {
365: q = (Namep) (p->datap);
366: mvarg(TYADDR, argslot, q->vardesc.varno);
367: argslot += SZADDR;
368: }
369: for(p = ep->arglist ; p ; p = p->nextp)
370: {
371: q = (Namep) (p->datap);
372: if(q->vtype==TYCHAR && q->vclass!=CLPROC)
373: {
374: if(q->vleng && ! ISCONST(q->vleng) )
375: mvarg(TYLENG, argslot,
376: q->vleng->addrblock.memno);
377: argslot += SZLENG;
378: }
379: }
380: p2pi("\taddl3\t$%d,fp,ap", argloc-ARGOFFSET);
381: p2pi("\tmovl\t$%d,(ap)\n", lastargslot/SZADDR);
382: }
383:
384: for(p = ep->arglist ; p ; p = p->nextp)
385: {
386: q = (Namep) (p->datap);
387: if(dp = q->vdim)
388: {
389: for(i = 0 ; i < dp->ndim ; ++i)
390: if(dp->dims[i].dimexpr)
391: puteq( fixtype(cpexpr(dp->dims[i].dimsize)),
392: fixtype(cpexpr(dp->dims[i].dimexpr)));
393: size = typesize[ q->vtype ];
394: if(q->vtype == TYCHAR)
395: if( ISICON(q->vleng) )
396: size *= q->vleng->constblock.const.ci;
397: else
398: size = -1;
399:
400: /* on VAX, get more efficient subscripting if subscripts
401: have zero-base, so fudge the argument pointers for arrays.
402: Not done if array bounds are being checked.
403: */
404: if(dp->basexpr)
405: puteq( cpexpr(fixtype(dp->baseoffset)),
406: cpexpr(fixtype(dp->basexpr)));
407:
408: if(! checksubs)
409: {
410: if(dp->basexpr)
411: {
412: if(size > 0)
413: tp = (expptr) ICON(size);
414: else
415: tp = (expptr) cpexpr(q->vleng);
416: putforce(TYINT,
417: fixtype( mkexpr(OPSTAR, tp,
418: cpexpr(dp->baseoffset)) ));
419: p2pi("\tsubl2\tr0,%d(ap)",
420: p->datap->nameblock.vardesc.varno +
421: ARGOFFSET);
422: }
423: else if(dp->baseoffset->constblock.const.ci != 0)
424: {
425: char buff[25];
426: if(size > 0)
427: {
428: sprintf(buff, "\tsubl2\t$%ld,%d(ap)",
429: dp->baseoffset->constblock.const.ci * size,
430: p->datap->nameblock.vardesc.varno +
431: ARGOFFSET);
432: }
433: else {
434: putforce(TYINT, mkexpr(OPSTAR, cpexpr(dp->baseoffset),
435: cpexpr(q->vleng) ));
436: sprintf(buff, "\tsubl2\tr0,%d(ap)",
437: p->datap->nameblock.vardesc.varno +
438: ARGOFFSET);
439: }
440: p2pass(buff);
441: }
442: }
443: }
444: }
445:
446: if(typeaddr)
447: puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
448: /* replace to avoid long jump problem
449: putgoto(ep->entrylabel);
450: */
451: p2pi("\tjmp\tL%d", ep->entrylabel);
452: }
453:
454:
455:
456:
457: prhead(fp)
458: FILEP fp;
459: {
460: #if FAMILY==PCC
461: p2triple(P2LBRACKET, ARGREG-highregvar, procno);
462: p2word( (long) (BITSPERCHAR*autoleng) );
463: p2flush();
464: #endif
465: }
466:
467:
468:
469: prdbginfo()
470: {
471: }
472:
473: #ifdef SDB
474:
475:
476: # ifdef UCBVAXASM
477: char *stabdline(code, type)
478: int code;
479: int type;
480: {
481: static char buff[30];
482:
483: sprintf(buff, "\t.stabd\t0%o,0,0%o\n", code, type);
484: return(buff);
485: }
486: # endif
487:
488:
489: prstab(s, code, type, loc)
490: char *s, *loc;
491: int code, type;
492: {
493: char * stabline();
494:
495: if(sdbflag)
496: fprintf(asmfile, stabline(s,code,type,loc) );
497: }
498:
499:
500:
501: char *stabline(s, code, type, loc)
502: register char *s;
503: int code;
504: int type;
505: char *loc;
506: {
507: static char buff[50] = "\t.stab\t\t";
508: register char *t;
509: register int i = 0;
510:
511: #ifdef UCBVAXASM
512: t = buff + 8;
513: if(s == NULL)
514: buff[6] = 'n'; /* .stabn line */
515: else
516: {
517: buff[6] = 's'; /* .stabs line */
518: *t++ = '"';
519: while(*s!='\0' && *s!=' ' && i<8)
520: {
521: *t++ = *s++;
522: ++i;
523: }
524: *t++ = '"';
525: *t++ = ',';
526: }
527:
528: #else
529: t = buff + 7;
530: if(s)
531: while( *s!='\0' && *s!=' ' && i<8 )
532: {
533: *t++ = '\'';
534: *t++ = *s++;
535: *t++ = ',';
536: ++i;
537: }
538: for( ; i<8 ; ++i)
539: {
540: *t++ = '0';
541: *t++ = ',';
542: }
543: #endif
544:
545:
546: sprintf(t, "0%o,0,0%o,%s\n", code, type, (loc? loc : "0") );
547: return(buff);
548: }
549:
550:
551:
552: prstleng(np, leng)
553: register Namep np;
554: ftnint leng;
555: {
556: ftnint iarrlen();
557:
558: prstab( varstr(VL,np->varname), N_LENG, 0, convic(leng) );
559: }
560:
561:
562:
563: stabtype(p)
564: register Namep p;
565: {
566: register int type;
567: register int shift;
568: type = types2[p->vtype];
569: if(p->vdim)
570: {
571: type |= 060; /* .stab code for array */
572: shift = 2;
573: }
574: else if(p->vclass == CLPROC)
575: {
576: type |= 040; /* .stab code for function */
577: shift = 2;
578: }
579: else
580: shift = 0;
581:
582: if(p->vstg == STGARG)
583: type |= (020 << shift); /* code for pointer-to */
584:
585: return(type);
586: }
587:
588:
589:
590:
591: prstssym(np)
592: register Namep np;
593: {
594: prstab(varstr(VL,np->varname), N_SSYM,
595: stabtype(np), convic(np->voffset) );
596: }
597: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.