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