Return to fhdr.c CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src

Annotation of 42BSD/ucb/pascal/src/fhdr.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)fhdr.c 1.6 2/1/83";
        !             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:        struct nl *cp, *dp;
        !            46:        int s, o, *pp;
        !            47: 
        !            48:        if (inpflist(r[2])) {
        !            49:                opush('l');
        !            50:                yyretrieve();   /* kludge */
        !            51:        }
        !            52:        pfcnt++;
        !            53:        parts[ cbn ] |= RPRT;
        !            54:        line = r[1];
        !            55:        if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
        !            56:                /*
        !            57:                 * Symbol already defined
        !            58:                 * in this block. it is either
        !            59:                 * a redeclared symbol (error)
        !            60:                 * a forward declaration,
        !            61:                 * or an external declaration.
        !            62:                 * check that forwards are of the right kind:
        !            63:                 *     if this fails, we are trying to redefine it
        !            64:                 *     and enter() will complain.
        !            65:                 */
        !            66:                if (  ( ( p->nl_flags & NFORWD ) != 0 )
        !            67:                   && (  ( p->class == FUNC && r[0] == T_FDEC )
        !            68:                      || ( p->class == PROC && r[0] == T_PDEC ) ) ) {
        !            69:                        /*
        !            70:                         * Grammar doesnt forbid
        !            71:                         * types on a resolution
        !            72:                         * of a forward function
        !            73:                         * declaration.
        !            74:                         */
        !            75:                        if (p->class == FUNC && r[4])
        !            76:                                error("Function type should be given only in forward declaration");
        !            77:                        /*
        !            78:                         * get another counter for the actual
        !            79:                         */
        !            80:                        if ( monflg ) {
        !            81:                            bodycnts[ cbn ] = getcnt();
        !            82:                        }
        !            83: #                      ifdef PC
        !            84:                            enclosing[ cbn ] = p -> symbol;
        !            85: #                      endif PC
        !            86: #                      ifdef PTREE
        !            87:                                /*
        !            88:                                 *      mark this proc/func as forward
        !            89:                                 *      in the pTree.
        !            90:                                 */
        !            91:                            pDEF( p -> inTree ).PorFForward = TRUE;
        !            92: #                      endif PTREE
        !            93:                        return (p);
        !            94:                }
        !            95:        }
        !            96: 
        !            97:        /* if a routine segment is being compiled,
        !            98:         * do level one processing.
        !            99:         */
        !           100: 
        !           101:         if ((r[0] != T_PROG) && (!progseen))
        !           102:                level1();
        !           103: 
        !           104: 
        !           105:        /*
        !           106:         * Declare the prog/proc/func
        !           107:         */
        !           108:        switch (r[0]) {
        !           109:            case T_PROG:
        !           110:                    progseen = TRUE;
        !           111:                    if (opt('z'))
        !           112:                            monflg = TRUE;
        !           113:                    program = p = defnl(r[2], PROG, 0, 0);
        !           114:                    p->value[3] = r[1];
        !           115:                    break;
        !           116:            case T_PDEC:
        !           117:                    if (r[4] != NIL)
        !           118:                            error("Procedures do not have types, only functions do");
        !           119:                    p = enter(defnl(r[2], PROC, 0, 0));
        !           120:                    p->nl_flags |= NMOD;
        !           121: #                  ifdef PC
        !           122:                        enclosing[ cbn ] = r[2];
        !           123:                        p -> extra_flags |= NGLOBAL;
        !           124: #                  endif PC
        !           125:                    break;
        !           126:            case T_FDEC:
        !           127:                    il = r[4];
        !           128:                    if (il == NIL)
        !           129:                            error("Function type must be specified");
        !           130:                    else if (il[0] != T_TYID) {
        !           131:                            il = NIL;
        !           132:                            error("Function type can be specified only by using a type identifier");
        !           133:                    } else
        !           134:                            il = gtype(il);
        !           135:                    p = enter(defnl(r[2], FUNC, il, NIL));
        !           136:                    p->nl_flags |= NMOD;
        !           137:                    /*
        !           138:                     * An arbitrary restriction
        !           139:                     */
        !           140:                    switch (o = classify(p->type)) {
        !           141:                            case TFILE:
        !           142:                            case TARY:
        !           143:                            case TREC:
        !           144:                            case TSET:
        !           145:                            case TSTR:
        !           146:                                    warning();
        !           147:                                    if (opt('s')) {
        !           148:                                            standard();
        !           149:                                    }
        !           150:                                    error("Functions should not return %ss", clnames[o]);
        !           151:                    }
        !           152: #                  ifdef PC
        !           153:                        enclosing[ cbn ] = r[2];
        !           154:                        p -> extra_flags |= NGLOBAL;
        !           155: #                  endif PC
        !           156:                    break;
        !           157:            default:
        !           158:                    panic("funchdr");
        !           159:        }
        !           160:        if (r[0] != T_PROG) {
        !           161:                /*
        !           162:                 * Mark this proc/func as
        !           163:                 * being forward declared
        !           164:                 */
        !           165:                p->nl_flags |= NFORWD;
        !           166:                /*
        !           167:                 * Enter the parameters
        !           168:                 * in the next block for
        !           169:                 * the time being
        !           170:                 */
        !           171:                if (++cbn >= DSPLYSZ) {
        !           172:                        error("Procedure/function nesting too deep");
        !           173:                        pexit(ERRS);
        !           174:                }
        !           175:                /*
        !           176:                 * For functions, the function variable
        !           177:                 */
        !           178:                if (p->class == FUNC) {
        !           179: #                      ifdef OBJ
        !           180:                            cp = defnl(r[2], FVAR, p->type, 0);
        !           181: #                      endif OBJ
        !           182: #                      ifdef PC
        !           183:                                /*
        !           184:                                 * fvars used to be allocated and deallocated
        !           185:                                 * by the caller right before the arguments.
        !           186:                                 * the offset of the fvar was kept in
        !           187:                                 * value[NL_OFFS] of function (very wierd,
        !           188:                                 * but see asgnop).
        !           189:                                 * now, they are locals to the function
        !           190:                                 * with the offset kept in the fvar.
        !           191:                                 */
        !           192: 
        !           193:                            cp = defnl(r[2], FVAR, p->type,
        !           194:                                (int)-leven(roundup(
        !           195:                                    (int)(DPOFF1+lwidth(p->type)),
        !           196:                                    (long)align(p->type))));
        !           197:                            cp -> extra_flags |= NLOCAL;
        !           198: #                      endif PC
        !           199:                        cp->chain = p;
        !           200:                        p->ptr[NL_FVAR] = cp;
        !           201:                }
        !           202:                /*
        !           203:                 * Enter the parameters
        !           204:                 * and compute total size
        !           205:                 */
        !           206:                p->value[NL_OFFS] = params(p, r[3]);
        !           207:                /*
        !           208:                 * because NL_LINENO field in the function 
        !           209:                 * namelist entry has been used (as have all
        !           210:                 * the other fields), the line number is
        !           211:                 * stored in the NL_LINENO field of its fvar.
        !           212:                 */
        !           213:                if (p->class == FUNC)
        !           214:                    p->ptr[NL_FVAR]->value[NL_LINENO] = r[1];
        !           215:                else
        !           216:                    p->value[NL_LINENO] = r[1];
        !           217:                cbn--;
        !           218:        } else { 
        !           219:                /*
        !           220:                 * The wonderful
        !           221:                 * program statement!
        !           222:                 */
        !           223: #              ifdef OBJ
        !           224:                    if (monflg) {
        !           225:                            put(1, O_PXPBUF);
        !           226:                            cntpatch = put(2, O_CASE4, (long)0);
        !           227:                            nfppatch = put(2, O_CASE4, (long)0);
        !           228:                    }
        !           229: #              endif OBJ
        !           230:                cp = p;
        !           231:                for (rl = r[3]; rl; rl = rl[2]) {
        !           232:                        if (rl[1] == NIL)
        !           233:                                continue;
        !           234:                        dp = defnl(rl[1], VAR, 0, 0);
        !           235:                        cp->chain = dp;
        !           236:                        cp = dp;
        !           237:                }
        !           238:        }
        !           239:        /*
        !           240:         * Define a branch at
        !           241:         * the "entry point" of
        !           242:         * the prog/proc/func.
        !           243:         */
        !           244:        p->value[NL_ENTLOC] = getlab();
        !           245:        if (monflg) {
        !           246:                bodycnts[ cbn ] = getcnt();
        !           247:                p->value[ NL_CNTR ] = 0;
        !           248:        }
        !           249: #      ifdef OBJ
        !           250:            put(2, O_TRA4, (long)p->value[NL_ENTLOC]);
        !           251: #      endif OBJ
        !           252: #      ifdef PTREE
        !           253:            {
        !           254:                pPointer        PF = tCopy( r );
        !           255: 
        !           256:                pSeize( PorFHeader[ nesting ] );
        !           257:                if ( r[0] != T_PROG ) {
        !           258:                        pPointer        *PFs;
        !           259: 
        !           260:                        PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs );
        !           261:                        *PFs = ListAppend( *PFs , PF );
        !           262:                } else {
        !           263:                        pDEF( PorFHeader[ nesting ] ).GlobProg = PF;
        !           264:                }
        !           265:                pRelease( PorFHeader[ nesting ] );
        !           266:            }
        !           267: #      endif PTREE
        !           268:        return (p);
        !           269: }
        !           270: 
        !           271:        /*
        !           272:         * deal with the parameter declaration for a routine.
        !           273:         * p is the namelist entry of the routine.
        !           274:         * formalist is the parse tree for the parameter declaration.
        !           275:         * formalist    [0]     T_LISTPP
        !           276:         *              [1]     pointer to a formal
        !           277:         *              [2]     pointer to next formal
        !           278:         * for by-value or by-reference formals, the formal is
        !           279:         * formal       [0]     T_PVAL or T_PVAR
        !           280:         *              [1]     pointer to id_list
        !           281:         *              [2]     pointer to type (error if not typeid)
        !           282:         * for function and procedure formals, the formal is
        !           283:         * formal       [0]     T_PFUNC or T_PPROC
        !           284:         *              [1]     pointer to id_list (error if more than one)
        !           285:         *              [2]     pointer to type (error if not typeid, or proc)
        !           286:         *              [3]     pointer to formalist for this routine.
        !           287:         */
        !           288: fparams(p, formal)
        !           289:        register struct nl *p;
        !           290:        int *formal;
        !           291: {
        !           292:        params(p, formal[3]);
        !           293:        p -> value[ NL_LINENO ] = formal[4];
        !           294:        p -> ptr[ NL_FCHAIN ] = p -> chain;
        !           295:        p -> chain = NIL;
        !           296: }
        !           297: 
        !           298: params(p, formalist)
        !           299:        register struct nl *p;
        !           300:        int *formalist;
        !           301: {
        !           302:        struct nl *chainp, *savedp;
        !           303:        struct nl *dp;
        !           304:        register int **formalp;         /* an element of the formal list */
        !           305:        register int *formal;           /* a formal */
        !           306:        int *typ, *idlist;
        !           307:        int w, o;
        !           308: 
        !           309:        /*
        !           310:         * Enter the parameters
        !           311:         * and compute total size
        !           312:         */
        !           313:        chainp = savedp = p;
        !           314: 
        !           315: #      ifdef OBJ
        !           316:            o = 0;
        !           317: #      endif OBJ
        !           318: #      ifdef PC
        !           319:                /*
        !           320:                 * parameters used to be allocated backwards,
        !           321:                 * then fixed.  for pc, they are allocated correctly.
        !           322:                 * also, they are aligned.
        !           323:                 */
        !           324:            o = DPOFF2;
        !           325: #      endif PC
        !           326:        for (formalp = formalist; formalp != NIL; formalp = formalp[2]) {
        !           327:                p = NIL;
        !           328:                formal = formalp[1];
        !           329:                if (formal == NIL)
        !           330:                        continue;
        !           331:                /*
        !           332:                 * Parametric procedures
        !           333:                 * don't have types !?!
        !           334:                 */
        !           335:                typ = formal[2];
        !           336:                if ( typ == NIL ) {
        !           337:                    if ( formal[0] != T_PPROC ) {
        !           338:                        error("Types must be specified for arguments");
        !           339:                        p = NIL;
        !           340:                    }
        !           341:                } else {
        !           342:                    if ( formal[0] == T_PPROC ) {
        !           343:                        error("Procedures cannot have types");
        !           344:                        p = NIL;
        !           345:                    } else {
        !           346:                        if (typ[0] != T_TYID) {
        !           347:                                error("Types for arguments can be specified only by using type identifiers");
        !           348:                                p = NIL;
        !           349:                        } else {
        !           350:                                p = gtype(typ);
        !           351:                        }
        !           352:                    }
        !           353:                }
        !           354:                for (idlist = formal[1]; idlist != NIL; idlist = idlist[2]) {
        !           355:                        switch (formal[0]) {
        !           356:                            default:
        !           357:                                    panic("funchdr2");
        !           358:                            case T_PVAL:
        !           359:                                    if (p != NIL) {
        !           360:                                            if (p->class == FILET)
        !           361:                                                    error("Files cannot be passed by value");
        !           362:                                            else if (p->nl_flags & NFILES)
        !           363:                                                    error("Files cannot be a component of %ss passed by value",
        !           364:                                                            nameof(p));
        !           365:                                    }
        !           366: #                                  ifdef OBJ
        !           367:                                        w = lwidth(p);
        !           368:                                        o -= even(w);
        !           369: #                                      ifdef DEC11
        !           370:                                            dp = defnl(idlist[1], VAR, p, o);
        !           371: #                                      else
        !           372:                                            dp = defnl(idlist[1], VAR, p,
        !           373:                                                (w < 2) ? o + 1 : o);
        !           374: #                                      endif DEC11
        !           375: #                                  endif OBJ
        !           376: #                                  ifdef PC
        !           377:                                        o = roundup(o, A_STACK);
        !           378:                                        w = lwidth(p);
        !           379: #                                      ifndef DEC11
        !           380:                                            if (w <= sizeof(int)) {
        !           381:                                                o += sizeof(int) - w;
        !           382:                                            }
        !           383: #                                      endif not DEC11
        !           384:                                        dp = defnl(idlist[1], VAR, p, o);
        !           385:                                        o += w;
        !           386: #                                  endif PC
        !           387:                                    dp->nl_flags |= NMOD;
        !           388:                                    break;
        !           389:                            case T_PVAR:
        !           390: #                                  ifdef OBJ
        !           391:                                        dp = defnl(idlist[1], REF, p, o -= sizeof ( int * ) );
        !           392: #                                  endif OBJ
        !           393: #                                  ifdef PC
        !           394:                                        dp = defnl( idlist[1] , REF , p
        !           395:                                                , o = roundup( o , (long)A_STACK ) );
        !           396:                                        o += sizeof(char *);
        !           397: #                                  endif PC
        !           398:                                    break;
        !           399:                            case T_PFUNC:
        !           400:                                    if (idlist[2] != NIL) {
        !           401:                                        error("Each function argument must be declared separately");
        !           402:                                        idlist[2] = NIL;
        !           403:                                    }
        !           404: #                                  ifdef OBJ
        !           405:                                        dp = defnl(idlist[1], FFUNC, p, o -= sizeof ( int * ) );
        !           406: #                                  endif OBJ
        !           407: #                                  ifdef PC
        !           408:                                        dp = defnl( idlist[1] , FFUNC , p
        !           409:                                                , o = roundup( o , (long)A_STACK ) );
        !           410:                                        o += sizeof(char *);
        !           411: #                                  endif PC
        !           412:                                    dp -> nl_flags |= NMOD;
        !           413:                                    fparams(dp, formal);
        !           414:                                    break;
        !           415:                            case T_PPROC:
        !           416:                                    if (idlist[2] != NIL) {
        !           417:                                        error("Each procedure argument must be declared separately");
        !           418:                                        idlist[2] = NIL;
        !           419:                                    }
        !           420: #                                  ifdef OBJ
        !           421:                                        dp = defnl(idlist[1], FPROC, p, o -= sizeof ( int * ) );
        !           422: #                                  endif OBJ
        !           423: #                                  ifdef PC
        !           424:                                        dp = defnl( idlist[1] , FPROC , p
        !           425:                                                , o = roundup( o , (long)A_STACK ) );
        !           426:                                        o += sizeof(char *);
        !           427: #                                  endif PC
        !           428:                                    dp -> nl_flags |= NMOD;
        !           429:                                    fparams(dp, formal);
        !           430:                                    break;
        !           431:                            }
        !           432:                        if (dp != NIL) {
        !           433: #                              ifdef PC
        !           434:                                    dp -> extra_flags |= NPARAM;
        !           435: #                              endif PC
        !           436:                                chainp->chain = dp;
        !           437:                                chainp = dp;
        !           438:                        }
        !           439:                }
        !           440:        }
        !           441:        p = savedp;
        !           442: #      ifdef OBJ
        !           443:                /*
        !           444:                 * Correct the naivete (naivety)
        !           445:                 * of our above code to
        !           446:                 * calculate offsets
        !           447:                 */
        !           448:            for (dp = p->chain; dp != NIL; dp = dp->chain)
        !           449:                    dp->value[NL_OFFS] += -o + DPOFF2;
        !           450:            return (-o + DPOFF2);
        !           451: #      endif OBJ
        !           452: #      ifdef PC
        !           453:            return roundup( o , (long)A_STACK );
        !           454: #      endif PC
        !           455: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.