1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 #ifndef lint 4 static char sccsid[] = "@(#)clas.c 1.7 08/19/83"; 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 RANGE: 75 p = p->type; 76 goto swit; 77 case TYPE: 78 if (p <= nl+TLAST) 79 return (p - nl); 80 panic("clas2"); 81 case FILET: 82 return (TFILE); 83 case RECORD: 84 return (TREC); 85 case SCAL: 86 return (TSCAL); 87 default: 88 { 89 panic("clas"); 90 return(NIL); 91 } 92 } 93 } 94 95 #ifndef PI0 96 /* 97 * Is p a text file? 98 */ 99 text(p) 100 struct nl *p; 101 { 102 103 return (p != NIL && p->class == FILET && p->type == nl+T1CHAR); 104 } 105 #endif 106 107 /* 108 * Scalar returns a pointer to 109 * the the base scalar type of 110 * its argument if its argument 111 * is a SCALar else NIL. 112 */ 113 struct nl * 114 scalar(p1) 115 struct nl *p1; 116 { 117 register struct nl *p; 118 119 p = p1; 120 if (p == NLNIL) 121 return (NLNIL); 122 if (p->class == RANGE) 123 p = p->type; 124 if (p == NLNIL) 125 return (NLNIL); 126 return (p->class == SCAL ? p : NLNIL); 127 } 128 129 /* 130 * Isa tells whether p 131 * is one of a group of 132 * namelist classes. The 133 * classes wanted are specified 134 * by the characters in s. 135 * (Note that s would more efficiently, 136 * if less clearly, be given by a mask.) 137 */ 138 isa(p, s) 139 register struct nl *p; 140 char *s; 141 { 142 register i; 143 register char *cp; 144 145 if (p == NIL) 146 return (NIL); 147 /* 148 * map ranges down to 149 * the base type 150 */ 151 if (p->class == RANGE) 152 p = p->type; 153 /* 154 * the following character/class 155 * associations are made: 156 * 157 * s scalar 158 * b Boolean 159 * c character 160 * i integer 161 * d double (real) 162 * t set 163 */ 164 switch (p->class) { 165 case SET: 166 i = TDOUBLE+1; 167 break; 168 case SCAL: 169 i = 0; 170 break; 171 default: 172 i = p - nl; 173 } 174 if (i >= 0 && i <= TDOUBLE+1) { 175 i = "sbcidt"[i]; 176 cp = s; 177 while (*cp) 178 if (*cp++ == i) 179 return (1); 180 } 181 return (NIL); 182 } 183 184 /* 185 * Isnta is !isa 186 */ 187 isnta(p, s) 188 struct nl *p; 189 char *s; 190 { 191 192 return (!isa(p, s)); 193 } 194 195 /* 196 * "shorthand" 197 */ 198 char * 199 nameof(p) 200 struct nl *p; 201 { 202 203 return (clnames[classify(p)]); 204 } 205 206 #ifndef PI0 207 /* find out for sure what kind of node this is being passed 208 possibly several different kinds of node are passed to it */ 209 int nowexp(r) 210 struct tnode *r; 211 { 212 if (r->tag == T_WEXP) { 213 if (r->var_node.cptr == NIL) 214 error("Oct/hex allowed only on writeln/write calls"); 215 else 216 error("Width expressions allowed only in writeln/write calls"); 217 return (1); 218 } 219 return (NIL); 220 } 221 #endif 222 223 /* 224 * is a variable a local, a formal parameter, or a global? 225 * all this from just the offset: 226 * globals are at levels 0 or 1 227 * positives are parameters 228 * negative evens are locals 229 */ 230 /*ARGSUSED*/ 231 whereis( offset , other_flags ) 232 int offset; 233 char other_flags; 234 { 235 236 # ifdef OBJ 237 return ( offset >= 0 ? PARAMVAR : LOCALVAR ); 238 # endif OBJ 239 # ifdef PC 240 switch ( other_flags & ( NGLOBAL | NPARAM | NLOCAL | NNLOCAL) ) { 241 default: 242 panic( "whereis" ); 243 case NGLOBAL: 244 return GLOBALVAR; 245 case NPARAM: 246 return PARAMVAR; 247 case NNLOCAL: 248 return NAMEDLOCALVAR; 249 case NLOCAL: 250 return LOCALVAR; 251 } 252 # endif PC 253 } 254