/* Copyright (c) 1979 Regents of the University of California */ static char sccsid[] = "@(#)fdec.c 1.7 10/28/80"; #include "whoami.h" #include "0.h" #include "tree.h" #include "opcode.h" #include "objfmt.h" #include "align.h" /* * this array keeps the pxp counters associated with * functions and procedures, so that they can be output * when their bodies are encountered */ int bodycnts[ DSPLYSZ ]; #ifdef PC # include "pc.h" # include "pcops.h" #endif PC #ifdef OBJ int cntpatch; int nfppatch; #endif OBJ /* * Funchdr inserts * declaration of a the * prog/proc/func into the * namelist. It also handles * the arguments and puts out * a transfer which defines * the entry point of a procedure. */ struct nl * funchdr(r) int *r; { register struct nl *p; register *il, **rl; int *rll; struct nl *cp, *dp, *sp; int s, o, *pp; if (inpflist(r[2])) { opush('l'); yyretrieve(); /* kludge */ } pfcnt++; parts[ cbn ] |= RPRT; line = r[1]; if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { /* * Symbol already defined * in this block. it is either * a redeclared symbol (error) * a forward declaration, * or an external declaration. */ if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { /* * Grammar doesnt forbid * types on a resolution * of a forward function * declaration. */ if (p->class == FUNC && r[4]) error("Function type should be given only in forward declaration"); /* * get another counter for the actual */ if ( monflg ) { bodycnts[ cbn ] = getcnt(); } # ifdef PC enclosing[ cbn ] = p -> symbol; # endif PC # ifdef PTREE /* * mark this proc/func as forward * in the pTree. */ pDEF( p -> inTree ).PorFForward = TRUE; # endif PTREE return (p); } } /* if a routine segment is being compiled, * do level one processing. */ if ((r[0] != T_PROG) && (!progseen)) level1(); /* * Declare the prog/proc/func */ switch (r[0]) { case T_PROG: progseen++; if (opt('z')) monflg++; program = p = defnl(r[2], PROG, 0, 0); p->value[3] = r[1]; break; case T_PDEC: if (r[4] != NIL) error("Procedures do not have types, only functions do"); p = enter(defnl(r[2], PROC, 0, 0)); p->nl_flags |= NMOD; # ifdef PC enclosing[ cbn ] = r[2]; # endif PC break; case T_FDEC: il = r[4]; if (il == NIL) error("Function type must be specified"); else if (il[0] != T_TYID) { il = NIL; error("Function type can be specified only by using a type identifier"); } else il = gtype(il); p = enter(defnl(r[2], FUNC, il, NIL)); p->nl_flags |= NMOD; /* * An arbitrary restriction */ switch (o = classify(p->type)) { case TFILE: case TARY: case TREC: case TSET: case TSTR: warning(); if (opt('s')) { standard(); } error("Functions should not return %ss", clnames[o]); } # ifdef PC enclosing[ cbn ] = r[2]; # endif PC break; default: panic("funchdr"); } if (r[0] != T_PROG) { /* * Mark this proc/func as * being forward declared */ p->nl_flags |= NFORWD; /* * Enter the parameters * in the next block for * the time being */ if (++cbn >= DSPLYSZ) { error("Procedure/function nesting too deep"); pexit(ERRS); } /* * For functions, the function variable */ if (p->class == FUNC) { # ifdef OBJ cp = defnl(r[2], FVAR, p->type, 0); # endif OBJ # ifdef PC /* * fvars used to be allocated and deallocated * by the caller right before the arguments. * the offset of the fvar was kept in * value[NL_OFFS] of function (very wierd, * but see asgnop). * now, they are locals to the function * with the offset kept in the fvar. */ cp = defnl( r[2] , FVAR , p -> type , -( roundup( DPOFF1+width( p -> type ) , align( p -> type ) ) ) ); # endif PC cp->chain = p; p->ptr[NL_FVAR] = cp; } /* * Enter the parameters * and compute total size */ cp = sp = p; # ifdef OBJ o = 0; # endif OBJ # ifdef PC /* * parameters used to be allocated backwards, * then fixed. for pc, they are allocated correctly. * also, they are aligned. */ o = DPOFF2; # endif PC for (rl = r[3]; rl != NIL; rl = rl[2]) { p = NIL; if (rl[1] == NIL) continue; /* * Parametric procedures * don't have types !?! */ if (rl[1][0] != T_PPROC) { rll = rl[1][2]; if (rll[0] != T_TYID) { error("Types for arguments can be specified only by using type identifiers"); p = NIL; } else p = gtype(rll); } for (il = rl[1][1]; il != NIL; il = il[2]) { switch (rl[1][0]) { default: panic("funchdr2"); case T_PVAL: if (p != NIL) { if (p->class == FILET) error("Files cannot be passed by value"); else if (p->nl_flags & NFILES) error("Files cannot be a component of %ss passed by value", nameof(p)); } # ifdef OBJ dp = defnl(il[1], VAR, p, o -= even(width(p))); # endif OBJ # ifdef PC dp = defnl( il[1] , VAR , p , o = roundup( o , A_STACK ) ); o += width( p ); # endif PC dp->nl_flags |= NMOD; break; case T_PVAR: # ifdef OBJ dp = defnl(il[1], REF, p, o -= sizeof ( int * ) ); # endif OBJ # ifdef PC dp = defnl( il[1] , REF , p , o = roundup( o , A_STACK ) ); o += sizeof(char *); # endif PC break; case T_PFUNC: # ifdef OBJ dp = defnl(il[1], FFUNC, p, o -= sizeof ( int * ) ); # endif OBJ # ifdef PC dp = defnl( il[1] , FFUNC , p , o = roundup( o , A_STACK ) ); o += sizeof(char *); # endif PC dp -> nl_flags |= NMOD; break; case T_PPROC: # ifdef OBJ dp = defnl(il[1], FPROC, p, o -= sizeof ( int * ) ); # endif OBJ # ifdef PC dp = defnl( il[1] , FPROC , p , o = roundup( o , A_STACK ) ); o += sizeof(char *); # endif PC dp -> nl_flags |= NMOD; break; } if (dp != NIL) { cp->chain = dp; cp = dp; } } } cbn--; p = sp; # ifdef OBJ p->value[NL_OFFS] = -o+DPOFF2; /* * Correct the naivete (naievity) * of our above code to * calculate offsets */ for (il = p->chain; il != NIL; il = il->chain) il->value[NL_OFFS] += p->value[NL_OFFS]; # endif OBJ # ifdef PC p -> value[ NL_OFFS ] = roundup( o , A_STACK ); # endif PC } else { /* * The wonderful * program statement! */ # ifdef OBJ if (monflg) { put(1, O_PXPBUF); cntpatch = put(2, O_CASE4, 0); nfppatch = put(2, O_CASE4, 0); } # endif OBJ cp = p; for (rl = r[3]; rl; rl = rl[2]) { if (rl[1] == NIL) continue; dp = defnl(rl[1], VAR, 0, 0); cp->chain = dp; cp = dp; } } /* * Define a branch at * the "entry point" of * the prog/proc/func. */ p->entloc = getlab(); if (monflg) { bodycnts[ cbn ] = getcnt(); p->value[ NL_CNTR ] = 0; } # ifdef OBJ put(2, O_TRA4, p->entloc); # endif OBJ # ifdef PTREE { pPointer PF = tCopy( r ); pSeize( PorFHeader[ nesting ] ); if ( r[0] != T_PROG ) { pPointer *PFs; PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); *PFs = ListAppend( *PFs , PF ); } else { pDEF( PorFHeader[ nesting ] ).GlobProg = PF; } pRelease( PorFHeader[ nesting ] ); } # endif PTREE return (p); } funcfwd(fp) struct nl *fp; { /* * save the counter for this function */ if ( monflg ) { fp -> value[ NL_CNTR ] = bodycnts[ cbn ]; } return (fp); } /* * Funcext marks the procedure or * function external in the symbol * table. Funcext should only be * called if PC, and is an error * otherwise. */ funcext(fp) struct nl *fp; { #ifdef PC if (opt('s')) { standard(); error("External procedures and functions are not standard"); } else { if (cbn == 1) { fp->ext_flags |= NEXTERN; stabefunc( fp -> symbol , fp -> class , line ); } else error("External procedures and functions can only be declared at the outermost level."); } #endif PC #ifdef OBJ error("Procedures or functions cannot be declared external."); #endif OBJ return(fp); } /* * Funcbody is called * when the actual (resolved) * declaration of a procedure is * encountered. It puts the names * of the (function) and parameters * into the symbol table. */ funcbody(fp) struct nl *fp; { register struct nl *q, *p; cbn++; if (cbn >= DSPLYSZ) { error("Too many levels of function/procedure nesting"); pexit(ERRS); } sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; gotos[cbn] = NIL; errcnt[cbn] = syneflg; parts[ cbn ] = NIL; dfiles[ cbn ] = FALSE; if (fp == NIL) return (NIL); /* * Save the virtual name * list stack pointer so * the space can be freed * later (funcend). */ fp->ptr[2] = nlp; # ifdef PC if ( fp -> class != PROG ) { stabfunc( fp -> symbol , fp -> class , line , cbn - 1 ); } else { stabfunc( "program" , fp -> class , line , 0 ); } # endif PC if (fp->class != PROG) { for (q = fp->chain; q != NIL; q = q->chain) { enter(q); # ifdef PC stabparam( q -> symbol , p2type( q -> type ) , q -> value[ NL_OFFS ] , lwidth( q -> type ) ); # endif PC } } if (fp->class == FUNC) { /* * For functions, enter the fvar */ enter(fp->ptr[NL_FVAR]); # ifdef PC q = fp -> ptr[ NL_FVAR ]; sizes[cbn].om_off -= lwidth( q -> type ); sizes[cbn].om_max = sizes[cbn].om_off; stabvar( q -> symbol , p2type( q -> type ) , cbn , q -> value[ NL_OFFS ] , lwidth( q -> type ) , line ); # endif PC } # ifdef PTREE /* * pick up the pointer to porf declaration */ PorFHeader[ ++nesting ] = fp -> inTree; # endif PTREE return (fp); } struct nl *Fp; int pnumcnt; /* * Funcend is called to * finish a block by generating * the code for the statements. * It then looks for unresolved declarations * of labels, procedures and functions, * and cleans up the name list. * For the program, it checks the * semantics of the program * statement (yuchh). */ funcend(fp, bundle, endline) struct nl *fp; int *bundle; int endline; { register struct nl *p; register int i, b; int var, inp, out, chkref, *blk; struct nl *iop; char *cp; extern int cntstat; # ifdef PC int toplabel = getlab(); int botlabel = getlab(); # endif PC cntstat = 0; /* * yyoutline(); */ if (program != NIL) line = program->value[3]; blk = bundle[2]; if (fp == NIL) { cbn--; # ifdef PTREE nesting--; # endif PTREE return; } #ifdef OBJ /* * Patch the branch to the * entry point of the function */ patch4(fp->entloc); /* * Put out the block entrance code and the block name. * the CONG is overlaid by a patch later! */ var = put(2, (lenstr(fp->symbol,0) << 8) | (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0); /* * output the number of bytes of arguments * this is only checked on formal calls. */ put(2, O_CASE4, cbn == 1 ? 0 : fp->value[NL_OFFS]-DPOFF2); put(2, O_CASE2, bundle[1]); putstr(fp->symbol, 0); #endif OBJ #ifdef PC /* * put out the procedure entry code */ if ( fp -> class == PROG ) { putprintf( " .text" , 0 ); putprintf( " .align 1" , 0 ); putprintf( " .globl _main" , 0 ); putprintf( "_main:" , 0 ); putprintf( " .word 0" , 0 ); putprintf( " calls $0,_PCSTART" , 0 ); putprintf( " movl 4(ap),__argc" , 0 ); putprintf( " movl 8(ap),__argv" , 0 ); putprintf( " calls $0,_program" , 0 ); putprintf( " calls $0,_PCEXIT" , 0 ); ftnno = fp -> entloc; putprintf( " .text" , 0 ); putprintf( " .align 1" , 0 ); putprintf( " .globl _program" , 0 ); putprintf( "_program:" , 0 ); } else { ftnno = fp -> entloc; putprintf( " .text" , 0 ); putprintf( " .align 1" , 0 ); putprintf( " .globl " , 1 ); for ( i = 1 ; i < cbn ; i++ ) { putprintf( EXTFORMAT , 1 , enclosing[ i ] ); } putprintf( "" , 0 ); for ( i = 1 ; i < cbn ; i++ ) { putprintf( EXTFORMAT , 1 , enclosing[ i ] ); } putprintf( ":" , 0 ); } stablbrac( cbn ); /* * register save mask */ if ( opt( 't' ) ) { putprintf( " .word 0x%x" , 0 , RUNCHECK | RSAVEMASK ); } else { putprintf( " .word 0x%x" , 0 , RSAVEMASK ); } putjbr( botlabel ); putlab( toplabel ); if ( profflag ) { /* * call mcount for profiling */ putprintf( " moval 1f,r0" , 0 ); putprintf( " jsb mcount" , 0 ); putprintf( " .data" , 0 ); putprintf( " .align 2" , 0 ); putprintf( "1:" , 0 ); putprintf( " .long 0" , 0 ); putprintf( " .text" , 0 ); } /* * set up unwind exception vector. */ putprintf( " moval %s,%d(%s)" , 0 , UNWINDNAME , UNWINDOFFSET , P2FPNAME ); /* * save address of display entry, for unwind. */ putprintf( " moval %s+%d,%d(%s)" , 0 , DISPLAYNAME , cbn * sizeof(struct dispsave) , DPTROFFSET , P2FPNAME ); /* * save old display */ putprintf( " movq %s+%d,%d(%s)" , 0 , DISPLAYNAME , cbn * sizeof(struct dispsave) , DSAVEOFFSET , P2FPNAME ); /* * set up new display by saving AP and FP in appropriate * slot in display structure. */ putprintf( " movq %s,%s+%d" , 0 , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) ); /* * ask second pass to allocate known locals */ putlbracket( ftnno , -sizes[ cbn ].om_max ); /* * and zero them if checking is on * by calling zframe( bytes of locals , highest local address ); */ if ( opt( 't' ) ) { if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) { putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_ZFRAME" ); putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1 , 0 , P2INT , 0 ); putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR ); putop( P2LISTOP , P2INT ); putop( P2CALL , P2INT ); putdot( filename , line ); } /* * check number of longs of arguments * this can only be wrong for formal calls. */ if ( fp -> class != PROG ) { putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) , "_NARGCHK" ); putleaf( P2ICON , (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) , 0 , P2INT , 0 ); putop( P2CALL , P2INT ); putdot( filename , line ); } } #endif PC if ( monflg ) { if ( fp -> value[ NL_CNTR ] != 0 ) { inccnt( fp -> value [ NL_CNTR ] ); } inccnt( bodycnts[ fp -> nl_block & 037 ] ); } if (fp->class == PROG) { /* * The glorious buffers option. * 0 = don't buffer output * 1 = line buffer output * 2 = 512 byte buffer output */ # ifdef OBJ if (opt('b') != 1) put(1, O_BUFF | opt('b') << 8); # endif OBJ # ifdef PC if ( opt( 'b' ) != 1 ) { putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" ); putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 ); putop( P2CALL , P2INT ); putdot( filename , line ); } # endif PC out = 0; for (p = fp->chain; p != NIL; p = p->chain) { if (strcmp(p->symbol, "input") == 0) { inp++; continue; } if (strcmp(p->symbol, "output") == 0) { out++; continue; } iop = lookup1(p->symbol); if (iop == NIL || bn != cbn) { error("File %s listed in program statement but not declared", p->symbol); continue; } if (iop->class != VAR) { error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]); continue; } if (iop->type == NIL) continue; if (iop->type->class != FILET) { error("File %s listed in program statement but defined as %s", p->symbol, nameof(iop->type)); continue; } # ifdef OBJ put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]); i = lenstr(p->symbol,0); put(2, O_LVCON, i); putstr(p->symbol, 0); do { i--; } while (p->symbol+i == 0); put(2, O_CON24, i+1); put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type)); put(1, O_DEFNAME); # endif OBJ # ifdef PC putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_DEFNAME" ); putLV( p -> symbol , bn , iop -> value[NL_OFFS] , p2type( iop ) ); putCONG( p -> symbol , strlen( p -> symbol ) , LREQ ); putop( P2LISTOP , P2INT ); putleaf( P2ICON , strlen( p -> symbol ) , 0 , P2INT , 0 ); putop( P2LISTOP , P2INT ); putleaf( P2ICON , text(iop->type) ? 0 : width(iop->type->type) , 0 , P2INT , 0 ); putop( P2LISTOP , P2INT ); putop( P2CALL , P2INT ); putdot( filename , line ); # endif PC } if (out == 0 && fp->chain != NIL) { recovered(); error("The file output must appear in the program statement file list"); } } /* * Process the prog/proc/func body */ noreach = 0; line = bundle[1]; statlist(blk); # ifdef PTREE { pPointer Body = tCopy( blk ); pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body; } # endif PTREE # ifdef OBJ if (cbn== 1 && monflg != 0) { patchfil(cntpatch - 2, cnts, 2); patchfil(nfppatch - 2, pfcnt, 2); } # endif OBJ # ifdef PC if ( fp -> class == PROG && monflg ) { putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_PMFLUSH" ); putleaf( P2ICON , cnts , 0 , P2INT , 0 ); putleaf( P2ICON , pfcnt , 0 , P2INT , 0 ); putop( P2LISTOP , P2INT ); putop( P2CALL , P2INT ); putdot( filename , line ); } # endif PC if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) { recovered(); error("Input is used but not defined in the program statement"); } /* * Clean up the symbol table displays and check for unresolves */ line = endline; b = cbn; Fp = fp; chkref = syneflg == errcnt[cbn] && opt('w') == 0; for (i = 0; i <= 077; i++) { for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { /* * Check for variables defined * but not referenced */ if (chkref && p->symbol != NIL) switch (p->class) { case FIELD: /* * If the corresponding record is * unused, we shouldn't complain about * the fields. */ default: if ((p->nl_flags & (NUSED|NMOD)) == 0) { warning(); nerror("%s %s is neither used nor set", classes[p->class], p->symbol); break; } /* * If a var parameter is either * modified or used that is enough. */ if (p->class == REF) continue; # ifdef OBJ if ((p->nl_flags & NUSED) == 0) { warning(); nerror("%s %s is never used", classes[p->class], p->symbol); break; } # endif OBJ # ifdef PC if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) { warning(); nerror("%s %s is never used", classes[p->class], p->symbol); break; } # endif PC if ((p->nl_flags & NMOD) == 0) { warning(); nerror("%s %s is used but never set", classes[p->class], p->symbol); break; } case LABEL: case FVAR: case BADUSE: break; } switch (p->class) { case BADUSE: cp = "s"; if (p->chain->ud_next == NIL) cp++; eholdnl(); if (p->value[NL_KINDS] & ISUNDEF) nerror("%s undefined on line%s", p->symbol, cp); else nerror("%s improperly used on line%s", p->symbol, cp); pnumcnt = 10; pnums(p->chain); pchr('\n'); break; case FUNC: case PROC: # ifdef OBJ if ((p->nl_flags & NFORWD)) nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); # endif OBJ # ifdef PC if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); # endif PC break; case LABEL: if (p->nl_flags & NFORWD) nerror("label %s was declared but not defined", p->symbol); break; case FVAR: if ((p->nl_flags & NMOD) == 0) nerror("No assignment to the function variable"); break; } } /* * Pop this symbol * table slot */ disptab[i] = p; } # ifdef OBJ put(1, O_END); # endif OBJ # ifdef PC /* * if there were file variables declared at this level * call pclose( &__disply[ cbn ] ) to clean them up. */ if ( dfiles[ cbn ] ) { putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_PCLOSE" ); putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave ) , P2PTR | P2CHAR ); putop( P2CALL , P2INT ); putdot( filename , line ); } /* * if this is a function, * the function variable is the return value. * if it's a scalar valued function, return scalar, * else, return a pointer to the structure value. */ if ( fp -> class == FUNC ) { struct nl *fvar = fp -> ptr[ NL_FVAR ]; long fvartype = p2type( fvar -> type ); long label; char labelname[ BUFSIZ ]; switch ( classify( fvar -> type ) ) { case TBOOL: case TCHAR: case TINT: case TSCAL: case TDOUBLE: case TPTR: putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 , fvar -> value[ NL_OFFS ] , fvartype ); break; default: label = getlab(); sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label ); putprintf( " .data" , 0 ); putprintf( " .lcomm %s,%d" , 0 , labelname , lwidth( fvar -> type ) ); putprintf( " .text" , 0 ); putleaf( P2NAME , 0 , 0 , fvartype , labelname ); putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 , fvar -> value[ NL_OFFS ] , fvartype ); putstrop( P2STASG , fvartype , lwidth( fvar -> type ) , align( fvar -> type ) ); putdot( filename , line ); putleaf( P2ICON , 0 , 0 , fvartype , labelname ); break; } putop( P2FORCE , fvartype ); putdot( filename , line ); } /* * restore old display entry from save area */ putprintf( " movq %d(%s),%s+%d" , 0 , DSAVEOFFSET , P2FPNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) ); stabrbrac( cbn ); putprintf( " ret" , 0 ); /* * let the second pass allocate locals */ putlab( botlabel ); putprintf( " subl2 $LF%d,sp" , 0 , ftnno ); putrbracket( ftnno ); putjbr( toplabel ); /* * declare pcp counters, if any */ if ( monflg && fp -> class == PROG ) { putprintf( " .data" , 0 ); putprintf( " .comm " , 1 ); putprintf( PCPCOUNT , 1 ); putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) ); putprintf( " .text" , 0 ); } # endif PC #ifdef DEBUG dumpnl(fp->ptr[2], fp->symbol); #endif /* * Restore the * (virtual) name list * position */ nlfree(fp->ptr[2]); /* * Proc/func has been * resolved */ fp->nl_flags &= ~NFORWD; /* * Patch the beg * of the proc/func to * the proper variable size */ if (Fp == NIL) elineon(); # ifdef OBJ patchfil(var, sizes[cbn].om_max, 2); # endif OBJ cbn--; if (inpflist(fp->symbol)) { opop('l'); } } /* * Segend is called to check for * unresolved variables, funcs and * procs, and deliver unresolved and * baduse error diagnostics at the * end of a routine segment (a separately * compiled segment that is not the * main program) for PC. This * routine should only be called * by PC (not standard). */ segend() { register struct nl *p; register int i,b; char *cp; #ifdef PC if (opt('s')) { standard(); error("Separately compiled routine segments are not standard."); } else { b = cbn; for (i=0; i<077; i++) { for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { switch (p->class) { case BADUSE: cp = 's'; if (p->chain->ud_next == NIL) cp++; eholdnl(); if (p->value[NL_KINDS] & ISUNDEF) nerror("%s undefined on line%s", p->symbol, cp); else nerror("%s improperly used on line%s", p->symbol, cp); pnumcnt = 10; pnums(p->chain); pchr('\n'); break; case FUNC: case PROC: if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); break; case FVAR: if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) nerror("No assignment to the function variable"); break; } } disptab[i] = p; } } #endif PC #ifdef OBJ error("Missing program statement and program body"); #endif OBJ } /* * Level1 does level one processing for * separately compiled routine segments */ level1() { # ifdef OBJ error("Missing program statement"); # endif OBJ # ifdef PC if (opt('s')) { standard(); error("Missing program statement"); } # endif PC cbn++; sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; gotos[cbn] = NIL; errcnt[cbn] = syneflg; parts[ cbn ] = NIL; dfiles[ cbn ] = FALSE; progseen++; } pnums(p) struct udinfo *p; { if (p->ud_next != NIL) pnums(p->ud_next); if (pnumcnt == 0) { printf("\n\t"); pnumcnt = 20; } pnumcnt--; printf(" %d", p->ud_line); } nerror(a1, a2, a3) { if (Fp != NIL) { yySsync(); #ifndef PI1 if (opt('l')) yyoutline(); #endif yysetfile(filename); printf("In %s %s:\n", classes[Fp->class], Fp->symbol); Fp = NIL; elineoff(); } error(a1, a2, a3); }