|
|
1.1 ! root 1: /* -*- Mode: C -*- */ ! 2: /* ! 3: $Source: /usr3/lang/benson/work/stripped_cfront/RCS/tree_walk.c,v $ $RCSfile: tree_walk.c,v $ ! 4: $Revision: 1.1 $ $Date: 89/11/20 08:51:06 $ ! 5: $Author: benson $ $Locker: $ ! 6: $State: Exp $ ! 7: */ ! 8: ! 9: /* Utilities for tree-walking */ ! 10: ! 11: #include "cfront.h" ! 12: #include "tree_walk.H" ! 13: #include <stdarg.h> ! 14: #include "hash.h" ! 15: // #include <alloca.h> ! 16: // need to add an explicit call of free ! 17: #include <streamdefs.h> ! 18: #include <malloc.h> ! 19: ! 20: class walker { ! 21: tree_walk_control control; ! 22: Pnode orig_addr; ! 23: Hash *nodes_seen_hash; ! 24: int depth; ! 25: int made_ht; ! 26: tree_walk_tree * cur_tree; ! 27: public: ! 28: walker(tree_walk_control& c) ; ! 29: ! 30: ~walker () { ! 31: if(made_ht) delete nodes_seen_hash; ! 32: } ! 33: tree_node_action walk (Pnode&); ! 34: tree_node_action walk_ (Pnode& n) ! 35: { ! 36: if(n) { ! 37: int save_depth = depth; ! 38: tree_walk_tree * save_cur_tree = cur_tree; ! 39: ! 40: depth ++; ! 41: if(control.alloc_stack_bytes) { ! 42: cur_tree = (tree_walk_tree *) ! 43: // alloca (control.alloc_stack_bytes + sizeof (tree_walk_tree)); ! 44: malloc(control.alloc_stack_bytes + sizeof (tree_walk_tree)); ! 45: cur_tree->parent = save_cur_tree; ! 46: } ! 47: tree_node_action r = walk(n); ! 48: depth = save_depth; ! 49: return r; ! 50: } else return tna_continue; ! 51: } ! 52: ! 53: tree_node_action walk(Pgen& n) ! 54: { return walk_ ((struct node * &)n); }; ! 55: tree_node_action walk(Pvec& n) ! 56: { return walk_ ((struct node * &)n); }; ! 57: tree_node_action walk(Pptr& n) ! 58: { return walk_ ((struct node * &)n); }; ! 59: tree_node_action walk(Ptype& n) ! 60: { return walk_ ((struct node * &)n); }; ! 61: tree_node_action walk(Pfct& n) ! 62: { return walk_ ((struct node * &)n); }; ! 63: tree_node_action walk(Ptable& n) ! 64: { return walk_ ((struct node * &)n); }; ! 65: tree_node_action walk(Pbase& n) ! 66: { return walk_ ((struct node * &)n); }; ! 67: tree_node_action walk(Pname& n) ! 68: { return walk_ ((struct node * &)n); }; ! 69: tree_node_action walk(Pexpr& n) ! 70: { return walk_ ((struct node * &)n); }; ! 71: tree_node_action walk(Pstmt& n) ! 72: { return walk_ ((struct node * &)n); }; ! 73: tree_node_action walk(Pblock& n) ! 74: { return walk_ ((struct node * &)n); }; ! 75: tree_node_action walk(Penum& n) ! 76: { return walk_ ((struct node * &)n); }; ! 77: tree_node_action walk(Pclass& n) ! 78: { return walk_ ((struct node * &)n); }; ! 79: tree_node_action walk(Pvirt& n) ! 80: { return walk_ ((struct node * &)n); }; ! 81: tree_node_action walk(Plist& n) ! 82: { return walk_ ((struct node * &)n); }; ! 83: tree_node_action walk(Pin& n) ! 84: { return walk_ ((struct node * &)n); }; ! 85: tree_node_action walk(struct ia * & n) ! 86: { return walk_ ((struct node * &)n); }; ! 87: tree_node_action walk(Pbcl& n) ! 88: { return walk_ ((struct node * &)n); }; ! 89: private: ! 90: int fetching () { return (control.fetcher != null_tfp); } ; ! 91: void free_fetched (void *); ! 92: int fetch (void *, unsigned long, void *&); ! 93: int fetch (void * a, unsigned long l, Pnode& p) ! 94: { ! 95: int ret; ! 96: void * t; /* this is an output argument */ ! 97: ret = fetch(a,l,t); ! 98: if(!ret) { ! 99: p = Pnode(t); ! 100: } ! 101: return ret; ! 102: }; ! 103: // void error (const char *,...); ?? at&t -- to get it up quick, line 155 ! 104: void error ( char *, unsigned long=0 ); ! 105: tree_node_action pre_act_on_node (Pnode node, node_class nc, ! 106: Pnode node_copy, Pnode& replacement); ! 107: ! 108: tree_node_action a_gen (Pnode, Pgen, Pnode&); ! 109: tree_node_action a_vec (Pnode, Pvec, Pnode&); ! 110: tree_node_action a_ptr (Pnode, Pptr, Pnode&); ! 111: tree_node_action a_fct (Pnode, Pfct, Pnode&); ! 112: tree_node_action a_table (Pnode, Ptable, Pnode&); ! 113: tree_node_action a_basetype (Pnode, Pbase, Pnode&); ! 114: tree_node_action a_name(Pnode, Pname, Pnode&); ! 115: tree_node_action a_expr (Pnode, Pexpr, Pnode&); ! 116: tree_node_action a_stmt (Pnode, Pstmt, Pnode&); ! 117: tree_node_action a_enumdef (Pnode, Penum, Pnode&); ! 118: tree_node_action a_classdef (Pnode, Pclass, Pnode&); ! 119: tree_node_action a_virt (Pnode, Pvirt, Pnode&); ! 120: tree_node_action a_name_list (Pnode, Plist, Pnode&); ! 121: tree_node_action a_iline (Pnode, Pin, Pnode&); ! 122: tree_node_action a_ia (Pnode, struct ia *, Pnode&); ! 123: tree_node_action a_baseclass (Pnode, Pbcl, Pnode&); ! 124: tree_node_action a_expr_guts (Pexpr); ! 125: }; ! 126: ! 127: ! 128: walker::walker(tree_walk_control& c) ! 129: { control = c; ! 130: made_ht = 0; ! 131: if (c.nodes_seen_hash) ! 132: nodes_seen_hash = c.nodes_seen_hash; ! 133: else { ! 134: nodes_seen_hash = new pointer_hash (100); ! 135: made_ht = 1; ! 136: } ! 137: depth = 0; ! 138: cur_tree = 0; ! 139: } ! 140: ! 141: ! 142: tree_node_action ! 143: walk_tree (tree_walk_control& c, Pnode& n) ! 144: { ! 145: walker w (c); ! 146: return w.walk(n); ! 147: } ! 148: ! 149: ! 150: /* error messages are of finite length, so no need to run ! 151: around mallocing strings */ ! 152: ! 153: // void walker::error (const char * format, ...) ! 154: void walker::error (char *format, unsigned long v) ! 155: { ! 156: va_list args; ! 157: va_start(args, format); ! 158: if(control.call_i_error) { ! 159: char buf[1000]; ! 160: // vsprintf(buf, format, args); ! 161: // vsprintf not universal: by inspection ! 162: // all calls are currently of 1 or 0 arguments ! 163: sprintf(buf, format, v); ! 164: (*control.i_error)('i', buf); ! 165: } else { ! 166: vostream_printf (format, args, *control.error_stream); ! 167: *control.error_stream << "\n"; ! 168: control.error_stream->flush(); ! 169: } ! 170: va_end (args); ! 171: } ! 172: ! 173: ! 174: void ! 175: walker::free_fetched (void * addr) ! 176: { ! 177: if (control.fetcher != null_tfp) /* null indicates no cross-address-space */ ! 178: free ((char *)addr); ! 179: } ! 180: ! 181: int ! 182: walker::fetch (void * addr, unsigned long length, void*& taddr) ! 183: { ! 184: int err; ! 185: ! 186: if (control.fetcher == null_tfp) { ! 187: taddr = addr; ! 188: return 0; ! 189: } else { ! 190: taddr = (void *)malloc ((unsigned int)length); ! 191: if(taddr == 0) { ! 192: error ("walker::fetch: failed to malloc %d bytes.", length); ! 193: return 1; ! 194: } ! 195: ! 196: err = (*control.fetcher) (control.callback_info, addr, length, 0, taddr); ! 197: if(err) { ! 198: error("walker::fetch: fetcher returned %d.", err); ! 199: return 1; ! 200: } ! 201: } ! 202: } ! 203: ! 204: /* ::walk is called with a node pointer and a reference to ! 205: a replacement node pointer. When it returns, ! 206: replacement will be set if the action procedure ! 207: called on the node decided to copy it or replace it. ! 208: There are two possible modularities. ! 209: In case there is cross-address-space action, ! 210: ::walk can't call the action procedure until it has ! 211: entered the case on node bases. Once it has, ! 212: it calls the per-structure-type procedure, ! 213: which calls the action proc. If the action ! 214: proc supplies a replacement, then that replacement ! 215: will be returned up via the reference parameters to ! 216: the per-structure procedures. ! 217: ! 218: It the action procedure returns tna_continue, ! 219: then the walk continues against the new copy of the node ! 220: so that further replacements are reflected in the new copies. ! 221: This prevents replacement from being meaningful cross-address-space, ! 222: since the new copy will presumably be in the current ! 223: (and not the cross) address space. That is, if the node ! 224: is replaced by the action proc, the pointers in the new ! 225: node will drive the subsequent tree walk. Usually one ! 226: would just bitcopy, and then they would be replaced in turn. ! 227: */ ! 228: ! 229: tree_node_action ! 230: walker::walk (Pnode& top) ! 231: { ! 232: Pnode replacement = 0; ! 233: tree_node_action err; ! 234: int class_err; ! 235: node_class nclass; ! 236: Pnode node = 0; /* assign to shut up compiler, ! 237: which dosen't recognize pass-by-reference as a set */ ! 238: ! 239: orig_addr = top; ! 240: ! 241: if(fetching ()) { ! 242: if(fetch((void *)top, sizeof (struct node), node)) ! 243: return tna_error; ! 244: } else node = top; ! 245: ! 246: /* This has a complete catalog of bases, rather than just a list ! 247: of those associated with data structures. Its important ! 248: to detect the errs. ! 249: */ ! 250: ! 251: nclass = classify_node (node, class_err); ! 252: ! 253: if(class_err) { ! 254: error("walker::walk: unknown node type %d.", node->base); ! 255: free_fetched ((void *)node); ! 256: err = tna_error; ! 257: goto Return; ! 258: } ! 259: ! 260: switch(nclass) ! 261: { ! 262: default: ! 263: case nc_unused: ! 264: error("walker::walk: unused node type %d.", node->base); ! 265: err = tna_error; ! 266: goto Return; ! 267: ! 268: case nc_eof: ! 269: break; ! 270: ! 271: case nc_virt: ! 272: fetch((void *)top, sizeof (struct virt), node); ! 273: err = a_virt(top, Pvirt (node), replacement); ! 274: break; ! 275: ! 276: case nc_nlist: ! 277: fetch((void *)top, sizeof (struct name_list), node); ! 278: err = a_name_list(top, (struct name_list *)node, replacement); ! 279: break; ! 280: ! 281: case nc_iline: ! 282: fetch((void *)top, sizeof (struct iline), node); ! 283: err = a_iline(top, (struct iline *)node, replacement); ! 284: break; ! 285: ! 286: case nc_gen: ! 287: fetch((void *)top, sizeof (struct gen), node); ! 288: err = a_gen(top, Pgen (node), replacement); ! 289: break; ! 290: ! 291: case nc_vec: ! 292: fetch((void *)top, sizeof (struct vec), node); ! 293: err = a_vec(top, Pvec(node), replacement); ! 294: break; ! 295: ! 296: case nc_ptr: ! 297: fetch((void *)top, sizeof (struct ptr), node); ! 298: err = a_ptr(top, Pptr(node), replacement); ! 299: break; ! 300: ! 301: case nc_fct: ! 302: fetch((void *)top, sizeof (struct fct), node); ! 303: err = a_fct(top, Pfct(node), replacement); ! 304: break; ! 305: ! 306: case nc_table: ! 307: fetch((void *)top, sizeof (struct table), node); ! 308: err = a_table(top, Ptable(node), replacement); ! 309: break; ! 310: ! 311: case nc_basetype: ! 312: fetch((void *)top, sizeof (struct basetype), node); ! 313: err = a_basetype(top, Pbase(node), replacement); ! 314: break; ! 315: ! 316: case nc_name: ! 317: fetch((void *)top, sizeof (struct name), node); ! 318: err = a_name(top, Pname(node), replacement); ! 319: break; ! 320: ! 321: case nc_expr: ! 322: fetch((void *)top, sizeof (struct expr), node); ! 323: err = a_expr(top, Pexpr(node), replacement); ! 324: break; ! 325: ! 326: case nc_stmt: ! 327: fetch((void *)top, sizeof (struct stmt), node); ! 328: err = a_stmt(top, Pstmt(node), replacement); ! 329: break; ! 330: ! 331: case nc_enumdef: ! 332: fetch((void *)top, sizeof (struct enumdef), node); ! 333: err = a_enumdef(top, Penum(node), replacement); ! 334: break; ! 335: ! 336: case nc_classdef: ! 337: fetch((void *)top, sizeof (struct classdef), node); ! 338: err = a_classdef(top, Pclass(node), replacement); ! 339: break; ! 340: ! 341: case nc_ia: ! 342: fetch((void *)top, sizeof (struct ia), node); ! 343: err = a_ia(top, (struct ia *)node, replacement); ! 344: break; ! 345: ! 346: case nc_baseclass: ! 347: fetch((void *)top, sizeof (struct basecl), node); ! 348: err = a_baseclass(top, Pbcl(node), replacement); ! 349: break; ! 350: ! 351: } ! 352: ! 353: if(replacement) { ! 354: if (fetching ()) { ! 355: error ! 356: ("walker::walk: Attempt to replace tree in cross-address space mode."); ! 357: err = tna_error; ! 358: } ! 359: else top = replacement; ! 360: } ! 361: ! 362: if (control.post_action_proc && err != tna_error) { ! 363: tree_node_action post_err; ! 364: Pnode& post_repl = node; ! 365: ! 366: (*control.post_action_proc) (post_repl, nclass, control.callback_info, post_err, ! 367: depth, orig_addr, *cur_tree); ! 368: if(post_err != tna_continue) err = post_err; ! 369: if(post_repl != node) { ! 370: if (fetching ()) { ! 371: error ! 372: ("walker::walk: Attempt to replace tree in cross-address space mode."); ! 373: err = tna_error; ! 374: } ! 375: else top = post_repl; ! 376: } ! 377: } ! 378: ! 379: free_fetched((void *) node); ! 380: ! 381: Return: ! 382: return err; ! 383: } ! 384: ! 385: /* This is called in pre-order for each node. Then ! 386: post_act_on_node is called after whatever recursive ! 387: processing ensues. ! 388: ! 389: This is called from each of the structure-specific procedures ! 390: to give the action procedure an opportunity to act. ! 391: It can return a replacement pointer and control ! 392: whether to examine the insides of the node. ! 393: */ ! 394: ! 395: tree_node_action ! 396: walker::pre_act_on_node (Pnode node, node_class nc, ! 397: Pnode node_copy, Pnode& replacement) ! 398: { ! 399: /* If we have been here before, then we never proceed */ ! 400: /* node_copy is != node when a fetcher is in use */ ! 401: ! 402: int found; ! 403: int old_node; ! 404: tree_node_action action; ! 405: Pnode new_node; ! 406: int register_in_hash = 1; ! 407: ! 408: nodes_seen_hash->action((int)node, 0, Hash::probe, found, old_node); ! 409: ! 410: if(found) { ! 411: new_node = Pnode(old_node); ! 412: if(new_node != node) replacement = new_node; ! 413: return tna_stop; /* no need to proceed */ ! 414: } ! 415: ! 416: /* OK, we don't know from a previous pass. Call our actor */ ! 417: ! 418: new_node = fetching () && node_copy ? node_copy : node; ! 419: ! 420: (*control.action_proc)(new_node, nc, control.callback_info, action, ! 421: depth, orig_addr, *cur_tree, ! 422: register_in_hash); ! 423: ! 424: if(action != tna_error && !fetching () && new_node != node) { ! 425: replacement = new_node; ! 426: if(register_in_hash) ! 427: nodes_seen_hash->action((int)node, ! 428: (int)new_node, ! 429: Hash::insert, 0, 0); ! 430: } ! 431: else { ! 432: if(register_in_hash) ! 433: nodes_seen_hash->action((int)node, (int) node, Hash::insert, 0, 0); ! 434: } ! 435: return action; ! 436: } ! 437: ! 438: tree_node_action walker::a_table(Pnode ta, Ptable t, Pnode& replacement) ! 439: { ! 440: /* no unions */ ! 441: ! 442: int nx; ! 443: tree_node_action action; ! 444: ! 445: action = pre_act_on_node(ta, nc_table, Pnode(t), replacement); ! 446: ! 447: if(action != tna_continue) return action; ! 448: ! 449: /* -----------------------------*/ ! 450: /* For Now, Never Walk a Table. */ ! 451: ! 452: action = tna_stop; return action; ! 453: ! 454: /* an array of pointers. */ ! 455: /* The action procedure is responsable for allocating a new one ! 456: of those if it replaced and continued. */ ! 457: ! 458: if(!fetching () && replacement) ! 459: t = Ptable(replacement); ! 460: ! 461: Pname * t_entries; ! 462: ! 463: if(fetching ()) { ! 464: void * temp; ! 465: fetch((void *)t->entries, t->size * sizeof(Pname), temp); ! 466: t_entries = (Pname *)temp; ! 467: } ! 468: else t_entries = t->entries; ! 469: ! 470: for(nx = 0; nx < t->size; nx ++) { ! 471: action = walk(t_entries[nx]); ! 472: if(action == tna_error) return action; ! 473: } ! 474: ! 475: if(fetching ()) free_fetched ((void *)t_entries); ! 476: ! 477: Pnode n = Pnode(t->real_block); ! 478: ! 479: action = walk(t->real_block); ! 480: if(action == tna_error) return action; ! 481: ! 482: action = walk(t->next); ! 483: ! 484: action = walk(t->t_name); ! 485: ! 486: return tna_continue; ! 487: } ! 488: ! 489: tree_node_action walker::a_enumdef (Pnode ta, Penum e, Pnode& replacement) ! 490: { ! 491: tree_node_action action = pre_act_on_node(ta, nc_enumdef, Pnode(e), replacement); ! 492: ! 493: action = walk(e->mem); ! 494: if(action == tna_error) return action; ! 495: ! 496: action = walk(e->e_type); ! 497: ! 498: return tna_continue; ! 499: } ! 500: ! 501: tree_node_action walker::a_virt(Pnode ta, Pvirt v, Pnode& replacement) ! 502: { ! 503: /* no unions */ ! 504: ! 505: int nx; ! 506: tree_node_action action = pre_act_on_node(ta, nc_enumdef, Pnode(v), replacement); ! 507: ! 508: if(action != tna_continue) return action; ! 509: ! 510: if(!fetching () && replacement) ! 511: v = Pvirt(replacement); ! 512: ! 513: /* an array of velem structures. */ ! 514: ! 515: velem * v_virt_init; ! 516: ! 517: if(fetching ()) { ! 518: void * t; ! 519: fetch((void *)v->virt_init, v->n_init * sizeof(velem), t); ! 520: v_virt_init = (velem *)t; ! 521: } ! 522: else v_virt_init = v->virt_init; ! 523: ! 524: for(nx = 0; nx < v->n_init; nx ++) { ! 525: action = walk(v_virt_init[nx].n); ! 526: if(action == tna_error) return action; ! 527: } ! 528: ! 529: if(fetching ()) free_fetched ((void *)v_virt_init); ! 530: ! 531: action = walk(v->vclass); ! 532: ! 533: return tna_continue; ! 534: } ! 535: ! 536: tree_node_action walker::a_classdef(Pnode ta, Pclass c, Pnode& replacement) ! 537: { ! 538: ! 539: tree_node_action action = pre_act_on_node(ta, nc_classdef, Pnode(c), replacement); ! 540: ! 541: if(action != tna_continue) return action; ! 542: ! 543: if(!fetching () && replacement) ! 544: c = Pclass(replacement); ! 545: ! 546: action = walk(c->baselist); ! 547: if(action == tna_error) return action; ! 548: ! 549: action=walk(c->mem_list); ! 550: if(action == tna_error) return action; ! 551: ! 552: action=walk(c->memtbl); ! 553: if(action == tna_error) return action; ! 554: ! 555: action=walk(c->friend_list); ! 556: if(action == tna_error) return action; ! 557: ! 558: action=walk(c->pubdef); ! 559: if(action == tna_error) return action; ! 560: ! 561: action=walk(c->tn_list); ! 562: if(action == tna_error) return action; ! 563: ! 564: action=walk(c->in_class); ! 565: if(action == tna_error) return action; ! 566: ! 567: action=walk(c->in_fct); ! 568: if(action == tna_error) return action; ! 569: ! 570: action=walk(c->this_type); ! 571: if(action == tna_error) return action; ! 572: ! 573: action=walk(c->virt_list); ! 574: if(action == tna_error) return action; ! 575: ! 576: action=walk(c->c_ctor); ! 577: if(action == tna_error) return action; ! 578: action=walk(c->c_dtor); ! 579: if(action == tna_error) return action; ! 580: action=walk(c->c_itor); ! 581: if(action == tna_error) return action; ! 582: ! 583: action=walk(c->conv); ! 584: if(action == tna_error) return action; ! 585: ! 586: return tna_continue; ! 587: } ! 588: ! 589: tree_node_action walker::a_basetype(Pnode ta, Pbase b, Pnode& replacement) ! 590: { ! 591: ! 592: tree_node_action action = pre_act_on_node(ta, nc_basetype, Pnode(b), replacement); ! 593: int derr; ! 594: ! 595: if(action != tna_continue) return action; ! 596: ! 597: if(!fetching () && replacement) ! 598: b = Pbase(replacement); ! 599: ! 600: action = walk(b->b_name); ! 601: if(action == tna_error) return action; ! 602: ! 603: action = walk(b->b_table); ! 604: if(action == tna_error) return action; ! 605: ! 606: action = walk(b->b_field); ! 607: if(action == tna_error) return action; ! 608: ! 609: action = walk(b->b_xname); ! 610: if(action == tna_error) return action; ! 611: ! 612: switch(derr = b->discriminator(0)) { ! 613: case 0: break; ! 614: case 1: ! 615: action = walk(b->b_fieldtype); ! 616: if(action == tna_error) return action; ! 617: break; ! 618: case 2: break; ! 619: default: ! 620: error ("a_basetype: discrim error %d.", derr); ! 621: return tna_error; ! 622: } ! 623: ! 624: return tna_continue; ! 625: } ! 626: ! 627: tree_node_action walker::a_fct(Pnode ta, Pfct f, Pnode& replacement) ! 628: { ! 629: ! 630: tree_node_action action = pre_act_on_node(ta, nc_fct, Pnode(f), replacement); ! 631: ! 632: if(action != tna_continue) return action; ! 633: ! 634: if(!fetching () && replacement) ! 635: f = Pfct(replacement); ! 636: ! 637: action = walk(f->returns); ! 638: if(action == tna_error) return action; ! 639: ! 640: action = walk(f->argtype); ! 641: if(action == tna_error) return action; ! 642: ! 643: action = walk(f->s_returns); ! 644: if(action == tna_error) return action; ! 645: ! 646: action = walk(f->f_this); ! 647: if(action == tna_error) return action; ! 648: ! 649: action = walk(f->memof); ! 650: if(action == tna_error) return action; ! 651: ! 652: action = walk(f->body); ! 653: if(action == tna_error) return action; ! 654: ! 655: action = walk(f->f_init); ! 656: if(action == tna_error) return action; ! 657: ! 658: action = walk(f->f_expr); ! 659: if(action == tna_error) return action; ! 660: ! 661: action = walk(f->last_expanded); ! 662: if(action == tna_error) return action; ! 663: ! 664: action = walk(f->f_result); ! 665: if(action == tna_error) return action; ! 666: ! 667: action = walk(f->f_args); ! 668: if(action == tna_error) return action; ! 669: ! 670: return tna_continue; ! 671: } ! 672: ! 673: tree_node_action walker::a_name_list(Pnode ta, Plist l, Pnode& replacement) ! 674: { ! 675: ! 676: int cl_error; ! 677: tree_node_action action = pre_act_on_node(ta, nc_nlist, Pnode(l), replacement); ! 678: ! 679: if(action == tna_stop) { ! 680: if(!fetching () && replacement) ! 681: l = Plist(replacement); ! 682: cl_error = 0; ! 683: if((classify_node(Pnode(l), cl_error) == nc_nlist) && !cl_error) { ! 684: action = walk(l->l); ! 685: if(action == tna_error) return action; ! 686: } ! 687: } ! 688: ! 689: if(action != tna_continue) return action; ! 690: ! 691: if(!fetching () && replacement) ! 692: l = Plist(replacement); ! 693: ! 694: action = walk(l->f); ! 695: if(action == tna_error) return action; ! 696: ! 697: action = walk(l->l); ! 698: if(action == tna_error) return action; ! 699: ! 700: return tna_continue; ! 701: } ! 702: ! 703: tree_node_action walker::a_gen(Pnode ta, Pgen g, Pnode& replacement) ! 704: { ! 705: ! 706: tree_node_action action = pre_act_on_node(ta, nc_gen, Pnode(g), replacement); ! 707: ! 708: if(action != tna_continue) return action; ! 709: ! 710: if(!fetching () && replacement) ! 711: g = Pgen(replacement); ! 712: ! 713: action = walk(g->fct_list); ! 714: if(action == tna_error) return action; ! 715: ! 716: return tna_continue; ! 717: } ! 718: ! 719: tree_node_action walker::a_vec(Pnode ta, Pvec v, Pnode& replacement) ! 720: { ! 721: ! 722: tree_node_action action = pre_act_on_node(ta, nc_vec, Pnode(v), replacement); ! 723: ! 724: if(action != tna_continue) return action; ! 725: ! 726: if(!fetching () && replacement) ! 727: v = Pvec(replacement); ! 728: ! 729: action = walk(v->typ); ! 730: if(action == tna_error) return action; ! 731: ! 732: action = walk(v->dim); ! 733: if(action == tna_error) return action; ! 734: ! 735: return tna_continue; ! 736: } ! 737: ! 738: tree_node_action walker::a_ptr(Pnode ta, Pptr p, Pnode& replacement) ! 739: { ! 740: ! 741: tree_node_action action = pre_act_on_node(ta, nc_ptr, Pnode(p), replacement); ! 742: ! 743: if(action != tna_continue) return action; ! 744: ! 745: if(!fetching () && replacement) ! 746: p = Pptr(replacement); ! 747: ! 748: action = walk(p->typ); ! 749: if(action == tna_error) return action; ! 750: ! 751: action = walk(p->memof); ! 752: if(action == tna_error) return action; ! 753: ! 754: return tna_continue; ! 755: } ! 756: ! 757: ! 758: tree_node_action walker::a_expr_guts(Pexpr e) ! 759: { ! 760: int derr; ! 761: tree_node_action action; ! 762: ! 763: switch(derr = e->discriminator (0)) { ! 764: case 1: ! 765: action = walk(e->tp); ! 766: if(action == tna_error) return action; ! 767: break; ! 768: case 0: ! 769: break; ! 770: default: ! 771: error ("a_expr: discrim error %d on union 0.", derr); ! 772: return tna_error; ! 773: } ! 774: ! 775: switch(derr = e->discriminator (1)) { ! 776: case 0: ! 777: break; ! 778: default: ! 779: error ("a_expr: discrim error %d on union 1.", derr); ! 780: return tna_error; ! 781: case 1: ! 782: action = walk(e->e1); ! 783: if(action == tna_error) return action; ! 784: break; ! 785: case 2: ! 786: break; ! 787: case 3: ! 788: break; ! 789: } ! 790: ! 791: switch(derr = e->discriminator (2)) { ! 792: case 0: ! 793: break; ! 794: default: ! 795: error ("a_expr: discrim error %d on union 2.", derr); ! 796: return tna_error; ! 797: case 1: ! 798: /* elists are special. e2 for an elist is a peer, not ! 799: a child. */ ! 800: if(e->base != ELIST) { ! 801: action = walk(e->e2); ! 802: if(action == tna_error) return action; ! 803: } ! 804: break; ! 805: case 2: ! 806: break; ! 807: case 3: ! 808: break; ! 809: case 4: ! 810: action = walk(e->n_initializer); ! 811: if(action == tna_error) return action; ! 812: break; ! 813: } ! 814: ! 815: switch(derr = e->discriminator (3)) { ! 816: case 0: ! 817: break; ! 818: default: ! 819: error ("a_expr: discrim error %d on union 3.", derr); ! 820: return tna_error; ! 821: case 1: ! 822: action = walk(e->tp2); ! 823: if(action == tna_error) return action; ! 824: break; ! 825: case 2: ! 826: action = walk(e->fct_name); ! 827: if(action == tna_error) return action; ! 828: break; ! 829: case 3: ! 830: action = walk(e->cond); ! 831: if(action == tna_error) return action; ! 832: break; ! 833: case 4: ! 834: action = walk(e->mem); ! 835: if(action == tna_error) return action; ! 836: break; ! 837: case 5: ! 838: action = walk(e->as_type); ! 839: if(action == tna_error) return action; ! 840: break; ! 841: case 6: ! 842: action = walk(e->n_table); ! 843: if(action == tna_error) return action; ! 844: break; ! 845: case 7: ! 846: action = walk(e->il); ! 847: if(action == tna_error) return action; ! 848: break; ! 849: case 8: ! 850: action = walk(e->query_this); ! 851: if(action == tna_error) return action; ! 852: break; ! 853: } ! 854: return tna_continue; ! 855: } ! 856: ! 857: ! 858: tree_node_action walker::a_expr(Pnode ta, Pexpr e, Pnode& replacement) ! 859: { ! 860: tree_node_action action = pre_act_on_node(ta, nc_expr, Pnode(e), replacement); ! 861: ! 862: if(action == tna_stop) { ! 863: if(!fetching () && replacement) ! 864: e = Pexpr(replacement); ! 865: /* ELIST implies that e2 is a peer, not a child */ ! 866: if(e->base == ELIST) { ! 867: action = walk(e->e2); ! 868: return action; ! 869: } ! 870: } ! 871: ! 872: if(action != tna_continue) return action; ! 873: ! 874: if(!fetching () && replacement) ! 875: e = Pexpr(replacement); ! 876: ! 877: action = a_expr_guts(e); ! 878: if (action == tna_error) return action; ! 879: if(e->base == ELIST) ! 880: action = walk(e->e2); ! 881: return action; ! 882: } ! 883: ! 884: tree_node_action walker::a_baseclass(Pnode ta, Pbcl b, Pnode& replacement) ! 885: { ! 886: tree_node_action action = pre_act_on_node(ta, nc_baseclass, Pnode(b), replacement); ! 887: ! 888: if(action != tna_continue) return action; ! 889: ! 890: if(!fetching () && replacement) ! 891: b = Pbcl(replacement); ! 892: ! 893: action = walk(b->bclass); ! 894: if(action == tna_error) return action; ! 895: ! 896: action = walk(b->init); ! 897: if(action == tna_error) return action; ! 898: ! 899: action = walk(b->next); ! 900: if(action == tna_error) return action; ! 901: ! 902: return tna_continue; ! 903: } ! 904: ! 905: ! 906: /* a name is also an expr. */ ! 907: ! 908: ! 909: tree_node_action walker::a_name(Pnode ta, Pname n, Pnode& replacement) ! 910: { ! 911: int derr; ! 912: int cl_error; ! 913: tree_node_action action = pre_act_on_node(ta, nc_name, Pnode(n), replacement); ! 914: ! 915: /* n_list is a sibling, not a child. We always process it ! 916: except in case of an error. */ ! 917: if(action == tna_stop) { ! 918: cl_error = 0; ! 919: if(!fetching () && replacement) ! 920: n = Pname(replacement); ! 921: if((classify_node(Pnode(n), cl_error) == nc_name) && !cl_error) { ! 922: if(depth > 0 || !control.dont_chase_lists_top) { ! 923: action = walk(n->n_list); ! 924: if(action == tna_error) return action; ! 925: } ! 926: } ! 927: return tna_stop; ! 928: } ! 929: ! 930: if(action != tna_continue) return action; ! 931: ! 932: if(!fetching () && replacement) ! 933: n = Pname(replacement); ! 934: ! 935: /* We don't walk n_tbl_list. Its not part of the graph. ! 936: */ ! 937: ! 938: switch(derr = n->discriminator(0)) { ! 939: case 0: ! 940: break; ! 941: case 1: ! 942: action = walk(n->n_qualifier); ! 943: if(action == tna_error) return action; ! 944: break; ! 945: case 2: ! 946: action = walk(n->n_realscope); ! 947: if(action == tna_error) return action; ! 948: break; ! 949: default: ! 950: error ("a_name: discrim error %d on union 0.", derr); ! 951: return tna_error; ! 952: } ! 953: ! 954: action = a_expr_guts(Pexpr(n)); ! 955: if(action == tna_error) return action; ! 956: ! 957: if(depth > 0 || !control.dont_chase_lists_top) { ! 958: action = walk(n->n_list); ! 959: if(action == tna_error) return action; ! 960: } ! 961: ! 962: return action; ! 963: } ! 964: ! 965: /* --- NOTE: s_list should be deferred until AFTER the post-action ! 966: procedure is called, if there is one. Since no one uses ! 967: post-actions yet I haven't bothered to make this fix. ! 968: --benson */ ! 969: ! 970: tree_node_action walker::a_stmt(Pnode ta, Pstmt s, Pnode& replacement) ! 971: { ! 972: int cl_error; ! 973: int derr; ! 974: tree_node_action action = pre_act_on_node(ta, nc_stmt, Pnode(s), replacement); ! 975: ! 976: if(action == tna_stop) { ! 977: if(!fetching () && replacement) ! 978: s = Pstmt(replacement); ! 979: cl_error = 0; ! 980: if((classify_node(Pnode(s), cl_error) == nc_stmt) && !cl_error) { ! 981: /* s_list is not our subordinate, it is our peer */ ! 982: if(depth > 0 || !control.dont_chase_lists_top) { ! 983: action = walk(s->s_list); /* continue walk of sibs */ ! 984: if (action == tna_error) return tna_error; ! 985: } ! 986: } ! 987: return tna_stop; ! 988: } ! 989: ! 990: if(action != tna_continue) return action; ! 991: ! 992: if(!fetching () && replacement) ! 993: s = Pstmt(replacement); ! 994: ! 995: action = walk(s->s); ! 996: if(action == tna_error) return action; ! 997: ! 998: action = walk(s->memtbl); ! 999: if(action == tna_error) return action; ! 1000: ! 1001: switch(derr = s->discriminator(0)) { ! 1002: default: ! 1003: error ("a_stmt: discrim error %d on union 0.", derr); ! 1004: return tna_error; ! 1005: case 4: ! 1006: case 0: break; ! 1007: case 1: ! 1008: action = walk(s->d); ! 1009: if(action == tna_error) return action; ! 1010: break; ! 1011: case 2: ! 1012: action = walk(s->e2); ! 1013: if(action == tna_error) return action; ! 1014: break; ! 1015: case 3: ! 1016: action = walk(s->has_default); ! 1017: if(action == tna_error) return action; ! 1018: break; ! 1019: case 5: ! 1020: action = walk(s->ret_tp); ! 1021: if(action == tna_error) return action; ! 1022: break; ! 1023: } ! 1024: ! 1025: switch(derr = s->discriminator(1)) { ! 1026: default: ! 1027: error ("a_stmt: discrim error %d on union 1.", derr); ! 1028: return tna_error; ! 1029: case 2: ! 1030: case 0: break; ! 1031: case 1: ! 1032: action = walk(s->e); ! 1033: if(action == tna_error) return action; ! 1034: break; ! 1035: case 3: ! 1036: action = walk(s->s2); ! 1037: if(action == tna_error) return action; ! 1038: break; ! 1039: } ! 1040: ! 1041: switch(derr = s->discriminator(2)) { ! 1042: default: ! 1043: error ("a_stmt: discrim error %d on union 2.", derr); ! 1044: return tna_error; ! 1045: case 0: break; ! 1046: case 1: ! 1047: action = walk(s->for_init); ! 1048: if(action == tna_error) return action; ! 1049: break; ! 1050: case 2: ! 1051: action = walk(s->else_stmt); ! 1052: if(action == tna_error) return action; ! 1053: break; ! 1054: case 3: ! 1055: action = walk(s->case_list); ! 1056: if(action == tna_error) return action; ! 1057: break; ! 1058: } ! 1059: ! 1060: if(depth > 0 || !control.dont_chase_lists_top) { ! 1061: action = walk(s->s_list); ! 1062: if(action == tna_error) return action; ! 1063: } ! 1064: ! 1065: return tna_continue; ! 1066: } ! 1067: ! 1068: tree_node_action walker::a_ia(Pnode ta, struct ia * ia, Pnode& replacement) ! 1069: { ! 1070: tree_node_action action = pre_act_on_node(ta, nc_ia, Pnode(ia), replacement); ! 1071: ! 1072: if(action != tna_continue) return action; ! 1073: ! 1074: if(!fetching () && replacement) ! 1075: ia = (struct ia *)&replacement; ! 1076: ! 1077: action = walk(ia->local); ! 1078: if(action == tna_error) return action; ! 1079: ! 1080: action = walk(ia->arg); ! 1081: if(action == tna_error) return action; ! 1082: ! 1083: action = walk(ia->tp); ! 1084: if(action == tna_error) return action; ! 1085: ! 1086: return tna_continue; ! 1087: } ! 1088: ! 1089: tree_node_action walker::a_iline(Pnode ta, Pin iline, Pnode& replacement) ! 1090: { ! 1091: tree_node_action action = pre_act_on_node(ta, nc_iline, Pnode(iline), replacement); ! 1092: ! 1093: if(action != tna_continue) return action; ! 1094: ! 1095: if(!fetching () && replacement) ! 1096: iline = Pin(replacement); ! 1097: ! 1098: action = walk(iline->fct_name); ! 1099: if(action == tna_error) return action; ! 1100: ! 1101: action = walk(iline->i_next); ! 1102: if(action == tna_error) return action; ! 1103: ! 1104: action = walk(iline->i_table); ! 1105: if(action == tna_error) return action; ! 1106: ! 1107: action = walk(iline->i_args); ! 1108: if(action == tna_error) return action; ! 1109: ! 1110: return tna_continue; ! 1111: } ! 1112: ! 1113: static char rcsinfo[] = "$Header: /usr3/lang/benson/work/stripped_cfront/RCS/tree_walk.c,v 1.1 89/11/20 08:51:06 benson Exp $"; ! 1114: ! 1115: ! 1116: /* ! 1117: $Log: tree_walk.c,v $ ! 1118: * Revision 1.1 89/11/20 08:51:06 benson ! 1119: * Initial revision ! 1120: * ! 1121: * Revision 1.17 89/10/20 14:32:06 benson ! 1122: * fixes to n_list processing and related items. ! 1123: * ! 1124: * Revision 1.16 89/10/04 19:03:50 dysak ! 1125: * Let the tree walker know about the n_persistent_db member of ! 1126: * a name node. ! 1127: * ! 1128: * Revision 1.15 89/10/02 09:58:33 benson ! 1129: * finish the job. ! 1130: * ! 1131: * Revision 1.14 89/10/02 09:44:30 benson ! 1132: * use hash table subclass. ! 1133: * ! 1134: * Revision 1.13 89/09/18 08:20:21 benson ! 1135: * flush freeze drying support. ! 1136: * ! 1137: * Revision 1.12 89/09/14 15:28:37 benson ! 1138: * don't especially prune at the gtbl and ktbl. Leave it to client to ! 1139: * do all pruning of this kind. ! 1140: * ! 1141: * Revision 1.11 89/09/13 09:21:26 benson ! 1142: * .10 also stops walking tables, ever. At least until we discover ! 1143: * a use for it. ! 1144: * ! 1145: * Revision 1.10 89/09/13 09:20:43 benson ! 1146: * rename aggregate to collection. ! 1147: * ! 1148: * Revision 1.9 89/09/02 22:07:13 benson ! 1149: * keep things out of the hash table. Used for template formals. ! 1150: * ! 1151: * Revision 1.8 89/08/29 13:41:05 benson ! 1152: * don't walk n_tbl_list ! 1153: * ! 1154: * Revision 1.7 89/08/24 08:44:52 benson ! 1155: * support for an activation stack. ! 1156: * ! 1157: * Revision 1.5 89/08/11 14:59:55 sam ! 1158: * ! 1159: * ! 1160: * Revision 1.4 89/07/27 13:32:28 benson ! 1161: * walk through stmt.memtbl. ! 1162: * ! 1163: * Revision 1.3 89/07/21 16:48:48 benson ! 1164: * fixes and extensions for frozen trees, notably support for BY_NAME. ! 1165: * ! 1166: * Revision 1.2 89/07/18 15:18:52 benson ! 1167: * fix bugs. ! 1168: * ! 1169: * Revision 1.1 89/07/14 10:55:49 benson ! 1170: * Initial revision ! 1171: * ! 1172: ! 1173: end_log ! 1174: */
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.