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