Commit | Line | Data |
---|---|---|
57e8da55 PK |
1 | /* Copyright (c) 1979 Regents of the University of California */ |
2 | ||
99f6998f | 3 | static char sccsid[] = "@(#)const.c 1.4 %G%"; |
57e8da55 PK |
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 | /* | |
af97bcfa | 19 | * this allows for multiple declaration |
57e8da55 PK |
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(); | |
af97bcfa PK |
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; | |
57e8da55 PK |
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 | |
b721c131 | 66 | if (cbn == 1) { |
99f6998f | 67 | stabgconst( cid , line ); |
b721c131 | 68 | } |
57e8da55 PK |
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 | \f | |
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 |