2.9BSD - /usr/src/ucb/pascal/pxp/yyid.c

   1: #
   2: /*
   3:  * pi - Pascal interpreter code translator
   4:  *
   5:  * Charles Haley, Bill Joy UCB
   6:  * Version 1.2 January 1979
   7:  *
   8:  *
   9:  * pxp - Pascal execution profiler
  10:  *
  11:  * Bill Joy UCB
  12:  * Version 1.2 January 1979
  13:  */
  14: 
  15: #include "0.h"
  16: #include "yy.h"
  17: 
  18: #ifdef PI
  19: extern  int *yypv;
  20: /*
  21:  * Determine whether the identifier whose name
  22:  * is "cp" can possibly be a kind, which is a
  23:  * namelist class.  We look through the symbol
  24:  * table for the first instance of cp as a non-field,
  25:  * and at all instances of cp as a field.
  26:  * If any of these are ok, we return true, else false.
  27:  * It would be much better to handle with's correctly,
  28:  * even to just know whether we are in a with at all.
  29:  *
  30:  * Note that we don't disallow constants on the lhs of assignment.
  31:  */
  32: identis(cp, kind)
  33:     register char *cp;
  34:     int kind;
  35: {
  36:     register struct nl *p;
  37:     int i;
  38: 
  39:     /*
  40: 	 * Cp is NIL when error recovery inserts it.
  41: 	 */
  42:     if (cp == NIL)
  43:         return (1);
  44: 
  45:     /*
  46: 	 * Record kind we want for possible later use by yyrecover
  47: 	 */
  48:     yyidwant = kind;
  49:     yyidhave = NIL;
  50:     i = cp & 077;
  51:     for (p = disptab[i]; p != NIL; p = p->nl_next)
  52:         if (p->symbol == cp) {
  53:             if (yyidok(p, kind))
  54:                 goto gotit;
  55:             if (p->class != FIELD && p->class != BADUSE)
  56:                 break;
  57:         }
  58:     if (p != NIL)
  59:         for (p = p->nl_next; p != NIL; p = p->nl_next)
  60:             if (p->symbol == cp && p->class == FIELD && yyidok(p, kind))
  61:                 goto gotit;
  62:     return (0);
  63: gotit:
  64:     if (p->class == BADUSE && !Recovery) {
  65:         yybadref(p, OY.Yyeline);
  66:         yypv[0] = NIL;
  67:     }
  68:     return (1);
  69: }
  70: 
  71: /*
  72:  * A bad reference to the identifier cp on line
  73:  * line and use implying the addition of kindmask
  74:  * to the mask of kind information.
  75:  */
  76: yybaduse(cp, line, kindmask)
  77:     register char *cp;
  78:     int line, kindmask;
  79: {
  80:     register struct nl *p, *oldp;
  81:     int i;
  82: 
  83:     i = cp & 077;
  84:     for (p = disptab[i]; p != NIL; p = p->nl_next)
  85:         if (p->symbol == cp)
  86:             break;
  87:     oldp = p;
  88:     if (p == NIL || p->class != BADUSE)
  89:         p = enter(defnl(cp, BADUSE, 0, 0));
  90:     p->value[NL_KINDS] =| kindmask;
  91:     yybadref(p, line);
  92:     return (oldp);
  93: }
  94: 
  95: struct  udinfo ud { 'XX', 'XX', 0};
  96: /*
  97:  * Record a reference to an undefined identifier,
  98:  * or one which is improperly used.
  99:  */
 100: yybadref(p, line)
 101:     register struct nl *p;
 102:     int line;
 103: {
 104:     register struct udinfo *udp;
 105: 
 106:     if (p->chain != NIL && p->chain->ud_line == line)
 107:         return;
 108:     udp = esavestr(&ud);
 109:     udp->ud_line = line;
 110:     udp->ud_next = p->chain;
 111:     p->chain = udp;
 112: }
 113: 
 114: #define varkinds    ((1<<CONST)|(1<<VAR)|(1<<REF)|(1<<ARRAY)|(1<<PTR)|(1<<RECORD)|(1<<FIELD)|(1<<FUNC)|(1<<FVAR))
 115: /*
 116:  * Is the symbol in the p entry of the namelist
 117:  * even possibly a kind kind?  If not, update
 118:  * what we have based on this encounter.
 119:  */
 120: yyidok(p, kind)
 121:     register struct nl *p;
 122:     int kind;
 123: {
 124: 
 125:     if (p->class == BADUSE) {
 126:         if (kind == VAR)
 127:             return (p->value[0] & varkinds);
 128:         return (p->value[0] & (1 << kind));
 129:     }
 130:     if (yyidok1(p, kind))
 131:         return (1);
 132:     if (yyidhave != NIL)
 133:         yyidhave = IMPROPER;
 134:     else
 135:         yyidhave = p->class;
 136:     return (0);
 137: }
 138: 
 139: yyidok1(p, kind)
 140:     register struct nl *p;
 141:     int kind;
 142: {
 143:     int i;
 144: 
 145:     switch (kind) {
 146:         case FUNC:
 147:             if (p->class == FVAR)
 148:                 return(1);
 149:         case CONST:
 150:         case TYPE:
 151:         case PROC:
 152:         case FIELD:
 153:             return (p->class == kind);
 154:         case VAR:
 155:             return (p->class == CONST || yyisvar(p, NIL));
 156:         case ARRAY:
 157:         case RECORD:
 158:             return (yyisvar(p, kind));
 159:         case PTRFILE:
 160:             return (yyisvar(p, PTR) || yyisvar(p, FILE));
 161:     }
 162: }
 163: 
 164: yyisvar(p, class)
 165:     register struct nl *p;
 166:     int class;
 167: {
 168: 
 169:     switch (p->class) {
 170:         case FIELD:
 171:         case VAR:
 172:         case REF:
 173:         case FVAR:
 174:         /*
 175: 		 * We would prefer to return
 176: 		 * parameterless functions only.
 177: 		 */
 178:         case FUNC:
 179:             return (class == NIL || (p->type != NIL && p->type->class == class));
 180:     }
 181:     return (0);
 182: }
 183: #endif
 184: #ifdef PXP
 185: #ifndef DEBUG
 186: identis()
 187: {
 188: 
 189:     return (1);
 190: }
 191: #endif
 192: #ifdef DEBUG
 193: extern  char *classes[];
 194: 
 195: char    kindchars[] "UCTVAQRDPF";
 196: /*
 197:  * Fake routine "identis" for pxp when testing error recovery.
 198:  * Looks at letters in variable names to answer questions
 199:  * about attributes.  Mapping is
 200:  *	C	const_id
 201:  *	T	type_id
 202:  *	V	var_id		also if any of AQRDF
 203:  *	A	array_id
 204:  *	Q	ptr_id
 205:  *	R	record_id
 206:  *	D	field_id	D for "dot"
 207:  *	P	proc_id
 208:  *	F	func_id
 209:  */
 210: identis(cp, kind)
 211:     register char *cp;
 212:     int kind;
 213: {
 214:     register char *dp;
 215:     char kindch;
 216: 
 217:     /*
 218: 	 * Don't do anything unless -T
 219: 	 */
 220:     if (!typetest)
 221:         return (1);
 222: 
 223:     /*
 224: 	 * Inserted symbols are always correct
 225: 	 */
 226:     if (cp == NIL)
 227:         return (1);
 228:     /*
 229: 	 * Set up the names for error messages
 230: 	 */
 231:     yyidwant = classes[kind];
 232:     for (dp = kindchars; *dp; dp++)
 233:         if (any(cp, *dp)) {
 234:             yyidhave = classes[dp - kindchars];
 235:             break;
 236:         }
 237: 
 238:     /*
 239: 	 * U in the name means undefined
 240: 	 */
 241:     if (any(cp, 'U'))
 242:         return (0);
 243: 
 244:     kindch = kindchars[kind];
 245:     if (kindch == 'V')
 246:         for (dp = "AQRDF"; *dp; dp++)
 247:             if (any(cp, *dp))
 248:                 return (1);
 249:     return (any(cp, kindch));
 250: }
 251: #endif
 252: #endif

Defined functions

Defined variables

Defined macros