|
|
1.1 ! root 1: /* Copyright (c) 1979 Regents of the University of California */ ! 2: ! 3: static char sccsid[] = "@(#)clas.c 1.1 8/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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.