/*@z29.c:Symbol Table:Declarations, hash()@***********************************/
/* */
/* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.26) */
/* COPYRIGHT (C) 1991, 2002 Jeffrey H. Kingston */
/* */
/* Jeffrey H. Kingston (jeff@cs.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 <nilobj>");
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("<nilobj>");
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("<nilobj>");
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, "\n");
}
fprintf(stderr, "average length counting duplicate names = %.1f\n",
(float) sum / sym_count);
fprintf(stderr, "average length not counting duplicate names = %.1f\n",
(float) usum / sym_count);
} /* 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
