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 | * This is the array of class | |
16 | * names for the classes returned | |
17 | * by classify. The order of the | |
18 | * classes is the same as the base | |
19 | * of the namelist, with special | |
20 | * negative index entries for structures, | |
21 | * scalars, pointers, sets and strings | |
22 | * to be collapsed into. | |
23 | */ | |
24 | char *clnxxxx[] = | |
25 | { | |
26 | "file", /* -7 TFILE */ | |
27 | "record", /* -6 TREC */ | |
28 | "array", /* -5 TARY */ | |
29 | "scalar", /* -4 TSCAL */ | |
30 | "pointer", /* -3 TPTR */ | |
31 | "set", /* -2 TSET */ | |
32 | "string", /* -1 TSTR */ | |
33 | "SNARK", /* 0 NIL */ | |
34 | "Boolean", /* 1 TBOOL */ | |
35 | "char", /* 2 TCHAR */ | |
36 | "integer", /* 3 TINT */ | |
37 | "real", /* 4 TREAL */ | |
38 | "\"nil\"", /* 5 TNIL */ | |
39 | }; | |
40 | ||
41 | char **clnames = &clnxxxx[-(TFIRST)]; | |
42 | ||
43 | /* | |
44 | * Classify takes a pointer | |
45 | * to a type and returns one | |
46 | * of several interesting group | |
47 | * classifications for easy use. | |
48 | */ | |
49 | classify(p1) | |
50 | struct nl *p1; | |
51 | { | |
52 | register struct nl *p; | |
53 | ||
54 | p = p1; | |
55 | swit: | |
56 | if (p == NIL) { | |
57 | nocascade(); | |
58 | return (NIL); | |
59 | } | |
60 | if (p == &nl[TSTR]) | |
61 | return (TSTR); | |
62 | switch (p->class) { | |
63 | case PTR: | |
64 | return (TPTR); | |
65 | case ARRAY: | |
66 | if (p->type == nl+T1CHAR) | |
67 | return (TSTR); | |
68 | return (TARY); | |
69 | case STR: | |
70 | return (TSTR); | |
71 | case SET: | |
72 | return (TSET); | |
73 | case RANGE: | |
74 | p = p->type; | |
75 | goto swit; | |
76 | case TYPE: | |
77 | if (p <= nl+TLAST) | |
78 | return (p - nl); | |
79 | panic("clas2"); | |
80 | case FILET: | |
81 | return (TFILE); | |
82 | case RECORD: | |
83 | return (TREC); | |
84 | case SCAL: | |
85 | return (TSCAL); | |
86 | default: | |
87 | panic("clas"); | |
88 | } | |
89 | } | |
90 | ||
91 | #ifndef PI0 | |
92 | /* | |
93 | * Is p a text file? | |
94 | */ | |
95 | text(p) | |
96 | struct nl *p; | |
97 | { | |
98 | ||
99 | return (p != NIL && p->class == FILET && p->type == nl+T1CHAR); | |
100 | } | |
101 | #endif | |
102 | ||
103 | /* | |
104 | * Scalar returns a pointer to | |
105 | * the the base scalar type of | |
106 | * its argument if its argument | |
107 | * is a SCALar else NIL. | |
108 | */ | |
109 | scalar(p1) | |
110 | struct nl *p1; | |
111 | { | |
112 | register struct nl *p; | |
113 | ||
114 | p = p1; | |
115 | if (p == NIL) | |
116 | return (NIL); | |
117 | if (p->class == RANGE) | |
118 | p = p->type; | |
119 | if (p == NIL) | |
120 | return (NIL); | |
121 | return (p->class == SCAL ? p : NIL); | |
122 | } | |
123 | ||
124 | /* | |
125 | * Isa tells whether p | |
126 | * is one of a group of | |
127 | * namelist classes. The | |
128 | * classes wanted are specified | |
129 | * by the characters in s. | |
130 | * (Note that s would more efficiently, | |
131 | * if less clearly, be given by a mask.) | |
132 | */ | |
133 | isa(p, s) | |
134 | register struct nl *p; | |
135 | char *s; | |
136 | { | |
137 | register i; | |
138 | register char *cp; | |
139 | ||
140 | if (p == NIL) | |
141 | return (NIL); | |
142 | /* | |
143 | * map ranges down to | |
144 | * the base type | |
145 | */ | |
146 | if (p->class == RANGE) | |
147 | p = p->type; | |
148 | /* | |
149 | * the following character/class | |
150 | * associations are made: | |
151 | * | |
152 | * s scalar | |
153 | * b Boolean | |
154 | * c character | |
155 | * i integer | |
156 | * d double (real) | |
157 | * t set | |
158 | */ | |
159 | switch (p->class) { | |
160 | case SET: | |
161 | i = TDOUBLE+1; | |
162 | break; | |
163 | case SCAL: | |
164 | i = 0; | |
165 | break; | |
166 | default: | |
167 | i = p - nl; | |
168 | } | |
169 | if (i >= 0 && i <= TDOUBLE+1) { | |
170 | i = "sbcidt"[i]; | |
171 | cp = s; | |
172 | while (*cp) | |
173 | if (*cp++ == i) | |
174 | return (1); | |
175 | } | |
176 | return (NIL); | |
177 | } | |
178 | ||
179 | /* | |
180 | * Isnta is !isa | |
181 | */ | |
182 | isnta(p, s) | |
183 | { | |
184 | ||
185 | return (!isa(p, s)); | |
186 | } | |
187 | ||
188 | /* | |
189 | * "shorthand" | |
190 | */ | |
191 | nameof(p) | |
192 | { | |
193 | ||
194 | return (clnames[classify(p)]); | |
195 | } | |
196 | ||
197 | #ifndef PI0 | |
198 | nowexp(r) | |
199 | int *r; | |
200 | { | |
201 | if (r[0] == T_WEXP) { | |
202 | if (r[2] == NIL) | |
203 | error("Oct/hex allowed only on writeln/write calls"); | |
204 | else | |
205 | error("Width expressions allowed only in writeln/write calls"); | |
206 | return (1); | |
207 | } | |
208 | return (NIL); | |
209 | } | |
210 | #endif |