2.9BSD - /usr/src/ucb/pascal/pi/const.c

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

Defined functions

Defined variables