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 * 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 */ 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 * 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 */ 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*/ 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