1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)const.c 1.5 08/29/82"; 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 } 103 104 #ifndef PI0 105 #ifndef PI1 106 constend() 107 { 108 109 } 110 #endif 111 #endif 112 113 /* 114 * Gconst extracts 115 * a constant declaration 116 * from the tree for it. 117 * only types of constants 118 * are integer, reals, strings 119 * and scalars, the first two 120 * being possibly signed. 121 */ 122 gconst(r) 123 int *r; 124 { 125 register struct nl *np; 126 register *cn; 127 char *cp; 128 int negd, sgnd; 129 long ci; 130 131 con.ctype = NIL; 132 cn = r; 133 negd = sgnd = 0; 134 loop: 135 if (cn == NIL || cn[1] == NIL) 136 return (NIL); 137 switch (cn[0]) { 138 default: 139 panic("gconst"); 140 case T_MINUSC: 141 negd = 1 - negd; 142 case T_PLUSC: 143 sgnd++; 144 cn = cn[1]; 145 goto loop; 146 case T_ID: 147 np = lookup(cn[1]); 148 if (np == NIL) 149 return; 150 if (np->class != CONST) { 151 derror("%s is a %s, not a constant as required", cn[1], classes[np->class]); 152 return; 153 } 154 con.ctype = np->type; 155 switch (classify(np->type)) { 156 case TINT: 157 con.crval = np->range[0]; 158 break; 159 case TDOUBLE: 160 con.crval = np->real; 161 break; 162 case TBOOL: 163 case TCHAR: 164 case TSCAL: 165 con.cival = np->value[0]; 166 con.crval = con.cival; 167 break; 168 case TSTR: 169 con.cpval = np->ptr[0]; 170 break; 171 case NIL: 172 con.ctype = NIL; 173 return; 174 default: 175 panic("gconst2"); 176 } 177 break; 178 case T_CBINT: 179 con.crval = a8tol(cn[1]); 180 goto restcon; 181 case T_CINT: 182 con.crval = atof(cn[1]); 183 if (con.crval > MAXINT || con.crval < MININT) { 184 derror("Constant too large for this implementation"); 185 con.crval = 0; 186 } 187 restcon: 188 ci = con.crval; 189 #ifndef PI0 190 if (bytes(ci, ci) <= 2) 191 con.ctype = nl+T2INT; 192 else 193 #endif 194 con.ctype = nl+T4INT; 195 break; 196 case T_CFINT: 197 con.ctype = nl+TDOUBLE; 198 con.crval = atof(cn[1]); 199 break; 200 case T_CSTRNG: 201 cp = cn[1]; 202 if (cp[1] == 0) { 203 con.ctype = nl+T1CHAR; 204 con.cival = cp[0]; 205 con.crval = con.cival; 206 break; 207 } 208 con.ctype = nl+TSTR; 209 con.cpval = savestr(cp); 210 break; 211 } 212 if (sgnd) { 213 if (isnta(con.ctype, "id")) 214 derror("%s constants cannot be signed", nameof(con.ctype)); 215 else { 216 if (negd) 217 con.crval = -con.crval; 218 ci = con.crval; 219 } 220 } 221 } 222 223 #ifndef PI0 224 isconst(r) 225 register int *r; 226 { 227 228 if (r == NIL) 229 return (1); 230 switch (r[0]) { 231 case T_MINUS: 232 r[0] = T_MINUSC; 233 r[1] = r[2]; 234 return (isconst(r[1])); 235 case T_PLUS: 236 r[0] = T_PLUSC; 237 r[1] = r[2]; 238 return (isconst(r[1])); 239 case T_VAR: 240 if (r[3] != NIL) 241 return (0); 242 r[0] = T_ID; 243 r[1] = r[2]; 244 return (1); 245 case T_BINT: 246 r[0] = T_CBINT; 247 r[1] = r[2]; 248 return (1); 249 case T_INT: 250 r[0] = T_CINT; 251 r[1] = r[2]; 252 return (1); 253 case T_FINT: 254 r[0] = T_CFINT; 255 r[1] = r[2]; 256 return (1); 257 case T_STRNG: 258 r[0] = T_CSTRNG; 259 r[1] = r[2]; 260 return (1); 261 } 262 return (0); 263 } 264 #endif 265