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