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