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