1747Speter /* Copyright (c) 1979 Regents of the University of California */ 2747Speter 3*14728Sthien #ifndef lint 4*14728Sthien static char sccsid[] = "@(#)clas.c 1.7 08/19/83"; 5*14728Sthien #endif 6747Speter 7747Speter #include "whoami.h" 8747Speter #include "0.h" 9747Speter #include "tree.h" 10*14728Sthien #include "tree_ty.h" 11747Speter 12747Speter /* 13747Speter * This is the array of class 14747Speter * names for the classes returned 15747Speter * by classify. The order of the 16747Speter * classes is the same as the base 17747Speter * of the namelist, with special 18747Speter * negative index entries for structures, 19747Speter * scalars, pointers, sets and strings 20747Speter * to be collapsed into. 21747Speter */ 22747Speter char *clnxxxx[] = 23747Speter { 24747Speter "file", /* -7 TFILE */ 25747Speter "record", /* -6 TREC */ 26747Speter "array", /* -5 TARY */ 27747Speter "scalar", /* -4 TSCAL */ 28747Speter "pointer", /* -3 TPTR */ 29747Speter "set", /* -2 TSET */ 30747Speter "string", /* -1 TSTR */ 31747Speter "SNARK", /* 0 NIL */ 32747Speter "Boolean", /* 1 TBOOL */ 33747Speter "char", /* 2 TCHAR */ 34747Speter "integer", /* 3 TINT */ 35747Speter "real", /* 4 TREAL */ 36747Speter "\"nil\"", /* 5 TNIL */ 37747Speter }; 38747Speter 39747Speter char **clnames = &clnxxxx[-(TFIRST)]; 40747Speter 41747Speter /* 42747Speter * Classify takes a pointer 43747Speter * to a type and returns one 44747Speter * of several interesting group 45747Speter * classifications for easy use. 46747Speter */ 47747Speter classify(p1) 48747Speter struct nl *p1; 49747Speter { 50747Speter register struct nl *p; 51747Speter 52747Speter p = p1; 53747Speter swit: 54*14728Sthien if (p == NLNIL) { 55747Speter nocascade(); 56747Speter return (NIL); 57747Speter } 58747Speter if (p == &nl[TSTR]) 59747Speter return (TSTR); 60747Speter if ( p == &nl[ TSET ] ) { 61747Speter return TSET; 62747Speter } 63747Speter switch (p->class) { 64747Speter case PTR: 65747Speter return (TPTR); 66747Speter case ARRAY: 67747Speter if (p->type == nl+T1CHAR) 68747Speter return (TSTR); 69747Speter return (TARY); 70747Speter case STR: 71747Speter return (TSTR); 72747Speter case SET: 73747Speter return (TSET); 74747Speter case RANGE: 75747Speter p = p->type; 76747Speter goto swit; 77747Speter case TYPE: 78747Speter if (p <= nl+TLAST) 79747Speter return (p - nl); 80747Speter panic("clas2"); 81747Speter case FILET: 82747Speter return (TFILE); 83747Speter case RECORD: 84747Speter return (TREC); 85747Speter case SCAL: 86747Speter return (TSCAL); 87747Speter default: 88*14728Sthien { 89*14728Sthien panic("clas"); 90*14728Sthien return(NIL); 91*14728Sthien } 92747Speter } 93747Speter } 94747Speter 95747Speter #ifndef PI0 96747Speter /* 97747Speter * Is p a text file? 98747Speter */ 99747Speter text(p) 100747Speter struct nl *p; 101747Speter { 102747Speter 103747Speter return (p != NIL && p->class == FILET && p->type == nl+T1CHAR); 104747Speter } 105747Speter #endif 106747Speter 107747Speter /* 108747Speter * Scalar returns a pointer to 109747Speter * the the base scalar type of 110747Speter * its argument if its argument 111747Speter * is a SCALar else NIL. 112747Speter */ 113*14728Sthien struct nl * 114747Speter scalar(p1) 115747Speter struct nl *p1; 116747Speter { 117747Speter register struct nl *p; 118747Speter 119747Speter p = p1; 120*14728Sthien if (p == NLNIL) 121*14728Sthien return (NLNIL); 122747Speter if (p->class == RANGE) 123747Speter p = p->type; 124*14728Sthien if (p == NLNIL) 125*14728Sthien return (NLNIL); 126*14728Sthien return (p->class == SCAL ? p : NLNIL); 127747Speter } 128747Speter 129747Speter /* 130747Speter * Isa tells whether p 131747Speter * is one of a group of 132747Speter * namelist classes. The 133747Speter * classes wanted are specified 134747Speter * by the characters in s. 135747Speter * (Note that s would more efficiently, 136747Speter * if less clearly, be given by a mask.) 137747Speter */ 138747Speter isa(p, s) 139747Speter register struct nl *p; 140747Speter char *s; 141747Speter { 142747Speter register i; 143747Speter register char *cp; 144747Speter 145747Speter if (p == NIL) 146747Speter return (NIL); 147747Speter /* 148747Speter * map ranges down to 149747Speter * the base type 150747Speter */ 151747Speter if (p->class == RANGE) 152747Speter p = p->type; 153747Speter /* 154747Speter * the following character/class 155747Speter * associations are made: 156747Speter * 157747Speter * s scalar 158747Speter * b Boolean 159747Speter * c character 160747Speter * i integer 161747Speter * d double (real) 162747Speter * t set 163747Speter */ 164747Speter switch (p->class) { 165747Speter case SET: 166747Speter i = TDOUBLE+1; 167747Speter break; 168747Speter case SCAL: 169747Speter i = 0; 170747Speter break; 171747Speter default: 172747Speter i = p - nl; 173747Speter } 174747Speter if (i >= 0 && i <= TDOUBLE+1) { 175747Speter i = "sbcidt"[i]; 176747Speter cp = s; 177747Speter while (*cp) 178747Speter if (*cp++ == i) 179747Speter return (1); 180747Speter } 181747Speter return (NIL); 182747Speter } 183747Speter 184747Speter /* 185747Speter * Isnta is !isa 186747Speter */ 187747Speter isnta(p, s) 188*14728Sthien struct nl *p; 189*14728Sthien char *s; 190747Speter { 191747Speter 192747Speter return (!isa(p, s)); 193747Speter } 194747Speter 195747Speter /* 196747Speter * "shorthand" 197747Speter */ 198*14728Sthien char * 199747Speter nameof(p) 200*14728Sthien struct nl *p; 201747Speter { 202747Speter 203747Speter return (clnames[classify(p)]); 204747Speter } 205747Speter 206747Speter #ifndef PI0 207*14728Sthien /* find out for sure what kind of node this is being passed 208*14728Sthien possibly several different kinds of node are passed to it */ 209*14728Sthien int nowexp(r) 210*14728Sthien struct tnode *r; 211747Speter { 212*14728Sthien if (r->tag == T_WEXP) { 213*14728Sthien if (r->var_node.cptr == NIL) 214747Speter error("Oct/hex allowed only on writeln/write calls"); 215747Speter else 216747Speter error("Width expressions allowed only in writeln/write calls"); 217747Speter return (1); 218747Speter } 219747Speter return (NIL); 220747Speter } 221747Speter #endif 2223276Smckusic 2233276Smckusic /* 2243825Speter * is a variable a local, a formal parameter, or a global? 2253276Smckusic * all this from just the offset: 2263825Speter * globals are at levels 0 or 1 2273276Smckusic * positives are parameters 2283276Smckusic * negative evens are locals 2293276Smckusic */ 230*14728Sthien /*ARGSUSED*/ 231*14728Sthien whereis( offset , other_flags ) 2323825Speter int offset; 2337920Smckusick char other_flags; 2343276Smckusic { 2353276Smckusic 2363825Speter # ifdef OBJ 2373825Speter return ( offset >= 0 ? PARAMVAR : LOCALVAR ); 2383825Speter # endif OBJ 2393825Speter # ifdef PC 2409127Smckusick switch ( other_flags & ( NGLOBAL | NPARAM | NLOCAL | NNLOCAL) ) { 241*14728Sthien default: 242*14728Sthien panic( "whereis" ); 2433825Speter case NGLOBAL: 2443825Speter return GLOBALVAR; 2453825Speter case NPARAM: 2463825Speter return PARAMVAR; 2479127Smckusick case NNLOCAL: 2489127Smckusick return NAMEDLOCALVAR; 2493825Speter case NLOCAL: 2503825Speter return LOCALVAR; 2513825Speter } 2523825Speter # endif PC 2533276Smckusic } 254