![[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.