1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)clas.c 1.1 08/27/80"; 4 5 #include "whoami.h" 6 #include "0.h" 7 #include "tree.h" 8 9 /* 10 * This is the array of class 11 * names for the classes returned 12 * by classify. The order of the 13 * classes is the same as the base 14 * of the namelist, with special 15 * negative index entries for structures, 16 * scalars, pointers, sets and strings 17 * to be collapsed into. 18 */ 19 char *clnxxxx[] = 20 { 21 "file", /* -7 TFILE */ 22 "record", /* -6 TREC */ 23 "array", /* -5 TARY */ 24 "scalar", /* -4 TSCAL */ 25 "pointer", /* -3 TPTR */ 26 "set", /* -2 TSET */ 27 "string", /* -1 TSTR */ 28 "SNARK", /* 0 NIL */ 29 "Boolean", /* 1 TBOOL */ 30 "char", /* 2 TCHAR */ 31 "integer", /* 3 TINT */ 32 "real", /* 4 TREAL */ 33 "\"nil\"", /* 5 TNIL */ 34 }; 35 36 char **clnames = &clnxxxx[-(TFIRST)]; 37 38 /* 39 * Classify takes a pointer 40 * to a type and returns one 41 * of several interesting group 42 * classifications for easy use. 43 */ 44 classify(p1) 45 struct nl *p1; 46 { 47 register struct nl *p; 48 49 p = p1; 50 swit: 51 if (p == NIL) { 52 nocascade(); 53 return (NIL); 54 } 55 if (p == &nl[TSTR]) 56 return (TSTR); 57 if ( p == &nl[ TSET ] ) { 58 return TSET; 59 } 60 switch (p->class) { 61 case PTR: 62 return (TPTR); 63 case ARRAY: 64 if (p->type == nl+T1CHAR) 65 return (TSTR); 66 return (TARY); 67 case STR: 68 return (TSTR); 69 case SET: 70 return (TSET); 71 case RANGE: 72 p = p->type; 73 goto swit; 74 case TYPE: 75 if (p <= nl+TLAST) 76 return (p - nl); 77 panic("clas2"); 78 case FILET: 79 return (TFILE); 80 case RECORD: 81 return (TREC); 82 case SCAL: 83 return (TSCAL); 84 default: 85 panic("clas"); 86 } 87 } 88 89 #ifndef PI0 90 /* 91 * Is p a text file? 92 */ 93 text(p) 94 struct nl *p; 95 { 96 97 return (p != NIL && p->class == FILET && p->type == nl+T1CHAR); 98 } 99 #endif 100 101 /* 102 * Scalar returns a pointer to 103 * the the base scalar type of 104 * its argument if its argument 105 * is a SCALar else NIL. 106 */ 107 scalar(p1) 108 struct nl *p1; 109 { 110 register struct nl *p; 111 112 p = p1; 113 if (p == NIL) 114 return (NIL); 115 if (p->class == RANGE) 116 p = p->type; 117 if (p == NIL) 118 return (NIL); 119 return (p->class == SCAL ? p : NIL); 120 } 121 122 /* 123 * Isa tells whether p 124 * is one of a group of 125 * namelist classes. The 126 * classes wanted are specified 127 * by the characters in s. 128 * (Note that s would more efficiently, 129 * if less clearly, be given by a mask.) 130 */ 131 isa(p, s) 132 register struct nl *p; 133 char *s; 134 { 135 register i; 136 register char *cp; 137 138 if (p == NIL) 139 return (NIL); 140 /* 141 * map ranges down to 142 * the base type 143 */ 144 if (p->class == RANGE) 145 p = p->type; 146 /* 147 * the following character/class 148 * associations are made: 149 * 150 * s scalar 151 * b Boolean 152 * c character 153 * i integer 154 * d double (real) 155 * t set 156 */ 157 switch (p->class) { 158 case SET: 159 i = TDOUBLE+1; 160 break; 161 case SCAL: 162 i = 0; 163 break; 164 default: 165 i = p - nl; 166 } 167 if (i >= 0 && i <= TDOUBLE+1) { 168 i = "sbcidt"[i]; 169 cp = s; 170 while (*cp) 171 if (*cp++ == i) 172 return (1); 173 } 174 return (NIL); 175 } 176 177 /* 178 * Isnta is !isa 179 */ 180 isnta(p, s) 181 { 182 183 return (!isa(p, s)); 184 } 185 186 /* 187 * "shorthand" 188 */ 189 nameof(p) 190 { 191 192 return (clnames[classify(p)]); 193 } 194 195 #ifndef PI0 196 nowexp(r) 197 int *r; 198 { 199 if (r[0] == T_WEXP) { 200 if (r[2] == NIL) 201 error("Oct/hex allowed only on writeln/write calls"); 202 else 203 error("Width expressions allowed only in writeln/write calls"); 204 return (1); 205 } 206 return (NIL); 207 } 208 #endif 209