4.3BSD - /usr/src/ucb/pascal/src/const.c

   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.2 (Berkeley) 6/21/85";
   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 )
  23:     int lineofyconst;
  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: const(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

Defined functions

Defined variables