![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tahoe.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / pgrm / f77 / pass1.tahoe|
Return to tahoe.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / f77 / pass1.tahoe |
1.1 root 1: #include "defs.h"
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 "pcc.h"
12:
13: /*
14: TAHOE - SPECIFIC ROUTINES
15: */
16:
17: int maxregvar = MAXREGVAR;
18: int regnum[] = { 10, 9, 8, 7, 6 } ;
19:
20: ftnint intcon[14] =
21: { 2, 2, 2, 2,
22: 15, 31, 24, 56,
23: -128, -128, 127, 127,
24: 0x7FFF, 0x7FFFFFFF };
25:
26: #if HERE == VAX || HERE == TAHOE
27: /* then put in constants in hex */
28: short realcon[6][4] =
29: {
30: { 0x80, 0, 0, 0 },
31: { 0x80, 0, 0, 0 },
32: { 0x7FFF, 0xFFFF, 0, 0 },
33: { 0x7FFF, 0xFFFF, 0xFFFF, 0xFFFF },
34: { 0x3480, 0, 0, 0 },
35: { 0x2480, 0, 0, 0 },
36: };
37: #else
38: double realcon[6] =
39: {
40: 2.9387358771e-39, /* 2 ** -128 */
41: 2.938735877055718800e-39, /* 2 ** -128 */
42: 1.7014117332e+38, /* 2**127 * (1 - 2**-24) */
43: 1.701411834604692250e+38, /* 2**127 * (1 - 2**-56) */
44: 5.960464e-8, /* 2 ** -24 */
45: 1.38777878078144567e-17, /* 2 ** -56 */
46: };
47: #endif
48:
49: /*
50: * The VAX assembler has a serious and not easily fixable problem
51: * with generating instructions that contain expressions of the form
52: * label1-label2 where there are .align's in-between the labels.
53: * Therefore, the compiler must keep track of the offsets and output
54: * .space where needed.
55: */
56: LOCAL int i_offset; /* initfile offset */
57: LOCAL int a_offset; /* asmfile offset */
58:
59: prsave(proflab)
60: int proflab;
61: {
62: if(profileflag)
63: {
64: fprintf(asmfile, "\t.align\t2\n");
65: fprintf(asmfile, "L%d:\t.long\t0\n", proflab);
66: p2pi("\tpushl\t$L%d", proflab);
67: p2pass("\tcallf\t$8,mcount");
68: }
69: p2pi("\tsubl3\t$LF%d,fp,sp", procno);
70: }
71:
72: goret(type)
73: int type;
74: {
75: register int r = 0;
76: switch(type) { /* from retval */
77: case TYDREAL:
78: r++;
79:
80: case TYLOGICAL:
81: case TYADDR:
82: case TYSHORT:
83: case TYLONG:
84: case TYREAL:
85: r++;
86:
87: case TYCHAR:
88: case TYCOMPLEX:
89: case TYDCOMPLEX:
90: break;
91: case TYSUBR:
92: if (substars) r++;
93: break;
94: default:
95: badtype("goret", type);
96: }
97: p2pi("\tret#%d", r);
98: }
99:
100: /*
101: * move argument slot arg1 (relative to fp)
102: * to slot arg2 (relative to ARGREG)
103: */
104: mvarg(type, arg1, arg2)
105: int type, arg1, arg2;
106: {
107: p2pij("\tmovl\t%d(fp),%d(fp)", arg1+ARGOFFSET, arg2+argloc);
108: }
109:
110: prlabel(fp, k)
111: FILEP fp;
112: int k;
113: {
114: fprintf(fp, "L%d:\n", k);
115: }
116:
117: prconi(fp, type, n)
118: FILEP fp;
119: int type;
120: ftnint n;
121: {
122: register int i;
123:
124: if(type == TYSHORT)
125: {
126: fprintf(fp, "\t.word\t%ld\n", n);
127: i = SZSHORT;
128: }
129: else
130: {
131: fprintf(fp, "\t.long\t%ld\n", n);
132: i = SZLONG;
133: }
134: if(fp == initfile)
135: i_offset += i;
136: else
137: a_offset += i;
138: }
139:
140: prcona(fp, a)
141: FILEP fp;
142: ftnint a;
143: {
144: fprintf(fp, "\t.long\tL%ld\n", a);
145: if(fp == initfile)
146: i_offset += SZLONG;
147: else
148: a_offset += SZLONG;
149: }
150:
151: prconr(fp, type, x)
152: FILEP fp;
153: int type;
154: double x;
155: {
156: /*
157: fprintf(fp, "\t%s\t0f%e\n", (type==TYREAL ? ".float" : ".double"), x);
158: */
159: /* non-portable cheat to preserve bit patterns */
160: /* this code should be the same for PDP, VAX and Tahoe */
161:
162: register struct sh4 {
163: unsigned short sh[4];
164: } *cheat;
165: register int i;
166:
167: cheat = (struct sh4 *)&x;
168: if(type == TYREAL) { /* force rounding */
169: float f;
170: f = x;
171: x = f;
172: }
173: fprintf(fp, " .long 0x%04x%04x", cheat->sh[0], cheat->sh[1]);
174: if(type == TYDREAL) {
175: fprintf(fp, ", 0x%04x%04x", cheat->sh[2], cheat->sh[3]);
176: fprintf(fp, " # .double %.17g\n", x);
177: i = SZDOUBLE;
178: }
179: else
180: {
181: fprintf(fp, " # .float %.8g\n", x);
182: i = SZFLOAT;
183: }
184: if(fp == initfile)
185: i_offset += i;
186: else
187: a_offset += i;
188: }
189:
190: praddr(fp, stg, varno, offset)
191: FILE *fp;
192: int stg, varno;
193: ftnint offset;
194: {
195: char *memname();
196:
197: if(stg == STGNULL)
198: fprintf(fp, "\t.long\t0\n");
199: else
200: {
201: fprintf(fp, "\t.long\t%s", memname(stg,varno));
202: if(offset)
203: fprintf(fp, "+%ld", offset);
204: fprintf(fp, "\n");
205: }
206: if(fp == initfile)
207: i_offset += SZADDR;
208: else
209: a_offset += SZADDR;
210: }
211: pralign(k)
212: int k;
213: {
214: register int lg;
215:
216: if (k > 4)
217: lg = 3;
218: else if (k > 2)
219: lg = 2;
220: else if (k > 1)
221: lg = 1;
222: else
223: return;
224: fprintf(initfile, "\t.align\t%d\n", lg);
225: i_offset += lg;
226: return;
227: }
228:
229:
230:
231: prspace(n)
232: int n;
233: {
234:
235: fprintf(initfile, "\t.space\t%d\n", n);
236: i_offset += n;
237: }
238:
239:
240: preven(k)
241: int k;
242: {
243: register int lg;
244:
245: if(k > 4)
246: lg = 3;
247: else if(k > 2)
248: lg = 2;
249: else if(k > 1)
250: lg = 1;
251: else
252: return;
253: fprintf(asmfile, "\t.align\t%d\n", lg);
254: a_offset += lg;
255: }
256:
257: praspace(n)
258: int n;
259: {
260:
261: fprintf(asmfile, "\t.space\t%d\n", n);
262: a_offset += n;
263: }
264:
265:
266: casegoto(index, nlab, labs)
267: expptr index;
268: register int nlab;
269: struct Labelblock *labs[];
270: {
271: register int i;
272: register int arrlab;
273:
274: putforce(TYINT, index);
275: p2pi("\tcasel\tr0,$1,$%d\n\t.align 1", nlab-1);
276: p2pi("L%d:", arrlab = newlabel() );
277: for(i = 0; i< nlab ; ++i)
278: if( labs[i] )
279: p2pij("\t.word\tL%d-L%d", labs[i]->labelno, arrlab);
280: }
281:
282:
283: prarif(p, neg, zer, pos)
284: expptr p;
285: int neg, zer, pos;
286: {
287: putforce(p->headblock.vtype, p);
288: p2pass("\ttstl\tr0");
289: p2pi("\tjlss\tL%d", neg);
290: p2pi("\tjeql\tL%d", zer);
291: p2pi("\tjbr\tL%d", pos);
292: }
293:
294: char *memname(stg, mem)
295: int stg, mem;
296: {
297: static char s[20];
298:
299: switch(stg)
300: {
301: case STGEXT:
302: case STGINTR:
303: if(extsymtab[mem].extname[0] == '@') { /* function opcodes */
304: strcpy(s, varstr(XL, extsymtab[mem].extname));
305: break;
306: }
307: case STGCOMMON:
308: sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) );
309: break;
310:
311: case STGBSS:
312: case STGINIT:
313: sprintf(s, "v.%d", mem);
314: break;
315:
316: case STGCONST:
317: sprintf(s, "L%d", mem);
318: break;
319:
320: case STGEQUIV:
321: sprintf(s, "q.%d", mem+eqvstart);
322: break;
323:
324: default:
325: badstg("memname", stg);
326: }
327: return(s);
328: }
329:
330: prlocvar(s, len)
331: char *s;
332: ftnint len;
333: {
334: int sz;
335: sz = len;
336: if (sz % SZINT)
337: sz += SZINT - (sz % SZINT);
338: fprintf(asmfile, "\t.lcomm\t%s,%ld\n", s, sz);
339: }
340:
341: char *
342: packbytes(cp)
343: register Constp cp;
344: {
345: #if HERE == VAX
346: static char shrt[16];
347: static char lng[4];
348: #endif
349:
350: switch (cp->vtype)
351: {
352: #if HERE == TAHOE
353: case TYSHORT:
354: { static short shrt;
355: shrt = cp->const.ci;
356: return ((char *)&shrt);
357: }
358: case TYLONG:
359: case TYLOGICAL:
360: case TYREAL:
361: case TYDREAL:
362: case TYDCOMPLEX:
363: return ((char *)&cp->const);
364: case TYCOMPLEX:
365: { static float quad[2];
366: quad[0] = cp->const.cd[0];
367: quad[1] = cp->const.cd[1];
368: return ((char *)quad);
369: }
370: #endif
371:
372: #if HERE == VAX
373: case TYLONG:
374: case TYLOGICAL:
375: swab4((char *)&cp->const.ci, lng, 4);
376: return (lng);
377:
378: case TYSHORT:
379: case TYREAL:
380: case TYDREAL:
381: case TYDCOMPLEX:
382: swab((char *)cp->const.cd, shrt, typesize[cp->vtype]);
383: return (shrt);
384: case TYCOMPLEX:
385: swab((char *)cp->const.cd, shrt, 4);
386: swab((char *)&(cp->const.cd[1]), &shrt[4], 4);
387: return (shrt);
388: #endif
389:
390: default:
391: badtype("packbytes", cp->vtype);
392: }
393: }
394:
395: #if HERE == VAX
396: /* correct the byte order in longs */
397: LOCAL swab4(from, to, n)
398: register char *to, *from;
399: register int n;
400: {
401: while(n >= 4) {
402: *to++ = from[3];
403: *to++ = from[2];
404: *to++ = from[1];
405: *to++ = from[0];
406: from += 4;
407: n -= 4;
408: }
409: while(n >= 2) {
410: *to++ = from[1];
411: *to++ = from[0];
412: from += 2;
413: n -= 2;
414: }
415: if(n > 0)
416: *to = *from;
417: }
418: #endif
419:
420: prsdata(s, len)
421: register char *s; /* must be aligned if HERE==TAHOE */
422: register int len;
423: {
424: static char longfmt[] = "\t.long\t0x%x\n";
425: static char wordfmt[] = "\t.word\t0x%x\n";
426: static char bytefmt[] = "\t.byte\t0x%x\n";
427:
428: register int i;
429: #if HERE == VAX
430: char quad[8];
431: swab4(s, quad, len);
432: s = quad;
433: #endif
434:
435: i = 0;
436: if ((len - i) >= 4)
437: {
438: fprintf(initfile, longfmt, *((int *) s));
439: i += 4;
440: }
441: if ((len - i) >= 2)
442: {
443: fprintf(initfile, wordfmt, 0xffff & (*((short *) (s + i))));
444: i += 2;
445: }
446: if ((len - i) > 0)
447: fprintf(initfile,bytefmt, 0xff & s[i]);
448:
449: i_offset += len;
450: return;
451: }
452:
453: prquad(s)
454: register long *s;
455: {
456: static char quadfmt1[] = "\t.quad\t0x%x\n";
457: static char quadfmt2[] = "\t.quad\t0x%x%08x\n";
458: #if HERE == VAX
459: char quad[8];
460: swab4((char *)s, quad, 8);
461: s = (long *)quad;
462: #endif
463:
464: if (s[0] == 0 )
465: fprintf(initfile, quadfmt1, s[1]);
466: else
467: fprintf(initfile, quadfmt2, s[0], s[1]);
468:
469: return;
470: }
471:
472: #ifdef UCBVAXASM
473: prfill(n, s)
474: int n;
475: register long *s;
476: {
477: static char fillfmt1[] = "\t.fill\t%d,8,0x%x\n";
478: static char fillfmt2[] = "\t.fill\t%d,8,0x%x%08x\n";
479: #if HERE == VAX
480: char quad[8];
481: swab4((char *)s, quad, 8);
482: s = (long *)quad;
483: #endif
484:
485: if (s[0] == 0 )
486: fprintf(initfile, fillfmt1, n, s[1]);
487: else
488: fprintf(initfile, fillfmt2, n, s[0], s[1]);
489:
490: return;
491: }
492: #endif
493:
494: prext(ep)
495: register struct Extsym *ep;
496: {
497: static char globlfmt[] = "\t.globl\t_%s\n";
498: static char commfmt[] = "\t.comm\t_%s,%ld\n";
499: static char align2fmt[] = "\t.align\t2\n";
500: static char labelfmt[] = "_%s:\n";
501:
502: static char seekerror[] = "seek error on tmp file";
503: static char readerror[] = "read error on tmp file";
504:
505: char *tag;
506: register int leng;
507: long pos;
508: register char *p;
509: long oldvalue[2];
510: long newvalue[2];
511: register int n;
512: register int repl;
513:
514: tag = varstr(XL, ep->extname);
515: leng = ep->maxleng;
516:
517: if (leng == 0)
518: {
519: if(*tag != '@') /* function opcodes */
520: fprintf(asmfile, globlfmt, tag);
521: return;
522: }
523:
524: if (ep->init == NO)
525: {
526: fprintf(asmfile, commfmt, tag, leng);
527: return;
528: }
529:
530: fprintf(asmfile, globlfmt, tag);
531: fprintf(initfile, align2fmt);
532: fprintf(initfile, labelfmt, tag);
533:
534: pos = lseek(cdatafile, ep->initoffset, 0);
535: if (pos == -1)
536: {
537: err(seekerror);
538: done(1);
539: }
540:
541: oldvalue[0] = 0;
542: oldvalue[1] = 0;
543: n = read(cdatafile, oldvalue, 8);
544: if (n < 0)
545: {
546: err(readerror);
547: done(1);
548: }
549:
550: if (leng <= 8)
551: {
552: p = (char *)oldvalue + leng;
553: while (p > (char *)oldvalue && *--p == '\0') /* SKIP */;
554: if (*p == '\0')
555: prspace(leng);
556: else if (leng == 8)
557: prquad(oldvalue);
558: else
559: prsdata(oldvalue, leng);
560:
561: return;
562: }
563:
564: repl = 1;
565: leng -= 8;
566:
567: while (leng >= 8)
568: {
569: newvalue[0] = 0;
570: newvalue[1] = 0;
571:
572: n = read(cdatafile, newvalue, 8);
573: if (n < 0)
574: {
575: err(readerror);
576: done(1);
577: }
578:
579: leng -= 8;
580:
581: if (oldvalue[0] == newvalue[0]
582: && oldvalue[1] == newvalue[1])
583: repl++;
584: else
585: {
586: if (oldvalue[0] == 0
587: && oldvalue[1] == 0)
588: prspace(8*repl);
589: else if (repl == 1)
590: prquad(oldvalue);
591: else
592: #ifdef UCBVAXASM
593: prfill(repl, oldvalue);
594: #else
595: {
596: while (repl-- > 0)
597: prquad(oldvalue);
598: }
599: #endif
600: oldvalue[0] = newvalue[0];
601: oldvalue[1] = newvalue[1];
602: repl = 1;
603: }
604: }
605:
606: newvalue[0] = 0;
607: newvalue[1] = 0;
608:
609: if (leng > 0)
610: {
611: n = read(cdatafile, newvalue, leng);
612: if (n < 0)
613: {
614: err(readerror);
615: done(1);
616: }
617: }
618:
619: if (oldvalue[1] == 0
620: && oldvalue[0] == 0
621: && newvalue[1] == 0
622: && newvalue[0] == 0)
623: {
624: prspace(8*repl + leng);
625: return;
626: }
627:
628: if (oldvalue[1] == 0
629: && oldvalue[0] == 0)
630: prspace(8*repl);
631: else if (repl == 1)
632: prquad(oldvalue);
633: else
634: #ifdef UCBVAXASM
635: prfill(repl, oldvalue);
636: #else
637: {
638: while (repl-- > 0)
639: prquad(oldvalue);
640: }
641: #endif
642:
643: prsdata(newvalue, leng);
644:
645: return;
646: }
647:
648: prlocdata(sname, leng, type, initoffset, inlcomm)
649: char *sname;
650: ftnint leng;
651: int type;
652: long initoffset;
653: char *inlcomm;
654: {
655: static char seekerror[] = "seek error on tmp file";
656: static char readerror[] = "read error on tmp file";
657:
658: static char labelfmt[] = "%s:\n";
659:
660: register int k;
661: register char *p;
662: register int repl;
663: register int first;
664: register long pos;
665: register long n;
666: long oldvalue[2];
667: long newvalue[2];
668:
669: *inlcomm = NO;
670:
671: k = leng;
672: first = YES;
673:
674: pos = lseek(vdatafile, initoffset, 0);
675: if (pos == -1)
676: {
677: err(seekerror);
678: done(1);
679: }
680:
681: oldvalue[0] = 0;
682: oldvalue[1] = 0;
683: n = read(vdatafile, oldvalue, 8);
684: if (n < 0)
685: {
686: err(readerror);
687: done(1);
688: }
689:
690: if (k <= 8)
691: {
692: p = (char *)oldvalue + k;
693: while (p > (char *)oldvalue && *--p == '\0')
694: /* SKIP */ ;
695: if (*p == '\0')
696: {
697: if (SMALLVAR(leng))
698: {
699: pralign(typealign[type]);
700: fprintf(initfile, labelfmt, sname);
701: prspace(leng);
702: }
703: else
704: {
705: preven(ALIDOUBLE);
706: prlocvar(sname, leng);
707: *inlcomm = YES;
708: }
709: }
710: else
711: {
712: fprintf(initfile, labelfmt, sname);
713: if (leng == 8)
714: prquad(oldvalue);
715: else
716: prsdata(oldvalue, leng);
717: }
718: return;
719: }
720:
721: repl = 1;
722: k -= 8;
723:
724: while (k >=8)
725: {
726: newvalue[0] = 0;
727: newvalue[1] = 0;
728:
729: n = read(vdatafile, newvalue, 8);
730: if (n < 0)
731: {
732: err(readerror);
733: done(1);
734: }
735:
736: k -= 8;
737:
738: if (oldvalue[0] == newvalue[0]
739: && oldvalue[1] == newvalue[1])
740: repl++;
741: else
742: {
743: if (first == YES)
744: {
745: pralign(typealign[type]);
746: fprintf(initfile, labelfmt, sname);
747: first = NO;
748: }
749:
750: if (oldvalue[0] == 0
751: && oldvalue[1] == 0)
752: prspace(8*repl);
753: else
754: {
755: while (repl-- > 0)
756: prquad(oldvalue);
757: }
758: oldvalue[0] = newvalue[0];
759: oldvalue[1] = newvalue[1];
760: repl = 1;
761: }
762: }
763:
764: newvalue[0] = 0;
765: newvalue[1] = 0;
766:
767: if (k > 0)
768: {
769: n = read(vdatafile, newvalue, k);
770: if (n < 0)
771: {
772: err(readerror);
773: done(1);
774: }
775: }
776:
777: if (oldvalue[1] == 0
778: && oldvalue[0] == 0
779: && newvalue[1] == 0
780: && newvalue[0] == 0)
781: {
782: if (first == YES && !SMALLVAR(leng))
783: {
784: prlocvar(sname, leng);
785: *inlcomm = YES;
786: }
787: else
788: {
789: if (first == YES)
790: {
791: pralign(typealign[type]);
792: fprintf(initfile, labelfmt, sname);
793: }
794: prspace(8*repl + k);
795: }
796: return;
797: }
798:
799: if (first == YES)
800: {
801: pralign(typealign[type]);
802: fprintf(initfile, labelfmt, sname);
803: }
804:
805: if (oldvalue[1] == 0
806: && oldvalue[0] == 0)
807: prspace(8*repl);
808: else
809: {
810: while (repl-- > 0)
811: prquad(oldvalue);
812: }
813:
814: prsdata(newvalue, k);
815:
816: return;
817: }
818:
819: prendproc()
820: {
821: }
822:
823: prtail()
824: {
825: }
826:
827: prolog(ep, argvec)
828: struct Entrypoint *ep;
829: Addrp argvec;
830: {
831: int i, argslot, proflab;
832: int size;
833: register chainp p;
834: register Namep q;
835: register struct Dimblock *dp;
836: expptr tp;
837: static char maskfmt[] = "\t.word\tLWM%d";
838: static char align1fmt[] = "\t.align\t1";
839:
840: if(procclass == CLMAIN) {
841: if(fudgelabel)
842: {
843: if(ep->entryname) {
844: p2pass(align1fmt);
845: p2ps("_%s:", varstr(XL, ep->entryname->extname));
846: p2pi(maskfmt, procno);
847: }
848: putlabel(fudgelabel);
849: fudgelabel = 0;
850: }
851: else
852: {
853: p2pass(align1fmt);
854: p2pass( "_MAIN_:" );
855: if(ep->entryname == NULL)
856: p2pi(maskfmt, procno);
857: }
858:
859: } else if(ep->entryname)
860: if(fudgelabel)
861: {
862: putlabel(fudgelabel);
863: fudgelabel = 0;
864: }
865: else
866: {
867: p2pass(align1fmt);
868: p2ps("_%s:", varstr(XL, ep->entryname->extname));
869: p2pi(maskfmt, procno);
870: prsave(newlabel());
871: }
872:
873: if(procclass == CLBLOCK)
874: return;
875: if (anylocals == YES)
876: p2pi("\tmovl\t$v.%d,r11", bsslabel);
877: if(argvec)
878: {
879: if (argvec->tag != TADDR) badtag ("prolog",argvec->tag);
880: argloc = argvec->memoffset->constblock.const.ci + SZINT;
881: /* first slot holds count */
882: if(proctype == TYCHAR)
883: {
884: mvarg(TYADDR, 0, chslot);
885: mvarg(TYLENG, SZADDR, chlgslot);
886: argslot = SZADDR + SZLENG;
887: }
888: else if( ISCOMPLEX(proctype) )
889: {
890: mvarg(TYADDR, 0, cxslot);
891: argslot = SZADDR;
892: }
893: else
894: argslot = 0;
895:
896: for(p = ep->arglist ; p ; p =p->nextp)
897: {
898: q = (Namep) (p->datap);
899: mvarg(TYADDR, argslot, q->vardesc.varno);
900: argslot += SZADDR;
901: }
902: for(p = ep->arglist ; p ; p = p->nextp)
903: {
904: q = (Namep) (p->datap);
905: if(q->vtype==TYCHAR && q->vclass!=CLPROC)
906: {
907: if(q->vleng && ! ISCONST(q->vleng) )
908: mvarg(TYLENG, argslot,
909: q->vleng->addrblock.memno);
910: argslot += SZLENG;
911: }
912: }
913: if ((ep->enamep->vtype == TYCOMPLEX) && (!ep->arglist))
914: p2pass("\tmovl\tfp,r12");
915: else
916: p2pi("\tsubl3\t$%d,fp,r12", ARGOFFSET-argloc);
917: } else
918: if((ep->arglist) || (ISCOMPLEX(proctype)) || (proctype == TYCHAR))
919: p2pass("\tmovl\tfp,r12");
920:
921: for(p = ep->arglist ; p ; p = p->nextp)
922: {
923: q = (Namep) (p->datap);
924: if(dp = q->vdim)
925: {
926: for(i = 0 ; i < dp->ndim ; ++i)
927: if(dp->dims[i].dimexpr)
928: puteq( fixtype(cpexpr(dp->dims[i].dimsize)),
929: fixtype(cpexpr(dp->dims[i].dimexpr)));
930: #ifdef SDB
931: if(sdbflag) {
932: for(i = 0 ; i < dp->ndim ; ++i) {
933: if(dp->dims[i].lbaddr)
934: puteq( fixtype(cpexpr(dp->dims[i].lbaddr)),
935: fixtype(cpexpr(dp->dims[i].lb)));
936: if(dp->dims[i].ubaddr)
937: puteq( fixtype(cpexpr(dp->dims[i].ubaddr)),
938: fixtype(cpexpr(dp->dims[i].ub)));
939:
940: }
941: }
942: #endif
943: size = typesize[ q->vtype ];
944: if(q->vtype == TYCHAR)
945: if( ISICON(q->vleng) )
946: size *= q->vleng->constblock.const.ci;
947: else
948: size = -1;
949:
950: /* on TAHOE, get more efficient subscripting if subscripts
951: have zero-base, so fudge the argument pointers for arrays.
952: Not done if array bounds are being checked.
953: */
954: if(dp->basexpr)
955: puteq( cpexpr(fixtype(dp->baseoffset)),
956: cpexpr(fixtype(dp->basexpr)));
957: #ifdef SDB
958: if( (! checksubs) && (! sdbflag) )
959: #else
960: if(! checksubs)
961: #endif
962: {
963: if(dp->basexpr)
964: {
965: if(size > 0)
966: tp = (expptr) ICON(size);
967: else
968: tp = (expptr) cpexpr(q->vleng);
969: putforce(TYINT,
970: fixtype( mkexpr(OPSTAR, tp,
971: cpexpr(dp->baseoffset)) ));
972: p2pi("\tsubl2\tr0,%d(r12)",
973: p->datap->nameblock.vardesc.varno +
974: ARGOFFSET);
975: }
976: else if(dp->baseoffset->constblock.const.ci != 0)
977: {
978: if(size > 0)
979: {
980: p2pij("\tsubl2\t$%ld,%d(r12)",
981: dp->baseoffset->constblock.const.ci * size,
982: p->datap->nameblock.vardesc.varno +
983: ARGOFFSET);
984: }
985: else {
986: putforce(TYINT, mkexpr(OPSTAR, cpexpr(dp->baseoffset),
987: cpexpr(q->vleng) ));
988: p2pi("\tsubl2\tr0,%d(r12)",
989: p->datap->nameblock.vardesc.varno +
990: ARGOFFSET);
991: }
992: }
993: }
994: }
995: }
996:
997: if(typeaddr)
998: puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
999: /* replace to avoid long jump problem
1000: putgoto(ep->entrylabel);
1001: */
1002: p2pi("\tjbr\tL%d", ep->entrylabel);
1003: }
1004:
1005: prhead(fp)
1006: FILEP fp;
1007: {
1008: #if FAMILY==PCC
1009: p2triple(PCCF_FLBRAC, ARGREG-highregvar, procno);
1010: p2word( (long) (BITSPERCHAR*autoleng) );
1011: p2flush();
1012: #endif
1013: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.