Annotation of 42BSD/ucb/pascal/src/const.c, revision 1.1.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

unix.superglobalmegacorp.com

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