Return to fdec.c CVS log

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

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

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)fdec.c 1.23 2/28/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: #include "tmps.h"
        !            12: 
        !            13: /*
        !            14:  * this array keeps the pxp counters associated with
        !            15:  * functions and procedures, so that they can be output
        !            16:  * when their bodies are encountered
        !            17:  */
        !            18: int    bodycnts[ DSPLYSZ ];
        !            19: 
        !            20: #ifdef PC
        !            21: #   include "pc.h"
        !            22: #   include "pcops.h"
        !            23: #endif PC
        !            24: 
        !            25: #ifdef OBJ
        !            26: int    cntpatch;
        !            27: int    nfppatch;
        !            28: #endif OBJ
        !            29: 
        !            30: funcfwd(fp)
        !            31:        struct nl *fp;
        !            32: {
        !            33: 
        !            34:            /*
        !            35:             *  save the counter for this function
        !            36:             */
        !            37:        if ( monflg ) {
        !            38:            fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
        !            39:        }
        !            40:        return (fp);
        !            41: }
        !            42: 
        !            43: /*
        !            44:  * Funcext marks the procedure or
        !            45:  * function external in the symbol
        !            46:  * table. Funcext should only be
        !            47:  * called if PC, and is an error
        !            48:  * otherwise.
        !            49:  */
        !            50: 
        !            51: funcext(fp)
        !            52:        struct nl *fp;
        !            53: {
        !            54: 
        !            55: #ifdef OBJ
        !            56:        error("Procedures or functions cannot be declared external.");
        !            57: #endif OBJ
        !            58: 
        !            59: #ifdef PC
        !            60:            /*
        !            61:             *  save the counter for this function
        !            62:             */
        !            63:        if ( monflg ) {
        !            64:            fp -> value[ NL_CNTR ] = bodycnts[ cbn ];
        !            65:        }
        !            66:        if (opt('s')) {
        !            67:                standard();
        !            68:                error("External procedures and functions are not standard");
        !            69:        } else {
        !            70:                if (cbn == 1) {
        !            71:                        fp->extra_flags |= NEXTERN;
        !            72:                        stabefunc( fp -> symbol , fp -> class , line );
        !            73:                }
        !            74:                else
        !            75:                        error("External procedures and functions can only be declared at the outermost level.");
        !            76:        }
        !            77: #endif PC
        !            78: 
        !            79:        return(fp);
        !            80: }
        !            81: 
        !            82: /*
        !            83:  * Funcbody is called
        !            84:  * when the actual (resolved)
        !            85:  * declaration of a procedure is
        !            86:  * encountered. It puts the names
        !            87:  * of the (function) and parameters
        !            88:  * into the symbol table.
        !            89:  */
        !            90: funcbody(fp)
        !            91:        struct nl *fp;
        !            92: {
        !            93:        register struct nl *q, *p;
        !            94: 
        !            95:        cbn++;
        !            96:        if (cbn >= DSPLYSZ) {
        !            97:                error("Too many levels of function/procedure nesting");
        !            98:                pexit(ERRS);
        !            99:        }
        !           100:        tmpinit(cbn);
        !           101:        gotos[cbn] = NIL;
        !           102:        errcnt[cbn] = syneflg;
        !           103:        parts[ cbn ] = NIL;
        !           104:        dfiles[ cbn ] = FALSE;
        !           105:        if (fp == NIL)
        !           106:                return (NIL);
        !           107:        /*
        !           108:         * Save the virtual name
        !           109:         * list stack pointer so
        !           110:         * the space can be freed
        !           111:         * later (funcend).
        !           112:         */
        !           113:        fp->ptr[2] = nlp;
        !           114:        if (fp->class != PROG) {
        !           115:                for (q = fp->chain; q != NIL; q = q->chain) {
        !           116:                        enter(q);
        !           117: #                      ifdef PC
        !           118:                            q -> extra_flags |= NPARAM;
        !           119: #                      endif PC
        !           120:                }
        !           121:        }
        !           122:        if (fp->class == FUNC) {
        !           123:                /*
        !           124:                 * For functions, enter the fvar
        !           125:                 */
        !           126:                enter(fp->ptr[NL_FVAR]);
        !           127: #              ifdef PC
        !           128:                    q = fp -> ptr[ NL_FVAR ];
        !           129:                    if (q -> type != NIL ) {
        !           130:                        sizes[cbn].curtmps.om_off = q -> value[NL_OFFS];
        !           131:                        sizes[cbn].om_max = q -> value[NL_OFFS];
        !           132:                    }
        !           133: #              endif PC
        !           134:        }
        !           135: #      ifdef PTREE
        !           136:                /*
        !           137:                 *      pick up the pointer to porf declaration
        !           138:                 */
        !           139:            PorFHeader[ ++nesting ] = fp -> inTree;
        !           140: #      endif PTREE
        !           141:        return (fp);
        !           142: }
        !           143: 
        !           144: /*
        !           145:  * Segend is called to check for
        !           146:  * unresolved variables, funcs and
        !           147:  * procs, and deliver unresolved and
        !           148:  * baduse error diagnostics at the
        !           149:  * end of a routine segment (a separately
        !           150:  * compiled segment that is not the 
        !           151:  * main program) for PC. This
        !           152:  * routine should only be called
        !           153:  * by PC (not standard).
        !           154:  */
        !           155:  segend()
        !           156:  {
        !           157:        register struct nl *p;
        !           158:        register int i,b;
        !           159:        char *cp;
        !           160: 
        !           161: #ifdef PC
        !           162:        if ( monflg ) {
        !           163:            error("Only the module containing the \"program\" statement");
        !           164:            cerror("can be profiled with ``pxp''.\n");
        !           165:        }
        !           166:        if (opt('s')) {
        !           167:                standard();
        !           168:                error("Separately compiled routine segments are not standard.");
        !           169:        } else {
        !           170:                b = cbn;
        !           171:                for (i=0; i<077; i++) {
        !           172:                        for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
        !           173:                        switch (p->class) {
        !           174:                                case BADUSE:
        !           175:                                        cp = 's';
        !           176:                                        if (p->chain->ud_next == NIL)
        !           177:                                                cp++;
        !           178:                                        eholdnl();
        !           179:                                        if (p->value[NL_KINDS] & ISUNDEF)
        !           180:                                                nerror("%s undefined on line%s", p->symbol, cp);
        !           181:                                        else
        !           182:                                                nerror("%s improperly used on line%s", p->symbol, cp);
        !           183:                                        pnumcnt = 10;
        !           184:                                        pnums(p->chain);
        !           185:                                        pchr('\n');
        !           186:                                        break;
        !           187:                                
        !           188:                                case FUNC:
        !           189:                                case PROC:
        !           190:                                        if ((p->nl_flags & NFORWD) &&
        !           191:                                            ((p->extra_flags & NEXTERN) == 0))
        !           192:                                                nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
        !           193:                                        break;
        !           194: 
        !           195:                                case FVAR:
        !           196:                                        if (((p->nl_flags & NMOD) == 0) &&
        !           197:                                            ((p->chain->extra_flags & NEXTERN) == 0))
        !           198:                                                nerror("No assignment to the function variable");
        !           199:                                        break;
        !           200:                            }
        !           201:                           }
        !           202:                           disptab[i] = p;
        !           203:                    }
        !           204:        }
        !           205: #endif PC
        !           206: #ifdef OBJ
        !           207:        error("Missing program statement and program body");
        !           208: #endif OBJ
        !           209: 
        !           210: }
        !           211: 
        !           212: 
        !           213: /*
        !           214:  * Level1 does level one processing for
        !           215:  * separately compiled routine segments
        !           216:  */
        !           217: level1()
        !           218: {
        !           219: 
        !           220: #      ifdef OBJ
        !           221:            error("Missing program statement");
        !           222: #      endif OBJ
        !           223: #      ifdef PC
        !           224:            if (opt('s')) {
        !           225:                    standard();
        !           226:                    error("Missing program statement");
        !           227:            }
        !           228: #      endif PC
        !           229: 
        !           230:        cbn++;
        !           231:        tmpinit(cbn);
        !           232:        gotos[cbn] = NIL;
        !           233:        errcnt[cbn] = syneflg;
        !           234:        parts[ cbn ] = NIL;
        !           235:        dfiles[ cbn ] = FALSE;
        !           236:        progseen = TRUE;
        !           237: }
        !           238: 
        !           239: 
        !           240: 
        !           241: pnums(p)
        !           242:        struct udinfo *p;
        !           243: {
        !           244: 
        !           245:        if (p->ud_next != NIL)
        !           246:                pnums(p->ud_next);
        !           247:        if (pnumcnt == 0) {
        !           248:                printf("\n\t");
        !           249:                pnumcnt = 20;
        !           250:        }
        !           251:        pnumcnt--;
        !           252:        printf(" %d", p->ud_line);
        !           253: }
        !           254: 
        !           255: nerror(a1, a2, a3)
        !           256: {
        !           257: 
        !           258:        if (Fp != NIL) {
        !           259:                yySsync();
        !           260: #ifndef PI1
        !           261:                if (opt('l'))
        !           262:                        yyoutline();
        !           263: #endif
        !           264:                yysetfile(filename);
        !           265:                printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
        !           266:                Fp = NIL;
        !           267:                elineoff();
        !           268:        }
        !           269:        error(a1, a2, a3);
        !           270: }

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