# 2.11BSD#431 - /usr/src/ucb/pascal/pi/clas.c

##### Functions

    classify          X
    isa               X
    isnta             X
    nameof            X
    nowexp            X
    scalar            X
    text              X

##### Variables

    clnames           X
    clnxxxx           X

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

#### Defined functions

classify defined in line 51; used 19 times

- in line 196
- in /usr/src/ucb/pascal/pi/const.c line 109
- in /usr/src/ucb/pascal/pi/conv.c line 65-68(2), 86
- in /usr/src/ucb/pascal/pi/fdec.c line 94
- in /usr/src/ucb/pascal/pi/func.c line 169
- in /usr/src/ucb/pascal/pi/proc.c line 306, 459, 533, 607, 640, 672
- in /usr/src/ucb/pascal/pi/rval.c line 143, 393-394(2)
- in /usr/src/ucb/pascal/pi/stat.c line 279
- in /usr/src/ucb/pascal/pi/type.c line 208-209(2)

isa defined in line 135; used 21 times

- in line 187
- in /usr/src/ucb/pascal/pi/call.c line 77
- in /usr/src/ucb/pascal/pi/const.c line 52-54(2)
- in /usr/src/ucb/pascal/pi/cset.c line 63, 71
- in /usr/src/ucb/pascal/pi/func.c line 127, 158-162(2), 169, 182-186(2), 194
- in /usr/src/ucb/pascal/pi/proc.c line 450
- in /usr/src/ucb/pascal/pi/rval.c line 235, 303-305(4)
- in /usr/src/ucb/pascal/pi/stat.c line 240
- in /usr/src/ucb/pascal/pi/type.c line 237

isnta defined in line 184; used 32 times

- in /usr/src/ucb/pascal/pi/case.c line 54
- in /usr/src/ucb/pascal/pi/const.c line 167
- in /usr/src/ucb/pascal/pi/cset.c line 67, 78
- in /usr/src/ucb/pascal/pi/func.c line 129, 141, 150, 201, 208, 215
- in /usr/src/ucb/pascal/pi/proc.c line 244, 254, 308, 631, 655, 695
- in /usr/src/ucb/pascal/pi/rval.c line 229, 243, 256-260(2), 272-276(2), 319-323(2), 336-340(2)
- in /usr/src/ucb/pascal/pi/stat.c line 333, 433, 486, 521, 548
- in /usr/src/ucb/pascal/pi/type.c line 243

nameof defined in line 193; used 58 times

- in /usr/src/ucb/pascal/pi/case.c line 55
- in /usr/src/ucb/pascal/pi/const.c line 168
- in /usr/src/ucb/pascal/pi/cset.c line 68
- in /usr/src/ucb/pascal/pi/fdec.c line 164, 357
- in /usr/src/ucb/pascal/pi/func.c line 130, 142, 151, 166, 178, 198-202(2), 209, 216, 232, 239
- in /usr/src/ucb/pascal/pi/lval.c line 115, 153, 175
- in /usr/src/ucb/pascal/pi/proc.c line 136, 245, 255, 499, 520, 534, 557, 608, 632, 641, 656, 673, 688, 696, 711, 747-752(2), 758
- in /usr/src/ucb/pascal/pi/rval.c line 230, 244, 257-261(2), 273-277(2), 320-324(2), 337-341(2), 472
- in /usr/src/ucb/pascal/pi/stat.c line 185, 334, 434, 487, 522, 549
- in /usr/src/ucb/pascal/pi/type.c line 146, 212(2), 245

nowexp defined in line 200; used 2 times

- in /usr/src/ucb/pascal/pi/lval.c line 39
- in /usr/src/ucb/pascal/pi/rval.c line 41

scalar defined in line 111; used 6 times

- in /usr/src/ucb/pascal/pi/conv.c line 101(2)
- in /usr/src/ucb/pascal/pi/rval.c line 412(2)
- in /usr/src/ucb/pascal/pi/type.c line 216(2)

text defined in line 97; used 5 times

- in /usr/src/ucb/pascal/pi/fdec.c line 366
- in /usr/src/ucb/pascal/pi/func.c line 231
- in /usr/src/ucb/pascal/pi/proc.c line 544, 687, 710

#### Defined variables

clnames defined in line 43; used 1 times

- in line 196

clnxxxx defined in line 26; used 1 times

- in line 43

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 703 |