projects / unix-history / blob
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
BSD 4 release
[unix-history] / usr / src / cmd / pc0 / fdec.c
/* 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);
}
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.