![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to lcode.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / link|
Return to lcode.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / link |
1.1 ! root 1: /* ! 2: * Routines to parse .u1 files and produce icode. ! 3: */ ! 4: ! 5: #include "ilink.h" ! 6: #include "opcode.h" ! 7: #include "datatype.h" ! 8: ! 9: static int pc = 0; /* simulated program counter */ ! 10: ! 11: /* ! 12: * gencode - read .u1 file, resolve variable references, and generate icode. ! 13: * Basic process is to read each line in the file and take some action ! 14: * as dictated by the opcode. This action sometimes involves parsing ! 15: * of operands and usually culminates in the call of the appropriate ! 16: * emit* routine. ! 17: * ! 18: * Appendix C of the "tour" has a complete description of the intermediate ! 19: * language that gencode parses. ! 20: */ ! 21: gencode() ! 22: { ! 23: register int op, k, lab; ! 24: int j, nargs, flags, implicit; ! 25: char *id, *name, *procname; ! 26: struct centry *cp; ! 27: struct gentry *gp; ! 28: struct fentry *fp, *flocate(); ! 29: ! 30: extern long getint(); ! 31: extern double getreal(); ! 32: extern char *getid(), *getstrlit(); ! 33: extern struct gentry *glocate(); ! 34: ! 35: while ((op = getop(&name)) != EOF) { ! 36: switch (op) { ! 37: ! 38: /* Ternary operators. */ ! 39: ! 40: case OP_TOBY: ! 41: case OP_SECT: ! 42: ! 43: /* Binary operators. */ ! 44: ! 45: case OP_ASGN: ! 46: case OP_CAT: ! 47: case OP_DIFF: ! 48: case OP_DIV: ! 49: case OP_EQV: ! 50: case OP_INTER: ! 51: case OP_LCONCAT: ! 52: case OP_LEXEQ: ! 53: case OP_LEXGE: ! 54: case OP_LEXGT: ! 55: case OP_LEXLE: ! 56: case OP_LEXLT: ! 57: case OP_LEXNE: ! 58: case OP_MINUS: ! 59: case OP_MOD: ! 60: case OP_MULT: ! 61: case OP_NEQV: ! 62: case OP_NUMEQ: ! 63: case OP_NUMGE: ! 64: case OP_NUMGT: ! 65: case OP_NUMLE: ! 66: case OP_NUMLT: ! 67: case OP_NUMNE: ! 68: case OP_PLUS: ! 69: case OP_POWER: ! 70: case OP_RASGN: ! 71: case OP_RSWAP: ! 72: case OP_SUBSC: ! 73: case OP_SWAP: ! 74: case OP_UNIONCS: ! 75: ! 76: /* Unary operators. */ ! 77: ! 78: case OP_BANG: ! 79: case OP_COMPL: ! 80: case OP_NEG: ! 81: case OP_NONNULL: ! 82: case OP_NULL: ! 83: case OP_NUMBER: ! 84: case OP_RANDOM: ! 85: case OP_REFRESH: ! 86: case OP_SIZE: ! 87: case OP_TABMAT: ! 88: case OP_VALUE: ! 89: ! 90: /* Instructions. */ ! 91: ! 92: case OP_BSCAN: ! 93: case OP_CCASE: ! 94: case OP_COACT: ! 95: case OP_COFAIL: ! 96: case OP_CORET: ! 97: case OP_DUP: ! 98: case OP_EFAIL: ! 99: case OP_ERET: ! 100: case OP_ESCAN: ! 101: case OP_ESUSP: ! 102: case OP_INCRES: ! 103: case OP_LIMIT: ! 104: case OP_LSUSP: ! 105: case OP_PFAIL: ! 106: case OP_PNULL: ! 107: case OP_POP: ! 108: case OP_PRET: ! 109: case OP_PSUSP: ! 110: case OP_PUSH1: ! 111: case OP_PUSHN1: ! 112: case OP_SDUP: ! 113: newline(); ! 114: emit(op, name); ! 115: break; ! 116: ! 117: case OP_CHFAIL: ! 118: case OP_CREATE: ! 119: case OP_GOTO: ! 120: case OP_INIT: ! 121: lab = getlab(); ! 122: newline(); ! 123: emitl(op, lab, name); ! 124: break; ! 125: ! 126: case OP_CSET: ! 127: case OP_REAL: ! 128: k = getdec(); ! 129: newline(); ! 130: emitr(op, ctable[k].c_pc, name); ! 131: break; ! 132: ! 133: case OP_FIELD: ! 134: id = getid(); ! 135: newline(); ! 136: fp = flocate(id); ! 137: if (fp == NULL) { ! 138: err(id, "invalid field name", 0); ! 139: break; ! 140: } ! 141: emitn(op, fp->f_fid-1, name); ! 142: break; ! 143: ! 144: case OP_FILE: ! 145: file = getid(); ! 146: newline(); ! 147: emiti(op, file - strings, name); ! 148: break; ! 149: ! 150: case OP_INT: ! 151: k = getdec(); ! 152: newline(); ! 153: cp = &ctable[k]; ! 154: if (cp->c_flag & F_LONGLIT) ! 155: emitr(OP_CON, cp->c_pc, name); ! 156: else { ! 157: int i; ! 158: i = (int)cp->c_val.ival; ! 159: if (i >= 0 && i < 16) ! 160: emit(OP_INTX+i, name); ! 161: else ! 162: emitint(op, i, name); ! 163: } ! 164: break; ! 165: ! 166: case OP_INVOKE: ! 167: k = getdec(); ! 168: newline(); ! 169: abbrev(op, k, name, OP_INVKX, 8); ! 170: break; ! 171: ! 172: case OP_KEYWD: ! 173: case OP_LLIST: ! 174: k = getdec(); ! 175: newline(); ! 176: emitn(op, k, name); ! 177: break; ! 178: ! 179: case OP_LAB: ! 180: lab = getlab(); ! 181: newline(); ! 182: if (Dflag) ! 183: fprintf(dbgfile, "L%d:\n", lab); ! 184: backpatch(lab); ! 185: break; ! 186: ! 187: case OP_LINE: ! 188: line = getdec(); ! 189: newline(); ! 190: abbrev(op, line, name, OP_LINEX, 64); ! 191: break; ! 192: ! 193: case OP_MARK: ! 194: lab = getlab(); ! 195: newline(); ! 196: if (lab != 0) ! 197: emitl(op, lab, name); ! 198: else ! 199: emit(OP_MARK0, "mark0"); ! 200: break; ! 201: ! 202: case OP_STR: ! 203: k = getdec(); ! 204: newline(); ! 205: cp = &ctable[k]; ! 206: id = cp->c_val.sval; ! 207: emitin(op, id-strings, cp->c_length, name); ! 208: break; ! 209: ! 210: case OP_UNMARK: ! 211: k = getdec(); ! 212: newline(); ! 213: abbrev(op, k, name, OP_UNMKX, 8); ! 214: break; ! 215: ! 216: case OP_VAR: ! 217: k = getdec(); ! 218: newline(); ! 219: flags = ltable[k].l_flag; ! 220: if (flags & F_GLOBAL) ! 221: abbrev(OP_GLOBAL, ltable[k].l_val.global-gtable, "global", ! 222: OP_GLOBX, 16); ! 223: else if (flags & F_STATIC) ! 224: abbrev(OP_STATIC, ltable[k].l_val.staticid-1, "static", ! 225: OP_STATX, 8); ! 226: else if (flags & F_ARGUMENT) ! 227: abbrev(OP_ARG, nargs-ltable[k].l_val.offset, "arg", ! 228: OP_ARGX, 8); ! 229: else ! 230: abbrev(OP_LOCAL, ltable[k].l_val.offset-1, "local", ! 231: OP_LOCX, 16); ! 232: break; ! 233: ! 234: /* Declarations. */ ! 235: ! 236: case OP_PROC: ! 237: procname = getid(); ! 238: newline(); ! 239: locinit(); ! 240: clearlab(); ! 241: line = 0; ! 242: gp = glocate(procname); ! 243: implicit = gp->g_flag & F_IMPERROR; ! 244: nargs = gp->g_nargs; ! 245: emiteven(); ! 246: break; ! 247: ! 248: case OP_LOCAL: ! 249: k = getdec(); ! 250: flags = getoct(); ! 251: id = getid(); ! 252: putloc(k, id, flags, implicit, procname); ! 253: break; ! 254: ! 255: case OP_CON: ! 256: k = getdec(); ! 257: flags = getoct(); ! 258: if (flags & F_INTLIT) ! 259: putconst(k, flags, 0, pc, getint()); ! 260: else if (flags & F_REALLIT) ! 261: putconst(k, flags, 0, pc, getreal()); ! 262: else if (flags & F_STRLIT) { ! 263: j = getdec(); ! 264: putconst(k, flags, j, pc, getstrlit(j)); ! 265: } ! 266: else if (flags & F_CSETLIT) { ! 267: j = getdec(); ! 268: putconst(k, flags, j, pc, getstrlit(j)); ! 269: } ! 270: else ! 271: fprintf(stderr, "gencode: illegal constant\n"); ! 272: newline(); ! 273: emitcon(k); ! 274: break; ! 275: ! 276: case OP_DECLEND: ! 277: newline(); ! 278: gp->g_pc = pc; ! 279: emitproc(procname, nargs, dynoff, statics-static1, static1); ! 280: break; ! 281: ! 282: case OP_END: ! 283: newline(); ! 284: flushcode(); ! 285: break; ! 286: ! 287: default: ! 288: fprintf(stderr, "gencode: illegal opcode(%d): %s\n", op, name); ! 289: newline(); ! 290: } ! 291: } ! 292: } ! 293: ! 294: /* ! 295: * abbrev - for certain opcodes with integer arguments that are small enough, ! 296: * use an abbreviated opcode that includes the integer argument in it. ! 297: */ ! 298: abbrev(op, n, name, altop, limit) ! 299: int op, n; ! 300: char *name; ! 301: int altop, limit; ! 302: { ! 303: if (n >= 0 && n < limit) ! 304: emit(altop+n, name); ! 305: else ! 306: emitn(op, n, name); ! 307: } ! 308: ! 309: /* ! 310: * emit - emit opcode. ! 311: * emitl - emit opcode with reference to program label, consult the "tour" ! 312: * for a description of the chaining and backpatching for labels. ! 313: * emitn - emit opcode with integer argument. ! 314: * emitr - emit opcode with pc-relative reference. ! 315: * emiti - emit opcode with reference to identifier table. ! 316: * emitin - emit opcode with reference to identifier table & integer argument. ! 317: * emitint - emit INT opcode with integer argument. ! 318: * emiteven - emit null bytes to bring pc to word boundary. ! 319: * emitcon - emit constant table entry. ! 320: * emitproc - emit procedure block. ! 321: * ! 322: * The emit* routines call out* routines to effect the "outputting" of icode. ! 323: * Note that the majority of the code for the emit* routines is for debugging ! 324: * purposes. ! 325: */ ! 326: emit(op, name) ! 327: int op; ! 328: char *name; ! 329: { ! 330: if (Dflag) ! 331: fprintf(dbgfile, "%d:\t%d\t\t\t\t# %s\n", pc, op, name); ! 332: outop(op); ! 333: } ! 334: ! 335: emitl(op, lab, name) ! 336: int op, lab; ! 337: char *name; ! 338: { ! 339: if (Dflag) ! 340: fprintf(dbgfile, "%d:\t%d\tL%d\t\t\t# %s\n", pc, op, lab, name); ! 341: if (lab >= maxlabels) ! 342: syserr("too many labels in ucode"); ! 343: outop(op); ! 344: if (labels[lab] <= 0) { /* forward reference */ ! 345: outopnd(labels[lab]); ! 346: labels[lab] = OPNDSIZE - pc; /* add to front of reference chain */ ! 347: } ! 348: else /* output relative offset */ ! 349: outopnd(labels[lab] - (pc + OPNDSIZE)); ! 350: } ! 351: ! 352: emitn(op, n, name) ! 353: int op, n; ! 354: char *name; ! 355: { ! 356: if (Dflag) ! 357: fprintf(dbgfile, "%d:\t%d\t%d\t\t\t# %s\n", pc, op, n, name); ! 358: outop(op); ! 359: outopnd(n); ! 360: } ! 361: ! 362: emitr(op, loc, name) ! 363: int op, loc; ! 364: char *name; ! 365: { ! 366: loc -= pc + (OPSIZE + OPNDSIZE); ! 367: if (Dflag) { ! 368: if (loc >= 0) ! 369: fprintf(dbgfile, "%d:\t%d\t*+%d\t\t\t# %s\n", pc, op, loc, name); ! 370: else ! 371: fprintf(dbgfile, "%d:\t%d\t*-%d\t\t\t# %s\n", pc, op, -loc, name); ! 372: } ! 373: outop(op); ! 374: outopnd(loc); ! 375: } ! 376: ! 377: emiti(op, offset, name) ! 378: int op, offset; ! 379: char *name; ! 380: { ! 381: if (Dflag) ! 382: fprintf(dbgfile, "%d:\t%d\tI+%d\t\t\t# %s\n", pc, op, offset, name); ! 383: outop(op); ! 384: outopnd(offset); ! 385: } ! 386: ! 387: emitin(op, offset, n, name) ! 388: int op, offset, n; ! 389: char *name; ! 390: { ! 391: if (Dflag) ! 392: fprintf(dbgfile, "%d:\t%d\tI+%d,%d\t\t\t# %s\n", pc, op, offset, n, name); ! 393: outop(op); ! 394: outopnd(offset); ! 395: outopnd(n); ! 396: } ! 397: /* ! 398: * emitint can have some pitfalls. outword is used to output the ! 399: * integer and this is picked up in the interpreter as the second ! 400: * word of a short integer. The integer value output must be ! 401: * the same size as what the interpreter expects. See op_int and op_intx ! 402: * in interp.s ! 403: */ ! 404: emitint(op, i, name) ! 405: int op, i; ! 406: char *name; ! 407: { ! 408: if (Dflag) ! 409: fprintf(dbgfile, "%d:\t%d\t%d\t\t\t# %s\n", pc, op, i, name); ! 410: outop(op); ! 411: outword(i); ! 412: } ! 413: ! 414: emiteven() ! 415: { ! 416: while ((pc % WORDSIZE) != 0) { ! 417: if (Dflag) ! 418: fprintf(dbgfile, "%d:\t0\n", pc); ! 419: outop(0); ! 420: } ! 421: } ! 422: ! 423: emitcon(k) ! 424: register int k; ! 425: { ! 426: register int i; ! 427: register char *s; ! 428: int csbuf[CSETSIZE]; ! 429: union { ! 430: char ovly[1]; /* Array used to overlay l and f on a bytewise basis. */ ! 431: long int l; ! 432: double f; ! 433: } x; ! 434: ! 435: if (ctable[k].c_flag & F_REALLIT) { ! 436: x.f = ctable[k].c_val.rval; ! 437: if (Dflag) { ! 438: fprintf(dbgfile, "%d:\t%d", pc, T_REAL); ! 439: dumpblock(x.ovly,sizeof(double)); ! 440: fprintf(dbgfile, "\t\t\t( %g )\n",x.f); ! 441: } ! 442: outword(T_REAL); ! 443: outblock(x.ovly,sizeof(double)); ! 444: } ! 445: else if (ctable[k].c_flag & F_LONGLIT) { ! 446: x.l = ctable[k].c_val.ival; ! 447: if (Dflag) { ! 448: fprintf(dbgfile, "%d:\t%d", pc, T_LONGINT); ! 449: dumpblock(x.ovly,sizeof(long)); ! 450: fprintf(dbgfile,"\t\t\t( %ld)\n",x.l); ! 451: } ! 452: outword(T_LONGINT); ! 453: outblock(x.ovly,sizeof(long)); ! 454: } ! 455: else if (ctable[k].c_flag & F_CSETLIT) { ! 456: for (i = 0; i < CSETSIZE; i++) ! 457: csbuf[i] = 0; ! 458: s = ctable[k].c_val.sval; ! 459: i = ctable[k].c_length; ! 460: while (i--) { ! 461: setb(*s, csbuf); ! 462: s++; ! 463: } ! 464: if (Dflag) ! 465: fprintf(dbgfile, "%d:\t%d", pc, T_CSET); ! 466: outword(T_CSET); ! 467: outblock(csbuf,sizeof(csbuf)); ! 468: if (Dflag) ! 469: dumpblock(csbuf,CSETSIZE); ! 470: } ! 471: } ! 472: ! 473: emitproc(name, nargs, ndyn, nstat, fstat) ! 474: char *name; ! 475: int nargs, ndyn, nstat, fstat; ! 476: { ! 477: register int i; ! 478: register char *p; ! 479: int size; ! 480: /* ! 481: * ProcBlockSize = sizeof(BasicProcBlock) + ! 482: * sizeof(descrip)*(# of args + # of dynamics + # of statics). ! 483: */ ! 484: size = (9*WORDSIZE) + (2*WORDSIZE) * (nargs+ndyn+nstat); ! 485: ! 486: if (Dflag) { ! 487: fprintf(dbgfile, "%d:\t%d", pc, T_PROC); /* type code */ ! 488: fprintf(dbgfile, "\t%d", size); /* size of block */ ! 489: fprintf(dbgfile, "\tZ+%d\n", pc+size); /* entry point */ ! 490: fprintf(dbgfile, "\t%d", nargs); /* # of arguments */ ! 491: fprintf(dbgfile, "\t%d", ndyn); /* # of dynamic locals */ ! 492: fprintf(dbgfile, "\t%d", nstat); /* # of static locals */ ! 493: fprintf(dbgfile, "\t%d\n", fstat); /* first static */ ! 494: fprintf(dbgfile, "\t%d\tI+%d\t\t\t# %s\n", /* name of procedure */ ! 495: strlen(name), name-strings, name); ! 496: } ! 497: outword(T_PROC); ! 498: outword(size); ! 499: outword(pc + size - 2*WORDSIZE); /* Have to allow for the two words ! 500: that we've already output. */ ! 501: outword(nargs); ! 502: outword(ndyn); ! 503: outword(nstat); ! 504: outword(fstat); ! 505: outword(strlen(name)); ! 506: outword(name - strings); ! 507: ! 508: /* ! 509: * Output string descriptors for argument names by looping through ! 510: * all locals, and picking out those with F_ARGUMENT set. ! 511: */ ! 512: for (i = 0; i <= nlocal; i++) { ! 513: if (ltable[i].l_flag & F_ARGUMENT) { ! 514: p = ltable[i].l_name; ! 515: if (Dflag) ! 516: fprintf(dbgfile, "\t%d\tI+%d\t\t\t# %s\n", strlen(p), p-strings, p); ! 517: outword(strlen(p)); ! 518: outword(p - strings); ! 519: } ! 520: } ! 521: ! 522: /* ! 523: * Output string descriptors for local variable names. ! 524: */ ! 525: for (i = 0; i <= nlocal; i++) { ! 526: if (ltable[i].l_flag & F_DYNAMIC) { ! 527: p = ltable[i].l_name; ! 528: if (Dflag) ! 529: fprintf(dbgfile, "\t%d\tI+%d\t\t\t# %s\n", strlen(p), p-strings, p); ! 530: outword(strlen(p)); ! 531: outword(p - strings); ! 532: } ! 533: } ! 534: ! 535: /* ! 536: * Output string descriptors for local variable names. ! 537: */ ! 538: for (i = 0; i <= nlocal; i++) { ! 539: if (ltable[i].l_flag & F_STATIC) { ! 540: p = ltable[i].l_name; ! 541: if (Dflag) ! 542: fprintf(dbgfile, "\t%d\tI+%d\t\t\t# %s\n", strlen(p), p-strings, p); ! 543: outword(strlen(p)); ! 544: outword(p - strings); ! 545: } ! 546: } ! 547: } ! 548: ! 549: /* ! 550: * gentables - generate interpreter code for global, static, ! 551: * identifier, and record tables, and built-in procedure blocks. ! 552: */ ! 553: ! 554: gentables() ! 555: { ! 556: register int i; ! 557: register char *s; ! 558: register struct gentry *gp; ! 559: struct fentry *fp; ! 560: struct rentry *rp; ! 561: struct header hdr; ! 562: ! 563: emiteven(); ! 564: ! 565: /* ! 566: * Output record constructor procedure blocks. ! 567: */ ! 568: hdr.records = pc; ! 569: if (Dflag) ! 570: fprintf(dbgfile, "%d:\t%d\t\t\t\t# record blocks\n", pc, nrecords); ! 571: outword(nrecords); ! 572: for (gp = gtable; gp < gfree; gp++) { ! 573: if (gp->g_flag & (F_RECORD & ~F_GLOBAL)) { ! 574: s = gp->g_name; ! 575: gp->g_pc = pc; ! 576: if (Dflag) { ! 577: fprintf(dbgfile, "%d:", pc); ! 578: fprintf(dbgfile, "\t%d", T_PROC); ! 579: fprintf(dbgfile, "\t%d", RKBLKSIZE); ! 580: fprintf(dbgfile, "\t_mkrec+4\n"); ! 581: fprintf(dbgfile, "\t%d", gp->g_nargs); ! 582: fprintf(dbgfile, "\t-2"); ! 583: fprintf(dbgfile, "\t%d", gp->g_procid); ! 584: fprintf(dbgfile, "\t0\n"); ! 585: fprintf(dbgfile, "\t%d\tI+%d\t\t\t# %s\n", strlen(s), s-strings, s); ! 586: } ! 587: outword(T_PROC); /* type code */ ! 588: outword(RKBLKSIZE); /* size of block */ ! 589: outword(0); /* entry point (filled in by interp)*/ ! 590: outword(gp->g_nargs); /* number of fields */ ! 591: outword(-2); /* record constructor indicator */ ! 592: outword(gp->g_procid); /* record id */ ! 593: outword(0); /* not used */ ! 594: outword(strlen(s)); /* name of record */ ! 595: outword(s - strings); ! 596: } ! 597: } ! 598: ! 599: /* ! 600: * Output record/field table. ! 601: */ ! 602: hdr.ftab = pc; ! 603: if (Dflag) ! 604: fprintf(dbgfile, "%d:\t\t\t\t\t# record/field table\n", pc); ! 605: for (fp = ftable; fp < ffree; fp++) { ! 606: if (Dflag) ! 607: fprintf(dbgfile, "%d:", pc); ! 608: rp = fp->f_rlist; ! 609: for (i = 1; i <= nrecords; i++) { ! 610: if (rp != NULL && rp->r_recid == i) { ! 611: if (Dflag) ! 612: fprintf(dbgfile, "\t%d", rp->r_fnum); ! 613: outword(rp->r_fnum); ! 614: rp = rp->r_link; ! 615: } ! 616: else { ! 617: if (Dflag) ! 618: fprintf(dbgfile, "\t-1"); ! 619: outword(-1); ! 620: } ! 621: if (Dflag && (i == nrecords || (i & 03) == 0)) ! 622: putc('\n', dbgfile); ! 623: } ! 624: } ! 625: ! 626: /* ! 627: * Output global variable descriptors. ! 628: */ ! 629: hdr.globals = pc; ! 630: for (gp = gtable; gp < gfree; gp++) { ! 631: if (gp->g_flag & (F_BUILTIN & ~F_GLOBAL)) { /* built-in procedure */ ! 632: if (Dflag) ! 633: fprintf(dbgfile, "%d:\t%06o\t%d\t\t\t# %s\n", ! 634: pc, D_PROC, -gp->g_procid, gp->g_name); ! 635: outword(D_PROC); ! 636: outword(-gp->g_procid); ! 637: } ! 638: else if (gp->g_flag & (F_PROC & ~F_GLOBAL)) { /* Icon procedure */ ! 639: if (Dflag) ! 640: fprintf(dbgfile, "%d:\t%06o\tZ+%d\t\t\t# %s\n", ! 641: pc, D_PROC, gp->g_pc, gp->g_name); ! 642: outword(D_PROC); ! 643: outword(gp->g_pc); ! 644: } ! 645: else if (gp->g_flag & (F_RECORD & ~F_GLOBAL)) { /* record constructor */ ! 646: if (Dflag) ! 647: fprintf(dbgfile, "%d:\t%06o\tZ+%d\t\t\t# %s\n", ! 648: pc, D_PROC, gp->g_pc, gp->g_name); ! 649: outword(D_PROC); ! 650: outword(gp->g_pc); ! 651: } ! 652: else { /* global variable */ ! 653: if (Dflag) ! 654: fprintf(dbgfile, "%d:\t0\t0\t\t\t# %s\n", pc, gp->g_name); ! 655: outword(0); ! 656: outword(0); ! 657: } ! 658: } ! 659: ! 660: /* ! 661: * Output descriptors for global variable names. ! 662: */ ! 663: hdr.gnames = pc; ! 664: for (gp = gtable; gp < gfree; gp++) { ! 665: if (Dflag) ! 666: fprintf(dbgfile, "%d:\t%d\tI+%d\t\t\t# %s\n", ! 667: pc, strlen(gp->g_name), gp->g_name-strings, gp->g_name); ! 668: outword(strlen(gp->g_name)); ! 669: outword(gp->g_name - strings); ! 670: } ! 671: ! 672: /* ! 673: * Output a null descriptor for each static variable. ! 674: */ ! 675: hdr.statics = pc; ! 676: for (i = statics; i > 0; i--) { ! 677: if (Dflag) ! 678: fprintf(dbgfile, "%d:\t0\t0\n", pc); ! 679: outword(0); ! 680: outword(0); ! 681: } ! 682: flushcode(); ! 683: ! 684: /* ! 685: * Output the identifier table. Note that the call to write ! 686: * really does all the work. ! 687: */ ! 688: hdr.ident = pc; ! 689: if (Dflag) { ! 690: for (s = strings; s < sfree; ) { ! 691: fprintf(dbgfile, "%d:\t%03o", pc, *s++); ! 692: for (i = 7; i > 0; i--) { ! 693: if (s >= sfree) ! 694: break; ! 695: fprintf(dbgfile, " %03o", *s++); ! 696: } ! 697: putc('\n', dbgfile); ! 698: } ! 699: } ! 700: write(fileno(outfile), strings, sfree - strings); ! 701: pc += sfree - strings; ! 702: ! 703: /* ! 704: * Output icode file header. ! 705: */ ! 706: hdr.size = pc; ! 707: hdr.trace = trace; ! 708: if (Dflag) { ! 709: fprintf(dbgfile, "size: %d\n", hdr.size); ! 710: fprintf(dbgfile, "trace: %d\n", hdr.trace); ! 711: fprintf(dbgfile, "records: %d\n", hdr.records); ! 712: fprintf(dbgfile, "ftab: %d\n", hdr.ftab); ! 713: fprintf(dbgfile, "globals: %d\n", hdr.globals); ! 714: fprintf(dbgfile, "gnames: %d\n", hdr.gnames); ! 715: fprintf(dbgfile, "statics: %d\n", hdr.statics); ! 716: fprintf(dbgfile, "ident: %d\n", hdr.ident); ! 717: } ! 718: fseek(outfile, (long)hdrloc, 0); ! 719: write(fileno(outfile), &hdr, sizeof hdr); ! 720: } ! 721: ! 722: #define CodeCheck if (codep >= code + maxcode)\ ! 723: syserr("out of code buffer space") ! 724: /* ! 725: * outop(i) outputs the integer i as an interpreter opcode. This ! 726: * assumes opcodes fit into a char. If they don't, outop will ! 727: * need to look like outword and outopnd. ! 728: */ ! 729: outop(op) ! 730: int op; ! 731: { ! 732: CodeCheck; ! 733: *codep++ = op; ! 734: pc++; ! 735: } ! 736: /* ! 737: * outopnd(i) outputs i as an operand for an interpreter operation. ! 738: * OPNDSIZE bytes must be moved from &opnd[0] to &codep[0]. ! 739: */ ! 740: outopnd(opnd) ! 741: int opnd; ! 742: { ! 743: int i; ! 744: union { ! 745: char *i; ! 746: char c[OPNDSIZE]; ! 747: } u; ! 748: ! 749: CodeCheck; ! 750: u.i = (char *) opnd; ! 751: ! 752: for (i = 0; i < OPNDSIZE; i++) ! 753: codep[i] = u.c[i]; ! 754: ! 755: codep += OPNDSIZE; ! 756: pc += OPNDSIZE; ! 757: } ! 758: /* ! 759: * outword(i) outputs i as a word that is used by the runtime system ! 760: * WORDSIZE bytes must be moved from &word[0] to &codep[0]. ! 761: */ ! 762: outword(word) ! 763: int word; ! 764: { ! 765: int i; ! 766: union { ! 767: char *i; ! 768: char c[WORDSIZE]; ! 769: } u; ! 770: ! 771: CodeCheck; ! 772: u.i = (char *) word; ! 773: ! 774: for (i = 0; i < WORDSIZE; i++) ! 775: codep[i] = u.c[i]; ! 776: ! 777: codep += WORDSIZE; ! 778: pc += WORDSIZE; ! 779: } ! 780: /* ! 781: * outblock(a,i) output i bytes starting at address a. ! 782: */ ! 783: outblock(addr,count) ! 784: char *addr; ! 785: int count; ! 786: { ! 787: if (codep + count > code + maxcode) ! 788: syserr("out of code buffer space"); ! 789: pc += count; ! 790: while (count--) ! 791: *codep++ = *addr++; ! 792: } ! 793: /* ! 794: * dumpblock(a,i) dump contents of i bytes at address a, used only ! 795: * in conjunction with -D. ! 796: */ ! 797: dumpblock(addr, count) ! 798: char *addr; ! 799: int count; ! 800: { ! 801: int i; ! 802: for (i = 0; i < count; i++) { ! 803: if ((i & 7) == 0) ! 804: fprintf(dbgfile,"\n\t"); ! 805: fprintf(dbgfile," %03o",(unsigned)addr[i]); ! 806: } ! 807: putc('\n',dbgfile); ! 808: } ! 809: ! 810: /* ! 811: * flushcode - write buffered code to the output file. ! 812: */ ! 813: flushcode() ! 814: { ! 815: if (codep > code) ! 816: /*fwrite(code, 1, codep - code, outfile);*/ ! 817: write(fileno(outfile), code, codep - code); ! 818: codep = code; ! 819: } ! 820: ! 821: /* ! 822: * clearlab - clear label table to all zeroes. ! 823: */ ! 824: clearlab() ! 825: { ! 826: register int i; ! 827: ! 828: for (i = 0; i < maxlabels; i++) ! 829: labels[i] = 0; ! 830: } ! 831: ! 832: /* ! 833: * backpatch - fill in all forward references to lab. ! 834: */ ! 835: backpatch(lab) ! 836: int lab; ! 837: { ! 838: register int p, r; ! 839: #ifdef VAX ! 840: register int *q; ! 841: #endif VAX ! 842: #ifdef PORT ! 843: int *q; /* BE SURE to properly declare q - this won't always work. */ ! 844: return; ! 845: #endif PORT ! 846: #ifdef PDP11 ! 847: register char *q; ! 848: #endif PDP11 ! 849: ! 850: if (lab >= maxlabels) ! 851: syserr("too many labels in ucode"); ! 852: p = labels[lab]; ! 853: if (p > 0) ! 854: syserr("multiply defined label in ucode"); ! 855: while (p < 0) { /* follow reference chain */ ! 856: r = pc - (OPNDSIZE - p); /* compute relative offset */ ! 857: #ifdef VAX ! 858: q = (int *) (codep - (pc + p)); /* point to word with address */ ! 859: p = *q; /* get next address on chain */ ! 860: *q = r; /* fill in correct offset */ ! 861: #endif VAX ! 862: ! 863: #ifdef PORT ! 864: #endif PORT ! 865: ! 866: #ifdef PDP11 ! 867: q = codep - (pc + p); /* point to word with address */ ! 868: p = *q++ & 0377; /* get next address on chain */ ! 869: p |= *q << 8; ! 870: *q = r >> 8; /* fill in correct offset */ ! 871: *--q = r; ! 872: #endif PDP11 ! 873: } ! 874: labels[lab] = pc; ! 875: } ! 876: ! 877: /* ! 878: * genheader - output the header line to the .u1 file. ! 879: */ ! 880: genheader() ! 881: { ! 882: fprintf(outfile,"%s",ixhdr); ! 883: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.