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