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