|
|
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: {float y = x; fprintf(fp, "\t.long\t0x%X\n", *(long *) &y); }
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: fixlwm();
319: }
320: else
321: {
322: p2pass( "_MAIN_:" );
323: if(ep->entryname == NULL)
324: p2pi("\t.word\tLWM%d", procno);
325: }
326:
327: } else if(ep->entryname)
328: if(fudgelabel)
329: {
330: putlabel(fudgelabel);
331: fudgelabel = 0;
332: fixlwm();
333: }
334: else
335: {
336: p2ps("_%s:", varstr(XL, ep->entryname->extname));
337: p2pi("\t.word\tLWM%d", procno);
338: prsave(newlabel());
339: }
340:
341: if(procclass == CLBLOCK)
342: return;
343: if(argvec)
344: {
345: argloc = argvec->memoffset->constblock.const.ci + SZINT;
346: /* first slot holds count */
347: if(proctype == TYCHAR)
348: {
349: mvarg(TYADDR, 0, chslot);
350: mvarg(TYLENG, SZADDR, chlgslot);
351: argslot = SZADDR + SZLENG;
352: }
353: else if( ISCOMPLEX(proctype) )
354: {
355: mvarg(TYADDR, 0, cxslot);
356: argslot = SZADDR;
357: }
358: else
359: argslot = 0;
360:
361: for(p = ep->arglist ; p ; p =p->nextp)
362: {
363: q = (Namep) (p->datap);
364: mvarg(TYADDR, argslot, q->vardesc.varno);
365: argslot += SZADDR;
366: }
367: for(p = ep->arglist ; p ; p = p->nextp)
368: {
369: q = (Namep) (p->datap);
370: if(q->vtype==TYCHAR && q->vclass!=CLPROC)
371: {
372: if(q->vleng && ! ISCONST(q->vleng) )
373: mvarg(TYLENG, argslot,
374: q->vleng->addrblock.memno);
375: argslot += SZLENG;
376: }
377: }
378: p2pi("\taddl3\t$%d,fp,ap", argloc-ARGOFFSET);
379: p2pi("\tmovl\t$%d,(ap)\n", lastargslot/SZADDR);
380: }
381:
382: for(p = ep->arglist ; p ; p = p->nextp)
383: {
384: q = (Namep) (p->datap);
385: if(dp = q->vdim)
386: {
387: for(i = 0 ; i < dp->ndim ; ++i)
388: if(dp->dims[i].dimexpr)
389: puteq( fixtype(cpexpr(dp->dims[i].dimsize)),
390: fixtype(cpexpr(dp->dims[i].dimexpr)));
391: size = typesize[ q->vtype ];
392: if(q->vtype == TYCHAR)
393: if( ISICON(q->vleng) )
394: size *= q->vleng->constblock.const.ci;
395: else
396: size = -1;
397:
398: /* on VAX, get more efficient subscripting if subscripts
399: have zero-base, so fudge the argument pointers for arrays.
400: Not done if array bounds are being checked.
401: */
402: if(dp->basexpr)
403: puteq( cpexpr(fixtype(dp->baseoffset)),
404: cpexpr(fixtype(dp->basexpr)));
405:
406: if(! checksubs)
407: {
408: if(dp->basexpr)
409: {
410: if(size > 0)
411: tp = (expptr) ICON(size);
412: else
413: tp = (expptr) cpexpr(q->vleng);
414: putforce(TYINT,
415: fixtype( mkexpr(OPSTAR, tp,
416: cpexpr(dp->baseoffset)) ));
417: p2pi("\tsubl2\tr0,%d(ap)",
418: p->datap->nameblock.vardesc.varno +
419: ARGOFFSET);
420: }
421: else if(dp->baseoffset->constblock.const.ci != 0)
422: {
423: char buff[25];
424: if(size > 0)
425: {
426: sprintf(buff, "\tsubl2\t$%ld,%d(ap)",
427: dp->baseoffset->constblock.const.ci * size,
428: p->datap->nameblock.vardesc.varno +
429: ARGOFFSET);
430: }
431: else {
432: putforce(TYINT, mkexpr(OPSTAR, cpexpr(dp->baseoffset),
433: cpexpr(q->vleng) ));
434: sprintf(buff, "\tsubl2\tr0,%d(ap)",
435: p->datap->nameblock.vardesc.varno +
436: ARGOFFSET);
437: }
438: p2pass(buff);
439: }
440: }
441: }
442: }
443:
444: if(typeaddr)
445: puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
446: /* replace to avoid long jump problem
447: putgoto(ep->entrylabel);
448: */
449: p2pi("\tjmp\tL%d", ep->entrylabel);
450: }
451:
452: fixlwm()
453: {
454: extern lwmno;
455: if (lwmno == procno)
456: return;
457: fprintf(asmfile, "\t.set\tLWM%d,0x%x\n",
458: procno, regmask[highregvar]);
459: lwmno = procno;
460: }
461:
462:
463: prhead(fp)
464: FILEP fp;
465: {
466: #if FAMILY==PCC
467: p2triple(P2LBRACKET, ARGREG-highregvar, procno);
468: p2word( (long) (BITSPERCHAR*autoleng) );
469: p2flush();
470: #endif
471: }
472:
473:
474:
475: prdbginfo()
476: {
477: }
478:
479: #ifdef SDB
480:
481:
482: # ifdef UCBVAXASM
483: char *stabdline(code, type)
484: int code;
485: int type;
486: {
487: static char buff[30];
488:
489: sprintf(buff, "\t.stabd\t0%o,0,0%o\n", code, type);
490: return(buff);
491: }
492: # endif
493:
494:
495: prstab(s, code, type, loc)
496: char *s, *loc;
497: int code, type;
498: {
499: char * stabline();
500:
501: if(sdbflag)
502: fprintf(asmfile, stabline(s,code,type,loc) );
503: }
504:
505:
506:
507: char *stabline(s, code, type, loc)
508: register char *s;
509: int code;
510: int type;
511: char *loc;
512: {
513: static char buff[512] = "\t.stab\t\t";
514: register char *t;
515: register int i = 0;
516:
517: #ifdef UCBVAXASM
518: t = buff + 8;
519: if(s == NULL)
520: buff[6] = 'n'; /* .stabn line */
521: else
522: {
523: buff[6] = 's'; /* .stabs line */
524: *t++ = '"';
525: while(*s!='\0' && *s!=' ')
526: {
527: #ifndef UCBPASS2
528: if (i == 8)
529: break;
530: #endif
531: *t++ = *s++;
532: ++i;
533: }
534: *t++ = '"';
535: *t++ = ',';
536: }
537:
538: #else
539: t = buff + 7;
540: if(s)
541: while( *s!='\0' && *s!=' ' && i<8 )
542: {
543: *t++ = '\'';
544: *t++ = *s++;
545: *t++ = ',';
546: ++i;
547: }
548: for( ; i<8 ; ++i)
549: {
550: *t++ = '0';
551: *t++ = ',';
552: }
553: #endif
554:
555:
556: sprintf(t, "0%o,0,0%o,%s\n", code, type, (loc? loc : "0") );
557: return(buff);
558: }
559:
560:
561:
562: prstleng(np, leng)
563: register Namep np;
564: ftnint leng;
565: {
566: ftnint iarrlen();
567:
568: prstab( varstr(VL,np->varname), N_LENG, 0, convic(leng) );
569: }
570:
571:
572:
573: stabtype(p)
574: register Namep p;
575: {
576: register int type;
577: register int shift;
578: type = types2[p->vtype];
579: if(p->vdim)
580: {
581: type |= 060; /* .stab code for array */
582: shift = 2;
583: }
584: else if(p->vclass == CLPROC)
585: {
586: type |= 040; /* .stab code for function */
587: shift = 2;
588: }
589: else
590: shift = 0;
591:
592: if(p->vstg == STGARG)
593: type |= (020 << shift); /* code for pointer-to */
594:
595: return(type);
596: }
597:
598:
599:
600:
601: prstssym(np)
602: register Namep np;
603: {
604: prstab(varstr(VL,np->varname), N_SSYM,
605: stabtype(np), convic(np->voffset) );
606: }
607: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.