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