4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/vax.c

   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.2 (Berkeley) 8/29/85";
   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->const.ci;
 407:       return (shrt);
 408: 
 409:     case TYLONG:
 410:     case TYLOGICAL:
 411:     case TYREAL:
 412:       *((int *) lng) = cp->const.ci;
 413:       return (lng);
 414: 
 415:     case TYDREAL:
 416:       ip = (int *) quad;
 417:       jp = (int *) &(cp->const.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->const.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->const.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.const.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.const.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.const.ci != 0)
1013:                 {
1014:                 char buff[25];
1015:                 if(size > 0)
1016:                     {
1017:                     sprintf(buff, "\tsubl2\t$%ld,%d(ap)",
1018:                         dp->baseoffset->constblock.const.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: }

Defined functions

Defined variables