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: };
|
Last modified: 1985-08-27
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 2623 |
|