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