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->constant.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->constant);
364     case TYCOMPLEX:
365       { static float quad[2];
366       quad[0] = cp->constant.cd[0];
367       quad[1] = cp->constant.cd[1];
368       return ((char *)quad);
369       }
370 #endif
371 
372 #if HERE == VAX
373     case TYLONG:
374     case TYLOGICAL:
375       swab4((char *)&cp->constant.ci, lng, 4);
376       return (lng);
377 
378     case TYSHORT:
379     case TYREAL:
380     case TYDREAL:
381     case TYDCOMPLEX:
382       swab((char *)cp->constant.cd, shrt, typesize[cp->vtype]);
383       return (shrt);
384     case TYCOMPLEX:
385       swab((char *)cp->constant.cd, shrt, 4);
386       swab((char *)&(cp->constant.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.constant.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.constant.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.constant.ci != 0)
977 				{
978 				if(size > 0)
979 					{
980 					p2pij("\tsubl2\t$%ld,%d(r12)",
981 						dp->baseoffset->constblock.constant.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 }
1014