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