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