Commit | Line | Data |
---|---|---|
0fc6e47b KB |
1 | /*- |
2 | * Copyright (c) 1980 The Regents of the University of California. | |
3 | * All rights reserved. | |
4 | * | |
5 | * %sccs.include.redist.c% | |
6468808a DF |
6 | */ |
7 | ||
8 | #ifndef lint | |
0fc6e47b KB |
9 | static char sccsid[] = "@(#)clas.c 5.3 (Berkeley) %G%"; |
10 | #endif /* not lint */ | |
11 | ||
22fb6780 PK |
12 | #include "whoami.h" |
13 | #include "0.h" | |
14 | #include "tree.h" | |
72fbef68 | 15 | #include "tree_ty.h" |
22fb6780 PK |
16 | |
17 | /* | |
18 | * This is the array of class | |
19 | * names for the classes returned | |
20 | * by classify. The order of the | |
21 | * classes is the same as the base | |
22 | * of the namelist, with special | |
23 | * negative index entries for structures, | |
24 | * scalars, pointers, sets and strings | |
25 | * to be collapsed into. | |
26 | */ | |
27 | char *clnxxxx[] = | |
28 | { | |
29 | "file", /* -7 TFILE */ | |
30 | "record", /* -6 TREC */ | |
31 | "array", /* -5 TARY */ | |
32 | "scalar", /* -4 TSCAL */ | |
33 | "pointer", /* -3 TPTR */ | |
34 | "set", /* -2 TSET */ | |
35 | "string", /* -1 TSTR */ | |
36 | "SNARK", /* 0 NIL */ | |
37 | "Boolean", /* 1 TBOOL */ | |
38 | "char", /* 2 TCHAR */ | |
39 | "integer", /* 3 TINT */ | |
40 | "real", /* 4 TREAL */ | |
41 | "\"nil\"", /* 5 TNIL */ | |
42 | }; | |
43 | ||
44 | char **clnames = &clnxxxx[-(TFIRST)]; | |
45 | ||
46 | /* | |
47 | * Classify takes a pointer | |
48 | * to a type and returns one | |
49 | * of several interesting group | |
50 | * classifications for easy use. | |
51 | */ | |
52 | classify(p1) | |
53 | struct nl *p1; | |
54 | { | |
55 | register struct nl *p; | |
56 | ||
57 | p = p1; | |
58 | swit: | |
72fbef68 | 59 | if (p == NLNIL) { |
22fb6780 PK |
60 | nocascade(); |
61 | return (NIL); | |
62 | } | |
63 | if (p == &nl[TSTR]) | |
64 | return (TSTR); | |
65 | if ( p == &nl[ TSET ] ) { | |
66 | return TSET; | |
67 | } | |
68 | switch (p->class) { | |
69 | case PTR: | |
70 | return (TPTR); | |
71 | case ARRAY: | |
72 | if (p->type == nl+T1CHAR) | |
73 | return (TSTR); | |
74 | return (TARY); | |
75 | case STR: | |
76 | return (TSTR); | |
77 | case SET: | |
78 | return (TSET); | |
9965cdc3 | 79 | case CRANGE: |
22fb6780 PK |
80 | case RANGE: |
81 | p = p->type; | |
82 | goto swit; | |
83 | case TYPE: | |
84 | if (p <= nl+TLAST) | |
85 | return (p - nl); | |
86 | panic("clas2"); | |
87 | case FILET: | |
88 | return (TFILE); | |
89 | case RECORD: | |
90 | return (TREC); | |
91 | case SCAL: | |
92 | return (TSCAL); | |
93 | default: | |
72fbef68 RT |
94 | { |
95 | panic("clas"); | |
96 | return(NIL); | |
97 | } | |
22fb6780 PK |
98 | } |
99 | } | |
100 | ||
101 | #ifndef PI0 | |
102 | /* | |
103 | * Is p a text file? | |
104 | */ | |
105 | text(p) | |
106 | struct nl *p; | |
107 | { | |
108 | ||
109 | return (p != NIL && p->class == FILET && p->type == nl+T1CHAR); | |
110 | } | |
111 | #endif | |
112 | ||
113 | /* | |
114 | * Scalar returns a pointer to | |
115 | * the the base scalar type of | |
116 | * its argument if its argument | |
117 | * is a SCALar else NIL. | |
118 | */ | |
72fbef68 | 119 | struct nl * |
22fb6780 PK |
120 | scalar(p1) |
121 | struct nl *p1; | |
122 | { | |
123 | register struct nl *p; | |
124 | ||
125 | p = p1; | |
72fbef68 RT |
126 | if (p == NLNIL) |
127 | return (NLNIL); | |
9965cdc3 | 128 | if (p->class == RANGE || p->class == CRANGE) |
22fb6780 | 129 | p = p->type; |
72fbef68 RT |
130 | if (p == NLNIL) |
131 | return (NLNIL); | |
132 | return (p->class == SCAL ? p : NLNIL); | |
22fb6780 PK |
133 | } |
134 | ||
135 | /* | |
136 | * Isa tells whether p | |
137 | * is one of a group of | |
138 | * namelist classes. The | |
139 | * classes wanted are specified | |
140 | * by the characters in s. | |
141 | * (Note that s would more efficiently, | |
142 | * if less clearly, be given by a mask.) | |
143 | */ | |
144 | isa(p, s) | |
145 | register struct nl *p; | |
146 | char *s; | |
147 | { | |
148 | register i; | |
149 | register char *cp; | |
150 | ||
151 | if (p == NIL) | |
152 | return (NIL); | |
153 | /* | |
154 | * map ranges down to | |
155 | * the base type | |
156 | */ | |
9965cdc3 | 157 | if (p->class == RANGE) { |
22fb6780 | 158 | p = p->type; |
9965cdc3 | 159 | } |
22fb6780 PK |
160 | /* |
161 | * the following character/class | |
162 | * associations are made: | |
163 | * | |
164 | * s scalar | |
165 | * b Boolean | |
166 | * c character | |
167 | * i integer | |
168 | * d double (real) | |
169 | * t set | |
170 | */ | |
171 | switch (p->class) { | |
172 | case SET: | |
173 | i = TDOUBLE+1; | |
174 | break; | |
175 | case SCAL: | |
176 | i = 0; | |
177 | break; | |
9965cdc3 KM |
178 | case CRANGE: |
179 | /* | |
180 | * find the base type of a conformant array range | |
181 | */ | |
182 | switch (classify(p->type)) { | |
183 | case TBOOL: i = 1; break; | |
184 | case TCHAR: i = 2; break; | |
185 | case TINT: i = 3; break; | |
186 | case TSCAL: i = 0; break; | |
187 | default: | |
188 | panic( "isa" ); | |
189 | } | |
190 | break; | |
22fb6780 PK |
191 | default: |
192 | i = p - nl; | |
193 | } | |
194 | if (i >= 0 && i <= TDOUBLE+1) { | |
195 | i = "sbcidt"[i]; | |
196 | cp = s; | |
197 | while (*cp) | |
198 | if (*cp++ == i) | |
199 | return (1); | |
200 | } | |
201 | return (NIL); | |
202 | } | |
203 | ||
204 | /* | |
205 | * Isnta is !isa | |
206 | */ | |
207 | isnta(p, s) | |
72fbef68 RT |
208 | struct nl *p; |
209 | char *s; | |
22fb6780 PK |
210 | { |
211 | ||
212 | return (!isa(p, s)); | |
213 | } | |
214 | ||
215 | /* | |
216 | * "shorthand" | |
217 | */ | |
72fbef68 | 218 | char * |
22fb6780 | 219 | nameof(p) |
72fbef68 | 220 | struct nl *p; |
22fb6780 PK |
221 | { |
222 | ||
223 | return (clnames[classify(p)]); | |
224 | } | |
225 | ||
226 | #ifndef PI0 | |
72fbef68 RT |
227 | /* find out for sure what kind of node this is being passed |
228 | possibly several different kinds of node are passed to it */ | |
229 | int nowexp(r) | |
230 | struct tnode *r; | |
22fb6780 | 231 | { |
72fbef68 RT |
232 | if (r->tag == T_WEXP) { |
233 | if (r->var_node.cptr == NIL) | |
22fb6780 PK |
234 | error("Oct/hex allowed only on writeln/write calls"); |
235 | else | |
236 | error("Width expressions allowed only in writeln/write calls"); | |
237 | return (1); | |
238 | } | |
239 | return (NIL); | |
240 | } | |
241 | #endif | |
4cadac06 KM |
242 | |
243 | /* | |
1f43951f | 244 | * is a variable a local, a formal parameter, or a global? |
4cadac06 | 245 | * all this from just the offset: |
1f43951f | 246 | * globals are at levels 0 or 1 |
4cadac06 KM |
247 | * positives are parameters |
248 | * negative evens are locals | |
4cadac06 | 249 | */ |
72fbef68 RT |
250 | /*ARGSUSED*/ |
251 | whereis( offset , other_flags ) | |
1f43951f | 252 | int offset; |
fa5256b7 | 253 | char other_flags; |
4cadac06 KM |
254 | { |
255 | ||
1f43951f PK |
256 | # ifdef OBJ |
257 | return ( offset >= 0 ? PARAMVAR : LOCALVAR ); | |
258 | # endif OBJ | |
259 | # ifdef PC | |
199b9670 | 260 | switch ( other_flags & ( NGLOBAL | NPARAM | NLOCAL | NNLOCAL) ) { |
72fbef68 RT |
261 | default: |
262 | panic( "whereis" ); | |
1f43951f PK |
263 | case NGLOBAL: |
264 | return GLOBALVAR; | |
265 | case NPARAM: | |
266 | return PARAMVAR; | |
199b9670 KM |
267 | case NNLOCAL: |
268 | return NAMEDLOCALVAR; | |
1f43951f PK |
269 | case NLOCAL: |
270 | return LOCALVAR; | |
1f43951f PK |
271 | } |
272 | # endif PC | |
4cadac06 | 273 | } |