xref: /original-bsd/usr.bin/f77/pass1.vax/vax.c (revision 2301fdfb)
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.3 (Berkeley) 01/03/88";
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->constant.ci;
407       return (shrt);
408 
409     case TYLONG:
410     case TYLOGICAL:
411     case TYREAL:
412       *((int *) lng) = cp->constant.ci;
413       return (lng);
414 
415     case TYDREAL:
416       ip = (int *) quad;
417       jp = (int *) &(cp->constant.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->constant.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->constant.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.constant.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.constant.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.constant.ci != 0)
1013 				{
1014 				char buff[25];
1015 				if(size > 0)
1016 					{
1017 					sprintf(buff, "\tsubl2\t$%ld,%d(ap)",
1018 						dp->baseoffset->constblock.constant.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 }
1063