1752Speter /* Copyright (c) 1979 Regents of the University of California */ 2752Speter 3*3276Smckusic static char sccsid[] = "@(#)fdec.c 1.18 03/16/81"; 4752Speter 5752Speter #include "whoami.h" 6752Speter #include "0.h" 7752Speter #include "tree.h" 8752Speter #include "opcode.h" 9752Speter #include "objfmt.h" 10752Speter #include "align.h" 11752Speter 12752Speter /* 13752Speter * this array keeps the pxp counters associated with 14752Speter * functions and procedures, so that they can be output 15752Speter * when their bodies are encountered 16752Speter */ 17752Speter int bodycnts[ DSPLYSZ ]; 18752Speter 19752Speter #ifdef PC 20752Speter # include "pc.h" 21752Speter # include "pcops.h" 22752Speter #endif PC 23752Speter 24752Speter #ifdef OBJ 25752Speter int cntpatch; 26752Speter int nfppatch; 27752Speter #endif OBJ 28752Speter 29752Speter funcfwd(fp) 30752Speter struct nl *fp; 31752Speter { 32752Speter 33752Speter /* 34752Speter * save the counter for this function 35752Speter */ 36752Speter if ( monflg ) { 37752Speter fp -> value[ NL_CNTR ] = bodycnts[ cbn ]; 38752Speter } 39752Speter return (fp); 40752Speter } 41752Speter 42752Speter /* 43752Speter * Funcext marks the procedure or 44752Speter * function external in the symbol 45752Speter * table. Funcext should only be 46752Speter * called if PC, and is an error 47752Speter * otherwise. 48752Speter */ 49752Speter 50752Speter funcext(fp) 51752Speter struct nl *fp; 52752Speter { 53752Speter 54752Speter #ifdef PC 55752Speter if (opt('s')) { 56752Speter standard(); 57752Speter error("External procedures and functions are not standard"); 58752Speter } else { 59752Speter if (cbn == 1) { 60752Speter fp->ext_flags |= NEXTERN; 61825Speter stabefunc( fp -> symbol , fp -> class , line ); 62752Speter } 63752Speter else 64752Speter error("External procedures and functions can only be declared at the outermost level."); 65752Speter } 66752Speter #endif PC 67752Speter #ifdef OBJ 68752Speter error("Procedures or functions cannot be declared external."); 69752Speter #endif OBJ 70752Speter 71752Speter return(fp); 72752Speter } 73752Speter 74752Speter /* 75752Speter * Funcbody is called 76752Speter * when the actual (resolved) 77752Speter * declaration of a procedure is 78752Speter * encountered. It puts the names 79752Speter * of the (function) and parameters 80752Speter * into the symbol table. 81752Speter */ 82752Speter funcbody(fp) 83752Speter struct nl *fp; 84752Speter { 85752Speter register struct nl *q, *p; 86752Speter 87752Speter cbn++; 88752Speter if (cbn >= DSPLYSZ) { 89752Speter error("Too many levels of function/procedure nesting"); 90752Speter pexit(ERRS); 91752Speter } 923222Smckusic sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1; 93*3276Smckusic sizes[cbn].reg_max = -1; 94*3276Smckusic sizes[cbn].curtmps.reg_off = 0; 95752Speter gotos[cbn] = NIL; 96752Speter errcnt[cbn] = syneflg; 97834Speter parts[ cbn ] = NIL; 98752Speter dfiles[ cbn ] = FALSE; 99752Speter if (fp == NIL) 100752Speter return (NIL); 101752Speter /* 102752Speter * Save the virtual name 103752Speter * list stack pointer so 104752Speter * the space can be freed 105752Speter * later (funcend). 106752Speter */ 107752Speter fp->ptr[2] = nlp; 108752Speter if (fp->class != PROG) { 109752Speter for (q = fp->chain; q != NIL; q = q->chain) { 110752Speter enter(q); 111752Speter } 112752Speter } 113752Speter if (fp->class == FUNC) { 114752Speter /* 115752Speter * For functions, enter the fvar 116752Speter */ 117752Speter enter(fp->ptr[NL_FVAR]); 118752Speter # ifdef PC 119752Speter q = fp -> ptr[ NL_FVAR ]; 120*3276Smckusic if (q -> ptr[ NL_OFFS ] != tmpalloc(leven(roundup( 121*3276Smckusic (int)lwidth(q -> type), (long)align(q -> type))), 122*3276Smckusic q -> type, NOREG)) 123*3276Smckusic panic("func var"); 124752Speter # endif PC 125752Speter } 126752Speter # ifdef PTREE 127752Speter /* 128752Speter * pick up the pointer to porf declaration 129752Speter */ 130752Speter PorFHeader[ ++nesting ] = fp -> inTree; 131752Speter # endif PTREE 132752Speter return (fp); 133752Speter } 134752Speter 135752Speter /* 136752Speter * Segend is called to check for 137752Speter * unresolved variables, funcs and 138752Speter * procs, and deliver unresolved and 139752Speter * baduse error diagnostics at the 140752Speter * end of a routine segment (a separately 141752Speter * compiled segment that is not the 142752Speter * main program) for PC. This 143752Speter * routine should only be called 144752Speter * by PC (not standard). 145752Speter */ 146752Speter segend() 147752Speter { 148752Speter register struct nl *p; 149752Speter register int i,b; 150752Speter char *cp; 151752Speter 152752Speter #ifdef PC 153752Speter if (opt('s')) { 154752Speter standard(); 155752Speter error("Separately compiled routine segments are not standard."); 156752Speter } else { 157752Speter b = cbn; 158752Speter for (i=0; i<077; i++) { 159752Speter for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 160752Speter switch (p->class) { 161752Speter case BADUSE: 162752Speter cp = 's'; 163752Speter if (p->chain->ud_next == NIL) 164752Speter cp++; 165752Speter eholdnl(); 166752Speter if (p->value[NL_KINDS] & ISUNDEF) 167752Speter nerror("%s undefined on line%s", p->symbol, cp); 168752Speter else 169752Speter nerror("%s improperly used on line%s", p->symbol, cp); 170752Speter pnumcnt = 10; 171752Speter pnums(p->chain); 172752Speter pchr('\n'); 173752Speter break; 174752Speter 175752Speter case FUNC: 176752Speter case PROC: 177752Speter if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 178752Speter nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 179752Speter break; 180752Speter 181752Speter case FVAR: 182752Speter if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) 183752Speter nerror("No assignment to the function variable"); 184752Speter break; 185752Speter } 186752Speter } 187752Speter disptab[i] = p; 188752Speter } 189752Speter } 190752Speter #endif PC 191752Speter #ifdef OBJ 192752Speter error("Missing program statement and program body"); 193752Speter #endif OBJ 194752Speter 195752Speter } 196752Speter 197752Speter 198752Speter /* 199752Speter * Level1 does level one processing for 200752Speter * separately compiled routine segments 201752Speter */ 202752Speter level1() 203752Speter { 204752Speter 205752Speter # ifdef OBJ 206752Speter error("Missing program statement"); 207752Speter # endif OBJ 208752Speter # ifdef PC 209752Speter if (opt('s')) { 210752Speter standard(); 211752Speter error("Missing program statement"); 212752Speter } 213752Speter # endif PC 214752Speter 215752Speter cbn++; 2163222Smckusic sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1; 217834Speter gotos[cbn] = NIL; 218834Speter errcnt[cbn] = syneflg; 219834Speter parts[ cbn ] = NIL; 220834Speter dfiles[ cbn ] = FALSE; 2213073Smckusic progseen = TRUE; 222752Speter } 223752Speter 224752Speter 225752Speter 226752Speter pnums(p) 227752Speter struct udinfo *p; 228752Speter { 229752Speter 230752Speter if (p->ud_next != NIL) 231752Speter pnums(p->ud_next); 232752Speter if (pnumcnt == 0) { 233752Speter printf("\n\t"); 234752Speter pnumcnt = 20; 235752Speter } 236752Speter pnumcnt--; 237752Speter printf(" %d", p->ud_line); 238752Speter } 239752Speter 240752Speter nerror(a1, a2, a3) 241752Speter { 242752Speter 243752Speter if (Fp != NIL) { 244752Speter yySsync(); 245752Speter #ifndef PI1 246752Speter if (opt('l')) 247752Speter yyoutline(); 248752Speter #endif 249752Speter yysetfile(filename); 250752Speter printf("In %s %s:\n", classes[Fp->class], Fp->symbol); 251752Speter Fp = NIL; 252752Speter elineoff(); 253752Speter } 254752Speter error(a1, a2, a3); 255752Speter } 256