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[] = "@(#)clas.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 * 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:
59 if (p == NLNIL) {
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);
79 case CRANGE:
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:
94 {
95 panic("clas");
96 return(NIL);
97 }
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 */
119 struct nl *
scalar(p1)120 scalar(p1)
121 struct nl *p1;
122 {
123 register struct nl *p;
124
125 p = p1;
126 if (p == NLNIL)
127 return (NLNIL);
128 if (p->class == RANGE || p->class == CRANGE)
129 p = p->type;
130 if (p == NLNIL)
131 return (NLNIL);
132 return (p->class == SCAL ? p : NLNIL);
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 */
isa(p,s)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 */
157 if (p->class == RANGE) {
158 p = p->type;
159 }
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;
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;
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)
208 struct nl *p;
209 char *s;
210 {
211
212 return (!isa(p, s));
213 }
214
215 /*
216 * "shorthand"
217 */
218 char *
nameof(p)219 nameof(p)
220 struct nl *p;
221 {
222
223 return (clnames[classify(p)]);
224 }
225
226 #ifndef PI0
227 /* find out for sure what kind of node this is being passed
228 possibly several different kinds of node are passed to it */
nowexp(r)229 int nowexp(r)
230 struct tnode *r;
231 {
232 if (r->tag == T_WEXP) {
233 if (r->var_node.cptr == NIL)
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
242
243 /*
244 * is a variable a local, a formal parameter, or a global?
245 * all this from just the offset:
246 * globals are at levels 0 or 1
247 * positives are parameters
248 * negative evens are locals
249 */
250 /*ARGSUSED*/
whereis(offset,other_flags)251 whereis( offset , other_flags )
252 int offset;
253 char other_flags;
254 {
255
256 # ifdef OBJ
257 return ( offset >= 0 ? PARAMVAR : LOCALVAR );
258 # endif OBJ
259 # ifdef PC
260 switch ( other_flags & ( NGLOBAL | NPARAM | NLOCAL | NNLOCAL) ) {
261 default:
262 panic( "whereis" );
263 case NGLOBAL:
264 return GLOBALVAR;
265 case NPARAM:
266 return PARAMVAR;
267 case NNLOCAL:
268 return NAMEDLOCALVAR;
269 case NLOCAL:
270 return LOCALVAR;
271 }
272 # endif PC
273 }
274