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