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