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