|
|
1.1 root 1: #include "defs"
2: #if FAMILY == DMR
3: # include "dmrdefs"
4: #endif
5: #if FAMILY==PCC
6: # include "pccdefs"
7: #endif
8:
9: /*
10: PDP 11-SPECIFIC ROUTINES
11: */
12:
13: int maxregvar = 0;
14: int regnum[] = { 3, 2 };
15:
16: ftnint intcon[14] =
17: { 2, 2, 2, 2,
18: 15, 31, 24, 56,
19: -128, -128, 127, 127,
20: 32767, 2147483647 };
21:
22: #if HERE == PDP11
23: /* then put in constants in octal */
24: long realcon[6][2] =
25: {
26: { 040000000, 0 },
27: { 040000000, 0 },
28: { 017777777777, 0 },
29: { 017777777777, 037777777777 },
30: { 06440000000, 0 },
31: { 04440000000, 0 }
32: };
33: #else
34: double realcon[6] =
35: {
36: 2.9387358771e-39,
37: 2.938735877055718800e-39
38: 1.7014117332e+38,
39: 1.701411834604692250e+38
40: 5.960464e-8,
41: 1.38777878078144567e-17,
42: };
43: #endif
44:
45:
46:
47:
48: prsave()
49: {
50: }
51:
52:
53:
54: goret(type)
55: int type;
56: {
57: #if FAMILY == DMR
58: p2op(P2RETURN);
59: #endif
60: #if FAMILY==PCC
61: p2pass("\tjmp\tcret");
62: #endif
63: }
64:
65:
66:
67:
68: /*
69: * move argument slot arg1 (relative to ap)
70: * to slot arg2 (relative to ARGREG)
71: */
72:
73: mvarg(type, arg1, arg2)
74: int type, arg1, arg2;
75: {
76: mvarg1(arg1+4, arg2);
77: if(type == TYLONG)
78: mvarg1(arg1+6, arg2+2);
79: }
80:
81:
82:
83:
84: mvarg1(m, n)
85: int m, n;
86: {
87: #if FAMILY == DMR
88: p2reg(ARGREG, P2SHORT|P2PTR);
89: p2op2(P2ICON, P2SHORT);
90: p2i(n);
91: p2op2(P2PLUS, P2SHORT|P2PTR);
92: p2op2(P2INDIRECT, P2SHORT);
93: p2reg(AUTOREG, P2SHORT|P2PTR);
94: p2op2(P2ICON, P2SHORT);
95: p2i(m);
96: p2op2(P2PLUS, P2SHORT|P2PTR);
97: p2op2(P2INDIRECT, P2SHORT);
98: p2op2(P2ASSIGN, P2SHORT);
99: putstmt();
100: #endif
101: #if FAMILY == PCC
102: p2pij("\tmov\t%d.(r5),%d.(r4)", m, n);
103: #endif
104: }
105:
106:
107:
108:
109: prlabel(fp, k)
110: FILEP fp;
111: int k;
112: {
113: fprintf(fp, "L%d:\n", k);
114: }
115:
116:
117:
118: prconi(fp, type, n)
119: FILEP fp;
120: int type;
121: ftnint n;
122: {
123: register int *np;
124: np = &n;
125: if(type == TYLONG)
126: fprintf(fp, "\t%d.;%d.\n", np[0], np[1]);
127: else
128: fprintf(fp, "\t%d.\n", np[1]);
129: }
130:
131:
132:
133: prcona(fp, a)
134: FILEP fp;
135: ftnint a;
136: {
137: fprintf(fp, "L%ld\n", a);
138: }
139:
140:
141:
142: #if HERE!=PDP11
143: BAD NEWS
144: #endif
145:
146: #if HERE==PDP11
147: prconr(fp, type, x)
148: FILEP fp;
149: int type;
150: double x;
151: {
152: register int k, *n;
153: n = &x; /* nonportable cheat */
154: k = (type==TYREAL ? 2 : 4);
155: fprintf(fp, "\t");
156: while(--k >= 0)
157: fprintf(fp, "%d.%c", *n++, (k==0 ? '\n' : ';') );
158: }
159: #endif
160:
161:
162:
163:
164: preven(k)
165: int k;
166: {
167: if(k > 1)
168: fprintf(asmfile, "\t.even\n", k);
169: }
170:
171:
172:
173: #if FAMILY == PCC
174:
175: prcmgoto(p, nlab, skiplabel, labarray)
176: expptr p;
177: int nlab, skiplabel, labarray;
178: {
179: int regno;
180:
181: putforce(p->vtype, p);
182:
183: if(p->vtype == TYLONG)
184: {
185: regno = 1;
186: p2pass("\ttst\tr0");
187: p2pi("\tbne\tL%d", skiplabel);
188: }
189: else
190: regno = 0;
191:
192: p2pij("\tcmp\tr%d,$%d.", regno, nlab);
193: p2pi("\tbhi\tL%d", skiplabel);
194: p2pi("\tasl\tr%d", regno);
195: p2pij("\tjmp\t*L%d(r%d)", labarray, regno);
196: }
197:
198:
199: prarif(p, neg,zer,pos)
200: expptr p;
201: int neg, zer, pos;
202: {
203: register int ptype;
204:
205: putforce( ptype = p->vtype, p);
206: if( ISINT(ptype) )
207: {
208: p2pass("\ttst\tr0");
209: p2pi("\tjlt\tL%d", neg);
210: p2pi("\tjgt\tL%d", pos);
211: if(ptype != TYSHORT)
212: {
213: p2pass("\ttst\tr1");
214: p2pi("\tjeq\tL%d", zer);
215: }
216: p2pi("\tjbr\tL%d", pos);
217: }
218: else
219: {
220: p2pass("\ttstf\tr0");
221: p2pass("\tcfcc");
222: p2pi("\tjeq\tL%d", zer);
223: p2pi("\tjlt\tL%d", neg);
224: p2pi("\tjmp\tL%d", pos);
225: }
226: }
227:
228: #endif
229:
230:
231:
232:
233: char *memname(stg, mem)
234: int stg, mem;
235: {
236: static char s[20];
237:
238: switch(stg)
239: {
240: case STGCOMMON:
241: case STGEXT:
242: sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) );
243: break;
244:
245: case STGBSS:
246: case STGINIT:
247: sprintf(s, "v.%d", mem);
248: break;
249:
250: case STGCONST:
251: sprintf(s, "L%d", mem);
252: break;
253:
254: case STGEQUIV:
255: sprintf(s, "q.%d", mem+eqvstart);
256: break;
257:
258: default:
259: fatali("memname: invalid vstg %d", stg);
260: }
261: return(s);
262: }
263:
264:
265: prlocvar(s, len)
266: char *s;
267: ftnint len;
268: {
269: fprintf(asmfile, "%s:", s);
270: prskip(asmfile, len);
271: }
272:
273:
274:
275: prext(name, leng, init)
276: char *name;
277: ftnint leng;
278: int init;
279: {
280: if(leng==0 || init)
281: fprintf(asmfile, "\t.globl\t_%s\n", name);
282: else
283: fprintf(asmfile, "\t.comm\t_%s,%ld.\n", name, leng);
284: }
285:
286:
287:
288: prendproc()
289: {
290: }
291:
292:
293:
294: prtail()
295: {
296: #if FAMILY == PCC
297: p2pass("\t.globl\tcsv,cret");
298: #else
299: p2op(P2EOF);
300: #endif
301: }
302:
303:
304:
305: prolog(ep, argvec)
306: struct Entrypoint *ep;
307: struct Addrblock *argvec;
308: {
309: int i, argslot, proflab;
310: register chainp p;
311: register struct Nameblock *q;
312: register struct Dimblock *dp;
313: struct Constblock *mkaddcon();
314:
315: if(procclass == CLMAIN)
316: prentry("MAIN__");
317:
318: if(ep->entryname)
319: prentry( varstr(XL, ep->entryname->extname) );
320:
321: if(procclass == CLBLOCK)
322: return;
323: if(profileflag)
324: proflab = newlabel();
325: #if FAMILY == PCC
326: if(profileflag)
327: {
328: fprintf(asmfile, "L%d:\t. = .+2\n", proflab);
329: p2pi("\tmov\t$L%d,r0", proflab);
330: p2pass("\tjsr\tpc,mcount");
331: }
332: p2pass("\tjsr\tr5,csv");
333: p2pi("\tsub\t$.F%d,sp", procno);
334: #else
335: if(profileflag)
336: p2op2(P2PROFILE, proflab);
337: p2op(P2SAVE);
338: p2op2(P2SETSTK, ( (((int) autoleng)+1) & ~01) );
339: #endif
340:
341: if(argvec == NULL)
342: addreg(argloc = 4);
343: else
344: {
345: addreg( argloc = argvec->memoffset->constblock.const.ci );
346: if(proctype == TYCHAR)
347: {
348: mvarg(TYADDR, 0, chslot);
349: mvarg(TYLENG, SZADDR, chlgslot);
350: argslot = SZADDR + SZLENG;
351: }
352: else if( ISCOMPLEX(proctype) )
353: {
354: mvarg(TYADDR, 0, cxslot);
355: argslot = SZADDR;
356: }
357: else
358: argslot = 0;
359:
360: for(p = ep->arglist ; p ; p =p->nextp)
361: {
362: q = p->datap;
363: mvarg(TYADDR, argslot, q->vardesc.varno);
364: argslot += SZADDR;
365: }
366: for(p = ep->arglist ; p ; p = p->nextp)
367: {
368: q = p->datap;
369: if(q->vtype==TYCHAR || q->vclass==CLPROC)
370: {
371: if( q->vleng && ! ISCONST(q->vleng) )
372: mvarg(TYLENG, argslot, q->vleng->addrblock.memno);
373: argslot += SZLENG;
374: }
375: }
376: }
377:
378: for(p = ep->arglist ; p ; p = p->nextp)
379: if(dp = ( (struct Nameblock *) (p->datap) ) ->vdim)
380: {
381: for(i = 0 ; i < dp->ndim ; ++i)
382: if(dp->dims[i].dimexpr)
383: puteq( fixtype(cpexpr(dp->dims[i].dimsize)),
384: fixtype(cpexpr(dp->dims[i].dimexpr)));
385: if(dp->basexpr)
386: puteq( cpexpr(fixtype(dp->baseoffset)),
387: cpexpr(fixtype(dp->basexpr)));
388: }
389:
390: if(typeaddr)
391: puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
392: putgoto(ep->entrylabel);
393: }
394:
395:
396:
397: prentry(s)
398: char *s;
399: {
400: #if FAMILY == PCC
401: p2ps("_%s:", s);
402: #else
403: p2op(P2RLABEL);
404: putc('_', textfile);
405: p2str(s);
406: #endif
407: }
408:
409:
410:
411:
412: addreg(k)
413: int k;
414: {
415: #if FAMILY == PCC
416: p2pass("\tmov\tr5,r4");
417: p2pi("\tadd\t$%d.,r4", k);
418: #else
419: p2reg(ARGREG, P2SHORT);
420: p2reg(AUTOREG, P2SHORT);
421: p2op2(P2ICON, P2SHORT);
422: p2i(k);
423: p2op2(P2PLUS, P2SHORT);
424: p2op2(P2ASSIGN, P2SHORT);
425: putstmt();
426: #endif
427: }
428:
429:
430:
431:
432:
433: prhead(fp)
434: FILEP fp;
435: {
436: #if FAMILY == PCC
437: p2triple(P2LBRACKET, ARGREG-1-highregvar, procno);
438: p2word( (long) (BITSPERCHAR*autoleng) );
439: p2flush();
440: #endif
441: }
442:
443: prdbginfo()
444: {
445: register char *s;
446: char *t, buff[50];
447: register struct Nameblock *p;
448: struct Hashentry *hp;
449:
450: if(s = entries->entryname->extname)
451: s = varstr(XL, s);
452: else if(procclass == CLMAIN)
453: s = "MAIN__";
454: else
455: return;
456:
457: if(procclass != CLBLOCK)
458: fprintf(asmfile, "~~%s = _%s\n", s, s);
459:
460: for(hp = hashtab ; hp<lasthash ; ++hp)
461: if(p = hp->varp)
462: {
463: s = NULL;
464: if(p->vstg == STGARG)
465: {
466: sprintf(buff, "%o", p->vardesc.varno+argloc);
467: s = buff;
468: }
469: else if(p->vclass == CLVAR)
470: switch(p->vstg)
471: {
472: case STGBSS:
473: case STGINIT:
474: case STGEQUIV:
475: t = memname(p->vstg, p->vardesc.varno);
476: if(p->voffset)
477: sprintf(buff, "%s+%o", t, p->voffset);
478: else
479: sprintf(buff, "%s", t);
480: s = buff;
481: break;
482:
483: case STGAUTO:
484: sprintf(buff, "%o", p->voffset);
485: s = buff;
486: break;
487:
488: default:
489: break;
490: }
491: if(s)
492: fprintf(asmfile, "~%s = %s\n", varstr(VL,p->varname), s);
493: }
494: fprintf(asmfile, "~~:\n");
495: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.