2.9BSD - /usr/src/cmd/f77/pdp11.c

   1: #include "defs"
   2: #include "string_defs"
   3: #if FAMILY == DMR
   4: #	include "dmrdefs"
   5: #endif
   6: #if FAMILY==SCJ && OUTPUT==BINARY
   7: #	include "scjdefs"
   8: #endif
   9: 
  10: /*
  11:       PDP 11-SPECIFIC PRINTING ROUTINES
  12: */
  13: 
  14: int maxregvar = 0;
  15: static char textline[50];
  16: int regnum[] = { 3, 2 };
  17: 
  18: 
  19: prsave()
  20: {
  21: }
  22: 
  23: 
  24: 
  25: goret(type)
  26: int type;
  27: {
  28: #if  FAMILY == DMR
  29:     p2op(P2RETURN);
  30: #endif
  31: #if FAMILY==SCJ
  32:     p2pass(sprintf(textline, "\tjmp\tcret"));
  33: #endif
  34: }
  35: 
  36: 
  37: 
  38: 
  39: /*
  40:  * move argument slot arg1 (relative to ap)
  41:  * to slot arg2 (relative to ARGREG)
  42:  */
  43: 
  44: mvarg(type, arg1, arg2)
  45: int type, arg1, arg2;
  46: {
  47: mvarg1(arg1+4, arg2);
  48: if(type == TYLONG)
  49:     mvarg1(arg1+6, arg2+2);
  50: }
  51: 
  52: 
  53: 
  54: 
  55: mvarg1(m, n)
  56: int m, n;
  57: {
  58: #if FAMILY == DMR
  59:     p2reg(ARGREG, P2SHORT|P2PTR);
  60:     p2op2(P2ICON, P2SHORT);
  61:     p2i(n);
  62:     p2op2(P2PLUS, P2SHORT|P2PTR);
  63:     p2op2(P2INDIRECT, P2SHORT);
  64:     p2reg(AUTOREG, P2SHORT|P2PTR);
  65:     p2op2(P2ICON, P2SHORT);
  66:     p2i(m);
  67:     p2op2(P2PLUS, P2SHORT|P2PTR);
  68:     p2op2(P2INDIRECT, P2SHORT);
  69:     p2op2(P2ASSIGN, P2SHORT);
  70:     putstmt();
  71: #endif
  72: #if FAMILY == SCJ
  73:     p2pass(sprintf(textline, "\tmov\t%d.(r5),%d.(r4)", m, n));
  74: #endif
  75: }
  76: 
  77: 
  78: 
  79: 
  80: prlabel(fp, k)
  81: FILEP fp;
  82: int k;
  83: {
  84: fprintf(fp, "L%d:\n", k);
  85: }
  86: 
  87: 
  88: 
  89: prconi(fp, type, n)
  90: FILEP fp;
  91: int type;
  92: ftnint n;
  93: {
  94: register int *np;
  95: np = &n;
  96: if(type == TYLONG)
  97:     fprintf(fp, "\t%d.;%d.\n", np[0], np[1]);
  98: else
  99:     fprintf(fp, "\t%d.\n", np[1]);
 100: }
 101: 
 102: 
 103: 
 104: prcona(fp, a)
 105: FILEP fp;
 106: ftnint a;
 107: {
 108: fprintf(fp, "L%ld\n", a);
 109: }
 110: 
 111: 
 112: 
 113: #if HERE!=PDP11
 114: BAD NEWS
 115: #endif
 116: 
 117: #if HERE==PDP11
 118: prconr(fp, type, x)
 119: FILEP fp;
 120: int type;
 121: double x;
 122: {
 123: register int k, *n;
 124: n = &x; /* nonportable cheat */
 125: k = (type==TYREAL ? 2 : 4);
 126: fprintf(fp, "\t");
 127: while(--k >= 0)
 128:     fprintf(fp, "%d.%c", *n++, (k==0 ? '\n' : ';') );
 129: }
 130: #endif
 131: 
 132: 
 133: 
 134: 
 135: preven(k)
 136: int k;
 137: {
 138: if(k > 1)
 139:     fprintf(asmfile, "\t.even\n", k);
 140: }
 141: 
 142: 
 143: 
 144: #if FAMILY == SCJ
 145: 
 146: prcmgoto(p, nlab, skiplabel, labarray)
 147: expptr p;
 148: int nlab, skiplabel, labarray;
 149: {
 150: int regno;
 151: 
 152: putforce(p->vtype, p);
 153: 
 154: if(p->vtype == TYLONG)
 155:     {
 156:     regno = 1;
 157:     p2pass(sprintf(textline, "\ttst\tr0"));
 158:     p2pass(sprintf(textline, "\tbne\tL%d", skiplabel));
 159:     }
 160: else
 161:     regno = 0;
 162: 
 163: p2pass(sprintf(textline, "\tcmp\tr%d,$%d.", regno, nlab));
 164: p2pass(sprintf(textline, "\tbhi\tL%d", skiplabel));
 165: p2pass(sprintf(textline, "\tasl\tr%d", regno));
 166: p2pass(sprintf(textline, "\tjmp\t*L%d(r%d)", labarray, regno));
 167: }
 168: 
 169: 
 170: prarif(p, neg,zer,pos)
 171: expptr p;
 172: int neg, zer, pos;
 173: {
 174: register int ptype;
 175: 
 176: putforce( ptype = p->vtype, p);
 177: if( ISINT(ptype) )
 178:     {
 179:     p2pass(sprintf(textline, "\ttst\tr0"));
 180:     p2pass(sprintf(textline, "\tjlt\tL%d", neg));
 181:     p2pass(sprintf(textline, "\tjgt\tL%d", pos));
 182:     if(ptype != TYSHORT)
 183:         {
 184:         p2pass(sprintf(textline, "\ttst\tr1"));
 185:         p2pass(sprintf(textline, "\tjeq\tL%d", zer));
 186:         }
 187:     p2pass(sprintf(textline, "\tjbr\tL%d", pos));
 188:     }
 189: else
 190:     {
 191:     p2pass(sprintf(textline, "\ttstf\tr0"));
 192:     p2pass(sprintf(textline, "\tcfcc"));
 193:     p2pass(sprintf(textline, "\tjeq\tL%d", zer));
 194:     p2pass(sprintf(textline, "\tjlt\tL%d", neg));
 195:     p2pass(sprintf(textline, "\tjmp\tL%d", pos));
 196:     }
 197: }
 198: 
 199: #endif
 200: 
 201: 
 202: 
 203: 
 204: char *memname(stg, mem)
 205: int stg, mem;
 206: {
 207: static char s[20];
 208: 
 209: switch(stg)
 210:     {
 211:     case STGCOMMON:
 212:     case STGEXT:
 213:         sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) );
 214:         break;
 215: 
 216:     case STGBSS:
 217:     case STGINIT:
 218:         sprintf(s, "v.%d", mem);
 219:         break;
 220: 
 221:     case STGCONST:
 222:         sprintf(s, "L%d", mem);
 223:         break;
 224: 
 225:     case STGEQUIV:
 226:         sprintf(s, "q.%d", mem);
 227:         break;
 228: 
 229:     default:
 230:         error("memname: invalid vstg %d", stg, 0, FATAL1);
 231:     }
 232: return(s);
 233: }
 234: 
 235: 
 236: prlocvar(s, len)
 237: char *s;
 238: ftnint len;
 239: {
 240: fprintf(asmfile, "%s:", s);
 241: prskip(asmfile, len);
 242: }
 243: 
 244: 
 245: 
 246: prext(name, leng, init)
 247: char *name;
 248: ftnint leng;
 249: int init;
 250: {
 251: if(leng==0 || init)
 252:     fprintf(asmfile, "\t.globl\t_%s\n", name);
 253: else
 254:     fprintf(asmfile, "\t.comm\t_%s,%ld.\n", name, leng);
 255: }
 256: 
 257: 
 258: 
 259: prendproc()
 260: {
 261: }
 262: 
 263: 
 264: 
 265: prtail()
 266: {
 267: #if FAMILY == SCJ
 268:     p2pass(sprintf(textline, "\t.globl\tcsv,cret"));
 269: #else
 270:     p2op(P2EOF);
 271: #endif
 272: }
 273: 
 274: 
 275: 
 276: prolog(ep, argvec)
 277: struct entrypoint *ep;
 278: struct addrblock *argvec;
 279: {
 280: int i, argslot, proflab;
 281: register chainp p;
 282: register struct nameblock *q;
 283: register struct dimblock *dp;
 284: struct constblock *mkaddcon();
 285: 
 286: if(procclass == CLMAIN)
 287:     prentry("MAIN__");
 288: 
 289: if(ep->entryname)
 290:     prentry( varstr(XL, ep->entryname->extname) );
 291: 
 292: if(procclass == CLBLOCK)
 293:     return;
 294: if(profileflag)
 295:     proflab = newlabel();
 296: #if FAMILY == SCJ
 297:     if(profileflag)
 298:         {
 299:         fprintf(asmfile, "L%d:\t. = .+2\n", proflab);
 300:         p2pass(sprintf(textline, "\tmov\t$L%d,r0", proflab));
 301:         p2pass(sprintf(textline, "\tjsr\tpc,mcount"));
 302:         }
 303:     p2pass(sprintf(textline, "\tjsr\tr5,csv"));
 304:     p2pass(sprintf(textline, "\tsub\t$.F%d,sp", procno));
 305: #else
 306:     if(profileflag)
 307:         p2op2(P2PROFIL, proflab);
 308:     p2op(P2SAVE);
 309:     p2op2(P2SETSTK, ( (((int) autoleng)+1) & ~01) );
 310: #endif
 311: 
 312: if(argvec == NULL)
 313:     addreg(argloc = 4);
 314: else
 315:     {
 316:     addreg( argloc = argvec->memoffset->const.ci );
 317:     if(proctype == TYCHAR)
 318:         {
 319:         mvarg(TYADDR, 0, chslot);
 320:         mvarg(TYLENG, SZADDR, chlgslot);
 321:         argslot = SZADDR + SZLENG;
 322:         }
 323:     else if( ISCOMPLEX(proctype) )
 324:         {
 325:         mvarg(TYADDR, 0, cxslot);
 326:         argslot = SZADDR;
 327:         }
 328:     else
 329:         argslot = 0;
 330: 
 331:     for(p = ep->arglist ; p ; p =p->nextp)
 332:         {
 333:         q = p->datap;
 334:         mvarg(TYADDR, argslot, q->vardesc.varno);
 335:         argslot += SZADDR;
 336:         }
 337:     for(p = ep->arglist ; p ; p = p->nextp)
 338:         {
 339:         q = p->datap;
 340:         if(q->vtype==TYCHAR || q->vclass==CLPROC)
 341:             {
 342:             if( q->vleng && ! ISCONST(q->vleng) )
 343:                 mvarg(TYLENG, argslot, q->vleng->memno);
 344:             argslot += SZLENG;
 345:             }
 346:         }
 347:     }
 348: 
 349: for(p = ep->arglist ; p ; p = p->nextp)
 350:     if(dp = ( (struct nameblock *) (p->datap) ) ->vdim)
 351:         {
 352:         for(i = 0 ; i < dp->ndim ; ++i)
 353:             if(dp->dims[i].dimexpr)
 354:                 puteq( fixtype(cpexpr(dp->dims[i].dimsize)),
 355:                     fixtype(cpexpr(dp->dims[i].dimexpr)));
 356:         if(dp->basexpr)
 357:             puteq(  cpexpr(fixtype(dp->baseoffset)),
 358:                 cpexpr(fixtype(dp->basexpr)));
 359:         }
 360: 
 361: if(typeaddr)
 362:     puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
 363: putgoto(ep->entrylabel);
 364: }
 365: 
 366: 
 367: 
 368: prentry(s)
 369: char *s;
 370: {
 371: #if FAMILY == SCJ
 372:     p2pass(sprintf(textline, "_%s:", s));
 373: #else
 374:     p2op(P2RLABEL);
 375:     putc('_', textfile);
 376:     p2str(s);
 377: #endif
 378: }
 379: 
 380: 
 381: 
 382: 
 383: addreg(k)
 384: int k;
 385: {
 386: #if FAMILY == SCJ
 387:     p2pass(sprintf(textline, "\tmov\tr5,r4"));
 388:     p2pass(sprintf(textline, "\tadd\t$%d.,r4", k));
 389: #else
 390:     p2reg(ARGREG, P2SHORT);
 391:     p2reg(AUTOREG, P2SHORT);
 392:     p2op2(P2ICON, P2SHORT);
 393:     p2i(k);
 394:     p2op2(P2PLUS, P2SHORT);
 395:     p2op2(P2ASSIGN, P2SHORT);
 396:     putstmt();
 397: #endif
 398: }
 399: 
 400: 
 401: 
 402: 
 403: 
 404: prhead(fp)
 405: FILEP fp;
 406: {
 407: #if FAMILY==SCJ
 408: #	if OUTPUT == BINARY
 409:         p2triple(P2LBRACKET, ARGREG-1-highregvar, procno);
 410:         p2word( (long) (BITSPERCHAR*autoleng) );
 411:         p2flush();
 412: #	else
 413:         fprintf(fp, "[%02d\t%06ld\t%02d\t\n", procno,
 414:             BITSPERCHAR*autoleng, ARGREG-1-highregvar);
 415: #	endif
 416: #endif
 417: }
 418: 
 419: prdbginfo()
 420: {
 421: register char *s;
 422: char *t, buff[50];
 423: register struct nameblock *p;
 424: struct hashentry *hp;
 425: 
 426: if(s = entries->entryname->extname)
 427:     s = varstr(XL, s);
 428: else if(procclass == CLMAIN)
 429:     s = "MAIN__";
 430: else
 431:     return;
 432: 
 433: /*
 434:  *!Remove wierd symbol definition so f77 code may be overlayed. wfj 11/80
 435: if(procclass != CLBLOCK)
 436: 	fprintf(asmfile, "~~%s = _%s\n", s, s);
 437:  * This code equiv's a tilde name to the external name, which is normally
 438:  * used by ld(1) to specify an intra-overlay address. I have no idea what
 439:  * this was useful for. wfj--
 440:  */
 441: 
 442: for(hp = hashtab ; hp<lasthash ; ++hp)
 443:     if(p = hp->varp)
 444:     {
 445:     s = NULL;
 446:     if(p->vstg == STGARG)
 447:         s = sprintf(buff, "%o", p->vardesc.varno+argloc);
 448:     else if(p->vclass == CLVAR)
 449:         switch(p->vstg)
 450:             {
 451:             case STGBSS:
 452:             case STGINIT:
 453:             case STGEQUIV:
 454:                 t = memname(p->vstg, p->vardesc.varno);
 455:                 if(p->voffset)
 456:                     s = sprintf(buff, "%s+%o", t, p->voffset);
 457:                 else
 458:                     s = sprintf(buff, "%s", t);
 459:                 break;
 460: 
 461:             case STGAUTO:
 462:                 s = sprintf(buff, "%o", p->voffset);
 463:                 break;
 464: 
 465:             default:
 466:                 break;
 467:             }
 468:     if(s)
 469:         fprintf(asmfile, "~%s = %s\n", varstr(VL,p->varname), s);
 470:     }
 471: fprintf(asmfile, "~~:\n");
 472: }

Defined functions

Defined variables