![[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] / 40BSD / cmd / pi|
Return to fdec.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)fdec.c 1.7 10/28/80";
4:
5: #include "whoami.h"
6: #include "0.h"
7: #include "tree.h"
8: #include "opcode.h"
9: #include "objfmt.h"
10: #include "align.h"
11:
12: /*
13: * this array keeps the pxp counters associated with
14: * functions and procedures, so that they can be output
15: * when their bodies are encountered
16: */
17: int bodycnts[ DSPLYSZ ];
18:
19: #ifdef PC
20: # include "pc.h"
21: # include "pcops.h"
22: #endif PC
23:
24: #ifdef OBJ
25: int cntpatch;
26: int nfppatch;
27: #endif OBJ
28:
29: /*
30: * Funchdr inserts
31: * declaration of a the
32: * prog/proc/func into the
33: * namelist. It also handles
34: * the arguments and puts out
35: * a transfer which defines
36: * the entry point of a procedure.
37: */
38:
39: struct nl *
40: funchdr(r)
41: int *r;
42: {
43: register struct nl *p;
44: register *il, **rl;
45: int *rll;
46: struct nl *cp, *dp, *sp;
47: int s, o, *pp;
48:
49: if (inpflist(r[2])) {
50: opush('l');
51: yyretrieve(); /* kludge */
52: }
53: pfcnt++;
54: parts[ cbn ] |= RPRT;
55: line = r[1];
56: if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
57: /*
58: * Symbol already defined
59: * in this block. it is either
60: * a redeclared symbol (error)
61: * a forward declaration,
62: * or an external declaration.
63: */
64: if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) {
65: /*
66: * Grammar doesnt forbid
67: * types on a resolution
68: * of a forward function
69: * declaration.
70: */
71: if (p->class == FUNC && r[4])
72: error("Function type should be given only in forward declaration");
73: /*
74: * get another counter for the actual
75: */
76: if ( monflg ) {
77: bodycnts[ cbn ] = getcnt();
78: }
79: # ifdef PC
80: enclosing[ cbn ] = p -> symbol;
81: # endif PC
82: # ifdef PTREE
83: /*
84: * mark this proc/func as forward
85: * in the pTree.
86: */
87: pDEF( p -> inTree ).PorFForward = TRUE;
88: # endif PTREE
89: return (p);
90: }
91: }
92:
93: /* if a routine segment is being compiled,
94: * do level one processing.
95: */
96:
97: if ((r[0] != T_PROG) && (!progseen))
98: level1();
99:
100:
101: /*
102: * Declare the prog/proc/func
103: */
104: switch (r[0]) {
105: case T_PROG:
106: progseen++;
107: if (opt('z'))
108: monflg++;
109: program = p = defnl(r[2], PROG, 0, 0);
110: p->value[3] = r[1];
111: break;
112: case T_PDEC:
113: if (r[4] != NIL)
114: error("Procedures do not have types, only functions do");
115: p = enter(defnl(r[2], PROC, 0, 0));
116: p->nl_flags |= NMOD;
117: # ifdef PC
118: enclosing[ cbn ] = r[2];
119: # endif PC
120: break;
121: case T_FDEC:
122: il = r[4];
123: if (il == NIL)
124: error("Function type must be specified");
125: else if (il[0] != T_TYID) {
126: il = NIL;
127: error("Function type can be specified only by using a type identifier");
128: } else
129: il = gtype(il);
130: p = enter(defnl(r[2], FUNC, il, NIL));
131: p->nl_flags |= NMOD;
132: /*
133: * An arbitrary restriction
134: */
135: switch (o = classify(p->type)) {
136: case TFILE:
137: case TARY:
138: case TREC:
139: case TSET:
140: case TSTR:
141: warning();
142: if (opt('s')) {
143: standard();
144: }
145: error("Functions should not return %ss", clnames[o]);
146: }
147: # ifdef PC
148: enclosing[ cbn ] = r[2];
149: # endif PC
150: break;
151: default:
152: panic("funchdr");
153: }
154: if (r[0] != T_PROG) {
155: /*
156: * Mark this proc/func as
157: * being forward declared
158: */
159: p->nl_flags |= NFORWD;
160: /*
161: * Enter the parameters
162: * in the next block for
163: * the time being
164: */
165: if (++cbn >= DSPLYSZ) {
166: error("Procedure/function nesting too deep");
167: pexit(ERRS);
168: }
169: /*
170: * For functions, the function variable
171: */
172: if (p->class == FUNC) {
173: # ifdef OBJ
174: cp = defnl(r[2], FVAR, p->type, 0);
175: # endif OBJ
176: # ifdef PC
177: /*
178: * fvars used to be allocated and deallocated
179: * by the caller right before the arguments.
180: * the offset of the fvar was kept in
181: * value[NL_OFFS] of function (very wierd,
182: * but see asgnop).
183: * now, they are locals to the function
184: * with the offset kept in the fvar.
185: */
186:
187: cp = defnl( r[2] , FVAR , p -> type
188: , -( roundup( DPOFF1+width( p -> type )
189: , align( p -> type ) ) ) );
190: # endif PC
191: cp->chain = p;
192: p->ptr[NL_FVAR] = cp;
193: }
194: /*
195: * Enter the parameters
196: * and compute total size
197: */
198: cp = sp = p;
199:
200: # ifdef OBJ
201: o = 0;
202: # endif OBJ
203: # ifdef PC
204: /*
205: * parameters used to be allocated backwards,
206: * then fixed. for pc, they are allocated correctly.
207: * also, they are aligned.
208: */
209: o = DPOFF2;
210: # endif PC
211: for (rl = r[3]; rl != NIL; rl = rl[2]) {
212: p = NIL;
213: if (rl[1] == NIL)
214: continue;
215: /*
216: * Parametric procedures
217: * don't have types !?!
218: */
219: if (rl[1][0] != T_PPROC) {
220: rll = rl[1][2];
221: if (rll[0] != T_TYID) {
222: error("Types for arguments can be specified only by using type identifiers");
223: p = NIL;
224: } else
225: p = gtype(rll);
226: }
227: for (il = rl[1][1]; il != NIL; il = il[2]) {
228: switch (rl[1][0]) {
229: default:
230: panic("funchdr2");
231: case T_PVAL:
232: if (p != NIL) {
233: if (p->class == FILET)
234: error("Files cannot be passed by value");
235: else if (p->nl_flags & NFILES)
236: error("Files cannot be a component of %ss passed by value",
237: nameof(p));
238: }
239: # ifdef OBJ
240: dp = defnl(il[1], VAR, p, o -= even(width(p)));
241: # endif OBJ
242: # ifdef PC
243: dp = defnl( il[1] , VAR , p
244: , o = roundup( o , A_STACK ) );
245: o += width( p );
246: # endif PC
247: dp->nl_flags |= NMOD;
248: break;
249: case T_PVAR:
250: # ifdef OBJ
251: dp = defnl(il[1], REF, p, o -= sizeof ( int * ) );
252: # endif OBJ
253: # ifdef PC
254: dp = defnl( il[1] , REF , p
255: , o = roundup( o , A_STACK ) );
256: o += sizeof(char *);
257: # endif PC
258: break;
259: case T_PFUNC:
260: # ifdef OBJ
261: dp = defnl(il[1], FFUNC, p, o -= sizeof ( int * ) );
262: # endif OBJ
263: # ifdef PC
264: dp = defnl( il[1] , FFUNC , p
265: , o = roundup( o , A_STACK ) );
266: o += sizeof(char *);
267: # endif PC
268: dp -> nl_flags |= NMOD;
269: break;
270: case T_PPROC:
271: # ifdef OBJ
272: dp = defnl(il[1], FPROC, p, o -= sizeof ( int * ) );
273: # endif OBJ
274: # ifdef PC
275: dp = defnl( il[1] , FPROC , p
276: , o = roundup( o , A_STACK ) );
277: o += sizeof(char *);
278: # endif PC
279: dp -> nl_flags |= NMOD;
280: break;
281: }
282: if (dp != NIL) {
283: cp->chain = dp;
284: cp = dp;
285: }
286: }
287: }
288: cbn--;
289: p = sp;
290: # ifdef OBJ
291: p->value[NL_OFFS] = -o+DPOFF2;
292: /*
293: * Correct the naivete (naievity)
294: * of our above code to
295: * calculate offsets
296: */
297: for (il = p->chain; il != NIL; il = il->chain)
298: il->value[NL_OFFS] += p->value[NL_OFFS];
299: # endif OBJ
300: # ifdef PC
301: p -> value[ NL_OFFS ] = roundup( o , A_STACK );
302: # endif PC
303: } else {
304: /*
305: * The wonderful
306: * program statement!
307: */
308: # ifdef OBJ
309: if (monflg) {
310: put(1, O_PXPBUF);
311: cntpatch = put(2, O_CASE4, 0);
312: nfppatch = put(2, O_CASE4, 0);
313: }
314: # endif OBJ
315: cp = p;
316: for (rl = r[3]; rl; rl = rl[2]) {
317: if (rl[1] == NIL)
318: continue;
319: dp = defnl(rl[1], VAR, 0, 0);
320: cp->chain = dp;
321: cp = dp;
322: }
323: }
324: /*
325: * Define a branch at
326: * the "entry point" of
327: * the prog/proc/func.
328: */
329: p->entloc = getlab();
330: if (monflg) {
331: bodycnts[ cbn ] = getcnt();
332: p->value[ NL_CNTR ] = 0;
333: }
334: # ifdef OBJ
335: put(2, O_TRA4, p->entloc);
336: # endif OBJ
337: # ifdef PTREE
338: {
339: pPointer PF = tCopy( r );
340:
341: pSeize( PorFHeader[ nesting ] );
342: if ( r[0] != T_PROG ) {
343: pPointer *PFs;
344:
345: PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs );
346: *PFs = ListAppend( *PFs , PF );
347: } else {
348: pDEF( PorFHeader[ nesting ] ).GlobProg = PF;
349: }
350: pRelease( PorFHeader[ nesting ] );
351: }
352: # endif PTREE
353: return (p);
354: }
355:
356: funcfwd(fp)
357: struct nl *fp;
358: {
359:
360: /*
361: * save the counter for this function
362: */
363: if ( monflg ) {
364: fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
365: }
366: return (fp);
367: }
368:
369: /*
370: * Funcext marks the procedure or
371: * function external in the symbol
372: * table. Funcext should only be
373: * called if PC, and is an error
374: * otherwise.
375: */
376:
377: funcext(fp)
378: struct nl *fp;
379: {
380:
381: #ifdef PC
382: if (opt('s')) {
383: standard();
384: error("External procedures and functions are not standard");
385: } else {
386: if (cbn == 1) {
387: fp->ext_flags |= NEXTERN;
388: stabefunc( fp -> symbol , fp -> class , line );
389: }
390: else
391: error("External procedures and functions can only be declared at the outermost level.");
392: }
393: #endif PC
394: #ifdef OBJ
395: error("Procedures or functions cannot be declared external.");
396: #endif OBJ
397:
398: return(fp);
399: }
400:
401: /*
402: * Funcbody is called
403: * when the actual (resolved)
404: * declaration of a procedure is
405: * encountered. It puts the names
406: * of the (function) and parameters
407: * into the symbol table.
408: */
409: funcbody(fp)
410: struct nl *fp;
411: {
412: register struct nl *q, *p;
413:
414: cbn++;
415: if (cbn >= DSPLYSZ) {
416: error("Too many levels of function/procedure nesting");
417: pexit(ERRS);
418: }
419: sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1;
420: gotos[cbn] = NIL;
421: errcnt[cbn] = syneflg;
422: parts[ cbn ] = NIL;
423: dfiles[ cbn ] = FALSE;
424: if (fp == NIL)
425: return (NIL);
426: /*
427: * Save the virtual name
428: * list stack pointer so
429: * the space can be freed
430: * later (funcend).
431: */
432: fp->ptr[2] = nlp;
433: # ifdef PC
434: if ( fp -> class != PROG ) {
435: stabfunc( fp -> symbol , fp -> class , line , cbn - 1 );
436: } else {
437: stabfunc( "program" , fp -> class , line , 0 );
438: }
439: # endif PC
440: if (fp->class != PROG) {
441: for (q = fp->chain; q != NIL; q = q->chain) {
442: enter(q);
443: # ifdef PC
444: stabparam( q -> symbol , p2type( q -> type )
445: , q -> value[ NL_OFFS ]
446: , lwidth( q -> type ) );
447: # endif PC
448: }
449: }
450: if (fp->class == FUNC) {
451: /*
452: * For functions, enter the fvar
453: */
454: enter(fp->ptr[NL_FVAR]);
455: # ifdef PC
456: q = fp -> ptr[ NL_FVAR ];
457: sizes[cbn].om_off -= lwidth( q -> type );
458: sizes[cbn].om_max = sizes[cbn].om_off;
459: stabvar( q -> symbol , p2type( q -> type ) , cbn
460: , q -> value[ NL_OFFS ] , lwidth( q -> type )
461: , line );
462: # endif PC
463: }
464: # ifdef PTREE
465: /*
466: * pick up the pointer to porf declaration
467: */
468: PorFHeader[ ++nesting ] = fp -> inTree;
469: # endif PTREE
470: return (fp);
471: }
472:
473: struct nl *Fp;
474: int pnumcnt;
475: /*
476: * Funcend is called to
477: * finish a block by generating
478: * the code for the statements.
479: * It then looks for unresolved declarations
480: * of labels, procedures and functions,
481: * and cleans up the name list.
482: * For the program, it checks the
483: * semantics of the program
484: * statement (yuchh).
485: */
486: funcend(fp, bundle, endline)
487: struct nl *fp;
488: int *bundle;
489: int endline;
490: {
491: register struct nl *p;
492: register int i, b;
493: int var, inp, out, chkref, *blk;
494: struct nl *iop;
495: char *cp;
496: extern int cntstat;
497: # ifdef PC
498: int toplabel = getlab();
499: int botlabel = getlab();
500: # endif PC
501:
502: cntstat = 0;
503: /*
504: * yyoutline();
505: */
506: if (program != NIL)
507: line = program->value[3];
508: blk = bundle[2];
509: if (fp == NIL) {
510: cbn--;
511: # ifdef PTREE
512: nesting--;
513: # endif PTREE
514: return;
515: }
516: #ifdef OBJ
517: /*
518: * Patch the branch to the
519: * entry point of the function
520: */
521: patch4(fp->entloc);
522: /*
523: * Put out the block entrance code and the block name.
524: * the CONG is overlaid by a patch later!
525: */
526: var = put(2, (lenstr(fp->symbol,0) << 8)
527: | (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0);
528: /*
529: * output the number of bytes of arguments
530: * this is only checked on formal calls.
531: */
532: put(2, O_CASE4, cbn == 1 ? 0 : fp->value[NL_OFFS]-DPOFF2);
533: put(2, O_CASE2, bundle[1]);
534: putstr(fp->symbol, 0);
535: #endif OBJ
536: #ifdef PC
537: /*
538: * put out the procedure entry code
539: */
540: if ( fp -> class == PROG ) {
541: putprintf( " .text" , 0 );
542: putprintf( " .align 1" , 0 );
543: putprintf( " .globl _main" , 0 );
544: putprintf( "_main:" , 0 );
545: putprintf( " .word 0" , 0 );
546: putprintf( " calls $0,_PCSTART" , 0 );
547: putprintf( " movl 4(ap),__argc" , 0 );
548: putprintf( " movl 8(ap),__argv" , 0 );
549: putprintf( " calls $0,_program" , 0 );
550: putprintf( " calls $0,_PCEXIT" , 0 );
551: ftnno = fp -> entloc;
552: putprintf( " .text" , 0 );
553: putprintf( " .align 1" , 0 );
554: putprintf( " .globl _program" , 0 );
555: putprintf( "_program:" , 0 );
556: } else {
557: ftnno = fp -> entloc;
558: putprintf( " .text" , 0 );
559: putprintf( " .align 1" , 0 );
560: putprintf( " .globl " , 1 );
561: for ( i = 1 ; i < cbn ; i++ ) {
562: putprintf( EXTFORMAT , 1 , enclosing[ i ] );
563: }
564: putprintf( "" , 0 );
565: for ( i = 1 ; i < cbn ; i++ ) {
566: putprintf( EXTFORMAT , 1 , enclosing[ i ] );
567: }
568: putprintf( ":" , 0 );
569: }
570: stablbrac( cbn );
571: /*
572: * register save mask
573: */
574: if ( opt( 't' ) ) {
575: putprintf( " .word 0x%x" , 0 , RUNCHECK | RSAVEMASK );
576: } else {
577: putprintf( " .word 0x%x" , 0 , RSAVEMASK );
578: }
579: putjbr( botlabel );
580: putlab( toplabel );
581: if ( profflag ) {
582: /*
583: * call mcount for profiling
584: */
585: putprintf( " moval 1f,r0" , 0 );
586: putprintf( " jsb mcount" , 0 );
587: putprintf( " .data" , 0 );
588: putprintf( " .align 2" , 0 );
589: putprintf( "1:" , 0 );
590: putprintf( " .long 0" , 0 );
591: putprintf( " .text" , 0 );
592: }
593: /*
594: * set up unwind exception vector.
595: */
596: putprintf( " moval %s,%d(%s)" , 0
597: , UNWINDNAME , UNWINDOFFSET , P2FPNAME );
598: /*
599: * save address of display entry, for unwind.
600: */
601: putprintf( " moval %s+%d,%d(%s)" , 0
602: , DISPLAYNAME , cbn * sizeof(struct dispsave)
603: , DPTROFFSET , P2FPNAME );
604: /*
605: * save old display
606: */
607: putprintf( " movq %s+%d,%d(%s)" , 0
608: , DISPLAYNAME , cbn * sizeof(struct dispsave)
609: , DSAVEOFFSET , P2FPNAME );
610: /*
611: * set up new display by saving AP and FP in appropriate
612: * slot in display structure.
613: */
614: putprintf( " movq %s,%s+%d" , 0
615: , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) );
616: /*
617: * ask second pass to allocate known locals
618: */
619: putlbracket( ftnno , -sizes[ cbn ].om_max );
620: /*
621: * and zero them if checking is on
622: * by calling zframe( bytes of locals , highest local address );
623: */
624: if ( opt( 't' ) ) {
625: if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
626: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
627: , "_ZFRAME" );
628: putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1
629: , 0 , P2INT , 0 );
630: putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR );
631: putop( P2LISTOP , P2INT );
632: putop( P2CALL , P2INT );
633: putdot( filename , line );
634: }
635: /*
636: * check number of longs of arguments
637: * this can only be wrong for formal calls.
638: */
639: if ( fp -> class != PROG ) {
640: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) ,
641: "_NARGCHK" );
642: putleaf( P2ICON ,
643: (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) ,
644: 0 , P2INT , 0 );
645: putop( P2CALL , P2INT );
646: putdot( filename , line );
647: }
648: }
649: #endif PC
650: if ( monflg ) {
651: if ( fp -> value[ NL_CNTR ] != 0 ) {
652: inccnt( fp -> value [ NL_CNTR ] );
653: }
654: inccnt( bodycnts[ fp -> nl_block & 037 ] );
655: }
656: if (fp->class == PROG) {
657: /*
658: * The glorious buffers option.
659: * 0 = don't buffer output
660: * 1 = line buffer output
661: * 2 = 512 byte buffer output
662: */
663: # ifdef OBJ
664: if (opt('b') != 1)
665: put(1, O_BUFF | opt('b') << 8);
666: # endif OBJ
667: # ifdef PC
668: if ( opt( 'b' ) != 1 ) {
669: putleaf( P2ICON , 0 , 0
670: , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" );
671: putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 );
672: putop( P2CALL , P2INT );
673: putdot( filename , line );
674: }
675: # endif PC
676: out = 0;
677: for (p = fp->chain; p != NIL; p = p->chain) {
678: if (strcmp(p->symbol, "input") == 0) {
679: inp++;
680: continue;
681: }
682: if (strcmp(p->symbol, "output") == 0) {
683: out++;
684: continue;
685: }
686: iop = lookup1(p->symbol);
687: if (iop == NIL || bn != cbn) {
688: error("File %s listed in program statement but not declared", p->symbol);
689: continue;
690: }
691: if (iop->class != VAR) {
692: error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
693: continue;
694: }
695: if (iop->type == NIL)
696: continue;
697: if (iop->type->class != FILET) {
698: error("File %s listed in program statement but defined as %s",
699: p->symbol, nameof(iop->type));
700: continue;
701: }
702: # ifdef OBJ
703: put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]);
704: i = lenstr(p->symbol,0);
705: put(2, O_LVCON, i);
706: putstr(p->symbol, 0);
707: do {
708: i--;
709: } while (p->symbol+i == 0);
710: put(2, O_CON24, i+1);
711: put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type));
712: put(1, O_DEFNAME);
713: # endif OBJ
714: # ifdef PC
715: putleaf( P2ICON , 0 , 0
716: , ADDTYPE( P2FTN | P2INT , P2PTR )
717: , "_DEFNAME" );
718: putLV( p -> symbol , bn , iop -> value[NL_OFFS]
719: , p2type( iop ) );
720: putCONG( p -> symbol , strlen( p -> symbol )
721: , LREQ );
722: putop( P2LISTOP , P2INT );
723: putleaf( P2ICON , strlen( p -> symbol )
724: , 0 , P2INT , 0 );
725: putop( P2LISTOP , P2INT );
726: putleaf( P2ICON
727: , text(iop->type) ? 0 : width(iop->type->type)
728: , 0 , P2INT , 0 );
729: putop( P2LISTOP , P2INT );
730: putop( P2CALL , P2INT );
731: putdot( filename , line );
732: # endif PC
733: }
734: if (out == 0 && fp->chain != NIL) {
735: recovered();
736: error("The file output must appear in the program statement file list");
737: }
738: }
739: /*
740: * Process the prog/proc/func body
741: */
742: noreach = 0;
743: line = bundle[1];
744: statlist(blk);
745: # ifdef PTREE
746: {
747: pPointer Body = tCopy( blk );
748:
749: pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body;
750: }
751: # endif PTREE
752: # ifdef OBJ
753: if (cbn== 1 && monflg != 0) {
754: patchfil(cntpatch - 2, cnts, 2);
755: patchfil(nfppatch - 2, pfcnt, 2);
756: }
757: # endif OBJ
758: # ifdef PC
759: if ( fp -> class == PROG && monflg ) {
760: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
761: , "_PMFLUSH" );
762: putleaf( P2ICON , cnts , 0 , P2INT , 0 );
763: putleaf( P2ICON , pfcnt , 0 , P2INT , 0 );
764: putop( P2LISTOP , P2INT );
765: putop( P2CALL , P2INT );
766: putdot( filename , line );
767: }
768: # endif PC
769: if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
770: recovered();
771: error("Input is used but not defined in the program statement");
772: }
773: /*
774: * Clean up the symbol table displays and check for unresolves
775: */
776: line = endline;
777: b = cbn;
778: Fp = fp;
779: chkref = syneflg == errcnt[cbn] && opt('w') == 0;
780: for (i = 0; i <= 077; i++) {
781: for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
782: /*
783: * Check for variables defined
784: * but not referenced
785: */
786: if (chkref && p->symbol != NIL)
787: switch (p->class) {
788: case FIELD:
789: /*
790: * If the corresponding record is
791: * unused, we shouldn't complain about
792: * the fields.
793: */
794: default:
795: if ((p->nl_flags & (NUSED|NMOD)) == 0) {
796: warning();
797: nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
798: break;
799: }
800: /*
801: * If a var parameter is either
802: * modified or used that is enough.
803: */
804: if (p->class == REF)
805: continue;
806: # ifdef OBJ
807: if ((p->nl_flags & NUSED) == 0) {
808: warning();
809: nerror("%s %s is never used", classes[p->class], p->symbol);
810: break;
811: }
812: # endif OBJ
813: # ifdef PC
814: if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) {
815: warning();
816: nerror("%s %s is never used", classes[p->class], p->symbol);
817: break;
818: }
819: # endif PC
820: if ((p->nl_flags & NMOD) == 0) {
821: warning();
822: nerror("%s %s is used but never set", classes[p->class], p->symbol);
823: break;
824: }
825: case LABEL:
826: case FVAR:
827: case BADUSE:
828: break;
829: }
830: switch (p->class) {
831: case BADUSE:
832: cp = "s";
833: if (p->chain->ud_next == NIL)
834: cp++;
835: eholdnl();
836: if (p->value[NL_KINDS] & ISUNDEF)
837: nerror("%s undefined on line%s", p->symbol, cp);
838: else
839: nerror("%s improperly used on line%s", p->symbol, cp);
840: pnumcnt = 10;
841: pnums(p->chain);
842: pchr('\n');
843: break;
844:
845: case FUNC:
846: case PROC:
847: # ifdef OBJ
848: if ((p->nl_flags & NFORWD))
849: nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
850: # endif OBJ
851: # ifdef PC
852: if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0))
853: nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
854: # endif PC
855: break;
856:
857: case LABEL:
858: if (p->nl_flags & NFORWD)
859: nerror("label %s was declared but not defined", p->symbol);
860: break;
861: case FVAR:
862: if ((p->nl_flags & NMOD) == 0)
863: nerror("No assignment to the function variable");
864: break;
865: }
866: }
867: /*
868: * Pop this symbol
869: * table slot
870: */
871: disptab[i] = p;
872: }
873:
874: # ifdef OBJ
875: put(1, O_END);
876: # endif OBJ
877: # ifdef PC
878: /*
879: * if there were file variables declared at this level
880: * call pclose( &__disply[ cbn ] ) to clean them up.
881: */
882: if ( dfiles[ cbn ] ) {
883: putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
884: , "_PCLOSE" );
885: putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave )
886: , P2PTR | P2CHAR );
887: putop( P2CALL , P2INT );
888: putdot( filename , line );
889: }
890: /*
891: * if this is a function,
892: * the function variable is the return value.
893: * if it's a scalar valued function, return scalar,
894: * else, return a pointer to the structure value.
895: */
896: if ( fp -> class == FUNC ) {
897: struct nl *fvar = fp -> ptr[ NL_FVAR ];
898: long fvartype = p2type( fvar -> type );
899: long label;
900: char labelname[ BUFSIZ ];
901:
902: switch ( classify( fvar -> type ) ) {
903: case TBOOL:
904: case TCHAR:
905: case TINT:
906: case TSCAL:
907: case TDOUBLE:
908: case TPTR:
909: putRV( fvar -> symbol , ( fvar -> nl_block ) & 037
910: , fvar -> value[ NL_OFFS ] , fvartype );
911: break;
912: default:
913: label = getlab();
914: sprintf( labelname , PREFIXFORMAT ,
915: LABELPREFIX , label );
916: putprintf( " .data" , 0 );
917: putprintf( " .lcomm %s,%d" , 0 ,
918: labelname , lwidth( fvar -> type ) );
919: putprintf( " .text" , 0 );
920: putleaf( P2NAME , 0 , 0 , fvartype , labelname );
921: putLV( fvar -> symbol , ( fvar -> nl_block ) & 037
922: , fvar -> value[ NL_OFFS ] , fvartype );
923: putstrop( P2STASG , fvartype , lwidth( fvar -> type ) ,
924: align( fvar -> type ) );
925: putdot( filename , line );
926: putleaf( P2ICON , 0 , 0 , fvartype , labelname );
927: break;
928: }
929: putop( P2FORCE , fvartype );
930: putdot( filename , line );
931: }
932: /*
933: * restore old display entry from save area
934: */
935:
936: putprintf( " movq %d(%s),%s+%d" , 0
937: , DSAVEOFFSET , P2FPNAME
938: , DISPLAYNAME , cbn * sizeof(struct dispsave) );
939: stabrbrac( cbn );
940: putprintf( " ret" , 0 );
941: /*
942: * let the second pass allocate locals
943: */
944: putlab( botlabel );
945: putprintf( " subl2 $LF%d,sp" , 0 , ftnno );
946: putrbracket( ftnno );
947: putjbr( toplabel );
948: /*
949: * declare pcp counters, if any
950: */
951: if ( monflg && fp -> class == PROG ) {
952: putprintf( " .data" , 0 );
953: putprintf( " .comm " , 1 );
954: putprintf( PCPCOUNT , 1 );
955: putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) );
956: putprintf( " .text" , 0 );
957: }
958: # endif PC
959: #ifdef DEBUG
960: dumpnl(fp->ptr[2], fp->symbol);
961: #endif
962: /*
963: * Restore the
964: * (virtual) name list
965: * position
966: */
967: nlfree(fp->ptr[2]);
968: /*
969: * Proc/func has been
970: * resolved
971: */
972: fp->nl_flags &= ~NFORWD;
973: /*
974: * Patch the beg
975: * of the proc/func to
976: * the proper variable size
977: */
978: if (Fp == NIL)
979: elineon();
980: # ifdef OBJ
981: patchfil(var, sizes[cbn].om_max, 2);
982: # endif OBJ
983: cbn--;
984: if (inpflist(fp->symbol)) {
985: opop('l');
986: }
987: }
988:
989:
990: /*
991: * Segend is called to check for
992: * unresolved variables, funcs and
993: * procs, and deliver unresolved and
994: * baduse error diagnostics at the
995: * end of a routine segment (a separately
996: * compiled segment that is not the
997: * main program) for PC. This
998: * routine should only be called
999: * by PC (not standard).
1000: */
1001: segend()
1002: {
1003: register struct nl *p;
1004: register int i,b;
1005: char *cp;
1006:
1007: #ifdef PC
1008: if (opt('s')) {
1009: standard();
1010: error("Separately compiled routine segments are not standard.");
1011: } else {
1012: b = cbn;
1013: for (i=0; i<077; i++) {
1014: for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
1015: switch (p->class) {
1016: case BADUSE:
1017: cp = 's';
1018: if (p->chain->ud_next == NIL)
1019: cp++;
1020: eholdnl();
1021: if (p->value[NL_KINDS] & ISUNDEF)
1022: nerror("%s undefined on line%s", p->symbol, cp);
1023: else
1024: nerror("%s improperly used on line%s", p->symbol, cp);
1025: pnumcnt = 10;
1026: pnums(p->chain);
1027: pchr('\n');
1028: break;
1029:
1030: case FUNC:
1031: case PROC:
1032: if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0))
1033: nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
1034: break;
1035:
1036: case FVAR:
1037: if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0))
1038: nerror("No assignment to the function variable");
1039: break;
1040: }
1041: }
1042: disptab[i] = p;
1043: }
1044: }
1045: #endif PC
1046: #ifdef OBJ
1047: error("Missing program statement and program body");
1048: #endif OBJ
1049:
1050: }
1051:
1052:
1053: /*
1054: * Level1 does level one processing for
1055: * separately compiled routine segments
1056: */
1057: level1()
1058: {
1059:
1060: # ifdef OBJ
1061: error("Missing program statement");
1062: # endif OBJ
1063: # ifdef PC
1064: if (opt('s')) {
1065: standard();
1066: error("Missing program statement");
1067: }
1068: # endif PC
1069:
1070: cbn++;
1071: sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1;
1072: gotos[cbn] = NIL;
1073: errcnt[cbn] = syneflg;
1074: parts[ cbn ] = NIL;
1075: dfiles[ cbn ] = FALSE;
1076: progseen++;
1077: }
1078:
1079:
1080:
1081: pnums(p)
1082: struct udinfo *p;
1083: {
1084:
1085: if (p->ud_next != NIL)
1086: pnums(p->ud_next);
1087: if (pnumcnt == 0) {
1088: printf("\n\t");
1089: pnumcnt = 20;
1090: }
1091: pnumcnt--;
1092: printf(" %d", p->ud_line);
1093: }
1094:
1095: nerror(a1, a2, a3)
1096: {
1097:
1098: if (Fp != NIL) {
1099: yySsync();
1100: #ifndef PI1
1101: if (opt('l'))
1102: yyoutline();
1103: #endif
1104: yysetfile(filename);
1105: printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
1106: Fp = NIL;
1107: elineoff();
1108: }
1109: error(a1, a2, a3);
1110: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.