/*@z29.c:Symbol Table:Declarations, hash()@***********************************/ /* */ /* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.27) */ /* COPYRIGHT (C) 1991, 2002 Jeffrey H. Kingston */ /* */ /* Jeffrey H. Kingston (jeff@it.usyd.edu.au) */ /* Basser Department of Computer Science */ /* The University of Sydney 2006 */ /* AUSTRALIA */ /* */ /* This program is free software; you can redistribute it and/or modify */ /* it under the terms of the GNU General Public License as published by */ /* the Free Software Foundation; either Version 2, or (at your option) */ /* any later version. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU General Public License for more details. */ /* */ /* You should have received a copy of the GNU General Public License */ /* along with this program; if not, write to the Free Software */ /* Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA */ /* */ /* FILE: z29.c */ /* MODULE: Symbol Table */ /* EXTERNS: InitSym(), PushScope(), PopScope(), SuppressVisible(), */ /* UnSuppressVisible(), SuppressScope(), UnSuppressScope(), */ /* SwitchScope(), UnSwitchScope(), BodyParAllowed(), */ /* BodyParNotAllowed(), InsertSym(), SearchSym(), */ /* SymName(), FullSymName(), ChildSym(), CheckSymSpread(), */ /* DeleteEverySym() */ /* */ /*****************************************************************************/ #include "externs.h" #define MAX_STACK 300 /* size of scope stack */ #define MAX_TAB 1783 /* size of hash table */ #define length(x) word_font(x) static OBJECT scope[MAX_STACK]; /* the scope stack */ static BOOLEAN npars_only[MAX_STACK]; /* look for NPAR exc */ static BOOLEAN vis_only[MAX_STACK]; /* look for visibles */ static BOOLEAN body_ok[MAX_STACK]; /* look for body par */ static BOOLEAN suppress_scope; /* suppress scoping */ static BOOLEAN suppress_visible; /* suppress visible */ static int scope_top; /* scope stack top */ static struct { OBJECT f1, f2; } symtab[MAX_TAB]; /* the hash table */ #if DEBUG_ON static int sym_spread[MAX_TAB] = { 0 }; /* hash table spread */ static int sym_count = 0; /* symbol count */ #endif /*****************************************************************************/ /* */ /* #define hash(str, len, val) */ /* */ /* Set val to the hash value of string str, which has length len. */ /* The hash function is just the character sum mod MAX_TAB. */ /* This definition assumes that working variables rlen and x exist. */ /* */ /*****************************************************************************/ #define hash(str, len, val) \ { rlen = len; \ x = str; \ val = *x++; \ while( --rlen ) val += *x++; \ val %= MAX_TAB; \ } /*@::InitSym(), PushScope(), PopScope(), SuppressVisible(), etc.@*************/ /* */ /* InitSym() */ /* */ /* Initialize the symbol table to empty. */ /* */ /*****************************************************************************/ void InitSym(void) { int i; scope_top = 0; suppress_scope = FALSE; suppress_visible = FALSE; for( i = 0; i < MAX_TAB; i++ ) symtab[i].f1 = symtab[i].f2 = (OBJECT) &symtab[i]; } /* end InitSym */ /*****************************************************************************/ /* */ /* PushScope(x, npars, vis) */ /* PopScope() */ /* */ /* Add or remove an OBJECT x (which must be in the symbol table) to or from */ /* the scope stack. If npars is TRUE, only the named parameters of x are */ /* added to scope. If vis is TRUE, only visible locals and parameters are */ /* added. */ /* */ /*****************************************************************************/ void PushScope(OBJECT x, BOOLEAN npars, BOOLEAN vis) { debug3(DST, DD, "[ PushScope(%s, %s, %s)", SymName(x), bool(npars), bool(vis)); assert( suppress_scope == FALSE, "PushScope: suppress_scope!" ); if( scope_top >= MAX_STACK ) { #if DEBUG_ON int i; for( i = 0; i < scope_top; i++ ) Error(29, 1, " scope[%2d] = %s", WARN, &fpos(x), i, SymName(scope[i])); #endif Error(29, 2, "scope depth limit exceeded", INTERN, &fpos(x)); } scope[scope_top] = x; npars_only[scope_top] = npars; vis_only[scope_top] = vis; body_ok[scope_top] = FALSE; scope_top++; } /* end PushScope */ void PopScope(void) { debug0(DST, DD, "] PopScope()"); assert( scope_top > 0, "PopScope: tried to pop empty scope stack"); assert( suppress_scope == FALSE, "PopScope: suppress_scope!" ); scope_top--; } /* end PopScope */ /*****************************************************************************/ /* */ /* SuppressVisible() */ /* UnSuppressVisible() */ /* */ /* Make all children of any symbol acceptable, not just the exported ones. */ /* */ /*****************************************************************************/ void SuppressVisible(void) { debug0(DST, DD, "[ SuppressVisible()"); suppress_visible = TRUE; } /* end SuppressVisible */ void UnSuppressVisible(void) { debug0(DST, DD, "] UnSuppressVisible()"); suppress_visible = FALSE; } /* end UnSuppressVisible */ /*@::SuppressScope(), UnSuppressScope(), SwitchScope(), UnswitchScope()@******/ /* */ /* SuppressScope() */ /* UnSuppressScope() */ /* */ /* Suppress all scopes (so that all calls to SearchSym fail); and undo it. */ /* */ /*****************************************************************************/ void SuppressScope(void) { debug0(DST, DD, "[ SuppressScope()"); suppress_scope = TRUE; } /* end SuppressScope */ void UnSuppressScope(void) { debug0(DST, DD, "] UnSuppressScope()"); suppress_scope = FALSE; } /* end UnSuppressScope */ /*****************************************************************************/ /* */ /* SwitchScope(sym) */ /* UnSwitchScope(sym) */ /* */ /* Switch to the scope of sym (if nilobj, StartSym); and switch back again. */ /* */ /*****************************************************************************/ void SwitchScope(OBJECT sym) { int i; OBJECT new_scopes[MAX_STACK]; if( sym == nilobj ) PushScope(StartSym, FALSE, FALSE); else { i = 0; while( sym != StartSym ) { new_scopes[i++] = enclosing(sym); sym = enclosing(sym); } while( i > 0 ) PushScope(new_scopes[--i], FALSE, FALSE); } } void UnSwitchScope(OBJECT sym) { if( sym == nilobj ) PopScope(); else { while( sym != StartSym ) { PopScope(); sym = enclosing(sym); } } } /*****************************************************************************/ /* */ /* BodyParAllowed() */ /* BodyParNotAllowed() */ /* */ /* Allow or disallow invocations of the body parameter of the current tos. */ /* */ /*****************************************************************************/ void BodyParAllowed(void) { debug0(DST, DD, "BodyParAllowed()"); body_ok[scope_top-1] = TRUE; } /* end BodyParAllowed */ void BodyParNotAllowed(void) { debug0(DST, DD, "BodyParNotAllowed()"); body_ok[scope_top-1] = FALSE; } /* end BodyParNotAllowed */ /*****************************************************************************/ /* */ /* DebugScope(void) */ /* */ /* Debug print of current scope stack */ /* */ /*****************************************************************************/ void DebugScope(void) { int i; if( suppress_scope ) { debug0(DST, D, "suppressed"); } else for( i = 0; i < scope_top; i++ ) { debug6(DST, D, "%s %s%s%s%s%s", i == scope_top - 1 ? "->" : " ", SymName(scope[i]), npars_only[i] ? " npars_only" : "", vis_only[i] ? " vis_only" : "", body_ok[i] ? " body_ok" : "", i == scope_top - 1 && suppress_visible ? " suppress_visible" : ""); } } /* end DebugScope */ /*@::ScopeSnapshot()@*********************************************************/ /* */ /* OBJECT GetScopeSnapshot() */ /* LoadScopeSnapshot(ss) */ /* ClearScopeSnapshot(ss) */ /* */ /* A scope snapshot is a complete record of the state of the scope stack */ /* at some moment. These routines allow you to take a scope snapshot, */ /* then subsequently load it (i.e. make it the current scope), then */ /* subsequently clear it (i.e. return to whatever was before the Load). */ /* */ /*****************************************************************************/ OBJECT GetScopeSnapshot() { OBJECT ss, x; int i; New(ss, ACAT); for( i = scope_top-1; scope[i] != StartSym; i-- ) { New(x, SCOPE_SNAPSHOT); Link(ss, x); Link(x, scope[i]); ss_npars_only(x) = npars_only[i]; ss_vis_only(x) = vis_only[i]; ss_body_ok(x) = body_ok[i]; } ss_suppress(ss) = suppress_visible; return ss; } /* end GetScopeSnapshot */ void LoadScopeSnapshot(OBJECT ss) { OBJECT link, x, sym; BOOLEAN tmp; assert( type(ss) == ACAT, "LoadScopeSnapshot: type(ss)!" ); PushScope(StartSym, FALSE, FALSE); for( link = LastDown(ss); link != ss; link = PrevDown(link) ) { Child(x, link); assert( type(x) == SCOPE_SNAPSHOT, "LoadScopeSnapshot: type(x)!" ); Child(sym, Down(x)); PushScope(sym, ss_npars_only(x), ss_vis_only(x)); body_ok[scope_top-1] = ss_body_ok(x); } tmp = suppress_visible; suppress_visible = ss_suppress(ss); ss_suppress(ss) = tmp; debug0(DST, D, "after LoadScopeSnapshot, scope is:") ifdebug(DST, D, DebugScope()); } /* end LoadScopeSnapshot */ void ClearScopeSnapshot(OBJECT ss) { while( scope[scope_top-1] != StartSym ) scope_top--; scope_top--; suppress_visible = ss_suppress(ss); } /* end ClearScopeSnapshot */ /*@::InsertSym()@*************************************************************/ /* */ /* OBJECT InsertSym(str, xtype, xfpos, xprecedence, indefinite, xrecursive, */ /* xpredefined, xenclosing, xbody) */ /* */ /* Insert a new symbol into the table. Its string value is str. */ /* Initialise the symbol as the parameters indicate. */ /* Return a pointer to the new symbol. */ /* If str is not a valid symbol name, InsertSym prints an error */ /* message and does not insert the symbol. */ /* */ /*****************************************************************************/ OBJECT InsertSym(FULL_CHAR *str, unsigned char xtype, FILE_POS *xfpos, unsigned char xprecedence, BOOLEAN xindefinite, BOOLEAN xrecursive, unsigned xpredefined, OBJECT xenclosing, OBJECT xbody) { register int sum, rlen; register unsigned char *x; OBJECT p, q, s, tmp, link, entry, plink; int len; debug3(DST, DD, "InsertSym( %s, %s, in %s )", Image(xtype), str, SymName(xenclosing)); if( !LexLegalName(str) ) Error(29, 3, "invalid symbol name %s", WARN, xfpos, str); New(s, xtype); FposCopy(fpos(s), *xfpos); has_body(s) = FALSE; filter(s) = nilobj; use_invocation(s) = nilobj; imports(s) = nilobj; imports_encl(s) = FALSE; right_assoc(s) = TRUE; precedence(s) = xprecedence; indefinite(s) = xindefinite; recursive(s) = xrecursive; predefined(s) = xpredefined; enclosing(s) = xenclosing; sym_body(s) = xbody; base_uses(s) = nilobj; uses(s) = nilobj; marker(s) = nilobj; cross_sym(s) = nilobj; is_extern_target(s) = FALSE; uses_extern_target(s)= FALSE; visible(s) = FALSE; uses_galley(s) = FALSE; horiz_galley(s) = ROWM; has_compulsory(s) = 0; is_compulsory(s) = FALSE; uses_count(s) = 0; dirty(s) = FALSE; if( enclosing(s) != nilobj && type(enclosing(s)) == NPAR ) dirty(s) = dirty(enclosing(s)) = TRUE; has_par(s) = FALSE; has_lpar(s) = FALSE; has_rpar(s) = FALSE; if( is_par(type(s)) ) has_par(enclosing(s)) = TRUE; if( type(s) == LPAR ) has_lpar(enclosing(s)) = TRUE; if( type(s) == RPAR ) has_rpar(enclosing(s)) = TRUE; /* assign a code letter between a and z to any NPAR symbol */ if( type(s) == NPAR ) { if( LastDown(enclosing(s)) != enclosing(s) ) { Child(tmp, LastDown(enclosing(s))); if( type(tmp) == NPAR ) { if( npar_code(tmp) == 'z' || npar_code(tmp) == ' ' ) npar_code(s) = ' '; else npar_code(s) = npar_code(tmp)+1; } else npar_code(s) = 'a'; } else npar_code(s) = 'a'; } has_target(s) = FALSE; force_target(s) = FALSE; if( !StringEqual(str, KW_TARGET) ) is_target(s) = FALSE; else { is_target(s) = has_target(enclosing(s)) = TRUE; /* if @Target is found after @Key, take note of external target */ if( has_key(enclosing(s)) && xbody != nilobj && is_cross(type(xbody)) ) { if( LastDown(xbody) != Down(xbody) ) { OBJECT sym; Child(sym, Down(xbody)); if( type(sym) == CLOSURE ) { is_extern_target(actual(sym)) = TRUE; uses_extern_target(actual(sym)) = TRUE; } } } } has_tag(s) = is_tag(s) = FALSE; has_key(s) = is_key(s) = FALSE; has_optimize(s) = is_optimize(s) = FALSE; has_merge(s) = is_merge(s) = FALSE; has_enclose(s) = is_enclose(s) = FALSE; if( enclosing(s) != nilobj && type(enclosing(s)) == LOCAL ) { if( StringEqual(str, KW_TAG) ) is_tag(s) = has_tag(enclosing(s)) = dirty(enclosing(s)) = TRUE; if( StringEqual(str, KW_OPTIMIZE) ) is_optimize(s) = has_optimize(enclosing(s)) = TRUE; if( StringEqual(str, KW_KEY) ) { is_key(s) = has_key(enclosing(s)) = dirty(enclosing(s)) = TRUE; /* if @Key is found after @Target, take note of external target */ for( link=Down(enclosing(s)); link!=enclosing(s); link=NextDown(link) ) { Child(p, link); if( is_target(p) && sym_body(p)!=nilobj && is_cross(type(sym_body(p))) ) { OBJECT sym; Child(sym, Down(sym_body(p))); if( type(sym) == CLOSURE ) { is_extern_target(actual(sym)) = TRUE; uses_extern_target(actual(sym)) = TRUE; } } } } if( StringEqual(str, KW_MERGE) ) is_merge(s) = has_merge(enclosing(s)) = TRUE; if( StringEqual(str, KW_ENCLOSE) ) is_enclose(s) = has_enclose(enclosing(s)) = TRUE; } if( StringEqual(str, KW_FILTER) ) { if( type(s) != LOCAL || enclosing(s) == StartSym ) Error(29, 4, "%s must be a local definition", WARN, &fpos(s), str); else if( !has_rpar(enclosing(s)) ) Error(29, 14, "%s must lie within a symbol with a right parameter", WARN, &fpos(s), KW_FILTER); else { filter(enclosing(s)) = s; precedence(enclosing(s)) = FILTER_PREC; } } if( type(s) == RPAR && has_body(enclosing(s)) && (is_tag(s) || is_key(s) || is_optimize(s)) ) Error(29, 5, "a body parameter may not be named %s", WARN, &fpos(s), str); if( type(s) == RPAR && has_target(enclosing(s)) && (is_tag(s) || is_key(s) || is_optimize(s)) ) Error(29, 6, "the right parameter of a galley may not be called %s", WARN, &fpos(s), str); len = StringLength(str); hash(str, len, sum); ifdebug(DST, DD, sym_spread[sum]++; sym_count++); entry = (OBJECT) &symtab[sum]; for( plink = Down(entry); plink != entry; plink = NextDown(plink) ) { Child(p, plink); if( length(p) == len && StringEqual(str, string(p)) ) { for( link = Down(p); link != p; link = NextDown(link) ) { Child(q, link); if( enclosing(s) == enclosing(q) ) { Error(29, 7, "symbol %s previously defined at%s", WARN, &fpos(s), str, EchoFilePos(&fpos(q)) ); if( AltErrorFormat ) { Error(29, 13, "symbol %s previously defined here", WARN, &fpos(q), str); } break; } } goto wrapup; } } /* need a new OBJECT as well as s */ NewWord(p, WORD, len, xfpos); length(p) = len; StringCopy(string(p), str); Link(entry, p); wrapup: Link(p, s); if( enclosing(s) != nilobj ) Link(enclosing(s), s); debug2(DST, DD, "InsertSym Link(%s, %s) and returning.", SymName(enclosing(s)), SymName(s)); return s; } /* end InsertSym */ /*****************************************************************************/ /* */ /* InsertAlternativeName(str, s, xfpos) */ /* */ /* Insert an alternative name for symbol s. */ /* */ /*****************************************************************************/ void InsertAlternativeName(FULL_CHAR *str, OBJECT s, FILE_POS *xfpos) { register int sum, rlen; register unsigned char *x; int len; OBJECT entry, link, plink, p, q; debug3(DST, DD, "InsertAlternativeName(%s, %s, %s)", str, SymName(s), EchoFilePos(xfpos)); len = StringLength(str); hash(str, len, sum); ifdebug(DST, DD, sym_spread[sum]++; sym_count++); entry = (OBJECT) &symtab[sum]; for( plink = Down(entry); plink != entry; plink = NextDown(plink) ) { Child(p, plink); if( length(p) == len && StringEqual(str, string(p)) ) { for( link = Down(p); link != p; link = NextDown(link) ) { Child(q, link); if( enclosing(s) == enclosing(q) ) { Error(29, 12, "symbol name %s previously defined at%s", WARN, &fpos(s), str, EchoFilePos(&fpos(q)) ); break; } } goto wrapup; } } /* need a new OBJECT as well as s */ NewWord(p, WORD, len, xfpos); length(p) = len; StringCopy(string(p), str); Link(entry, p); wrapup: Link(p, s); /* not for copies if( enclosing(s) != nilobj ) Link(enclosing(s), s); */ debug0(DST, DD, "InsertAlternativeName returning."); } /* end InsertAlternativeName */ /*@::SearchSym(), SymName()@**************************************************/ /* */ /* OBJECT SearchSym(str, len) */ /* */ /* Search the symbol table for str, with length len, and return an */ /* OBJECT referencing the entry if found. Otherwise return nilobj. */ /* */ /*****************************************************************************/ OBJECT SearchSym(FULL_CHAR *str, int len) { register int rlen, sum; register FULL_CHAR *x, *y; OBJECT p, q, link, plink, entry; int s; debug2(DST, DDD, "SearchSym( %c..., %d )", str[0], len); hash(str, len, sum); rlen = len; entry = (OBJECT) &symtab[sum]; for( plink = Down(entry); plink != entry; plink = NextDown(plink) ) { Child(p, plink); if( rlen == length(p) ) { x = str; y = string(p); do; while( *x++ == *y++ && --rlen ); if( rlen == 0 ) { debug1(DST, DDD, " found %s", string(p)); s = scope_top; do { s--; for( link = Down(p); link != p; link = NextDown(link) ) { Child(q, link); { debugcond4(DST, DDD, enclosing(q) == scope[s], " !npars_only[s] = %s, !vis_only[s] = %s, body_ok[s] = %s, !ss = %s", bool(!npars_only[s]), bool(!vis_only[s]), bool(body_ok[s]), bool(!suppress_scope)); } if( enclosing(q) == scope[s] && (!npars_only[s] || type(q) == NPAR) && (!vis_only[s] || visible(q) || suppress_visible ) && (body_ok[s] || type(q)!=RPAR || !has_body(enclosing(q)) || suppress_visible ) && (!suppress_scope || StringEqual(string(p), KW_INCLUDE) || StringEqual(string(p), KW_SYSINCLUDE)) ) { debug3(DST, DD, "SearchSym returning %s %s%%%s", Image(type(q)), SymName(q), SymName(enclosing(q))); return q; } } } while( scope[s] != StartSym ); } } rlen = len; } debug0(DST, DDD, "SearchSym returning "); return nilobj; } /* end SearchSym */ /*****************************************************************************/ /* */ /* FULL_CHAR *SymName(s) */ /* */ /* Return the string value of the name of symbol s. */ /* */ /*****************************************************************************/ FULL_CHAR *SymName(OBJECT s) { OBJECT p; if( s == nilobj ) return AsciiToFull(""); Parent(p, Up(s)); assert( is_word(type(p)), "SymName: !is_word(type(p))!" ); return string(p); } /* end SymName */ /*@::FullSymName(), ChildSym()@***********************************************/ /* */ /* FULL_CHAR *FullSymName(x, str) */ /* */ /* Return the path name of symbol x. with str separating each entry. */ /* */ /*****************************************************************************/ FULL_CHAR *FullSymName(OBJECT x, FULL_CHAR *str) { OBJECT stack[20]; int i; static FULL_CHAR buff[MAX_BUFF], *sname; if( x == nilobj ) return AsciiToFull(""); assert( enclosing(x) != nilobj, "FullSymName: enclosing(x) == nilobj!" ); for( i = 0; enclosing(x) != nilobj && i < 20; i++ ) { stack[i] = x; x = enclosing(x); } StringCopy(buff, STR_EMPTY); for( i--; i > 0; i-- ) { sname = SymName(stack[i]); if( StringLength(sname)+StringLength(str)+StringLength(buff) >= MAX_BUFF ) Error(29, 8, "full name of symbol is too long", FATAL, &fpos(x)); StringCat(buff, sname); StringCat(buff, str); } sname = SymName(stack[0]); if( StringLength(sname) + StringLength(buff) >= MAX_BUFF ) Error(29, 9, "full name of symbol is too long", FATAL, &fpos(x)); StringCat(buff, sname); return buff; } /* end FullSymName */ /*****************************************************************************/ /* */ /* OBJECT ChildSym(s, typ) */ /* */ /* Find the child of symbol s of type typ, either LPAR or RPAR. */ /* */ /*****************************************************************************/ OBJECT ChildSym(OBJECT s, unsigned typ) { OBJECT link, y; for( link = Down(s); link != s; link = NextDown(link) ) { Child(y, link); if( type(y) == typ && enclosing(y) == s ) return y; } Error(29, 10, "symbol %s has missing %s", FATAL, &fpos(s), SymName(s), Image(typ)); return nilobj; } /* end ChildSym */ /*****************************************************************************/ /* */ /* OBJECT ChildSymWithCode(s, code) */ /* */ /* Find the child of symbol s with the given npar code, else nil. */ /* */ /*****************************************************************************/ OBJECT ChildSymWithCode(OBJECT s, unsigned char code) { OBJECT link, y; for( link = Down(actual(s)); link != actual(s); link = NextDown(link) ) { Child(y, link); if( type(y) == NPAR && enclosing(y) == actual(s) && npar_code(y) == code ) return y; } Error(29, 11, "symbol %s has erroneous code %c (database out of date?)", FATAL, &fpos(s), SymName(actual(s)), (char) code); return nilobj; } /* end ChildSym */ /*@::CheckSymSpread(), DeleteSymBody()@***************************************/ /* */ /* CheckSymSpread() */ /* */ /* Check the spread of symbols through the hash table. */ /* */ /*****************************************************************************/ #if DEBUG_ON void CheckSymSpread(void) { int i, j, sum, usum; OBJECT entry, plink; debug2(DST, DD, "Symbol table spread (table size = %d, symbols = %d):", MAX_TAB, sym_count); usum = sum = 0; for( i = 0; i < MAX_TAB; i++ ) { fprintf(stderr, "%4d: ", i); for( j = 1; j <= sym_spread[i]; j++ ) { fprintf(stderr, "."); sum += j; } entry = (OBJECT) &symtab[i]; for( plink=Down(entry), j=1; plink != entry; plink=NextDown(plink), j++ ) { fprintf(stderr, "+"); usum += j; } fprintf(stderr, "%s", STR_NEWLINE); } fprintf(stderr, "average length counting duplicate names = %.1f", (float) sum / sym_count); fprintf(stderr, "%s", STR_NEWLINE); fprintf(stderr, "average length not counting duplicate names = %.1f", (float) usum / sym_count); fprintf(stderr, "%s", STR_NEWLINE); } /* end CheckSymSpread */ /*****************************************************************************/ /* */ /* static DeleteSymBody(s) */ /* */ /* Delete the body of symbol s. */ /* */ /*****************************************************************************/ static void DeleteSymBody(OBJECT s) { OBJECT t; debug1(DST, DDD, "DeleteSymBody( %s )", SymName(s)); switch( type(s) ) { case MACRO: while( sym_body(s) != nilobj ) { t = sym_body(s); sym_body(s) = Delete(sym_body(s), PARENT); Dispose(t); } break; case LPAR: case NPAR: case RPAR: case LOCAL: if( sym_body(s) != nilobj ) DisposeObject(sym_body(s)); break; default: assert1(FALSE, "DeleteSymBody:", Image(type(s))); break; } debug0(DST, DDD, "DeleteSymBody returning."); } /* end DeleteSymBody */ /*@::DeleteEverySym()@********************************************************/ /* */ /* DeleteEverySym() */ /* */ /* Delete every symbol in the symbol table. */ /* Note that we first delete all bodies, then the symbols themselves. */ /* This is so that the closures within the bodies have well-defined */ /* actual() pointers, even while the symbol table is being disposed. */ /* If this is not done, debug output during the disposal gets confused. */ /* */ /*****************************************************************************/ void DeleteEverySym(void) { int i, j, load, cost; OBJECT p, plink, link, x, entry; debug0(DST, DD, "DeleteEverySym()"); /* dispose the bodies of all symbols */ for( i = 0; i < MAX_TAB; i++ ) { entry = (OBJECT) &symtab[i]; for( plink = Down(entry); plink != entry; plink = NextDown(plink) ) { Child(p, plink); for( link = Down(p); link != p; link = NextDown(link) ) { Child(x, link); DeleteSymBody(x); /* *** will not work now while( base_uses(x) != nilobj ) { tmp = base_uses(x); base_uses(x) = next(tmp); PutMem(tmp, USES_SIZE); } while( uses(x) != nilobj ) { tmp = uses(x); uses(x) = next(tmp); PutMem(tmp, USES_SIZE); } *** */ } } } /* dispose the symbol name strings, gather statistics, and print them */ load = cost = 0; for( i = 0; i < MAX_TAB; i++ ) { j = 1; entry = (OBJECT) &symtab[i]; while( Down(entry) != entry ) { load += 1; cost += j; j += 1; DisposeChild(Down(entry)); } } if( load > 0 ) { debug4(DST, DD, "size = %d, items = %d (%d%%), probes = %.1f", MAX_TAB, load, (100*load)/MAX_TAB, (float) cost/load); } else { debug1(DST, DD, "table size = %d, no entries in table", MAX_TAB); } debug0(DST, DD, "DeleteEverySym returning."); } /* end DeleteEverySym */ #endif