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) 06/05/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 } 272