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