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