Return to const.c CVS log

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

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

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)const.c 1.5 8/29/82";
        !             4: 
        !             5: #include "whoami.h"
        !             6: #include "0.h"
        !             7: #include "tree.h"
        !             8: 
        !             9: /*
        !            10:  * Const enters the definitions
        !            11:  * of the constant declaration
        !            12:  * part into the namelist.
        !            13:  */
        !            14: #ifndef PI1
        !            15: constbeg( lineofyconst , r )
        !            16:     int        lineofyconst;
        !            17: {
        !            18:     static bool        const_order = FALSE;
        !            19:     static bool        const_seen = FALSE;
        !            20: 
        !            21: /*
        !            22:  * this allows for multiple declaration
        !            23:  * parts, unless the "standard" option
        !            24:  * has been specified.
        !            25:  * If a routine segment is being compiled,
        !            26:  * do level one processing.
        !            27:  */
        !            28: 
        !            29:        if (!progseen)
        !            30:                level1();
        !            31:        line = lineofyconst;
        !            32:        if (parts[ cbn ] & (TPRT|VPRT|RPRT)) {
        !            33:            if ( opt( 's' ) ) {
        !            34:                standard();
        !            35:                error("Constant declarations should precede type, var and routine declarations");
        !            36:            } else {
        !            37:                if ( !const_order ) {
        !            38:                    const_order = TRUE;
        !            39:                    warning();
        !            40:                    error("Constant declarations should precede type, var and routine declarations");
        !            41:                }
        !            42:            }
        !            43:        }
        !            44:        if (parts[ cbn ] & CPRT) {
        !            45:            if ( opt( 's' ) ) {
        !            46:                standard();
        !            47:                error("All constants should be declared in one const part");
        !            48:            } else {
        !            49:                if ( !const_seen ) {
        !            50:                    const_seen = TRUE;
        !            51:                    warning();
        !            52:                    error("All constants should be declared in one const part");
        !            53:                }
        !            54:            }
        !            55:        }
        !            56:        parts[ cbn ] |= CPRT;
        !            57: }
        !            58: #endif PI1
        !            59: 
        !            60: const(cline, cid, cdecl)
        !            61:        int cline;
        !            62:        register char *cid;
        !            63:        register int *cdecl;
        !            64: {
        !            65:        register struct nl *np;
        !            66: 
        !            67: #ifdef PI0
        !            68:        send(REVCNST, cline, cid, cdecl);
        !            69: #endif
        !            70:        line = cline;
        !            71:        gconst(cdecl);
        !            72:        np = enter(defnl(cid, CONST, con.ctype, con.cival));
        !            73: #ifndef PI0
        !            74:        np->nl_flags |= NMOD;
        !            75: #endif
        !            76: 
        !            77: #ifdef PC
        !            78:        if (cbn == 1) {
        !            79:            stabgconst( cid , line );
        !            80:        }
        !            81: #endif PC
        !            82: 
        !            83: #      ifdef PTREE
        !            84:            {
        !            85:                pPointer        Const = ConstDecl( cid , cdecl );
        !            86:                pPointer        *Consts;
        !            87: 
        !            88:                pSeize( PorFHeader[ nesting ] );
        !            89:                Consts = &( pDEF( PorFHeader[ nesting ] ).PorFConsts );
        !            90:                *Consts = ListAppend( *Consts , Const );
        !            91:                pRelease( PorFHeader[ nesting ] );
        !            92:            }
        !            93: #      endif
        !            94:        if (con.ctype == NIL)
        !            95:                return;
        !            96:        if ( con.ctype == nl + TSTR )
        !            97:                np->ptr[0] = con.cpval;
        !            98:        if (isa(con.ctype, "i"))
        !            99:                np->range[0] = con.crval;
        !           100:        else if (isa(con.ctype, "d"))
        !           101:                np->real = con.crval;
        !           102: }
        !           103: 
        !           104: #ifndef PI0
        !           105: #ifndef PI1
        !           106: constend()
        !           107: {
        !           108: 
        !           109: }
        !           110: #endif
        !           111: #endif
        !           112: 
        !           113: /*
        !           114:  * Gconst extracts
        !           115:  * a constant declaration
        !           116:  * from the tree for it.
        !           117:  * only types of constants
        !           118:  * are integer, reals, strings
        !           119:  * and scalars, the first two
        !           120:  * being possibly signed.
        !           121:  */
        !           122: gconst(r)
        !           123:        int *r;
        !           124: {
        !           125:        register struct nl *np;
        !           126:        register *cn;
        !           127:        char *cp;
        !           128:        int negd, sgnd;
        !           129:        long ci;
        !           130: 
        !           131:        con.ctype = NIL;
        !           132:        cn = r;
        !           133:        negd = sgnd = 0;
        !           134: loop:
        !           135:        if (cn == NIL || cn[1] == NIL)
        !           136:                return (NIL);
        !           137:        switch (cn[0]) {
        !           138:                default:
        !           139:                        panic("gconst");
        !           140:                case T_MINUSC:
        !           141:                        negd = 1 - negd;
        !           142:                case T_PLUSC:
        !           143:                        sgnd++;
        !           144:                        cn = cn[1];
        !           145:                        goto loop;
        !           146:                case T_ID:
        !           147:                        np = lookup(cn[1]);
        !           148:                        if (np == NIL)
        !           149:                                return;
        !           150:                        if (np->class != CONST) {
        !           151:                                derror("%s is a %s, not a constant as required", cn[1], classes[np->class]);
        !           152:                                return;
        !           153:                        }
        !           154:                        con.ctype = np->type;
        !           155:                        switch (classify(np->type)) {
        !           156:                                case TINT:
        !           157:                                        con.crval = np->range[0];
        !           158:                                        break;
        !           159:                                case TDOUBLE:
        !           160:                                        con.crval = np->real;
        !           161:                                        break;
        !           162:                                case TBOOL:
        !           163:                                case TCHAR:
        !           164:                                case TSCAL:
        !           165:                                        con.cival = np->value[0];
        !           166:                                        con.crval = con.cival;
        !           167:                                        break;
        !           168:                                case TSTR:
        !           169:                                        con.cpval = np->ptr[0];
        !           170:                                        break;
        !           171:                                case NIL:
        !           172:                                        con.ctype = NIL;
        !           173:                                        return;
        !           174:                                default:
        !           175:                                        panic("gconst2");
        !           176:                        }
        !           177:                        break;
        !           178:                case T_CBINT:
        !           179:                        con.crval = a8tol(cn[1]);
        !           180:                        goto restcon;
        !           181:                case T_CINT:
        !           182:                        con.crval = atof(cn[1]);
        !           183:                        if (con.crval > MAXINT || con.crval < MININT) {
        !           184:                                derror("Constant too large for this implementation");
        !           185:                                con.crval = 0;
        !           186:                        }
        !           187: restcon:
        !           188:                        ci = con.crval;
        !           189: #ifndef PI0
        !           190:                        if (bytes(ci, ci) <= 2)
        !           191:                                con.ctype = nl+T2INT;
        !           192:                        else    
        !           193: #endif
        !           194:                                con.ctype = nl+T4INT;
        !           195:                        break;
        !           196:                case T_CFINT:
        !           197:                        con.ctype = nl+TDOUBLE;
        !           198:                        con.crval = atof(cn[1]);
        !           199:                        break;
        !           200:                case T_CSTRNG:
        !           201:                        cp = cn[1];
        !           202:                        if (cp[1] == 0) {
        !           203:                                con.ctype = nl+T1CHAR;
        !           204:                                con.cival = cp[0];
        !           205:                                con.crval = con.cival;
        !           206:                                break;
        !           207:                        }
        !           208:                        con.ctype = nl+TSTR;
        !           209:                        con.cpval = savestr(cp);
        !           210:                        break;
        !           211:        }
        !           212:        if (sgnd) {
        !           213:                if (isnta(con.ctype, "id"))
        !           214:                        derror("%s constants cannot be signed", nameof(con.ctype));
        !           215:                else {
        !           216:                        if (negd)
        !           217:                                con.crval = -con.crval;
        !           218:                        ci = con.crval;
        !           219:                }
        !           220:        }
        !           221: }
        !           222: 
        !           223: #ifndef PI0
        !           224: isconst(r)
        !           225:        register int *r;
        !           226: {
        !           227: 
        !           228:        if (r == NIL)
        !           229:                return (1);
        !           230:        switch (r[0]) {
        !           231:                case T_MINUS:
        !           232:                        r[0] = T_MINUSC;
        !           233:                        r[1] = r[2];
        !           234:                        return (isconst(r[1]));
        !           235:                case T_PLUS:
        !           236:                        r[0] = T_PLUSC;
        !           237:                        r[1] = r[2];
        !           238:                        return (isconst(r[1]));
        !           239:                case T_VAR:
        !           240:                        if (r[3] != NIL)
        !           241:                                return (0);
        !           242:                        r[0] = T_ID;
        !           243:                        r[1] = r[2];
        !           244:                        return (1);
        !           245:                case T_BINT:
        !           246:                        r[0] = T_CBINT;
        !           247:                        r[1] = r[2];
        !           248:                        return (1);
        !           249:                case T_INT:
        !           250:                        r[0] = T_CINT;
        !           251:                        r[1] = r[2];
        !           252:                        return (1);
        !           253:                case T_FINT:
        !           254:                        r[0] = T_CFINT;
        !           255:                        r[1] = r[2];
        !           256:                        return (1);
        !           257:                case T_STRNG:
        !           258:                        r[0] = T_CSTRNG;
        !           259:                        r[1] = r[2];
        !           260:                        return (1);
        !           261:        }
        !           262:        return (0);
        !           263: }
        !           264: #endif

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