![[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 [Research Unix] / researchv10dc / cmd / icon / src / link|
Return to lcode.c CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / src / link |
1.1 root 1: /*
2: * Routines to parse .u1 files and produce icode.
3: */
4:
5: #include "opcode.h"
6: #include "ilink.h"
7: #include "../h/keyword.h"
8: #include "../h/version.h"
9: #include "../h/header.h"
10:
11: #ifndef MaxHeader
12: #define MaxHeader MaxHdr
13: #endif MaxHeader
14:
15: static word pc = 0; /* simulated program counter */
16:
17: #define outword(n) wordout((word)(n))
18:
19: /*
20: * gencode - read .u1 file, resolve variable references, and generate icode.
21: * Basic process is to read each line in the file and take some action
22: * as dictated by the opcode. This action sometimes involves parsing
23: * of operands and usually culminates in the call of the appropriate
24: * emit* routine.
25: *
26: * Appendix C of the "tour" has a complete description of the intermediate
27: * language that gencode parses.
28: */
29: gencode()
30: {
31: register int op, k, lab;
32: int j, nargs, flags, implicit;
33: char *id, *name, *procname;
34: struct centry *cp;
35: struct gentry *gp;
36: struct fentry *fp, *flocate();
37:
38: extern long getint();
39: extern double getreal();
40: union {
41: long ival;
42: double rval;
43: char *sval;
44: } gg;
45: extern char *getid(), *getstrlit();
46: extern struct gentry *glocate();
47:
48: while ((op = getop(&name)) != EOF) {
49: switch (op) {
50:
51: /* Ternary operators. */
52:
53: case Op_Toby:
54: case Op_Sect:
55:
56: /* Binary operators. */
57:
58: case Op_Asgn:
59: case Op_Cat:
60: case Op_Diff:
61: case Op_Div:
62: case Op_Eqv:
63: case Op_Inter:
64: case Op_Lconcat:
65: case Op_Lexeq:
66: case Op_Lexge:
67: case Op_Lexgt:
68: case Op_Lexle:
69: case Op_Lexlt:
70: case Op_Lexne:
71: case Op_Minus:
72: case Op_Mod:
73: case Op_Mult:
74: case Op_Neqv:
75: case Op_Numeq:
76: case Op_Numge:
77: case Op_Numgt:
78: case Op_Numle:
79: case Op_Numlt:
80: case Op_Numne:
81: case Op_Plus:
82: case Op_Power:
83: case Op_Rasgn:
84: case Op_Rswap:
85: case Op_Subsc:
86: case Op_Swap:
87: case Op_Unions:
88:
89: /* Unary operators. */
90:
91: case Op_Bang:
92: case Op_Compl:
93: case Op_Neg:
94: case Op_Nonnull:
95: case Op_Null:
96: case Op_Number:
97: case Op_Random:
98: case Op_Refresh:
99: case Op_Size:
100: case Op_Tabmat:
101: case Op_Value:
102:
103: /* Instructions. */
104:
105: case Op_Bscan:
106: case Op_Ccase:
107: case Op_Coact:
108: case Op_Cofail:
109: case Op_Coret:
110: case Op_Dup:
111: case Op_Efail:
112: case Op_Eret:
113: case Op_Escan:
114: case Op_Esusp:
115: case Op_Limit:
116: case Op_Lsusp:
117: case Op_Pfail:
118: case Op_Pnull:
119: case Op_Pop:
120: case Op_Pret:
121: case Op_Psusp:
122: case Op_Push1:
123: case Op_Pushn1:
124: case Op_Sdup:
125: newline();
126: emit(op, name);
127: break;
128:
129: case Op_Chfail:
130: case Op_Create:
131: case Op_Goto:
132: case Op_Init:
133: lab = getlab();
134: newline();
135: emitl(op, lab, name);
136: break;
137:
138: case Op_Cset:
139: case Op_Real:
140: k = getdec();
141: newline();
142: emitr(op, ctable[k].c_pc, name);
143: break;
144:
145: case Op_Field:
146: id = getid();
147: newline();
148: fp = flocate(id);
149: if (fp == NULL) {
150: err(id, "invalid field name", 0);
151: break;
152: }
153: emitn(op, (word)(fp->f_fid-1), name);
154: break;
155:
156: case Op_Int:
157: k = getdec();
158: newline();
159: cp = &ctable[k];
160: if (cp->c_flag & F_LongLit)
161: emitr(Op_Long, cp->c_pc, "long");
162: else {
163: long int i;
164: i = (long)cp->c_val.ival;
165: emitint(op, i, name);
166: }
167: break;
168:
169: case Op_Invoke:
170: k = getdec();
171: newline();
172: emitn(op, (word)k, name);
173: break;
174:
175: case Op_Keywd:
176: k = getdec();
177: newline();
178: switch (k) {
179: case K_FAIL:
180: emit(Op_Efail,"efail");
181: break;
182: case K_NULL:
183: emit(Op_Pnull,"pnull");
184: break;
185: default:
186: emitn(op, (word)k, name);
187: }
188: break;
189:
190: case Op_Llist:
191: k = getdec();
192: newline();
193: emitn(op, (word)k, name);
194: break;
195:
196: case Op_Lab:
197: lab = getlab();
198: newline();
199: if (Dflag)
200: fprintf(dbgfile, "L%d:\n", lab);
201: backpatch(lab);
202: break;
203:
204: case Op_Line:
205: line = getdec();
206: newline();
207: emitn(op, (word)line, name);
208: break;
209:
210: case Op_Mark:
211: lab = getlab();
212: newline();
213: emitl(op, lab, name);
214: break;
215:
216: case Op_Mark0:
217: emit(op, name);
218: break;
219:
220: case Op_Str:
221: k = getdec();
222: newline();
223: cp = &ctable[k];
224: id = cp->c_val.sval;
225: emitin(op, (word)(id-strings), cp->c_length, name);
226: break;
227:
228: case Op_Tally:
229: k = getdec();
230: newline();
231: emitn(op, (word)k, name);
232: break;
233:
234: case Op_Unmark:
235: emit(Op_Unmark, name);
236: break;
237:
238: case Op_Var:
239: k = getdec();
240: newline();
241: flags = ltable[k].l_flag;
242: if (flags & F_Global)
243: emitn(Op_Global, (word)(ltable[k].l_val.global-gtable), "global");
244: else if (flags & F_Static)
245: emitn(Op_Static, (word)(ltable[k].l_val.staticid-1), "static");
246: else if (flags & F_Argument)
247: emitn(Op_Arg, (word)(ltable[k].l_val.offset-1), "arg");
248: else
249: emitn(Op_Local, (word)(ltable[k].l_val.offset-1), "local");
250: break;
251:
252: /* Declarations. */
253:
254: case Op_Proc:
255: procname = getid();
256: newline();
257: locinit();
258: clearlab();
259: line = 0;
260: gp = glocate(procname);
261: implicit = gp->g_flag & F_ImpError;
262: nargs = gp->g_nargs;
263: emiteven();
264: break;
265:
266: case Op_Local:
267: k = getdec();
268: flags = getoct();
269: id = getid();
270: putloc(k, id, flags, implicit, procname);
271: break;
272:
273: case Op_Con:
274: k = getdec();
275: flags = getoct();
276: if (flags & F_IntLit) {
277: gg.ival = getint();
278: putconst(k, flags, 0, pc, gg);
279: }
280: else if (flags & F_RealLit) {
281: gg.rval = getreal();
282: putconst(k, flags, 0, pc, gg);
283: }
284: else if (flags & F_StrLit) {
285: j = getdec();
286: gg.sval = getstrlit(j);
287: putconst(k, flags, j, pc, gg);
288: }
289: else if (flags & F_CsetLit) {
290: j = getdec();
291: gg.sval = getstrlit(j);
292: putconst(k, flags, j, pc, gg);
293: }
294: else
295: fprintf(stderr, "gencode: illegal constant\n");
296: newline();
297: emitcon(k);
298: break;
299:
300: case Op_Filen:
301: file = getid();
302: newline();
303: break;
304:
305: case Op_Declend:
306: newline();
307: gp->g_pc = pc;
308: emitproc(procname, nargs, dynoff, statics-static1, static1);
309: break;
310:
311: case Op_End:
312: newline();
313: flushcode();
314: break;
315:
316: default:
317: fprintf(stderr, "gencode: illegal opcode(%d): %s\n", op, name);
318: newline();
319: }
320: }
321: }
322:
323: /*
324: * emit - emit opcode.
325: * emitl - emit opcode with reference to program label, consult the "tour"
326: * for a description of the chaining and backpatching for labels.
327: * emitn - emit opcode with integer argument.
328: * emitr - emit opcode with pc-relative reference.
329: * emiti - emit opcode with reference to identifier table.
330: * emitin - emit opcode with reference to identifier table & integer argument.
331: * emitint - emit word opcode with integer argument.
332: * emiteven - emit null bytes to bring pc to word boundary.
333: * emitcon - emit constant table entry.
334: * emitproc - emit procedure block.
335: *
336: * The emit* routines call out* routines to effect the "outputting" of icode.
337: * Note that the majority of the code for the emit* routines is for debugging
338: * purposes.
339: */
340: emit(op, name)
341: int op;
342: char *name;
343: {
344: if (Dflag)
345: fprintf(dbgfile, "%ld:\t%d\t\t\t\t# %s\n", (long)pc, op, name);
346: outword(op);
347: }
348:
349: emitl(op, lab, name)
350: int op, lab;
351: char *name;
352: {
353: if (Dflag)
354: fprintf(dbgfile, "%ld:\t%d\tL%d\t\t\t# %s\n", (long)pc, op, lab, name);
355: if (lab >= maxlabels)
356: syserr("too many labels in ucode");
357: outword(op);
358: if (labels[lab] <= 0) { /* forward reference */
359: outword(labels[lab]);
360: labels[lab] = WordSize - pc; /* add to front of reference chain */
361: }
362: else /* output relative offset */
363: outword(labels[lab] - (pc + WordSize));
364: }
365:
366: emitn(op, n, name)
367: int op;
368: word n;
369: char *name;
370: {
371: if (Dflag)
372: fprintf(dbgfile, "%ld:\t%d\t%ld\t\t\t# %s\n", (long)pc, op, (long)n, name);
373: outword(op);
374: outword(n);
375: }
376:
377: emitr(op, loc, name)
378: int op;
379: word loc;
380: char *name;
381: {
382: loc -= pc + (WordSize * 2);
383: if (Dflag) {
384: if (loc >= 0)
385: fprintf(dbgfile, "%ld:\t%d\t*+%ld\t\t\t# %s\n",(long) pc, op, (long)loc, name);
386: else
387: fprintf(dbgfile, "%ld:\t%d\t*-%ld\t\t\t# %s\n",(long) pc, op, (long)-loc, name);
388: }
389: outword(op);
390: outword(loc);
391: }
392:
393: emiti(op, offset, name)
394: int op;
395: word offset;
396: char *name;
397: {
398: if (Dflag)
399: fprintf(dbgfile, "%ld:\t%d\tI+%d\t\t\t# %s\n", (long)pc, op, offset, name);
400: outword(op);
401: outword(offset);
402: }
403:
404: emitin(op, offset, n, name)
405: int op, n;
406: word offset;
407: char *name;
408: {
409: if (Dflag)
410: fprintf(dbgfile, "%ld:\t%d\t%d,I+%ld\t\t\t# %s\n", (long)pc, op, n, (long)offset, name);
411: outword(op);
412: outword(n);
413: outword(offset);
414: }
415: /*
416: * emitint can have some pitfalls. outword is used to output the
417: * integer and this is picked up in the interpreter as the second
418: * word of a short integer. The integer value output must be
419: * the same size as what the interpreter expects. See op_int and op_intx
420: * in interp.s
421: */
422: emitint(op, i, name)
423: int op;
424: long int i;
425: char *name;
426: {
427: if (Dflag)
428: fprintf(dbgfile, "%ld:\t%d\t%ld\t\t\t# %s\n", (long)pc, op, (long)i, name);
429: outword(op);
430: outword(i);
431: }
432:
433: emiteven()
434: {
435: while ((pc % WordSize) != 0) {
436: if (Dflag)
437: fprintf(dbgfile, "%ld:\t0\n",(long) pc);
438: outword(0);
439: }
440: }
441:
442: emitcon(k)
443: register int k;
444: {
445: register int i, j;
446: register char *s;
447: int csbuf[CsetSize];
448: union {
449: char ovly[1]; /* Array used to overlay l and f on a bytewise basis. */
450: long int l;
451: double f;
452: } x;
453:
454: if (ctable[k].c_flag & F_RealLit) {
455: #ifdef Double
456: /* access real values one word at a time */
457: { int *rp, *rq;
458: rp = (int *) &(x.f);
459: rq = (int *) &(ctable[k].c_val.rval);
460: *rp++ = *rq++;
461: *rp = *rq;
462: }
463: #else Double
464: x.f = ctable[k].c_val.rval;
465: #endif Double
466: if (Dflag) {
467: fprintf(dbgfile, "%ld:\t%d\n", (long)pc, T_Real);
468: dumpblock(x.ovly,sizeof(double));
469: fprintf(dbgfile, "\t\t\t( %g )\n",x.f);
470: }
471: outword(T_Real);
472:
473: #ifdef Double
474: /* fill out real block with an empty word */
475: outword(0);
476: #endif Double
477: outblock(x.ovly,sizeof(double));
478: }
479: else if (ctable[k].c_flag & F_LongLit) {
480: x.l = ctable[k].c_val.ival;
481: if (Dflag) {
482: fprintf(dbgfile, "%ld:\t%d\n",(long) pc, T_Longint);
483: dumpblock(x.ovly,sizeof(long));
484: fprintf(dbgfile,"\t\t\t( %ld)\n",(long)x.l);
485: }
486: outword(T_Longint);
487: outblock(x.ovly,sizeof(long));
488: }
489: else if (ctable[k].c_flag & F_CsetLit) {
490: for (i = 0; i < CsetSize; i++)
491: csbuf[i] = 0;
492: s = ctable[k].c_val.sval;
493: i = ctable[k].c_length;
494: while (i--) {
495: Setb(*s, csbuf);
496: s++;
497: }
498: j = 0;
499: for (i = 0; i < 256; i++) {
500: if (Testb(i, csbuf))
501: j++;
502: }
503: if (Dflag) {
504: fprintf(dbgfile, "%ld:\t%d\n",(long) pc, T_Cset);
505: fprintf(dbgfile, "\t%d\n",j);
506: fprintf(dbgfile,csbuf,sizeof(csbuf));
507: }
508: outword(T_Cset);
509: outword(j); /* cset size */
510: outblock(csbuf,sizeof(csbuf));
511: if (Dflag)
512: dumpblock(csbuf,CsetSize);
513: }
514: }
515:
516: emitproc(name, nargs, ndyn, nstat, fstat)
517: char *name;
518: int nargs, ndyn, nstat, fstat;
519: {
520: register int i;
521: register char *p;
522: int size;
523: /*
524: * FncBlockSize = sizeof(BasicFncBlock) +
525: * sizeof(descrip)*(# of args + # of dynamics + # of statics).
526: */
527: size = (10*WordSize) + (2*WordSize) * (nargs+ndyn+nstat);
528:
529: if (Dflag) {
530: fprintf(dbgfile, "%ld:\t%d\n", (long)pc, T_Proc); /* type code */
531: fprintf(dbgfile, "\t%d\n", size); /* size of block */
532: fprintf(dbgfile, "\tZ+%ld\n",(long)(pc+size)); /* entry point */
533: fprintf(dbgfile, "\t%d\n", nargs); /* # of arguments */
534: fprintf(dbgfile, "\t%d\n", ndyn); /* # of dynamic locals */
535: fprintf(dbgfile, "\t%d\n", nstat); /* # of static locals */
536: fprintf(dbgfile, "\t%d\n", fstat); /* first static */
537: fprintf(dbgfile, "\t%s\n", file); /* file */
538: fprintf(dbgfile, "\t%d\tI+%ld\t\t\t# %s\n", /* name of procedure */
539: strlen(name), (long)(name-strings), name);
540: }
541: outword(T_Proc);
542: outword(size);
543: outword(pc + size - 2*WordSize); /* Have to allow for the two words
544: that we've already output. */
545: outword(nargs);
546: outword(ndyn);
547: outword(nstat);
548: outword(fstat);
549: outword(file - strings);
550: outword(strlen(name));
551: outword(name - strings);
552:
553: /*
554: * Output string descriptors for argument names by looping through
555: * all locals, and picking out those with F_Argument set.
556: */
557: for (i = 0; i <= nlocal; i++) {
558: if (ltable[i].l_flag & F_Argument) {
559: p = ltable[i].l_name;
560: if (Dflag)
561: fprintf(dbgfile, "\t%d\tI+%ld\t\t\t# %s\n", strlen(p), (long)(p-strings), p);
562: outword(strlen(p));
563: outword(p - strings);
564: }
565: }
566:
567: /*
568: * Output string descriptors for local variable names.
569: */
570: for (i = 0; i <= nlocal; i++) {
571: if (ltable[i].l_flag & F_Dynamic) {
572: p = ltable[i].l_name;
573: if (Dflag)
574: fprintf(dbgfile, "\t%d\tI+%ld\t\t\t# %s\n", strlen(p), (long)(p-strings), p);
575: outword(strlen(p));
576: outword(p - strings);
577: }
578: }
579:
580: /*
581: * Output string descriptors for local variable names.
582: */
583: for (i = 0; i <= nlocal; i++) {
584: if (ltable[i].l_flag & F_Static) {
585: p = ltable[i].l_name;
586: if (Dflag)
587: fprintf(dbgfile, "\t%d\tI+%ld\t\t\t# %s\n", strlen(p), (long)(p-strings), p);
588: outword(strlen(p));
589: outword(p - strings);
590: }
591: }
592: }
593:
594: /*
595: * gentables - generate interpreter code for global, static,
596: * identifier, and record tables, and built-in procedure blocks.
597: */
598:
599: gentables()
600: {
601: register int i;
602: register char *s;
603: register struct gentry *gp;
604: struct fentry *fp;
605: struct rentry *rp;
606: struct header hdr;
607: char *strcpy();
608:
609: emiteven();
610:
611: /*
612: * Output record constructor procedure blocks.
613: */
614: hdr.records = pc;
615: if (Dflag)
616: fprintf(dbgfile, "%ld:\t%d\t\t\t\t# record blocks\n",(long)pc, nrecords);
617: outword(nrecords);
618: for (gp = gtable; gp < gfree; gp++) {
619: if (gp->g_flag & (F_Record & ~F_Global)) {
620: s = gp->g_name;
621: gp->g_pc = pc;
622: if (Dflag) {
623: fprintf(dbgfile, "%ld:\n", pc);
624: fprintf(dbgfile, "\t%d\n", T_Proc);
625: fprintf(dbgfile, "\t%d\n", RkBlkSize);
626: fprintf(dbgfile, "\t_mkrec\n");
627: fprintf(dbgfile, "\t%d\n", gp->g_nargs);
628: fprintf(dbgfile, "\t-2\n");
629: fprintf(dbgfile, "\t%d\n", gp->g_procid);
630: fprintf(dbgfile, "\t0\n");
631: fprintf(dbgfile, "\t0\n");
632: fprintf(dbgfile, "\t%d\tI+%ld\t\t\t# %s\n", strlen(s), (long)(s-strings), s);
633: }
634: outword(T_Proc); /* type code */
635: outword(RkBlkSize); /* size of block */
636: outword(0); /* entry point (filled in by interp)*/
637: outword(gp->g_nargs); /* number of fields */
638: outword(-2); /* record constructor indicator */
639: outword(gp->g_procid); /* record id */
640: outword(0); /* not used */
641: outword(0); /* not used */
642: outword(strlen(s)); /* name of record */
643: outword(s - strings);
644: }
645: }
646:
647: /*
648: * Output record/field table.
649: */
650: hdr.ftab = pc;
651: if (Dflag)
652: fprintf(dbgfile, "%ld:\t\t\t\t\t# record/field table\n", (long)pc);
653: for (fp = ftable; fp < ffree; fp++) {
654: if (Dflag)
655: fprintf(dbgfile, "%ld:\n", (long)pc);
656: rp = fp->f_rlist;
657: for (i = 1; i <= nrecords; i++) {
658: if (rp != NULL && rp->r_recid == i) {
659: if (Dflag)
660: fprintf(dbgfile, "\t%d\n", rp->r_fnum);
661: outword(rp->r_fnum);
662: rp = rp->r_link;
663: }
664: else {
665: if (Dflag)
666: fprintf(dbgfile, "\t-1\n");
667: outword(-1);
668: }
669: if (Dflag && (i == nrecords || (i & 03) == 0))
670: putc('\n', dbgfile);
671: }
672: }
673:
674: /*
675: * Output global variable descriptors.
676: */
677: hdr.globals = pc;
678: for (gp = gtable; gp < gfree; gp++) {
679: if (gp->g_flag & (F_Builtin & ~F_Global)) { /* built-in procedure */
680: if (Dflag)
681: fprintf(dbgfile, "%ld:\t%06lo\t%d\t\t\t# %s\n",
682: (long)pc, (long)D_Proc, -gp->g_procid, gp->g_name);
683: outword(D_Proc);
684: outword(-gp->g_procid);
685: }
686: else if (gp->g_flag & (F_Proc & ~F_Global)) { /* Icon procedure */
687: if (Dflag)
688: fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n",
689: (long)pc,(long)D_Proc, (long)gp->g_pc, gp->g_name);
690: outword(D_Proc);
691: outword(gp->g_pc);
692: }
693: else if (gp->g_flag & (F_Record & ~F_Global)) { /* record constructor */
694: if (Dflag)
695: fprintf(dbgfile, "%ld:\t%06lo\tZ+%ld\t\t\t# %s\n",
696: (long)pc, (long)D_Proc, (long)gp->g_pc, gp->g_name);
697: outword(D_Proc);
698: outword(gp->g_pc);
699: }
700: else { /* global variable */
701: if (Dflag)
702: fprintf(dbgfile, "%ld:\t%06lo\t0\t\t\t# %s\n",(long)pc,(long)D_Null, gp->g_name);
703: outword(D_Null);
704: outword(0);
705: }
706: }
707:
708: /*
709: * Output descriptors for global variable names.
710: */
711: hdr.gnames = pc;
712: for (gp = gtable; gp < gfree; gp++) {
713: if (Dflag)
714: fprintf(dbgfile, "%ld:\t%d\tI+%ld\t\t\t# %s\n",
715: (long)pc, strlen(gp->g_name), (long)(gp->g_name-strings), gp->g_name);
716: outword(strlen(gp->g_name));
717: outword(gp->g_name - strings);
718: }
719:
720: /*
721: * Output a null descriptor for each static variable.
722: */
723: hdr.statics = pc;
724: for (i = statics; i > 0; i--) {
725: if (Dflag)
726: fprintf(dbgfile, "%ld:\t0\t0\n", (long)pc);
727: outword(D_Null);
728: outword(0);
729: }
730: flushcode();
731:
732: /*
733: * Output the identifier table. Note that the call to write
734: * really does all the work.
735: */
736: hdr.ident = pc;
737: if (Dflag) {
738: for (s = strings; s < strfree; ) {
739: fprintf(dbgfile, "%ld:\t%03o\n", (long)pc, *s++);
740: for (i = 7; i > 0; i--) {
741: if (s >= strfree)
742: break;
743: fprintf(dbgfile, " %03o\n", *s++);
744: }
745: putc('\n', dbgfile);
746: }
747: }
748: #ifndef MSDOS
749: write(fileno(outfile), strings, strfree - strings);
750: #else MSDOS
751: #ifdef SPTR
752: write(fileno(outfile), strings, strfree - strings);
753: #else /* Handle the case where strfree-strings will create a long int */
754: longwrite(fileno(outfile), strings, (long)(strfree - strings));
755: #endif
756: #endif MSDOS
757: pc += strfree - strings;
758:
759: /*
760: * Output icode file header.
761: */
762: hdr.hsize = pc;
763: strcpy((char *)hdr.config,IVersion);
764: hdr.trace = trace;
765: if (Dflag) {
766: fprintf(dbgfile, "size: %ld\n", (long)hdr.hsize);
767: fprintf(dbgfile, "trace: %ld\n", (long)hdr.trace);
768: fprintf(dbgfile, "records: %ld\n", (long)hdr.records);
769: fprintf(dbgfile, "ftab: %ld\n", (long)hdr.ftab);
770: fprintf(dbgfile, "globals: %ld\n", (long)hdr.globals);
771: fprintf(dbgfile, "gnames: %ld\n", (long)hdr.gnames);
772: fprintf(dbgfile, "statics: %ld\n", (long)hdr.statics);
773: fprintf(dbgfile, "ident: %ld\n", (long)hdr.ident);
774: fprintf(dbgfile, "config: %s\n", hdr.config);
775: }
776: #ifndef NoHeader
777: fseek(outfile, (long)MaxHeader, 0);
778: #else NoHeader
779: fseek(outfile, 0L, 0);
780: #endif NoHeader
781: write(fileno(outfile), &hdr, sizeof hdr);
782: }
783:
784: #define CodeCheck if (codep >= code + maxcode)\
785: syserr("out of code buffer space")
786: /*
787: * outword(i) outputs i as a word that is used by the runtime system
788: * WordSize bytes must be moved from &word[0] to &codep[0].
789: */
790: wordout(oword)
791: word oword;
792: {
793: int i;
794: union {
795: word i;
796: char c[WordSize];
797: } u;
798:
799: CodeCheck;
800: u.i = oword;
801:
802: for (i = 0; i < WordSize; i++)
803: codep[i] = u.c[i];
804:
805: codep += WordSize;
806: pc += WordSize;
807: }
808: /*
809: * outblock(a,i) output i bytes starting at address a.
810: */
811: outblock(addr,count)
812: char *addr;
813: int count;
814: {
815: if (codep + count > code + maxcode)
816: syserr("out of code buffer space");
817: pc += count;
818: while (count--)
819: *codep++ = *addr++;
820: }
821: /*
822: * dumpblock(a,i) dump contents of i bytes at address a, used only
823: * in conjunction with -D.
824: */
825: dumpblock(addr, count)
826: char *addr;
827: int count;
828: {
829: int i;
830: for (i = 0; i < count; i++) {
831: if ((i & 7) == 0)
832: fprintf(dbgfile,"\n\t");
833: fprintf(dbgfile," %03o\n",(unsigned)addr[i]);
834: }
835: putc('\n',dbgfile);
836: }
837:
838: /*
839: * flushcode - write buffered code to the output file.
840: */
841: flushcode()
842: {
843: if (codep > code)
844: write(fileno(outfile), code, codep - code);
845: codep = code;
846: }
847:
848: /*
849: * clearlab - clear label table to all zeroes.
850: */
851: clearlab()
852: {
853: register int i;
854:
855: for (i = 0; i < maxlabels; i++)
856: labels[i] = 0;
857: }
858:
859: /*
860: * backpatch - fill in all forward references to lab.
861: */
862: backpatch(lab)
863: int lab;
864: {
865: word p, r;
866: register char *q;
867: register char *cp, *cr;
868: register int j;
869:
870: if (lab >= maxlabels)
871: syserr("too many labels in ucode");
872:
873: p = labels[lab];
874: if (p > 0)
875: syserr("multiply defined label in ucode");
876: while (p < 0) { /* follow reference chain */
877: r = pc - (WordSize - p); /* compute relative offset */
878: q = codep - (pc + p); /* point to word with address */
879: cp = (char *) &p; /* address of integer p */
880: cr = (char *) &r; /* address of integer r */
881: for (j = 0; j < WordSize; j++) { /* move bytes from int pointed to */
882: *cp++ = *q; /* by q to p, and move bytes from */
883: *q++ = *cr++; /* r to int pointed to by q */
884: } /* moves integers at arbitrary addresses */
885: }
886: labels[lab] = pc;
887: }
888: #ifdef MSDOS
889: #ifdef LPTR
890: /* Write a long string in 32k chunks */
891: static longwrite(file,s,len)
892: int file;
893: char *s;
894: long int len;
895: {
896: long int loopnum;
897: unsigned int leftover;
898: char *p;
899:
900: loopnum = len / 32768;
901: leftover = len % 32768;
902: for(p = s, loopnum = len/32768;loopnum;loopnum--) {
903: write(file,p,32768);
904: p += 32768;
905: }
906: if(leftover) write(file,p,leftover);
907: }
908: #endif LPTR
909: #endif MSDOS
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.