13191Smckusick /* Copyright (c) 1979 Regents of the University of California */ 23191Smckusick 3*3838Speter static char sccsid[] = "@(#)fhdr.c 1.3 06/01/81"; 43191Smckusick 53191Smckusick #include "whoami.h" 63191Smckusick #include "0.h" 73191Smckusick #include "tree.h" 83191Smckusick #include "opcode.h" 93191Smckusick #include "objfmt.h" 103191Smckusick #include "align.h" 113191Smckusick 123191Smckusick /* 133191Smckusick * this array keeps the pxp counters associated with 143191Smckusick * functions and procedures, so that they can be output 153191Smckusick * when their bodies are encountered 163191Smckusick */ 173191Smckusick int bodycnts[ DSPLYSZ ]; 183191Smckusick 193191Smckusick #ifdef PC 203191Smckusick # include "pc.h" 213191Smckusick # include "pcops.h" 223191Smckusick #endif PC 233191Smckusick 243191Smckusick #ifdef OBJ 253191Smckusick int cntpatch; 263191Smckusick int nfppatch; 273191Smckusick #endif OBJ 283191Smckusick 293191Smckusick /* 303191Smckusick * Funchdr inserts 313191Smckusick * declaration of a the 323191Smckusick * prog/proc/func into the 333191Smckusick * namelist. It also handles 343191Smckusick * the arguments and puts out 353191Smckusick * a transfer which defines 363191Smckusick * the entry point of a procedure. 373191Smckusick */ 383191Smckusick 393191Smckusick struct nl * 403191Smckusick funchdr(r) 413191Smckusick int *r; 423191Smckusick { 433191Smckusick register struct nl *p; 443191Smckusick register *il, **rl; 453302Smckusic struct nl *cp, *dp; 463302Smckusic int s, o, *pp; 473191Smckusick 483191Smckusick if (inpflist(r[2])) { 493191Smckusick opush('l'); 503191Smckusick yyretrieve(); /* kludge */ 513191Smckusick } 523191Smckusick pfcnt++; 533191Smckusick parts[ cbn ] |= RPRT; 543191Smckusick line = r[1]; 553191Smckusick if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { 563191Smckusick /* 573191Smckusick * Symbol already defined 583191Smckusick * in this block. it is either 593191Smckusick * a redeclared symbol (error) 603191Smckusick * a forward declaration, 613191Smckusick * or an external declaration. 623191Smckusick */ 633191Smckusick if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { 643191Smckusick /* 653191Smckusick * Grammar doesnt forbid 663191Smckusick * types on a resolution 673191Smckusick * of a forward function 683191Smckusick * declaration. 693191Smckusick */ 703191Smckusick if (p->class == FUNC && r[4]) 713191Smckusick error("Function type should be given only in forward declaration"); 723191Smckusick /* 733191Smckusick * get another counter for the actual 743191Smckusick */ 753191Smckusick if ( monflg ) { 763191Smckusick bodycnts[ cbn ] = getcnt(); 773191Smckusick } 783191Smckusick # ifdef PC 793191Smckusick enclosing[ cbn ] = p -> symbol; 803191Smckusick # endif PC 813191Smckusick # ifdef PTREE 823191Smckusick /* 833191Smckusick * mark this proc/func as forward 843191Smckusick * in the pTree. 853191Smckusick */ 863191Smckusick pDEF( p -> inTree ).PorFForward = TRUE; 873191Smckusick # endif PTREE 883191Smckusick return (p); 893191Smckusick } 903191Smckusick } 913191Smckusick 923191Smckusick /* if a routine segment is being compiled, 933191Smckusick * do level one processing. 943191Smckusick */ 953191Smckusick 963191Smckusick if ((r[0] != T_PROG) && (!progseen)) 973191Smckusick level1(); 983191Smckusick 993191Smckusick 1003191Smckusick /* 1013191Smckusick * Declare the prog/proc/func 1023191Smckusick */ 1033191Smckusick switch (r[0]) { 1043191Smckusick case T_PROG: 1053191Smckusick progseen = TRUE; 1063191Smckusick if (opt('z')) 1073191Smckusick monflg = TRUE; 1083191Smckusick program = p = defnl(r[2], PROG, 0, 0); 1093191Smckusick p->value[3] = r[1]; 1103191Smckusick break; 1113191Smckusick case T_PDEC: 1123191Smckusick if (r[4] != NIL) 1133191Smckusick error("Procedures do not have types, only functions do"); 1143191Smckusick p = enter(defnl(r[2], PROC, 0, 0)); 1153191Smckusick p->nl_flags |= NMOD; 1163191Smckusick # ifdef PC 1173191Smckusick enclosing[ cbn ] = r[2]; 118*3838Speter p -> extra_flags |= NGLOBAL; 1193191Smckusick # endif PC 1203191Smckusick break; 1213191Smckusick case T_FDEC: 1223191Smckusick il = r[4]; 1233191Smckusick if (il == NIL) 1243191Smckusick error("Function type must be specified"); 1253191Smckusick else if (il[0] != T_TYID) { 1263191Smckusick il = NIL; 1273191Smckusick error("Function type can be specified only by using a type identifier"); 1283191Smckusick } else 1293191Smckusick il = gtype(il); 1303191Smckusick p = enter(defnl(r[2], FUNC, il, NIL)); 1313191Smckusick p->nl_flags |= NMOD; 1323191Smckusick /* 1333191Smckusick * An arbitrary restriction 1343191Smckusick */ 1353191Smckusick switch (o = classify(p->type)) { 1363191Smckusick case TFILE: 1373191Smckusick case TARY: 1383191Smckusick case TREC: 1393191Smckusick case TSET: 1403191Smckusick case TSTR: 1413191Smckusick warning(); 1423191Smckusick if (opt('s')) { 1433191Smckusick standard(); 1443191Smckusick } 1453191Smckusick error("Functions should not return %ss", clnames[o]); 1463191Smckusick } 1473191Smckusick # ifdef PC 1483191Smckusick enclosing[ cbn ] = r[2]; 149*3838Speter p -> extra_flags |= NGLOBAL; 1503191Smckusick # endif PC 1513191Smckusick break; 1523191Smckusick default: 1533191Smckusick panic("funchdr"); 1543191Smckusick } 1553191Smckusick if (r[0] != T_PROG) { 1563191Smckusick /* 1573191Smckusick * Mark this proc/func as 1583191Smckusick * being forward declared 1593191Smckusick */ 1603191Smckusick p->nl_flags |= NFORWD; 1613191Smckusick /* 1623191Smckusick * Enter the parameters 1633191Smckusick * in the next block for 1643191Smckusick * the time being 1653191Smckusick */ 1663191Smckusick if (++cbn >= DSPLYSZ) { 1673191Smckusick error("Procedure/function nesting too deep"); 1683191Smckusick pexit(ERRS); 1693191Smckusick } 1703191Smckusick /* 1713191Smckusick * For functions, the function variable 1723191Smckusick */ 1733191Smckusick if (p->class == FUNC) { 1743191Smckusick # ifdef OBJ 1753191Smckusick cp = defnl(r[2], FVAR, p->type, 0); 1763191Smckusick # endif OBJ 1773191Smckusick # ifdef PC 1783191Smckusick /* 1793191Smckusick * fvars used to be allocated and deallocated 1803191Smckusick * by the caller right before the arguments. 1813191Smckusick * the offset of the fvar was kept in 1823191Smckusick * value[NL_OFFS] of function (very wierd, 1833191Smckusick * but see asgnop). 1843191Smckusick * now, they are locals to the function 1853191Smckusick * with the offset kept in the fvar. 1863191Smckusick */ 1873191Smckusick 1883191Smckusick cp = defnl(r[2], FVAR, p->type, 1893302Smckusic (int)-leven(roundup( 1903302Smckusic (int)(DPOFF1+lwidth(p->type)), 1913302Smckusic (long)align(p->type)))); 192*3838Speter cp -> extra_flags |= NLOCAL; 1933191Smckusick # endif PC 1943191Smckusick cp->chain = p; 1953191Smckusick p->ptr[NL_FVAR] = cp; 1963191Smckusick } 1973191Smckusick /* 1983191Smckusick * Enter the parameters 1993191Smckusick * and compute total size 2003191Smckusick */ 2013302Smckusic p->value[NL_OFFS] = params(p, r[3]); 2023302Smckusic /* 2033302Smckusic * because NL_LINENO field in the function 2043302Smckusic * namelist entry has been used (as have all 2053302Smckusic * the other fields), the line number is 2063302Smckusic * stored in the NL_LINENO field of its fvar. 2073302Smckusic */ 2083302Smckusic if (p->class == FUNC) 2093302Smckusic p->ptr[NL_FVAR]->value[NL_LINENO] = r[1]; 2103302Smckusic else 2113302Smckusic p->value[NL_LINENO] = r[1]; 2123191Smckusick cbn--; 2133191Smckusick } else { 2143191Smckusick /* 2153191Smckusick * The wonderful 2163191Smckusick * program statement! 2173191Smckusick */ 2183191Smckusick # ifdef OBJ 2193191Smckusick if (monflg) { 2203191Smckusick put(1, O_PXPBUF); 2213191Smckusick cntpatch = put(2, O_CASE4, (long)0); 2223191Smckusick nfppatch = put(2, O_CASE4, (long)0); 2233191Smckusick } 2243191Smckusick # endif OBJ 2253191Smckusick cp = p; 2263191Smckusick for (rl = r[3]; rl; rl = rl[2]) { 2273191Smckusick if (rl[1] == NIL) 2283191Smckusick continue; 2293191Smckusick dp = defnl(rl[1], VAR, 0, 0); 2303191Smckusick cp->chain = dp; 2313191Smckusick cp = dp; 2323191Smckusick } 2333191Smckusick } 2343191Smckusick /* 2353191Smckusick * Define a branch at 2363191Smckusick * the "entry point" of 2373191Smckusick * the prog/proc/func. 2383191Smckusick */ 2393191Smckusick p->entloc = getlab(); 2403191Smckusick if (monflg) { 2413191Smckusick bodycnts[ cbn ] = getcnt(); 2423191Smckusick p->value[ NL_CNTR ] = 0; 2433191Smckusick } 2443191Smckusick # ifdef OBJ 2453191Smckusick put(2, O_TRA4, (long)p->entloc); 2463191Smckusick # endif OBJ 2473191Smckusick # ifdef PTREE 2483191Smckusick { 2493191Smckusick pPointer PF = tCopy( r ); 2503191Smckusick 2513191Smckusick pSeize( PorFHeader[ nesting ] ); 2523191Smckusick if ( r[0] != T_PROG ) { 2533191Smckusick pPointer *PFs; 2543191Smckusick 2553191Smckusick PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); 2563191Smckusick *PFs = ListAppend( *PFs , PF ); 2573191Smckusick } else { 2583191Smckusick pDEF( PorFHeader[ nesting ] ).GlobProg = PF; 2593191Smckusick } 2603191Smckusick pRelease( PorFHeader[ nesting ] ); 2613191Smckusick } 2623191Smckusick # endif PTREE 2633191Smckusick return (p); 2643191Smckusick } 2653302Smckusic 2663302Smckusic /* 2673302Smckusic * deal with the parameter declaration for a routine. 2683302Smckusic * p is the namelist entry of the routine. 2693302Smckusic * formalist is the parse tree for the parameter declaration. 2703302Smckusic * formalist [0] T_LISTPP 2713302Smckusic * [1] pointer to a formal 2723302Smckusic * [2] pointer to next formal 2733302Smckusic * for by-value or by-reference formals, the formal is 2743302Smckusic * formal [0] T_PVAL or T_PVAR 2753302Smckusic * [1] pointer to id_list 2763302Smckusic * [2] pointer to type (error if not typeid) 2773302Smckusic * for function and procedure formals, the formal is 2783302Smckusic * formal [0] T_PFUNC or T_PPROC 2793302Smckusic * [1] pointer to id_list (error if more than one) 2803302Smckusic * [2] pointer to type (error if not typeid, or proc) 2813302Smckusic * [3] pointer to formalist for this routine. 2823302Smckusic */ 2833302Smckusic fparams(p, formal) 2843302Smckusic register struct nl *p; 2853302Smckusic int *formal; 2863302Smckusic { 2873302Smckusic params(p, formal[3]); 2883302Smckusic p -> value[ NL_LINENO ] = formal[4]; 2893302Smckusic p -> ptr[ NL_FCHAIN ] = p -> chain; 2903302Smckusic p -> chain = NIL; 2913302Smckusic } 2923302Smckusic 2933302Smckusic params(p, formalist) 2943302Smckusic register struct nl *p; 2953302Smckusic int *formalist; 2963302Smckusic { 2973302Smckusic struct nl *chainp, *savedp; 2983302Smckusic struct nl *dp; 2993302Smckusic register int **formalp; /* an element of the formal list */ 3003302Smckusic register int *formal; /* a formal */ 3013302Smckusic int *typ, *idlist; 3023302Smckusic int w, o; 3033302Smckusic 3043302Smckusic /* 3053302Smckusic * Enter the parameters 3063302Smckusic * and compute total size 3073302Smckusic */ 3083302Smckusic chainp = savedp = p; 3093302Smckusic 3103302Smckusic # ifdef OBJ 3113302Smckusic o = 0; 3123302Smckusic # endif OBJ 3133302Smckusic # ifdef PC 3143302Smckusic /* 3153302Smckusic * parameters used to be allocated backwards, 3163302Smckusic * then fixed. for pc, they are allocated correctly. 3173302Smckusic * also, they are aligned. 3183302Smckusic */ 3193302Smckusic o = DPOFF2; 3203302Smckusic # endif PC 3213302Smckusic for (formalp = formalist; formalp != NIL; formalp = formalp[2]) { 3223302Smckusic p = NIL; 3233302Smckusic formal = formalp[1]; 3243302Smckusic if (formal == NIL) 3253302Smckusic continue; 3263302Smckusic /* 3273302Smckusic * Parametric procedures 3283302Smckusic * don't have types !?! 3293302Smckusic */ 3303302Smckusic typ = formal[2]; 3313302Smckusic if ( typ == NIL ) { 3323302Smckusic if ( formal[0] != T_PPROC ) { 3333302Smckusic error("Types must be specified for arguments"); 3343302Smckusic p = NIL; 3353302Smckusic } 3363302Smckusic } else { 3373302Smckusic if ( formal[0] == T_PPROC ) { 3383302Smckusic error("Procedures cannot have types"); 3393302Smckusic p = NIL; 3403302Smckusic } else { 3413302Smckusic if (typ[0] != T_TYID) { 3423302Smckusic error("Types for arguments can be specified only by using type identifiers"); 3433302Smckusic p = NIL; 3443302Smckusic } else { 3453302Smckusic p = gtype(typ); 3463302Smckusic } 3473302Smckusic } 3483302Smckusic } 3493302Smckusic for (idlist = formal[1]; idlist != NIL; idlist = idlist[2]) { 3503302Smckusic switch (formal[0]) { 3513302Smckusic default: 3523302Smckusic panic("funchdr2"); 3533302Smckusic case T_PVAL: 3543302Smckusic if (p != NIL) { 3553302Smckusic if (p->class == FILET) 3563302Smckusic error("Files cannot be passed by value"); 3573302Smckusic else if (p->nl_flags & NFILES) 3583302Smckusic error("Files cannot be a component of %ss passed by value", 3593302Smckusic nameof(p)); 3603302Smckusic } 3613302Smckusic # ifdef OBJ 3623302Smckusic w = lwidth(p); 3633302Smckusic o -= even(w); 3643302Smckusic # ifdef DEC11 3653302Smckusic dp = defnl(idlist[1], VAR, p, o); 3663302Smckusic # else 3673302Smckusic dp = defnl(idlist[1], VAR, p, 3683302Smckusic (w < 2) ? o + 1 : o); 3693302Smckusic # endif DEC11 3703302Smckusic # endif OBJ 3713302Smckusic # ifdef PC 3723302Smckusic dp = defnl( idlist[1] , VAR , p 3733302Smckusic , o = roundup( o , (long)A_STACK ) ); 3743302Smckusic o += lwidth( p ); 3753302Smckusic # endif PC 3763302Smckusic dp->nl_flags |= NMOD; 3773302Smckusic break; 3783302Smckusic case T_PVAR: 3793302Smckusic # ifdef OBJ 3803302Smckusic dp = defnl(idlist[1], REF, p, o -= sizeof ( int * ) ); 3813302Smckusic # endif OBJ 3823302Smckusic # ifdef PC 3833302Smckusic dp = defnl( idlist[1] , REF , p 3843302Smckusic , o = roundup( o , (long)A_STACK ) ); 3853302Smckusic o += sizeof(char *); 3863302Smckusic # endif PC 3873302Smckusic break; 3883302Smckusic case T_PFUNC: 3893302Smckusic if (idlist[2] != NIL) { 3903302Smckusic error("Each function argument must be declared separately"); 3913302Smckusic idlist[2] = NIL; 3923302Smckusic } 3933302Smckusic # ifdef OBJ 3943302Smckusic dp = defnl(idlist[1], FFUNC, p, o -= sizeof ( int * ) ); 3953302Smckusic # endif OBJ 3963302Smckusic # ifdef PC 3973302Smckusic dp = defnl( idlist[1] , FFUNC , p 3983302Smckusic , o = roundup( o , (long)A_STACK ) ); 3993302Smckusic o += sizeof(char *); 4003302Smckusic # endif PC 4013302Smckusic dp -> nl_flags |= NMOD; 4023302Smckusic fparams(dp, formal); 4033302Smckusic break; 4043302Smckusic case T_PPROC: 4053302Smckusic if (idlist[2] != NIL) { 4063302Smckusic error("Each procedure argument must be declared separately"); 4073302Smckusic idlist[2] = NIL; 4083302Smckusic } 4093302Smckusic # ifdef OBJ 4103302Smckusic dp = defnl(idlist[1], FPROC, p, o -= sizeof ( int * ) ); 4113302Smckusic # endif OBJ 4123302Smckusic # ifdef PC 4133302Smckusic dp = defnl( idlist[1] , FPROC , p 4143302Smckusic , o = roundup( o , (long)A_STACK ) ); 4153302Smckusic o += sizeof(char *); 4163302Smckusic # endif PC 4173302Smckusic dp -> nl_flags |= NMOD; 4183302Smckusic fparams(dp, formal); 4193302Smckusic break; 4203302Smckusic } 4213302Smckusic if (dp != NIL) { 422*3838Speter # ifdef PC 423*3838Speter dp -> extra_flags |= NPARAM; 424*3838Speter # endif PC 4253302Smckusic chainp->chain = dp; 4263302Smckusic chainp = dp; 4273302Smckusic } 4283302Smckusic } 4293302Smckusic } 4303302Smckusic p = savedp; 4313302Smckusic # ifdef OBJ 4323302Smckusic /* 4333302Smckusic * Correct the naivete (naivety) 4343302Smckusic * of our above code to 4353302Smckusic * calculate offsets 4363302Smckusic */ 4373302Smckusic for (dp = p->chain; dp != NIL; dp = dp->chain) 4383302Smckusic dp->value[NL_OFFS] += -o + DPOFF2; 4393302Smckusic return (-o + DPOFF2); 4403302Smckusic # endif OBJ 4413302Smckusic # ifdef PC 4423302Smckusic return roundup( o , (long)A_STACK ); 4433302Smckusic # endif PC 4443302Smckusic } 445