diff options
Diffstat (limited to 'src/icont/lcode.c')
-rw-r--r-- | src/icont/lcode.c | 1564 |
1 files changed, 1564 insertions, 0 deletions
diff --git a/src/icont/lcode.c b/src/icont/lcode.c new file mode 100644 index 0000000..a1481f1 --- /dev/null +++ b/src/icont/lcode.c @@ -0,0 +1,1564 @@ +/* + * lcode.c -- linker routines to parse .u1 files and produce icode. + */ + +#include "link.h" +#include "tproto.h" +#include "tglobals.h" +#include "opcode.h" +#include "keyword.h" +#include "../h/version.h" +#include "../h/header.h" + +/* + * This needs fixing ... + */ +#undef CsetPtr +#define CsetPtr(b,c) ((c) + (((b)&0377) >> LogIntBits)) + +/* + * Prototypes. + */ + +static void align (void); +static void backpatch (int lab); +static void clearlab (void); +static void flushcode (void); +static void intout (int oint); +static void lemit (int op,char *name); +static void lemitcon (int k); +static void lemitin (int op,word offset,int n,char *name); +static void lemitint (int op,long i,char *name); +static void lemitl (int op,int lab,char *name); +static void lemitn (int op,word n,char *name); +static void lemitproc (word name,int nargs,int ndyn,int nstat,int fstat); +static void lemitr (int op,word loc,char *name); +static void misalign (void); +static void outblock (char *addr,int count); +static void setfile (void); +static void wordout (word oword); + +#ifdef FieldTableCompression + static void charout (unsigned char oint); + static void shortout (short oint); +#endif /* FieldTableCompression */ + +#ifdef DeBugLinker + static void dumpblock (char *addr,int count); +#endif /* DeBugLinker */ + +word pc = 0; /* simulated program counter */ + +#define outword(n) wordout((word)(n)) +#define outop(n) intout((int)(n)) +#define outchar(n) charout((unsigned char)(n)) +#define outshort(n) shortout((short)(n)) +#define CodeCheck(n) if ((long)codep + (n) > (long)((long)codeb + maxcode))\ + codeb = (char *) trealloc(codeb, &codep, &maxcode, 1,\ + (n), "code buffer"); + +#define ByteBits 8 + +/* + * gencode - read .u1 file, resolve variable references, and generate icode. + * Basic process is to read each line in the file and take some action + * as dictated by the opcode. This action sometimes involves parsing + * of arguments and usually culminates in the call of the appropriate + * lemit* routine. + */ +void gencode() + { + register int op, k, lab; + int j, nargs, flags, implicit; + char *name; + word id, procname; + struct centry *cp; + struct gentry *gp; + struct fentry *fp; + union xval gg; + + while ((op = getopc(&name)) != EOF) { + switch (op) { + + /* Ternary operators. */ + + case Op_Toby: + case Op_Sect: + + /* Binary operators. */ + + case Op_Asgn: + case Op_Cat: + case Op_Diff: + case Op_Div: + case Op_Eqv: + case Op_Inter: + case Op_Lconcat: + case Op_Lexeq: + case Op_Lexge: + case Op_Lexgt: + case Op_Lexle: + case Op_Lexlt: + case Op_Lexne: + case Op_Minus: + case Op_Mod: + case Op_Mult: + case Op_Neqv: + case Op_Numeq: + case Op_Numge: + case Op_Numgt: + case Op_Numle: + case Op_Numlt: + case Op_Numne: + case Op_Plus: + case Op_Power: + case Op_Rasgn: + case Op_Rswap: + case Op_Subsc: + case Op_Swap: + case Op_Unions: + + /* Unary operators. */ + + case Op_Bang: + case Op_Compl: + case Op_Neg: + case Op_Nonnull: + case Op_Null: + case Op_Number: + case Op_Random: + case Op_Refresh: + case Op_Size: + case Op_Tabmat: + case Op_Value: + + /* Instructions. */ + + case Op_Bscan: + case Op_Ccase: + case Op_Coact: + case Op_Cofail: + case Op_Coret: + case Op_Dup: + case Op_Efail: + case Op_Eret: + case Op_Escan: + case Op_Esusp: + case Op_Limit: + case Op_Lsusp: + case Op_Pfail: + case Op_Pnull: + case Op_Pop: + case Op_Pret: + case Op_Psusp: + case Op_Push1: + case Op_Pushn1: + case Op_Sdup: + newline(); + lemit(op, name); + break; + + case Op_Chfail: + case Op_Create: + case Op_Goto: + case Op_Init: + lab = getlab(); + newline(); + lemitl(op, lab, name); + break; + + case Op_Cset: + case Op_Real: + k = getdec(); + newline(); + lemitr(op, lctable[k].c_pc, name); + break; + + case Op_Field: + id = getid(); + newline(); + fp = flocate(id); + if (fp != NULL) + lemitn(op, (word)(fp->f_fid-1), name); + else + lemitn(op, (word)-1, name); /* no warning any more */ + break; + + + case Op_Int: { + long i; + k = getdec(); + newline(); + cp = &lctable[k]; + /* + * Check to see if a large integers has been converted to a string. + * If so, generate the code for +s. + */ + if (cp->c_flag & F_StrLit) { + lemit(Op_Pnull,"pnull"); + lemitin(Op_Str, cp->c_val.sval, cp->c_length, "str"); + lemit(Op_Number,"number"); + break; + } + i = (long)cp->c_val.ival; + lemitint(op, i, name); + break; + } + + + case Op_Invoke: + k = getdec(); + newline(); + if (k == -1) + lemit(Op_Apply,"apply"); + else + lemitn(op, (word)k, name); + break; + + case Op_Keywd: + id = getstr(); + newline(); + k = klookup(&lsspace[id]); + switch (k) { + case 0: + lfatal(&lsspace[id],"invalid keyword"); + break; + case K_FAIL: + lemit(Op_Efail,"efail"); + break; + case K_NULL: + lemit(Op_Pnull,"pnull"); + break; + default: + lemitn(op, (word)k, name); + } + break; + + case Op_Llist: + k = getdec(); + newline(); + lemitn(op, (word)k, name); + break; + + case Op_Lab: + lab = getlab(); + newline(); + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "L%d:\n", lab); + #endif /* DeBugLinker */ + backpatch(lab); + break; + + case Op_Line: + /* + * Line number change. + * All the interesting stuff happens in Op_Colm now. + */ + lineno = getdec(); + + #ifndef SrcColumnInfo + /* + * Enter the value in the line number table + * that is stored in the icode file and used during error + * handling and execution monitoring. One can generate a VM + * instruction for these changes, but since the numbers are not + * saved and restored during backtracking, it is more accurate + * to check for line number changes in-line in the interpreter. + * Fortunately, the in-line check is about as fast as executing + * Op_Line instructions. All of this is complicated by the use + * of Op_Line to generate Noop instructions when enabled by the + * LineCodes #define. + * + * If SrcColumnInfo is required, this code is duplicated, + * with changes, in the Op_Colm case below. + */ + if (lnfree >= &lntable[nsize]) + lntable = (struct ipc_line *)trealloc(lntable,&lnfree,&nsize, + sizeof(struct ipc_line), 1, "line number table"); + lnfree->ipc = pc; + lnfree->line = lineno; + lnfree++; + #endif /* SrcColumnInfo */ + + /* + * Could generate an Op_Line for monitoring, but don't anymore: + * + * lemitn(op, (word)lineno, name); + */ + + newline(); + + #ifdef LineCodes + #ifndef EventMon + lemit(Op_Noop,"noop"); + #endif /* EventMon */ + #endif /* LineCodes */ + + break; + + case Op_Colm: /* always recognize, maybe ignore */ + + colmno = getdec(); + #ifdef SrcColumnInfo + if (lnfree >= &lntable[nsize]) + lntable = (struct ipc_line *)trealloc(lntable,&lnfree,&nsize, + sizeof(struct ipc_line), 1, "line number table"); + lnfree->ipc = pc; + lnfree->line = lineno + (colmno << 16); + lnfree++; + #endif /* SrcColumnInfo */ + break; + + case Op_Mark: + lab = getlab(); + newline(); + lemitl(op, lab, name); + break; + + case Op_Mark0: + lemit(op, name); + break; + + case Op_Str: + k = getdec(); + newline(); + cp = &lctable[k]; + lemitin(op, cp->c_val.sval, cp->c_length, name); + break; + + case Op_Tally: + k = getdec(); + newline(); + lemitn(op, (word)k, name); + break; + + case Op_Unmark: + lemit(Op_Unmark, name); + break; + + case Op_Var: + k = getdec(); + newline(); + flags = lltable[k].l_flag; + if (flags & F_Global) + lemitn(Op_Global, (word)(lltable[k].l_val.global->g_index), + "global"); + else if (flags & F_Static) + lemitn(Op_Static, (word)(lltable[k].l_val.staticid-1), "static"); + else if (flags & F_Argument) + lemitn(Op_Arg, (word)(lltable[k].l_val.offset-1), "arg"); + else + lemitn(Op_Local, (word)(lltable[k].l_val.offset-1), "local"); + break; + + /* Declarations. */ + + case Op_Proc: + getstr(); + newline(); + procname = putident(strlen(&lsspace[lsfree]) + 1, 0); + if (procname >= 0 && (gp = glocate(procname)) != NULL) { + /* + * Initialize for wanted procedure. + */ + locinit(); + clearlab(); + lineno = 0; + implicit = gp->g_flag & F_ImpError; + nargs = gp->g_nargs; + align(); + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "\n# procedure %s\n", &lsspace[lsfree]); + #endif /* DeBugLinker */ + } + else { + /* + * Skip unreferenced procedure. + */ + while ((op = getopc(&name)) != EOF && op != Op_End) + if (op == Op_Filen) + setfile(); /* handle filename op while skipping */ + else + newline(); /* ignore everything else */ + } + break; + + case Op_Local: + k = getdec(); + flags = getoct(); + id = getid(); + putlocal(k, id, flags, implicit, procname); + break; + + case Op_Con: + k = getdec(); + flags = getoct(); + if (flags & F_IntLit) { + { + long m; + word s_indx; + + j = getdec(); /* number of characters in integer */ + m = getint(j,&s_indx); /* convert if possible */ + if (m < 0) { /* negative indicates integer too big */ + gg.sval = s_indx; /* convert to a string */ + putconst(k, F_StrLit, j, pc, &gg); + } + else { /* integers is small enough */ + gg.ival = m; + putconst(k, flags, 0, pc, &gg); + } + } + } + else if (flags & F_RealLit) { + gg.rval = getreal(); + putconst(k, flags, 0, pc, &gg); + } + else if (flags & F_StrLit) { + j = getdec(); + gg.sval = getstrlit(j); + putconst(k, flags, j, pc, &gg); + } + else if (flags & F_CsetLit) { + j = getdec(); + gg.sval = getstrlit(j); + putconst(k, flags, j, pc, &gg); + } + else + fprintf(stderr, "gencode: illegal constant\n"); + newline(); + lemitcon(k); + break; + + case Op_Filen: + setfile(); + break; + + case Op_Declend: + newline(); + gp->g_pc = pc; + lemitproc(procname, nargs, dynoff, lstatics-static1, static1); + break; + + case Op_End: + newline(); + flushcode(); + break; + + default: + fprintf(stderr, "gencode: illegal opcode(%d): %s\n", op, name); + newline(); + } + } + } + +/* + * setfile - handle Op_Filen. + */ +static void setfile() + { + if (fnmfree >= &fnmtbl[fnmsize]) + fnmtbl = (struct ipc_fname *) trealloc(fnmtbl, &fnmfree, + &fnmsize, sizeof(struct ipc_fname), 1, "file name table"); + fnmfree->ipc = pc; + fnmfree->fname = getrest(); + strcpy(icnname, &lsspace[fnmfree->fname]); + fnmfree++; + newline(); + } + +/* + * lemit - emit opcode. + * lemitl - emit opcode with reference to program label. + * for a description of the chaining and backpatching for labels. + * lemitn - emit opcode with integer argument. + * lemitr - emit opcode with pc-relative reference. + * lemitin - emit opcode with reference to identifier table & integer argument. + * lemitint - emit word opcode with integer argument. + * lemitcon - emit constant table entry. + * lemitproc - emit procedure block. + * + * The lemit* routines call out* routines to effect the "outputting" of icode. + * Note that the majority of the code for the lemit* routines is for debugging + * purposes. + */ +static void lemit(op, name) +int op; +char *name; + { + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%d\t\t\t\t# %s\n", (long)pc, op, name); + #endif /* DeBugLinker */ + + outop(op); + } + +static void lemitl(op, lab, name) +int op, lab; +char *name; + { + misalign(); + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%d\tL%d\t\t\t# %s\n", (long)pc, op, lab, name); + #endif /* DeBugLinker */ + + if (lab >= maxlabels) + labels = (word *) trealloc(labels, NULL, &maxlabels, sizeof(word), + lab - maxlabels + 1, "labels"); + outop(op); + if (labels[lab] <= 0) { /* forward reference */ + outword(labels[lab]); + labels[lab] = WordSize - pc; /* add to front of reference chain */ + } + else /* output relative offset */ + outword(labels[lab] - (pc + WordSize)); + } + +static void lemitn(op, n, name) +int op; +word n; +char *name; + { + misalign(); + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%d\t%ld\t\t\t# %s\n", (long)pc, op, (long)n, + name); + #endif /* DeBugLinker */ + + outop(op); + outword(n); + } + + +static void lemitr(op, loc, name) +int op; +word loc; +char *name; + { + misalign(); + + loc -= pc + ((IntBits/ByteBits) + WordSize); + + #ifdef DeBugLinker + if (Dflag) { + if (loc >= 0) + fprintf(dbgfile, "%ld:\t%d\t*+%ld\t\t\t# %s\n",(long) pc, op, + (long)loc, name); + else + fprintf(dbgfile, "%ld:\t%d\t*-%ld\t\t\t# %s\n",(long) pc, op, + (long)-loc, name); + } + #endif /* DeBugLinker */ + + outop(op); + outword(loc); + } + +static void lemitin(op, offset, n, name) +int op, n; +word offset; +char *name; + { + misalign(); + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%d\t%d,S+%ld\t\t\t# %s\n", (long)pc, op, n, + (long)offset, name); + #endif /* DeBugLinker */ + + outop(op); + outword(n); + outword(offset); + } + +/* + * lemitint can have some pitfalls. outword is used to output the + * integer and this is picked up in the interpreter as the second + * word of a short integer. The integer value output must be + * the same size as what the interpreter expects. See op_int and op_intx + * in interp.s + */ +static void lemitint(op, i, name) +int op; +long i; +char *name; + { + misalign(); + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile,"%ld:\t%d\t%ld\t\t\t# %s\n",(long)pc,op,(long)i,name); + #endif /* DeBugLinker */ + + outop(op); + outword(i); + } + +static void lemitcon(k) +register int k; + { + register int i, j; + register char *s; + int csbuf[CsetSize]; + union { + char ovly[1]; /* Array used to overlay l and f on a bytewise basis. */ + long l; + double f; + } x; + + if (lctable[k].c_flag & F_RealLit) { + + #ifdef Double + /* access real values one word at a time */ + int *rp, *rq; + rp = (int *) &(x.f); + rq = (int *) &(lctable[k].c_val.rval); + *rp++ = *rq++; + *rp = *rq; + #else /* Double */ + x.f = lctable[k].c_val.rval; + #endif /* Double */ + + #ifdef DeBugLinker + if (Dflag) { + fprintf(dbgfile,"%ld:\t%d\t\t\t\t# real(%g)",(long)pc,T_Real, x.f); + dumpblock(x.ovly,sizeof(double)); + } + #endif /* DeBugLinker */ + + outword(T_Real); + + #ifdef Double + #if WordBits != 64 + /* fill out real block with an empty word */ + outword(0); + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile,"\t0\t\t\t\t\t# padding\n"); + #endif /* DeBugLinker */ + #endif /* WordBits != 64 */ + #endif /* Double */ + + outblock(x.ovly,sizeof(double)); + } + else if (lctable[k].c_flag & F_CsetLit) { + for (i = 0; i < CsetSize; i++) + csbuf[i] = 0; + s = &lsspace[lctable[k].c_val.sval]; + i = lctable[k].c_length; + while (i--) { + Setb(*s, csbuf); + s++; + } + j = 0; + for (i = 0; i < 256; i++) { + if (Testb(i, csbuf)) + j++; + } + + #ifdef DeBugLinker + if (Dflag) { + fprintf(dbgfile, "%ld:\t%d\n",(long) pc, T_Cset); + fprintf(dbgfile, "\t%d\n",j); + } + #endif /* DeBugLinker */ + + outword(T_Cset); + outword(j); /* cset size */ + outblock((char *)csbuf,sizeof(csbuf)); + + #ifdef DeBugLinker + if (Dflag) + dumpblock((char *)csbuf,CsetSize); + #endif /* DeBugLinker */ + + } + } + +static void lemitproc(name, nargs, ndyn, nstat, fstat) +word name; +int nargs, ndyn, nstat, fstat; + { + register int i; + register char *p; + word s_indx; + int size; + /* + * FncBlockSize = sizeof(BasicFncBlock) + + * sizeof(descrip)*(# of args + # of dynamics + # of statics). + */ + size = (9*WordSize) + (2*WordSize) * (abs(nargs)+ndyn+nstat); + + p = &lsspace[name]; + #ifdef DeBugLinker + if (Dflag) { + fprintf(dbgfile, "%ld:\t%d\n", (long)pc, T_Proc); /* type code */ + fprintf(dbgfile, "\t%d\n", size); /* size of block */ + fprintf(dbgfile, "\tZ+%ld\n",(long)(pc+size)); /* entry point */ + fprintf(dbgfile, "\t%d\n", nargs); /* # arguments */ + fprintf(dbgfile, "\t%d\n", ndyn); /* # dynamic locals */ + fprintf(dbgfile, "\t%d\n", nstat); /* # static locals */ + fprintf(dbgfile, "\t%d\n", fstat); /* first static */ + fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", /* name of procedure */ + (int)strlen(p), (long)(name), p); + } + #endif /* DeBugLinker */ + + outword(T_Proc); + outword(size); + outword(pc + size - 2*WordSize); /* Have to allow for the two words + that we've already output. */ + outword(nargs); + outword(ndyn); + outword(nstat); + outword(fstat); + outword(strlen(p)); /* procedure name: length & offset */ + outword(name); + + /* + * Output string descriptors for argument names by looping through + * all locals, and picking out those with F_Argument set. + */ + for (i = 0; i <= nlocal; i++) { + if (lltable[i].l_flag & F_Argument) { + s_indx = lltable[i].l_name; + p = &lsspace[s_indx]; + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p), + (long)s_indx, p); + #endif /* DeBugLinker */ + + outword(strlen(p)); + outword(s_indx); + } + } + + /* + * Output string descriptors for local variable names. + */ + for (i = 0; i <= nlocal; i++) { + if (lltable[i].l_flag & F_Dynamic) { + s_indx = lltable[i].l_name; + p = &lsspace[s_indx]; + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p), + (long)s_indx, p); + #endif /* DeBugLinker */ + + outword(strlen(p)); + outword(s_indx); + } + } + + /* + * Output string descriptors for static variable names. + */ + for (i = 0; i <= nlocal; i++) { + if (lltable[i].l_flag & F_Static) { + s_indx = lltable[i].l_name; + p = &lsspace[s_indx]; + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(p), + (long)s_indx, p); + #endif /* DeBugLinker */ + + outword(strlen(p)); + outword(s_indx); + } + } + } + +/* + * gentables - generate interpreter code for global, static, + * identifier, and record tables, and built-in procedure blocks. + */ + +void gentables() + { + register int i; + register char *s; + register struct gentry *gp; + struct fentry *fp; + struct rentry *rp; + struct header hdr; + + /* + * Output record constructor procedure blocks. + */ + align(); + hdr.Records = pc; + + #ifdef DeBugLinker + if (Dflag) { + fprintf(dbgfile, "\n\n# global tables\n"); + fprintf(dbgfile, "\n%ld:\t%d\t\t\t\t# record blocks\n", + (long)pc, nrecords); + } + #endif /* DeBugLinker */ + + outword(nrecords); + for (gp = lgfirst; gp != NULL; gp = gp->g_next) { + if ((gp->g_flag & F_Record) && gp->g_procid > 0) { + s = &lsspace[gp->g_name]; + gp->g_pc = pc; + + #ifdef DeBugLinker + if (Dflag) { + fprintf(dbgfile, "%ld:\n", pc); + fprintf(dbgfile, "\t%d\n", T_Proc); + fprintf(dbgfile, "\t%d\n", RkBlkSize(gp)); + fprintf(dbgfile, "\t_mkrec\n"); + fprintf(dbgfile, "\t%d\n", gp->g_nargs); + fprintf(dbgfile, "\t-2\n"); + fprintf(dbgfile, "\t%d\n", gp->g_procid); + fprintf(dbgfile, "\t1\n"); + fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", (int)strlen(s), + (long)gp->g_name, s); + } + #endif /* DeBugLinker */ + + outword(T_Proc); /* type code */ + outword(RkBlkSize(gp)); + outword(0); /* entry point (filled in by interp)*/ + outword(gp->g_nargs); /* number of fields */ + outword(-2); /* record constructor indicator */ + outword(gp->g_procid); /* record id */ + outword(1); /* serial number */ + outword(strlen(s)); /* name of record: size and offset */ + outword(gp->g_name); + + for (i=0;i<gp->g_nargs;i++) { /* field names (filled in by interp) */ + int foundit = 0; + /* + * Find the field list entry corresponding to field i in + * record gp, then write out a descriptor for it. + */ + for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) { + for (rp = fp->f_rlist; rp!= NULL; rp=rp->r_link) { + if (rp->r_gp == gp && rp->r_fnum == i) { + if (foundit) { + /* + * This internal error should never occur + */ + fprintf(stderr,"found rec %d field %d already!!\n", + gp->g_procid, i); + fflush(stderr); + exit(1); + } + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "\t%d\tS+%ld\t\t\t# %s\n", + (int)strlen(&lsspace[fp->f_name]), + fp->f_name, &lsspace[fp->f_name]); + #endif /* DeBugLinker */ + outword(strlen(&lsspace[fp->f_name])); + outword(fp->f_name); + foundit++; + } + } + } + if (!foundit) { + /* + * This internal error should never occur + */ + fprintf(stderr,"never found rec %d field %d!!\n", + gp->g_procid,i); + fflush(stderr); + exit(1); + } + } + } + } + + #ifndef FieldTableCompression + + /* + * Output record/field table (not compressed). + */ + hdr.Ftab = pc; + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile,"\n%ld:\t\t\t\t\t# record/field table\n",(long)pc); + #endif /* DeBugLinker */ + + for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) { + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t\t\t\t\t# %s\n", (long)pc, + &lsspace[fp->f_name]); + #endif /* DeBugLinker */ + rp = fp->f_rlist; + for (i = 1; i <= nrecords; i++) { + while (rp != NULL && rp->r_gp->g_procid < 0) + rp = rp->r_link; /* skip unreferenced constructor */ + if (rp != NULL && rp->r_gp->g_procid == i) { + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "\t%d\n", rp->r_fnum); + #endif /* DeBugLinker */ + outop(rp->r_fnum); + rp = rp->r_link; + } + else { + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "\t-1\n"); + #endif /* DeBugLinker */ + outop(-1); + } + #ifdef DeBugLinker + if (Dflag && (i == nrecords || (i & 03) == 0)) + putc('\n', dbgfile); + #endif /* DeBugLinker */ + } + } + + #else /* FieldTableCompression */ + + /* + * Output record/field table (compressed). + * This code has not been tested recently. + */ + { + int counter = 0, f_num, first, begin, end, entries; + int *f_fo, *f_row, *f_tabp; + char *f_bm; + int pointer, first_avail = 0, inserted, bytes; + hdr.Fo = pc; + + /* + * Compute the field width required for this binary; + * it is determined by the maximum # of fields in any one record. + */ + long ct = 0; + for (gp = lgfirst; gp != NULL; gp = gp->g_next) + if ((gp->g_flag & F_Record) && gp->g_procid > 0) + if (gp->g_nargs > ct) ct=gp->g_nargs; + if (ct > 65535L) hdr.FtabWidth = 4; + else if (ct > 254) hdr.FtabWidth = 2; /* 255 is (not present) */ + else hdr.FtabWidth = 1; + + /* Find out how many field names there are. */ + hdr.Nfields = 0; + for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) + hdr.Nfields++; + + entries = hdr.Nfields * nrecords / 4 + 1; + f_tabp = malloc (entries * sizeof (int)); + for (i = 0; i < entries; i++) + f_tabp[i] = -1; + f_fo = malloc (hdr.Nfields * sizeof (int)); + + bytes = nrecords / 8; + if (nrecords % 8 != 0) + bytes++; + f_bm = calloc (hdr.Nfields, bytes); + f_row = malloc (nrecords * sizeof (int)); + f_num = 0; + + for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) { + rp = fp->f_rlist; + first = 1; + for (i = 0; i < nrecords; i++) { + while (rp != NULL && rp->r_gp->g_procid < 0) + rp = rp->r_link; /* skip unreferenced constructor */ + if (rp != NULL && rp->r_gp->g_procid == i + 1) { + if (first) { + first = 0; + begin = end = i; + } + else + end = i; + f_row[i] = rp->r_fnum; + rp = rp->r_link; + } + else { + f_row[i] = -1; + } + } + + inserted = 0; + pointer = first_avail; + while (!inserted) { + inserted = 1; + for (i = begin; i <= end; i++) { + if (pointer + (end - begin) >= entries) { + int j; + int old_entries = entries; + entries *= 2; + f_tabp = realloc (f_tabp, entries * sizeof (int)); + for (j = old_entries; j < entries; j++) + f_tabp[j] = -1; + } + if (f_row[i] != -1) + if (f_tabp[pointer + (i - begin)] != -1) { + inserted = 0; + break; + } + } + pointer++; + } + pointer--; + + /* Create bitmap */ + for (i = 0; i < nrecords; i++) { + int index = f_num * bytes + i / 8; + /* Picks out byte within bitmap row */ + if (f_row[i] != -1) { + f_bm[index] |= 01; + } + if (i % 8 != 7) + f_bm [index] <<= 1; + } + + if (nrecords%8) + f_bm[(f_num + 1) * bytes - 1] <<= 7 - (nrecords % 8); + + f_fo[f_num++] = pointer - begin; + /* So that f_fo[] points to the first bit */ + + for (i = begin; i <= end; i++) + if (f_row[i] != -1) + f_tabp[pointer + (i - begin)] = f_row[i]; + if (pointer + (end - begin) >= counter) + counter = pointer + (end - begin + 1); + while ((f_tabp[first_avail] != -1) && (first_avail <= counter)) + first_avail++; + } + + /* Write out the arrays. */ + #ifdef DeBugLinker + if (Dflag) + fprintf (dbgfile, "\n%ld:\t\t\t\t\t# field offset array\n", + (long)pc); + #endif /* DeBugLinker */ + + /* + * Compute largest value stored in fo array + */ + { + word maxfo = 0; + for (i = 0; i < hdr.Nfields; i++) { + if (f_fo[i] > maxfo) maxfo = f_fo[i]; + } + if (maxfo < 254) + hdr.FoffWidth = 1; + else if (maxfo < 65535L) + hdr.FoffWidth = 2; + else + hdr.FoffWidth = 4; + } + + for (i = 0; i < hdr.Nfields; i++) { + #ifdef DeBugLinker + if (Dflag) + fprintf (dbgfile, "\t%d\n", f_fo[i]); + #endif /* DeBugLinker */ + if (hdr.FoffWidth == 1) { + outchar(f_fo[i]); + } + else if (hdr.FoffWidth == 2) + outshort(f_fo[i]); + else + outop (f_fo[i]); + } + + #ifdef DeBugLinker + if (Dflag) + fprintf (dbgfile, "\n%ld:\t\t\t\t\t# Bit maps array\n", + (long)pc); + #endif /* DeBugLinker */ + + for (i = 0; i < hdr.Nfields; i++) { + #ifdef DeBugLinker + if (Dflag) { + int ct, index = i * bytes; + unsigned char this_bit = 0200; + + fprintf (dbgfile, "\t"); + for (ct = 0; ct < nrecords; ct++) { + if ((f_bm[index] | this_bit) == f_bm[index]) + fprintf (dbgfile, "1"); + else + fprintf (dbgfile, "0"); + + if (ct % 8 == 7) { + fprintf (dbgfile, " "); + index++; + this_bit = 0200; + } + else + this_bit >>= 1; + } + fprintf (dbgfile, "\n"); + } + #endif /* DeBugLinker */ + for (pointer = i * bytes; pointer < (i + 1) * bytes; pointer++) { + outchar (f_bm[pointer]); + } + } + + align(); + + #ifdef DeBugLinker + if (Dflag) + fprintf (dbgfile, "\n%ld:\t\t\t\t\t# record/field array\n", + (long)pc); + #endif /* DeBugLinker */ + + hdr.Ftab = pc; + for (i = 0; i < counter; i++) { + #ifdef DeBugLinker + if (Dflag) + fprintf (dbgfile, "\t%d\t%d\n", i, f_tabp[i]); + #endif /* DeBugLinker */ + if (hdr.FtabWidth == 1) + outchar(f_tabp[i]); + else if (hdr.FtabWidth == 2) + outshort(f_tabp[i]); + else + outop (f_tabp[i]); + } + + /* Free memory allocated by Jigsaw. */ + free (f_fo); + free (f_bm); + free (f_tabp); + free (f_row); + } + + #endif /* FieldTableCompression */ + + /* + * Output descriptors for field names. + */ + align(); + hdr.Fnames = pc; + for (fp = lffirst; fp != NULL; fp = fp->f_nextentry) { + s = &lsspace[fp->f_name]; + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%d\tS+%ld\t\t\t# %s\n", + (long)pc, (int)strlen(s), (long)fp->f_name, s); + #endif /* DeBugLinker */ + + outword(strlen(s)); /* name of field: length & offset */ + outword(fp->f_name); + } + + /* + * Output global variable descriptors. + */ + hdr.Globals = pc; + for (gp = lgfirst; gp != NULL; gp = gp->g_next) { + if (gp->g_flag & F_Builtin) { /* function */ + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%06lo\t%d\t\t\t# %s\n", + (long)pc, (long)D_Proc, -gp->g_procid, &lsspace[gp->g_name]); + #endif /* DeBugLinker */ + outword(D_Proc); + outword(-gp->g_procid); + } + else if (gp->g_flag & F_Proc) { /* Icon procedure */ + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n", + (long)pc,(long)D_Proc, (long)gp->g_pc, &lsspace[gp->g_name]); + #endif /* DeBugLinker */ + outword(D_Proc); + outword(gp->g_pc); + } + else if (gp->g_flag & F_Record) { /* record constructor */ + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n", (long) pc, + (long)D_Proc, (long)gp->g_pc, &lsspace[gp->g_name]); + #endif /* DeBugLinker */ + outword(D_Proc); + outword(gp->g_pc); + } + else { /* simple global variable */ + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%06lo\t0\t\t\t# %s\n",(long)pc, + (long)D_Null, &lsspace[gp->g_name]); + #endif /* DeBugLinker */ + outword(D_Null); + outword(0); + } + } + + /* + * Output descriptors for global variable names. + */ + hdr.Gnames = pc; + for (gp = lgfirst; gp != NULL; gp = gp->g_next) { + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t%d\tS+%ld\t\t\t# %s\n", + (long)pc, (int)strlen(&lsspace[gp->g_name]), (long)(gp->g_name), + &lsspace[gp->g_name]); + #endif /* DeBugLinker */ + + outword(strlen(&lsspace[gp->g_name])); + outword(gp->g_name); + } + + /* + * Output a null descriptor for each static variable. + */ + hdr.Statics = pc; + for (i = lstatics; i > 0; i--) { + + #ifdef DeBugLinker + if (Dflag) + fprintf(dbgfile, "%ld:\t0\t0\n", (long)pc); + #endif /* DeBugLinker */ + + outword(D_Null); + outword(0); + } + flushcode(); + + /* + * Output the string constant table and the two tables associating icode + * locations with source program locations. Note that the calls to write + * really do all the work. + */ + + hdr.Filenms = pc; + if (longwrite((char *)fnmtbl, (long)((char *)fnmfree - (char *)fnmtbl), + outfile) < 0) + quit("cannot write icode file"); + + #ifdef DeBugLinker + if (Dflag) { + int k = 0; + struct ipc_fname *ptr; + for (ptr = fnmtbl; ptr < fnmfree; ptr++) { + fprintf(dbgfile, "%ld:\t%03d\tS+%03d\t\t\t# %s\n", + (long)(pc + k), ptr->ipc, ptr->fname, &lsspace[ptr->fname]); + k = k + 8; + } + putc('\n', dbgfile); + } + + #endif /* DeBugLinker */ + + pc += (char *)fnmfree - (char *)fnmtbl; + + hdr.linenums = pc; + if (longwrite((char *)lntable, (long)((char *)lnfree - (char *)lntable), + outfile) < 0) + quit("cannot write icode file"); + + #ifdef DeBugLinker + if (Dflag) { + int k = 0; + struct ipc_line *ptr; + for (ptr = lntable; ptr < lnfree; ptr++) { + fprintf(dbgfile, "%ld:\t%03d\t%03d\n", (long)(pc + k), + ptr->ipc, ptr->line); + k = k + 8; + } + putc('\n', dbgfile); + } + + #endif /* DeBugLinker */ + + pc += (char *)lnfree - (char *)lntable; + + hdr.Strcons = pc; + #ifdef DeBugLinker + if (Dflag) { + int c, j, k; + j = k = 0; + for (s = lsspace; s < &lsspace[lsfree]; ) { + fprintf(dbgfile, "%ld:\t%03o", (long)(pc + k), *s++ & 0377); + k = k + 8; + for (i = 7; i > 0; i--) { + if (s >= &lsspace[lsfree]) + fprintf(dbgfile," "); + else + fprintf(dbgfile, " %03o", *s++ & 0377); + } + fprintf(dbgfile, " "); + for (i = 0; i < 8; i++) + if (j < lsfree) { + c = lsspace[j++]; + putc(isprint(c & 0377) ? c : ' ', dbgfile); + } + putc('\n', dbgfile); + } + } + + #endif /* DeBugLinker */ + + if (longwrite(lsspace, (long)lsfree, outfile) < 0) + quit("cannot write icode file"); + + pc += lsfree; + + /* + * Output icode file header. + */ + hdr.hsize = pc; + strcpy((char *)hdr.config,IVersion); + hdr.trace = trace; + + + #ifdef DeBugLinker + if (Dflag) { + fprintf(dbgfile, "\n"); + fprintf(dbgfile, "size: %ld\n", (long)hdr.hsize); + fprintf(dbgfile, "trace: %ld\n", (long)hdr.trace); + fprintf(dbgfile, "records: %ld\n", (long)hdr.Records); + fprintf(dbgfile, "ftab: %ld\n", (long)hdr.Ftab); + fprintf(dbgfile, "fnames: %ld\n", (long)hdr.Fnames); + fprintf(dbgfile, "globals: %ld\n", (long)hdr.Globals); + fprintf(dbgfile, "gnames: %ld\n", (long)hdr.Gnames); + fprintf(dbgfile, "statics: %ld\n", (long)hdr.Statics); + fprintf(dbgfile, "strcons: %ld\n", (long)hdr.Strcons); + fprintf(dbgfile, "filenms: %ld\n", (long)hdr.Filenms); + fprintf(dbgfile, "linenums: %ld\n", (long)hdr.linenums); + fprintf(dbgfile, "config: %s\n", hdr.config); + } + #endif /* DeBugLinker */ + + fseek(outfile, hdrsize, 0); + if (longwrite((char *)&hdr, (long)sizeof(hdr), outfile) < 0) + quit("cannot write icode file"); + + if (verbose >= 2) { + word tsize = sizeof(hdr) + hdr.hsize; + fprintf(stderr, " bootstrap %7ld\n", hdrsize); + tsize += hdrsize; + fprintf(stderr, " header %7ld\n", (long)sizeof(hdr)); + fprintf(stderr, " procedures %7ld\n", (long)hdr.Records); + fprintf(stderr, " records %7ld\n", (long)(hdr.Ftab - hdr.Records)); + fprintf(stderr, " fields %7ld\n", (long)(hdr.Globals - hdr.Ftab)); + fprintf(stderr, " globals %7ld\n", (long)(hdr.Statics - hdr.Globals)); + fprintf(stderr, " statics %7ld\n", (long)(hdr.Filenms - hdr.Statics)); + fprintf(stderr, " linenums %7ld\n", (long)(hdr.Strcons - hdr.Filenms)); + fprintf(stderr, " strings %7ld\n", (long)(hdr.hsize - hdr.Strcons)); + fprintf(stderr, " total %7ld\n", (long)tsize); + } + } + +/* + * align() outputs zeroes as padding until pc is a multiple of WordSize. + */ +static void align() + { + static word x = 0; + + if (pc % WordSize != 0) + outblock((char *)&x, (int)(WordSize - (pc % WordSize))); + } + +/* + * misalign() outputs a Noop instruction for padding if pc + sizeof(int) + * is not a multiple of WordSize. This is for operations that output + * an int opcode followed by an operand that needs to be word-aligned. + */ +static void misalign() + { + if ((pc + IntBits/ByteBits) % WordSize != 0) + lemit(Op_Noop, "noop [pad]"); + } + +/* + * intout(i) outputs i as an int that is used by the runtime system + * IntBits/ByteBits bytes must be moved from &word[0] to &codep[0]. + */ +static void intout(oint) +int oint; + { + int i; + union { + int i; + char c[IntBits/ByteBits]; + } u; + + CodeCheck(IntBits/ByteBits); + u.i = oint; + + for (i = 0; i < IntBits/ByteBits; i++) + codep[i] = u.c[i]; + + codep += IntBits/ByteBits; + pc += IntBits/ByteBits; + } + +#ifdef FieldTableCompression +/* + * charout(i) outputs i as an unsigned char that is used by the runtime system + */ +static void charout(unsigned char ochar) + { + CodeCheck(1); + *codep++ = (unsigned char)ochar; + pc++; + } +/* + * shortout(i) outputs i as a short that is used by the runtime system + * IntBits/ByteBits bytes must be moved from &word[0] to &codep[0]. + */ +static void shortout(short oint) + { + int i; + union { + short i; + char c[2]; + } u; + + CodeCheck(2); + u.i = oint; + + for (i = 0; i < 2; i++) + codep[i] = u.c[i]; + + codep += 2; + pc += 2; + } +#endif /* FieldTableCompression */ + + +/* + * wordout(i) outputs i as a word that is used by the runtime system + * WordSize bytes must be moved from &oword[0] to &codep[0]. + */ +static void wordout(oword) +word oword; + { + int i; + union { + word i; + char c[WordSize]; + } u; + + CodeCheck(WordSize); + u.i = oword; + + for (i = 0; i < WordSize; i++) + codep[i] = u.c[i]; + + codep += WordSize; + pc += WordSize; + } + +/* + * outblock(a,i) output i bytes starting at address a. + */ +static void outblock(addr,count) +char *addr; +int count; + { + CodeCheck(count); + pc += count; + while (count--) + *codep++ = *addr++; + } + +#ifdef DeBugLinker + /* + * dumpblock(a,i) dump contents of i bytes at address a, used only + * in conjunction with -L. + */ + static void dumpblock(addr, count) + char *addr; + int count; + { + int i; + for (i = 0; i < count; i++) { + if ((i & 7) == 0) + fprintf(dbgfile,"\n\t"); + fprintf(dbgfile," %03o",(0377 & (unsigned)addr[i])); + } + putc('\n',dbgfile); + } + #endif /* DeBugLinker */ + +/* + * flushcode - write buffered code to the output file. + */ +static void flushcode() + { + if (codep > codeb) + if (longwrite(codeb, DiffPtrs(codep,codeb), outfile) < 0) + quit("cannot write icode file"); + codep = codeb; + } + +/* + * clearlab - clear label table to all zeroes. + */ +static void clearlab() + { + register int i; + + for (i = 0; i < maxlabels; i++) + labels[i] = 0; + } + +/* + * backpatch - fill in all forward references to lab. + */ +static void backpatch(lab) +int lab; + { + word p, r; + char *q; + char *cp, *cr; + register int j; + + if (lab >= maxlabels) + labels = (word *) trealloc(labels, NULL, &maxlabels, sizeof(word), + lab - maxlabels + 1, "labels"); + + p = labels[lab]; + if (p > 0) + quit("multiply defined label in ucode"); + while (p < 0) { /* follow reference chain */ + r = pc - (WordSize - p); /* compute relative offset */ + q = codep - (pc + p); /* point to word with address */ + cp = (char *) &p; /* address of integer p */ + cr = (char *) &r; /* address of integer r */ + for (j = 0; j < WordSize; j++) { /* move bytes from word pointed to */ + *cp++ = *q; /* by q to p, and move bytes from */ + *q++ = *cr++; /* r to word pointed to by q */ + } /* moves integers at arbitrary addresses */ + } + labels[lab] = pc; + } + +#ifdef DeBugLinker + void idump(s) /* dump code region */ + char *s; + { + int *c; + + fprintf(stderr,"\ndump of code region %s:\n",s); + for (c = (int *)codeb; c < (int *)codep; c++) + fprintf(stderr,"%ld: %d\n",(long)c, (int)*c); + fflush(stderr); + } + #endif /* DeBugLinker */ |