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