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