1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
   2: 
   3: /* $Header: b2ana.c,v 1.4 85/08/22 16:54:05 timo Exp $ */
   4: 
   5: /* Prepare for code generation -- find out which tags are targets */
   6: 
   7: #include "b.h"
   8: #include "b1obj.h"
   9: #include "b2nod.h"
  10: #include "b2gen.h" /* Must be after b2nod.h */
  11: #include "b3err.h"
  12: #include "b3env.h"
  13: #include "b3sou.h" /* For get_pname */
  14: 
  15: 
  16: Visible int nextvarnumber; /* Counts local targets (including formals) */
  17: 
  18: Visible value formals, locals, globals, mysteries, refinements;
  19: 
  20: 
  21: Visible value *setup(t) parsetree t; {
  22:     typenode n= Nodetype(t);
  23:     bool in_prmnv= !Unit(n);
  24:     nextvarnumber= 0;
  25:     formals= mk_elt();
  26:     mysteries= mk_elt();
  27:     if (in_prmnv) {
  28:         globals= copy(prmnv->tab);
  29:         locals= Vnil;
  30:         refinements= mk_elt();
  31:         return Command(n) ? &globals : Pnil;
  32:     } else {
  33:         globals= mk_elt();
  34:         locals= mk_elt();
  35:         refinements=
  36:             copy(*Branch(t, n == HOW_TO ? HOW_R_NAMES : FPR_R_NAMES));
  37:         unit_context(t);
  38:         return &locals;
  39:     }
  40: }
  41: 
  42: Hidden Procedure unit_context(t) parsetree t; {
  43:     cntxt= In_unit;
  44:     release(uname); uname= get_pname(t);
  45: }
  46: 
  47: Visible Procedure cleanup() {
  48:     release(formals);
  49:     release(locals);
  50:     release(globals);
  51:     release(mysteries);
  52:     release(refinements);
  53: }
  54: 
  55: /* ********************************************************************	*/
  56: 
  57: /* Analyze parse tree, finding the targets and formal parameters.
  58:    Formal parameters of HOW'TO's are of course found in the unit heading.
  59:    Formal parameters of YIELDs and TESTs are treated as local targets.
  60:    Global targets are also easily found: they are mentioned in a SHARE command.
  61:    Local targets appear on their own or in collateral forms after PUT IN,
  62:    DRAW or CHOOSE, or as bound tags after FOR, SOME, EACH or NO.
  63:    Note that DELETE x, REMOVE e FROM x, or PUT e IN x[k] (etc.) don't
  64:    introduce local targets, because in all these cases x must have been
  65:    initialized first.  This speeds up our task of finding targets,
  66:    since we don't have to visit all nodes: only nodes that may contain
  67:    commands or tests, and the positions mentioned here, need be visited.
  68:    (And of course unit headings).
  69:    We don't have to look for refinements since these are already known
  70:    from the unit heading.
  71:  */
  72: 
  73: Hidden Procedure a_tag(name, targs) value name; value *targs; {
  74:     value *aa; int varnumber;
  75:     if (locals != Vnil && envassoc(locals, name)) return;
  76:     if (envassoc(globals, name)) return;
  77:     if (envassoc(formals, name)) return;
  78:     if (envassoc(refinements, name)) {
  79:         if (targs != &mysteries)
  80:             fixerr(MESS(4600, "a refinement may not be used as a target"));
  81:         return;
  82:     }
  83:     if (aa= envassoc(mysteries, name)) {
  84:         if (targs == &mysteries) return;
  85:         varnumber= SmallIntVal(*aa);
  86:         e_delete(&mysteries, name);
  87:     }
  88:     else if (targs != &globals) varnumber= nextvarnumber++;
  89:     else varnumber= 0;
  90:     e_replace(MkSmallInt(varnumber), targs, name);
  91: }
  92: 
  93: Hidden Procedure a_fpr_formals(t) parsetree t; {
  94:     typenode n= Nodetype(t);
  95:     switch (n) {
  96:     case TAG:
  97:         break;
  98:     case MONF: case MONPRD:
  99:         analyze(*Branch(t, MON_RIGHT), &locals);
 100:         break;
 101:     case DYAF: case DYAPRD:
 102:         analyze(*Branch(t, DYA_LEFT), &locals);
 103:         analyze(*Branch(t, DYA_RIGHT), &locals);
 104:         break;
 105:     default: syserr(MESS(4601, "a_fpr_formals"));
 106:     }
 107: }
 108: 
 109: Visible Procedure analyze(t, targs) parsetree t; value *targs; {
 110:     typenode nt; string s; char c; int n, k, len; value v;
 111:     if (!Is_node(t) || !still_ok) return;
 112:     nt= Nodetype(t);
 113:     if (nt < 0 || nt >= NTYPES) syserr(MESS(4602, "analyze bad tree"));
 114:     s= gentab[nt];
 115:     if (s == NULL) return;
 116:     n= First_fieldnr;
 117:     while ((c= *s++) != '\0' && still_ok) {
 118:         switch (c) {
 119:         case '0':
 120:         case '1':
 121:         case '2':
 122:         case '3':
 123:         case '4':
 124:         case '5':
 125:         case '6':
 126:         case '7':
 127:         case '8':
 128:         case '9':
 129:             n= (c - '0') + First_fieldnr;
 130:             break;
 131:         case 'c':
 132:             v= *Branch(t, n);
 133:             if (v != Vnil) {
 134:                 len= Nfields(v);
 135:                 for (k= 0; k < len; ++k)
 136:                     analyze(*Field(v, k), targs);
 137:             }
 138:             ++n;
 139:             break;
 140:         case '#':
 141:             curlino= *Branch(t, n);
 142:             /* Fall through */
 143:         case 'l':
 144:         case 'v':
 145:             ++n;
 146:             break;
 147:         case 'm':
 148:             analyze(*Branch(t, n), &mysteries);
 149:             ++n;
 150:             break;
 151:         case 'g':
 152:             analyze(*Branch(t, n), &globals);
 153:             ++n;
 154:             break;
 155:         case '!':
 156:             analyze(*Branch(t, n),
 157:                 locals != Vnil ? &locals : &globals);
 158:             ++n;
 159:             break;
 160:         case 'x':
 161:             curline= *Branch(t, n);
 162:             /* Fall through */
 163:         case 'a':
 164:         case 'u':
 165:             analyze(*Branch(t, n), targs);
 166:             ++n;
 167:             break;
 168:         case 't':
 169:             analyze(*Branch(t, n), Pnil);
 170:             ++n;
 171:             break;
 172:         case 'f':
 173:             a_fpr_formals(*Branch(t, n));
 174:             ++n;
 175:             break;
 176:         case 'h':
 177:             v= *Branch(t, n);
 178:             if (v != Vnil && Is_text(v))
 179:                 a_tag(v, &formals);
 180:             else
 181:                 analyze(v, &formals);
 182:             ++n;
 183:             break;
 184:         case '=':
 185:             *Branch(t, n)= MkSmallInt(nextvarnumber);
 186:             ++n;
 187:             break;
 188:         case 'T':
 189:             if (targs != Pnil)
 190:                 a_tag((value)*Branch(t, TAG_NAME), targs);
 191:             break;
 192:         }
 193:     }
 194: }
 195: 
 196: /* ********************************************************************	*/
 197: 
 198: /* Table describing the actions of the fixer for each node type */
 199: 
 200: 
 201: /*
 202: 	LIST OF CODES AND THEIR MEANING
 203: 
 204: 	char	fix		n?	analyze
 205: 
 206: 	0-9			n= c-'0'
 207: 
 208: 	#	set curlino	++n	set curlino
 209: 	=			++n	set to nextvarnum
 210: 	!	locate		++n	analyze; force targs= &local
 211: 	a	locate		++n	analyze
 212: 	c	collateral	++n	analyze collateral
 213: 	f	fpr_formals	++n	a_fpr_formals
 214: 	g			++n	global
 215: 	h			++n	how'to formal
 216: 	l	locate		++n
 217: 	m	actual param	++n	mystery
 218: 	t	test		++n	analyze; set targs= 0
 219: 	u	unit		++n	analyze
 220: 	v	evaluate	++n
 221: 	x	execute		++n	analyze
 222: 
 223: 	?	special code for UNPARSED
 224: 	C	special code for comparison
 225: 	D	special code for DYAF
 226: 	E	special code for DYAPRD
 227: 	G	jumpto(l1)
 228: 	H	here(&l1)
 229: 	I	if (*Branch(t, n) != NilTree) jump2here(t)
 230: 	J	jump2here(t)
 231: 	K	hold(&st)
 232: 	L	let_go(&st)
 233: 	M	special code for MONF
 234: 	N	special code for MONPRD
 235: 	R	if (!reachable()) error("command cannot be reached")
 236: 	S	jumpto(Stop)
 237: 	T	special code for TAG
 238: 	U	special code for user-defined-command
 239: 	V	visit(t)
 240: 	W	visit2(t, seterr(1))
 241: 	X	visit(t) or lvisit(t) depending on flag
 242: 	Y	special code for YIELD/TEST
 243: 	Z	special code for refinement
 244: 
 245: */
 246: 
 247: 
 248: Visible string gentab[]= {
 249: 
 250:     /* HOW_TO */ "1h3xSu6=",
 251:     /* YIELD */ "2fV4xYu7=",
 252:     /* TEST */ "2fV4xYu7=",
 253:     /* REFINEMENT */ "H2xZSu",
 254: 
 255:     /* Commands */
 256: 
 257:     /* SUITE */ "#RVx3x",
 258:     /* PUT */ "vaV",
 259:     /* INSERT */ "vlV",
 260:     /* REMOVE */ "vlV",
 261:     /* CHOOSE */ "avV",
 262:     /* DRAW */ "aV",
 263:     /* SET_RANDOM */ "vV",
 264:     /* DELETE */ "lV",
 265:     /* CHECK */ "tV",
 266:     /* SHARE */ "g",
 267: 
 268:     /* WRITE */ "1vV",
 269:     /* READ */ "avV",
 270:     /* READ_RAW */ "aV",
 271: 
 272:     /* IF */ "tV2xJ",
 273:     /* WHILE */ "HtV2xGJ",
 274:     /* FOR */ "avHV3xGJ",
 275: 
 276:     /* SELECT */ "1x",
 277:     /* TEST_SUITE */ "#tW3xKIxL",
 278:     /* ELSE */ "#2x",
 279: 
 280:     /* QUIT */ "VS",
 281:     /* RETURN */ "vVS",
 282:     /* REPORT */ "tVS",
 283:     /* SUCCEED */ "VS",
 284:     /* FAIL */ "VS",
 285: 
 286:     /* USER_COMMAND */ "1mUV",
 287:     /* EXTENDED_COMMAND */ "1cV",
 288: 
 289:     /* Expressions, targets, tests */
 290: 
 291:     /* TAG */ "T",
 292:     /* COMPOUND */ "a",
 293: 
 294:     /* Expressions, targets */
 295: 
 296:     /* COLLATERAL */ "cX",
 297:     /* SELECTION */ "lvX",
 298:     /* BEHEAD */ "lvX",
 299:     /* CURTAIL */ "lvX",
 300: 
 301:     /* Expressions, tests */
 302: 
 303:     /* UNPARSED */ "?",
 304: 
 305:     /* Expressions */
 306: 
 307:     /* MONF */ "M1vV",
 308:     /* DYAF */ "Dv2vV",
 309:     /* NUMBER */ "V",
 310:     /* TEXT_DIS */ "1v",
 311:     /* TEXT_LIT */ "1vV",
 312:     /* TEXT_CONV */ "vvV",
 313:     /* ELT_DIS */ "V",
 314:     /* LIST_DIS */ "cV",
 315:     /* RANGE_DIS */ "vvV",
 316:     /* TAB_DIS */ "cV",
 317: 
 318:     /* Tests */
 319: 
 320:     /* AND */ "tVtJ",
 321:     /* OR */ "tVtJ",
 322:     /* NOT */ "tV",
 323:     /* SOME_IN */ "!vHVtGJ",
 324:     /* EACH_IN */ "!vHVtGJ",
 325:     /* NO_IN */ "!vHVtGJ",
 326:     /* SOME_PARSING */ "!vHVtGJ",
 327:     /* EACH_PARSING */ "!vHVtGJ",
 328:     /* NO_PARSING */ "!vHVtGJ",
 329:     /* MONPRD */ "N1vV",
 330:     /* DYAPRD */ "Ev2vV",
 331:     /* LESS_THAN */ "vvVC",
 332:     /* AT_MOST */ "vvVC",
 333:     /* GREATER_THAN */ "vvVC",
 334:     /* AT_LEAST */ "vvVC",
 335:     /* EQUAL */ "vvVC",
 336:     /* UNEQUAL */ "vvVC",
 337:     /* Nonode */ "",
 338: 
 339:     /* TAGformal */ "T",
 340:     /* TAGlocal */ "T",
 341:     /* TAGglobal */ "T",
 342:     /* TAGmystery */ "T",
 343:     /* TAGrefinement */ "T",
 344:     /* TAGzerfun */ "T",
 345:     /* TAGzerprd */ "T",
 346: 
 347:     /* ACTUAL */ "1mm",
 348:     /* FORMAL */ "1hh",
 349: };

Defined functions

a_fpr_formals defined in line 93; used 1 times
a_tag defined in line 73; used 2 times
analyze defined in line 109; used 11 times
cleanup defined in line 47; used 1 times
setup defined in line 21; used 2 times
unit_context defined in line 42; used 1 times
  • in line 37

Defined variables

formals defined in line 18; used 5 times
gentab defined in line 248; used 1 times
globals defined in line 18; used 8 times
locals defined in line 18; used 11 times
mysteries defined in line 18; used 7 times
nextvarnumber defined in line 16; used 3 times
refinements defined in line 18; used 4 times
Last modified: 1985-08-27
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 954
Valid CSS Valid XHTML 1.0 Strict