2.9BSD - /usr/src/ucb/pascal/pi/put.c

   1: /*	@(#)put.c	2.3	SCCS id keyword	*/
   2: /* Copyright (c) 1979 Regents of the University of California */
   3: #
   4: /*
   5:  * pi - Pascal interpreter code translator
   6:  *
   7:  * Charles Haley, Bill Joy UCB
   8:  * Version 1.2 November 1978
   9:  */
  10: 
  11: #include "whoami"
  12: #include "opcode.h"
  13: #include "0.h"
  14: 
  15: short   *obufp  = obuf;
  16: 
  17: /*
  18:  * If DEBUG is defined, include the table
  19:  * of the printing opcode names.
  20:  */
  21: #ifdef DEBUG
  22: char    *otext[] = {
  23: #include "OPnames.h"
  24: };
  25: #endif
  26: 
  27: /*
  28:  * Put is responsible for the interpreter equivalent of code
  29:  * generation.  Since the interpreter is specifically designed
  30:  * for Pascal, little work is required here.
  31:  */
  32: put(a)
  33: {
  34:     register int *p, i;
  35:     register char *cp;
  36:     int n, subop, suboppr, op, oldlc, w;
  37:     char *string;
  38:     static int casewrd;
  39: 
  40:     /*
  41: 	 * It would be nice to do some more
  42: 	 * optimizations here.  The work
  43: 	 * done to collapse offsets in lval
  44: 	 * should be done here, the IFEQ etc
  45: 	 * relational operators could be used
  46: 	 * etc.
  47: 	 */
  48:     oldlc = lc;
  49:     if (cgenflg)
  50:         /*
  51: 		 * code disabled - do nothing
  52: 		 */
  53:         return (oldlc);
  54:     p = &a;
  55:     n = *p++;
  56:     suboppr = subop = (*p>>8) & 0377;
  57:     op = *p & 0377;
  58:     string = 0;
  59: #ifdef DEBUG
  60:     if ((cp = otext[op]) == NIL) {
  61:         printf("op= %o\n", op);
  62:         panic("put");
  63:     }
  64: #endif
  65:     switch (op) {
  66: /*****
  67: 		case O_LINO:
  68: 			if (line == codeline)
  69: 				return (oldlc);
  70: 			codeline = line;
  71: *****/
  72:         case O_PUSH:
  73:         case O_POP:
  74:             if (p[1] == 0)
  75:                 return (oldlc);
  76:         case O_NEW:
  77:         case O_DISPOSE:
  78:         case O_AS:
  79:         case O_IND:
  80:         case O_OFF:
  81:         case O_INX2:
  82:         case O_INX4:
  83:         case O_CARD:
  84:         case O_ADDT:
  85:         case O_SUBT:
  86:         case O_MULT:
  87:         case O_IN:
  88:         case O_CASE1OP:
  89:         case O_CASE2OP:
  90:         case O_CASE4OP:
  91:         case O_PACK:
  92:         case O_UNPACK:
  93:         case O_RANG2:
  94:         case O_RSNG2:
  95:         case O_RANG42:
  96:         case O_RSNG42:
  97:             if (p[1] == 0)
  98:                 break;
  99:         case O_CON2:
 100:             if (p[1] < 128 && p[1] >= -128) {
 101:                 suboppr = subop = p[1];
 102:                 p++;
 103:                 n--;
 104:                 if (op == O_CON2)
 105:                     op = O_CON1;
 106:             }
 107:             break;
 108:         case O_CON8:
 109:             {
 110:             short   *sp = &p[1];
 111: 
 112: #ifdef  DEBUG
 113:             if ( opt( 'c' ) )
 114:                 printf ( "%5d\tCON8\t%10.3f\n" , lc
 115:                    , * ( ( double * ) &p[1] ) );
 116: #endif
 117:             word ( op );
 118:             for ( i = 1 ; i <= 4 ; i ++ )
 119:                 word ( *sp ++ );
 120:             return ( oldlc );
 121:             }
 122:         default:
 123:             if (op >= O_REL2 && op <= O_REL84) {
 124:                 if ((i = (subop >> 1) * 5 ) >= 30)
 125:                     i -= 30;
 126:                 else
 127:                     i += 2;
 128: #ifdef DEBUG
 129:                 string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
 130: #endif
 131:                 suboppr = 0;
 132:             }
 133:             break;
 134:         case O_IF:
 135:         case O_TRA:
 136: /*****
 137: 			codeline = 0;
 138: *****/
 139:         case O_CALL:
 140:         case O_FOR1U:
 141:         case O_FOR2U:
 142:         case O_FOR4U:
 143:         case O_FOR1D:
 144:         case O_FOR2D:
 145:         case O_FOR4D:
 146:             p[1] -= (unsigned) lc + 2;
 147:             break;
 148:         case O_WRIT82:
 149: #ifdef DEBUG
 150:             string = &"22\024\042\044"[subop*3];
 151: #endif
 152:             suboppr = 0;
 153:             break;
 154:         case O_CONG:
 155:             i = p[1];
 156:             cp = * ( ( char ** ) &p[2] ) ;
 157: #ifdef DEBUG
 158:             if (opt('c'))
 159:                 printf("%5d\tCONG:%d\t%s\n", lc, i, cp);
 160: #endif
 161:             if (i <= 127)
 162:                 word(O_CON | i << 8);
 163:             else {
 164:                 word(O_CON);
 165:                 word(i);
 166:             }
 167:             while (i > 0) {
 168:                 w = *cp ? *cp++ : ' ';
 169:                 w |= (*cp ? *cp++ : ' ') << 8;
 170:                 word(w);
 171:                 i -= 2;
 172:             }
 173:             return (oldlc);
 174:         case O_CONC:
 175: #ifdef DEBUG
 176:             (string = "'x'")[1] = p[1];
 177: #endif
 178:             suboppr = 0;
 179:             op = O_CON1;
 180:             subop = p[1];
 181:             goto around;
 182:         case O_CON1:
 183:             suboppr = subop = p[1];
 184: around:
 185:             n--;
 186:             break;
 187:         case O_CASEBEG:
 188:             casewrd = 0;
 189:             return (oldlc);
 190:         case O_CASEEND:
 191:             if ((unsigned) lc & 1) {
 192:                 lc--;
 193:                 word(casewrd);
 194:             }
 195:             return (oldlc);
 196:         case O_CASE1:
 197: #ifdef DEBUG
 198:             if (opt('c'))
 199:                 printf("%5d\tCASE1\t%d\n"
 200:                     , lc
 201:                     , ( int ) *( ( long * ) &p[1] ) );
 202: #endif
 203:             /*
 204: 			 * this to build a byte size case table
 205: 			 * saving bytes across calls in casewrd
 206: 			 * so they can be put out by word()
 207: 			 */
 208:             lc++;
 209:             if ((unsigned) lc & 1) {
 210:                 casewrd = *( ( long * ) &p[1] ) & 0377;
 211:             } else {
 212:                 lc -= 2;
 213:                 word (   casewrd
 214:                        | ( ( int ) *( ( long * ) &p[1] ) << 8 ) );
 215:             }
 216:             return (oldlc);
 217:         case O_CASE2:
 218: #ifdef DEBUG
 219:             if (opt('c'))
 220:                 printf("%5d\tCASE2\t%d\n"
 221:                     , lc
 222:                     , ( int ) *( ( long * ) &p[1] ) );
 223: #endif
 224:             word( ( short ) *( ( long * ) &p[1] ) );
 225:             return (oldlc);
 226:         case O_CON4:
 227:         case O_CASE4:
 228:         case O_RANG4:
 229:         case O_RANG4 + 1:   /* O_RANG24 */
 230:         case O_RSNG4:
 231:         case O_RSNG4 + 1:   /* O_RSNG24 */
 232:             {
 233:             short   *sp = &p[1];
 234:             long    *lp = &p[1];
 235: 
 236: #ifdef DEBUG
 237:             if (opt('c'))
 238:                 {
 239:                 printf ( "%5d\t%s\t" , lc , cp );
 240:                 for ( i = 1 ; i < n
 241:                     ; i += sizeof ( long )/sizeof ( short ) )
 242:                     printf ( "%D " , *lp ++ );
 243:                 pchr ( '\n' );
 244:                 }
 245: #endif
 246:             if ( op != O_CASE4 )
 247:                 word ( op );
 248:             for ( i = 1 ; i < n ; i ++ )
 249:                 word ( *sp ++ );
 250:             return ( oldlc );
 251:             }
 252:     }
 253: #ifdef DEBUG
 254:     if (opt('c')) {
 255:         printf("%5d\t%s", lc, cp);
 256:         if (suboppr)
 257:             printf(":%d", suboppr);
 258:         if (string)
 259:             printf("\t%s",string);
 260:         if (n > 1)
 261:             pchr('\t');
 262:         for (i=1; i<n; i++)
 263:             printf("%d ", ( short ) p[i]);
 264:         pchr('\n');
 265:     }
 266: #endif
 267:     if (op != NIL)
 268:         word(op | subop << 8);
 269:     /*
 270: 	 * this needs to be buggered for the VAX
 271: 	 */
 272:     for (i=1; i<n; i++)
 273:         word(p[i]);
 274:     return (oldlc);
 275: }
 276: 
 277: /*
 278:  * Putspace puts out a table
 279:  * of nothing to leave space
 280:  * for the case branch table e.g.
 281:  */
 282: putspace(n)
 283:     int n;
 284: {
 285:     register i;
 286: #ifdef DEBUG
 287:     if (opt('c'))
 288:         printf("%5d\t.=.+%d\n", lc, n);
 289: #endif
 290:     for (i = even(n); i > 0; i -= 2)
 291:         word(0);
 292: }
 293: 
 294: /*
 295:  * Patch repairs the branch
 296:  * at location loc to come
 297:  * to the current location.
 298:  */
 299: patch(loc)
 300: {
 301: 
 302:     patchfil(loc, lc-loc-2);
 303: }
 304: 
 305: /*
 306:  * Patchfil makes loc+2 have value
 307:  * as its contents.
 308:  */
 309: patchfil(loc, value)
 310:     char *loc;
 311:     int value;
 312: {
 313:     register i;
 314: 
 315:     if (cgenflg < 0)
 316:         return;
 317:     if (loc > lc)
 318:         panic("patchfil");
 319: #ifdef DEBUG
 320:     if (opt('c'))
 321:         printf("\tpatch %u %d\n", loc, value);
 322: #endif
 323:     i = ((unsigned) loc + 2 - ((unsigned) lc & ~0777))/2;
 324:     if (i >= 0 && i < 512)
 325:         obuf[i] = value;
 326:     else {
 327:         lseek(ofil, (long) loc+2, 0);
 328:         write(ofil, &value, 2);
 329:         lseek(ofil, (long) 0, 2);
 330:     }
 331: }
 332: 
 333: /*
 334:  * Put the word o into the code
 335:  */
 336: word(o)
 337:     int o;
 338: {
 339: 
 340:     *obufp = o;
 341:     obufp++;
 342:     lc += 2;
 343:     if (obufp >= obuf+256)
 344:         pflush();
 345: }
 346: 
 347: extern char *obj;
 348: /*
 349:  * Flush the code buffer
 350:  */
 351: pflush()
 352: {
 353:     register i;
 354: 
 355:     i = (obufp - ( ( short * ) obuf ) ) * 2;
 356:     if (i != 0 && write(ofil, obuf, i) != i)
 357:         perror(obj), pexit(DIED);
 358:     obufp = obuf;
 359: }
 360: 
 361: /*
 362:  * Getlab - returns the location counter.
 363:  * included here for the eventual code generator.
 364:  */
 365: getlab()
 366: {
 367: 
 368:     return (lc);
 369: }
 370: 
 371: /*
 372:  * Putlab - lay down a label.
 373:  */
 374: putlab(l)
 375:     int l;
 376: {
 377: 
 378:     return (l);
 379: }

Defined functions

Defined variables