![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fdec.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / pi|
Return to fdec.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2: #
3: /*
4: * pi - Pascal interpreter code translator
5: *
6: * Charles Haley, Bill Joy UCB
7: * Version 1.2 November 1978
8: */
9:
10: #include "whoami"
11: #include "0.h"
12: #include "tree.h"
13: #include "opcode.h"
14:
15: int cntpatch;
16: int nfppatch;
17:
18: /*
19: * Funchdr inserts
20: * declaration of a the
21: * prog/proc/func into the
22: * namelist. It also handles
23: * the arguments and puts out
24: * a transfer which defines
25: * the entry point of a procedure.
26: */
27:
28: struct nl *
29: funchdr(r)
30: int *r;
31: {
32: register struct nl *p;
33: register *il, **rl;
34: int *rll;
35: struct nl *cp, *dp, *sp;
36: int o, *pp;
37:
38: if (inpflist(r[2])) {
39: opush('l');
40: yyretrieve(); /* kludge */
41: }
42: pfcnt++;
43: line = r[1];
44: if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
45: /*
46: * Symbol already defined
47: * in this block. it is either
48: * a redeclared symbol (error)
49: * or a forward declaration.
50: */
51: if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) {
52: /*
53: * Grammar doesnt forbid
54: * types on a resolution
55: * of a forward function
56: * declaration.
57: */
58: if (p->class == FUNC && r[4])
59: error("Function type should be given only in forward declaration");
60: if (monflg)
61: putcnt();
62: # ifdef PTREE
63: /*
64: * mark this proc/func as forward
65: * in the pTree.
66: */
67: pDEF( p -> inTree ).PorFForward = TRUE;
68: # endif
69: return (p);
70: }
71: }
72: /*
73: * Declare the prog/proc/func
74: */
75: switch (r[0]) {
76: case T_PROG:
77: if (opt('z'))
78: monflg++;
79: program = p = defnl(r[2], PROG, 0, 0);
80: p->value[3] = r[1];
81: break;
82: case T_PDEC:
83: if (r[4] != NIL)
84: error("Procedures do not have types, only functions do");
85: p = enter(defnl(r[2], PROC, 0, 0));
86: p->nl_flags |= NMOD;
87: break;
88: case T_FDEC:
89: il = r[4];
90: if (il == NIL)
91: error("Function type must be specified");
92: else if (il[0] != T_TYID) {
93: il = NIL;
94: error("Function type can be specified only by using a type identifier");
95: } else
96: il = gtype(il);
97: p = enter(defnl(r[2], FUNC, il, NIL));
98: p->nl_flags |= NMOD;
99: /*
100: * An arbitrary restriction
101: */
102: switch (o = classify(p->type)) {
103: case TFILE:
104: case TARY:
105: case TREC:
106: case TSET:
107: case TSTR:
108: warning();
109: if (opt('s'))
110: standard();
111: error("Functions should not return %ss", clnames[o]);
112: }
113: break;
114: default:
115: panic("funchdr");
116: }
117: if (r[0] != T_PROG) {
118: /*
119: * Mark this proc/func as
120: * being forward declared
121: */
122: p->nl_flags |= NFORWD;
123: /*
124: * Enter the parameters
125: * in the next block for
126: * the time being
127: */
128: if (++cbn >= DSPLYSZ) {
129: error("Procedure/function nesting too deep");
130: pexit(ERRS);
131: }
132: /*
133: * For functions, the function variable
134: */
135: if (p->class == FUNC) {
136: cp = defnl(r[2], FVAR, p->type, 0);
137: cp->chain = p;
138: p->ptr[NL_FVAR] = cp;
139: }
140: /*
141: * Enter the parameters
142: * and compute total size
143: */
144: cp = sp = p;
145: o = 0;
146: for (rl = r[3]; rl != NIL; rl = rl[2]) {
147: p = NIL;
148: if (rl[1] == NIL)
149: continue;
150: /*
151: * Parametric procedures
152: * don't have types !?!
153: */
154: if (rl[1][0] != T_PPROC) {
155: rll = rl[1][2];
156: if (rll[0] != T_TYID) {
157: error("Types for arguments can be specified only by using type identifiers");
158: p = NIL;
159: } else
160: p = gtype(rll);
161: }
162: for (il = rl[1][1]; il != NIL; il = il[2]) {
163: switch (rl[1][0]) {
164: default:
165: panic("funchdr2");
166: case T_PVAL:
167: if (p != NIL) {
168: if (p->class == FILET)
169: error("Files cannot be passed by value");
170: else if (p->nl_flags & NFILES)
171: error("Files cannot be a component of %ss passed by value",
172: nameof(p));
173: }
174: dp = defnl(il[1], VAR, p, o -= even(width(p)));
175: dp->nl_flags |= NMOD;
176: break;
177: case T_PVAR:
178: dp = defnl(il[1], REF, p, o -= sizeof ( int * ) );
179: break;
180: case T_PFUNC:
181: case T_PPROC:
182: error("Procedure/function parameters not implemented");
183: continue;
184: }
185: if (dp != NIL) {
186: cp->chain = dp;
187: cp = dp;
188: }
189: }
190: }
191: cbn--;
192: p = sp;
193: p->value[NL_OFFS] = -o+DPOFF2;
194: /*
195: * Correct the naievity
196: * of our above code to
197: * calculate offsets
198: */
199: for (il = p->chain; il != NIL; il = il->chain)
200: il->value[NL_OFFS] += p->value[NL_OFFS];
201: } else {
202: /*
203: * The wonderful
204: * program statement!
205: */
206: if (monflg) {
207: cntpatch = put2(O_PXPBUF, 0);
208: nfppatch = put3(NIL, 0, 0);
209: }
210: cp = p;
211: for (rl = r[3]; rl; rl = rl[2]) {
212: if (rl[1] == NIL)
213: continue;
214: dp = defnl(rl[1], VAR, 0, 0);
215: cp->chain = dp;
216: cp = dp;
217: }
218: }
219: /*
220: * Define a branch at
221: * the "entry point" of
222: * the prog/proc/func.
223: */
224: p->entloc = getlab();
225: if (monflg) {
226: put2(O_TRACNT, p->entloc);
227: putcnt();
228: } else
229: put2(O_TRA4, p->entloc);
230: # ifdef PTREE
231: {
232: pPointer PF = tCopy( r );
233:
234: pSeize( PorFHeader[ nesting ] );
235: if ( r[0] != T_PROG ) {
236: pPointer *PFs;
237:
238: PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs );
239: *PFs = ListAppend( *PFs , PF );
240: } else {
241: pDEF( PorFHeader[ nesting ] ).GlobProg = PF;
242: }
243: pRelease( PorFHeader[ nesting ] );
244: }
245: # endif
246: return (p);
247: }
248:
249: funcfwd(fp)
250: struct nl *fp;
251: {
252:
253: return (fp);
254: }
255:
256: /*
257: * Funcbody is called
258: * when the actual (resolved)
259: * declaration of a procedure is
260: * encountered. It puts the names
261: * of the (function) and parameters
262: * into the symbol table.
263: */
264: funcbody(fp)
265: struct nl *fp;
266: {
267: register struct nl *q, *p;
268:
269: cbn++;
270: if (cbn >= DSPLYSZ) {
271: error("Too many levels of function/procedure nesting");
272: pexit(ERRS);
273: }
274: sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1;
275: gotos[cbn] = NIL;
276: errcnt[cbn] = syneflg;
277: parts = NIL;
278: if (fp == NIL)
279: return (NIL);
280: /*
281: * Save the virtual name
282: * list stack pointer so
283: * the space can be freed
284: * later (funcend).
285: */
286: fp->ptr[2] = nlp;
287: if (fp->class != PROG)
288: for (q = fp->chain; q != NIL; q = q->chain)
289: enter(q);
290: if (fp->class == FUNC) {
291: /*
292: * For functions, enter the fvar
293: */
294: enter(fp->ptr[NL_FVAR]);
295: }
296: # ifdef PTREE
297: /*
298: * pick up the pointer to porf declaration
299: */
300: PorFHeader[ ++nesting ] = fp -> inTree;
301: # endif
302: return (fp);
303: }
304:
305: struct nl *Fp;
306: int pnumcnt;
307: /*
308: * Funcend is called to
309: * finish a block by generating
310: * the code for the statements.
311: * It then looks for unresolved declarations
312: * of labels, procedures and functions,
313: * and cleans up the name list.
314: * For the program, it checks the
315: * semantics of the program
316: * statement (yuchh).
317: */
318: funcend(fp, bundle, endline)
319: struct nl *fp;
320: int *bundle;
321: int endline;
322: {
323: register struct nl *p;
324: register int i, b;
325: int var, inp, out, chkref, *blk;
326: struct nl *iop;
327: char *cp;
328: extern int cntstat;
329: # ifdef PPC
330: int toplabel = newlabel();
331: int botlabel = newlabel();
332: # endif
333:
334: cntstat = 0;
335: /*
336: * yyoutline();
337: */
338: if (program != NIL)
339: line = program->value[3];
340: blk = bundle[2];
341: if (fp == NIL) {
342: cbn--;
343: # ifdef PTREE
344: nesting--;
345: # endif
346: return;
347: }
348: #ifdef OBJ
349: /*
350: * Patch the branch to the
351: * entry point of the function
352: */
353: patch4(fp->entloc);
354: /*
355: * Put out the block entrance code and the block name.
356: * the CONG is overlaid by a patch later!
357: */
358: var = put1(cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG);
359: put( 2 + (sizeof ( char * )/sizeof ( short )) , O_CONG, 8, fp->symbol);
360: put2(NIL, bundle[1]);
361: #endif
362: #ifdef PPC
363: /*
364: * put out the procedure entry code
365: */
366: if ( fp -> class == PROG ) {
367: puttext( " .data" );
368: puttext( " .align 1" );
369: putprintf( " .comm _display,%d"
370: , DSPLYSZ * sizeof( int * ) );
371: puttext( " .text" );
372: puttext( " .align 1" );
373: puttext( " .globl _main" );
374: puttext( "_main:" );
375: }
376: ftnno = newlabel();
377: puttext( " .text" );
378: puttext( " .align 1" );
379: putprintf( " .globl _%.7s" , fp -> symbol );
380: putprintf( "_%.7s:" , fp -> symbol );
381: /* register save mask for function */
382: putprintf( " .word 0" );
383: putprintf( " jbr B%d" , botlabel );
384: putprintf( "T%d:" , toplabel );
385: /* save old display */
386: putprintf( " movl _display+%o,(fp)" , cbn * sizeof( int * ) );
387: /* set up new display */
388: putprintf( " movl fp,_display+%o" , cbn * sizeof( int * ) );
389: /* 'allocate' local storage */
390: putlbracket();
391: #endif
392: if (fp->class == PROG) {
393: /*
394: * The glorious buffers option.
395: * 0 = don't buffer output
396: * 1 = line buffer output
397: * 2 = 512 byte buffer output
398: */
399: # ifdef OBJ
400: if (opt('b') != 1)
401: put1(O_BUFF | opt('b') << 8);
402: # endif
403: inp = 0;
404: out = 0;
405: for (p = fp->chain; p != NIL; p = p->chain) {
406: if (strcmp(p->symbol, "input") == 0) {
407: inp++;
408: continue;
409: }
410: if (strcmp(p->symbol, "output") == 0) {
411: out++;
412: continue;
413: }
414: iop = lookup1(p->symbol);
415: if (iop == NIL || bn != cbn) {
416: error("File %s listed in program statement but not declared", p->symbol);
417: continue;
418: }
419: if (iop->class != VAR) {
420: error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
421: continue;
422: }
423: if (iop->type == NIL)
424: continue;
425: if (iop->type->class != FILET) {
426: error("File %s listed in program statement but defined as %s",
427: p->symbol, nameof(iop->type));
428: continue;
429: }
430: # ifdef OBJ
431: put2(O_LV | bn << 9, iop->value[NL_OFFS]);
432: b = p->symbol;
433: while (b->pchar != '\0')
434: b++;
435: i = b - ( (int) p->symbol );
436: put( 2 + (sizeof ( char * )/sizeof ( short ))
437: , O_CONG, i, p->symbol);
438: put2(O_DEFNAME | i << 8
439: , text(iop->type) ? 0: width(iop->type->type));
440: # endif
441: }
442: if (out == 0 && fp->chain != NIL) {
443: recovered();
444: error("The file output must appear in the program statement file list");
445: }
446: }
447: /*
448: * Process the prog/proc/func body
449: */
450: noreach = 0;
451: line = bundle[1];
452: statlist(blk);
453: # ifdef PTREE
454: {
455: pPointer Body = tCopy( blk );
456:
457: pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body;
458: }
459: # endif
460: # ifdef OBJ
461: if (cbn== 1 && monflg != 0) {
462: patchfil(cntpatch, cnts, 1);
463: patchfil(nfppatch, pfcnt, 1);
464: }
465: # endif
466: if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
467: recovered();
468: error("Input is used but not defined in the program statement");
469: }
470: /*
471: * Clean up the symbol table displays and check for unresolves
472: */
473: line = endline;
474: b = cbn;
475: Fp = fp;
476: chkref = syneflg == errcnt[cbn] && opt('w') == 0;
477: for (i = 0; i <= 077; i++) {
478: for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
479: /*
480: * Check for variables defined
481: * but not referenced
482: */
483: if (chkref && p->symbol != NIL)
484: switch (p->class) {
485: case FIELD:
486: /*
487: * If the corresponding record is
488: * unused, we shouldn't complain about
489: * the fields.
490: */
491: default:
492: if ((p->nl_flags & (NUSED|NMOD)) == 0) {
493: warning();
494: nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
495: break;
496: }
497: /*
498: * If a var parameter is either
499: * modified or used that is enough.
500: */
501: if (p->class == REF)
502: continue;
503: if ((p->nl_flags & NUSED) == 0) {
504: warning();
505: nerror("%s %s is never used", classes[p->class], p->symbol);
506: break;
507: }
508: if ((p->nl_flags & NMOD) == 0) {
509: warning();
510: nerror("%s %s is used but never set", classes[p->class], p->symbol);
511: break;
512: }
513: case LABEL:
514: case FVAR:
515: case BADUSE:
516: break;
517: }
518: switch (p->class) {
519: case BADUSE:
520: cp = "s";
521: if (p->chain->ud_next == NIL)
522: cp++;
523: eholdnl();
524: if (p->value[NL_KINDS] & ISUNDEF)
525: nerror("%s undefined on line%s", p->symbol, cp);
526: else
527: nerror("%s improperly used on line%s", p->symbol, cp);
528: pnumcnt = 10;
529: pnums(p->chain);
530: pchr('\n');
531: break;
532:
533: case FUNC:
534: case PROC:
535: if (p->nl_flags & NFORWD)
536: nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
537: break;
538:
539: case LABEL:
540: if (p->nl_flags & NFORWD)
541: nerror("label %s was declared but not defined", p->symbol);
542: break;
543: case FVAR:
544: if ((p->nl_flags & NMOD) == 0)
545: nerror("No assignment to the function variable");
546: break;
547: }
548: }
549: /*
550: * Pop this symbol
551: * table slot
552: */
553: disptab[i] = p;
554: }
555:
556: # ifdef OBJ
557: put1(O_END);
558: # endif
559: # ifdef PPC
560: putprintf( " movl (fp),_display+%o"
561: , cbn * sizeof( int * ) );
562: puttext( " ret" );
563: putprintf( "B%d:" , botlabel );
564: putprintf( " subl2 $.F%d,sp" , ftnno );
565: putrbracket();
566: putprintf( " jbr T%d" , toplabel );
567: if ( fp -> class == PROG )
568: puteof();
569: # endif
570: #ifdef DEBUG
571: dumpnl(fp->ptr[2], fp->symbol);
572: #endif
573: /*
574: * Restore the
575: * (virtual) name list
576: * position
577: */
578: nlfree(fp->ptr[2]);
579: /*
580: * Proc/func has been
581: * resolved
582: */
583: fp->nl_flags &= ~NFORWD;
584: /*
585: * Patch the beg
586: * of the proc/func to
587: * the proper variable size
588: */
589: i = sizes[cbn].om_max;
590: # ifdef PDP11
591: # define TOOMUCH -50000.
592: # endif
593: # ifdef VAX
594: # define TOOMUCH -32767.
595: # endif
596: if (sizes[cbn].om_max < TOOMUCH)
597: nerror("Storage requirement of %ld bytes exceeds hardware capacity", -sizes[cbn].om_max);
598: if (Fp == NIL)
599: elineon();
600: # ifdef OBJ
601: patchfil(var, i, 1);
602: # endif
603: cbn--;
604: if (inpflist(fp->symbol)) {
605: opop('l');
606: }
607: }
608:
609: pnums(p)
610: struct udinfo *p;
611: {
612:
613: if (p->ud_next != NIL)
614: pnums(p->ud_next);
615: if (pnumcnt == 0) {
616: printf("\n\t");
617: pnumcnt = 20;
618: }
619: pnumcnt--;
620: printf(" %d", p->ud_line);
621: }
622:
623: nerror(a1, a2, a3)
624: {
625:
626: if (Fp != NIL) {
627: yySsync();
628: #ifndef PI1
629: if (opt('l'))
630: yyoutline();
631: #endif
632: yysetfile(filename);
633: printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
634: Fp = NIL;
635: elineoff();
636: }
637: error(a1, a2, a3);
638: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.