1 /*@z29.c:Symbol Table:Declarations, hash()@***********************************/
2 /* */
3 /* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.39) */
4 /* COPYRIGHT (C) 1991, 2008 Jeffrey H. Kingston */
5 /* */
6 /* Jeffrey H. Kingston (jeff@it.usyd.edu.au) */
7 /* School of Information Technologies */
8 /* The University of Sydney 2006 */
9 /* AUSTRALIA */
10 /* */
11 /* This program is free software; you can redistribute it and/or modify */
12 /* it under the terms of the GNU General Public License as published by */
13 /* the Free Software Foundation; either Version 3, or (at your option) */
14 /* any later version. */
15 /* */
16 /* This program is distributed in the hope that it will be useful, */
17 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
18 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
19 /* GNU General Public License for more details. */
20 /* */
21 /* You should have received a copy of the GNU General Public License */
22 /* along with this program; if not, write to the Free Software */
23 /* Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA */
24 /* */
25 /* FILE: z29.c */
26 /* MODULE: Symbol Table */
27 /* EXTERNS: InitSym(), PushScope(), PopScope(), SuppressVisible(), */
28 /* UnSuppressVisible(), SuppressScope(), UnSuppressScope(), */
29 /* SwitchScope(), UnSwitchScope(), BodyParAllowed(), */
30 /* BodyParNotAllowed(), InsertSym(), SearchSym(), */
31 /* SymName(), FullSymName(), ChildSym(), CheckSymSpread(), */
32 /* DeleteEverySym() */
33 /* */
34 /*****************************************************************************/
35 #include "externs.h"
36
37 #define MAX_STACK 300 /* size of scope stack */
38 #define MAX_TAB 1783 /* size of hash table */
39
40 #define length(x) word_font(x)
41
42 static OBJECT scope[MAX_STACK]; /* the scope stack */
43 static BOOLEAN npars_only[MAX_STACK]; /* look for NPAR exc */
44 static BOOLEAN vis_only[MAX_STACK]; /* look for visibles */
45 static BOOLEAN body_ok[MAX_STACK]; /* look for body par */
46 static BOOLEAN suppress_scope; /* suppress scoping */
47 static BOOLEAN suppress_visible; /* suppress visible */
48 static int scope_top; /* scope stack top */
49 static struct { OBJECT f1, f2; } symtab[MAX_TAB]; /* the hash table */
50 #if DEBUG_ON
51 static int sym_spread[MAX_TAB]; /* hash table spread */
52 static int sym_count; /* symbol count */
53 #endif
54
55
56 /*****************************************************************************/
57 /* */
58 /* #define hash(str, len, val) */
59 /* */
60 /* Set val to the hash value of string str, which has length len. */
61 /* The hash function is just the character sum mod MAX_TAB. */
62 /* This definition assumes that working variables rlen and x exist. */
63 /* */
64 /*****************************************************************************/
65
66 #define hash(str, len, val) \
67 { rlen = len; \
68 x = str; \
69 val = *x++; \
70 while( --rlen ) val += *x++; \
71 val %= MAX_TAB; \
72 }
73
74
75 /*@::InitSym(), PushScope(), PopScope(), SuppressVisible(), etc.@*************/
76 /* */
77 /* InitSym() */
78 /* */
79 /* Initialize the symbol table to empty. */
80 /* */
81 /*****************************************************************************/
82
InitSym(void)83 void InitSym(void)
84 { int i;
85 scope_top = 0;
86 suppress_scope = FALSE;
87 suppress_visible = FALSE;
88 for( i = 0; i < MAX_TAB; i++ )
89 symtab[i].f1 = symtab[i].f2 = (OBJECT) &symtab[i];
90 #if DEBUG_ON
91 for( i = 0; i < MAX_TAB; i++ )
92 sym_spread[i] = 0;
93 sym_count = 0;
94 #endif
95 } /* end InitSym */
96
97
98 /*****************************************************************************/
99 /* */
100 /* PushScope(x, npars, vis) */
101 /* PopScope() */
102 /* */
103 /* Add or remove an OBJECT x (which must be in the symbol table) to or from */
104 /* the scope stack. If npars is TRUE, only the named parameters of x are */
105 /* added to scope. If vis is TRUE, only visible locals and parameters are */
106 /* added. */
107 /* */
108 /*****************************************************************************/
109
PushScope(OBJECT x,BOOLEAN npars,BOOLEAN vis)110 void PushScope(OBJECT x, BOOLEAN npars, BOOLEAN vis)
111 { debug3(DST, DD, "[ PushScope(%s, %s, %s)", SymName(x), bool(npars), bool(vis));
112 assert( suppress_scope == FALSE, "PushScope: suppress_scope!" );
113 if( scope_top >= MAX_STACK )
114 {
115 #if DEBUG_ON
116 int i;
117 for( i = 0; i < scope_top; i++ )
118 Error(29, 1, " scope[%2d] = %s", WARN, &fpos(x), i, SymName(scope[i]));
119 #endif
120 Error(29, 2, "scope depth limit exceeded", INTERN, &fpos(x));
121 }
122 scope[scope_top] = x;
123 npars_only[scope_top] = npars;
124 vis_only[scope_top] = vis;
125 body_ok[scope_top] = FALSE;
126 scope_top++;
127 } /* end PushScope */
128
PopScope(void)129 void PopScope(void)
130 { debug0(DST, DD, "] PopScope()");
131 assert( scope_top > 0, "PopScope: tried to pop empty scope stack");
132 assert( suppress_scope == FALSE, "PopScope: suppress_scope!" );
133 scope_top--;
134 } /* end PopScope */
135
136
137 /*****************************************************************************/
138 /* */
139 /* SuppressVisible() */
140 /* UnSuppressVisible() */
141 /* */
142 /* Make all children of any symbol acceptable, not just the exported ones. */
143 /* */
144 /*****************************************************************************/
145
SuppressVisible(void)146 void SuppressVisible(void)
147 { debug0(DST, DD, "[ SuppressVisible()");
148 suppress_visible = TRUE;
149 } /* end SuppressVisible */
150
UnSuppressVisible(void)151 void UnSuppressVisible(void)
152 { debug0(DST, DD, "] UnSuppressVisible()");
153 suppress_visible = FALSE;
154 } /* end UnSuppressVisible */
155
156
157 /*@::SuppressScope(), UnSuppressScope(), SwitchScope(), UnswitchScope()@******/
158 /* */
159 /* SuppressScope() */
160 /* UnSuppressScope() */
161 /* */
162 /* Suppress all scopes (so that all calls to SearchSym fail); and undo it. */
163 /* */
164 /*****************************************************************************/
165
166
SuppressScope(void)167 void SuppressScope(void)
168 { debug0(DST, DD, "[ SuppressScope()");
169 suppress_scope = TRUE;
170 } /* end SuppressScope */
171
UnSuppressScope(void)172 void UnSuppressScope(void)
173 { debug0(DST, DD, "] UnSuppressScope()");
174 suppress_scope = FALSE;
175 } /* end UnSuppressScope */
176
177
178 /*****************************************************************************/
179 /* */
180 /* SwitchScope(sym) */
181 /* UnSwitchScope(sym) */
182 /* */
183 /* Switch to the scope of sym (if nilobj, StartSym); and switch back again. */
184 /* */
185 /*****************************************************************************/
186
SwitchScope(OBJECT sym)187 void SwitchScope(OBJECT sym)
188 { int i;
189 OBJECT new_scopes[MAX_STACK];
190 if( sym == nilobj ) PushScope(StartSym, FALSE, FALSE);
191 else
192 { i = 0;
193 while( sym != StartSym )
194 { new_scopes[i++] = enclosing(sym);
195 sym = enclosing(sym);
196 }
197 while( i > 0 ) PushScope(new_scopes[--i], FALSE, FALSE);
198 }
199 }
200
UnSwitchScope(OBJECT sym)201 void UnSwitchScope(OBJECT sym)
202 { if( sym == nilobj ) PopScope();
203 else
204 { while( sym != StartSym )
205 { PopScope();
206 sym = enclosing(sym);
207 }
208 }
209 }
210
211
212 /*****************************************************************************/
213 /* */
214 /* BodyParAllowed() */
215 /* BodyParNotAllowed() */
216 /* */
217 /* Allow or disallow invocations of the body parameter of the current tos. */
218 /* */
219 /*****************************************************************************/
220
BodyParAllowed(void)221 void BodyParAllowed(void)
222 { debug0(DST, DD, "BodyParAllowed()");
223 body_ok[scope_top-1] = TRUE;
224 } /* end BodyParAllowed */
225
BodyParNotAllowed(void)226 void BodyParNotAllowed(void)
227 { debug0(DST, DD, "BodyParNotAllowed()");
228 body_ok[scope_top-1] = FALSE;
229 } /* end BodyParNotAllowed */
230
231
232 /*****************************************************************************/
233 /* */
234 /* DebugScope(void) */
235 /* */
236 /* Debug print of current scope stack */
237 /* */
238 /*****************************************************************************/
239
DebugScope(void)240 void DebugScope(void)
241 { int i;
242 if( suppress_scope )
243 {
244 debug0(DST, D, "suppressed");
245 }
246 else for( i = 0; i < scope_top; i++ )
247 { debug6(DST, D, "%s %s%s%s%s%s",
248 i == scope_top - 1 ? "->" : " ",
249 SymName(scope[i]),
250 npars_only[i] ? " npars_only" : "",
251 vis_only[i] ? " vis_only" : "",
252 body_ok[i] ? " body_ok" : "",
253 i == scope_top - 1 && suppress_visible ? " suppress_visible" : "");
254 }
255 } /* end DebugScope */
256
257
258 /*@::ScopeSnapshot()@*********************************************************/
259 /* */
260 /* OBJECT GetScopeSnapshot() */
261 /* LoadScopeSnapshot(ss) */
262 /* ClearScopeSnapshot(ss) */
263 /* */
264 /* A scope snapshot is a complete record of the state of the scope stack */
265 /* at some moment. These routines allow you to take a scope snapshot, */
266 /* then subsequently load it (i.e. make it the current scope), then */
267 /* subsequently clear it (i.e. return to whatever was before the Load). */
268 /* */
269 /*****************************************************************************/
270
GetScopeSnapshot()271 OBJECT GetScopeSnapshot()
272 { OBJECT ss, x; int i;
273 New(ss, ACAT);
274 for( i = scope_top-1; scope[i] != StartSym; i-- )
275 {
276 New(x, SCOPE_SNAPSHOT);
277 Link(ss, x);
278 Link(x, scope[i]);
279 ss_npars_only(x) = npars_only[i];
280 ss_vis_only(x) = vis_only[i];
281 ss_body_ok(x) = body_ok[i];
282 }
283 ss_suppress(ss) = suppress_visible;
284 return ss;
285 } /* end GetScopeSnapshot */
286
287
LoadScopeSnapshot(OBJECT ss)288 void LoadScopeSnapshot(OBJECT ss)
289 { OBJECT link, x, sym; BOOLEAN tmp;
290 assert( type(ss) == ACAT, "LoadScopeSnapshot: type(ss)!" );
291 PushScope(StartSym, FALSE, FALSE);
292 for( link = LastDown(ss); link != ss; link = PrevDown(link) )
293 { Child(x, link);
294 assert( type(x) == SCOPE_SNAPSHOT, "LoadScopeSnapshot: type(x)!" );
295 Child(sym, Down(x));
296 PushScope(sym, ss_npars_only(x), ss_vis_only(x));
297 body_ok[scope_top-1] = ss_body_ok(x);
298 }
299 tmp = suppress_visible;
300 suppress_visible = ss_suppress(ss);
301 ss_suppress(ss) = tmp;
302 debug0(DST, D, "after LoadScopeSnapshot, scope is:")
303 ifdebug(DST, D, DebugScope());
304 } /* end LoadScopeSnapshot */
305
306
ClearScopeSnapshot(OBJECT ss)307 void ClearScopeSnapshot(OBJECT ss)
308 {
309 while( scope[scope_top-1] != StartSym )
310 scope_top--;
311 scope_top--;
312 suppress_visible = ss_suppress(ss);
313 } /* end ClearScopeSnapshot */
314
315
316 /*@::InsertSym()@*************************************************************/
317 /* */
318 /* OBJECT InsertSym(str, xtype, xfpos, xprecedence, indefinite, xrecursive, */
319 /* xpredefined, xenclosing, xbody) */
320 /* */
321 /* Insert a new symbol into the table. Its string value is str. */
322 /* Initialise the symbol as the parameters indicate. */
323 /* Return a pointer to the new symbol. */
324 /* If str is not a valid symbol name, InsertSym prints an error */
325 /* message and does not insert the symbol. */
326 /* */
327 /*****************************************************************************/
328
InsertSym(FULL_CHAR * str,unsigned char xtype,FILE_POS * xfpos,unsigned char xprecedence,BOOLEAN xindefinite,BOOLEAN xrecursive,unsigned xpredefined,OBJECT xenclosing,OBJECT xbody)329 OBJECT InsertSym(FULL_CHAR *str, unsigned char xtype, FILE_POS *xfpos,
330 unsigned char xprecedence, BOOLEAN xindefinite, BOOLEAN xrecursive,
331 unsigned xpredefined, OBJECT xenclosing, OBJECT xbody)
332 { register int sum, rlen;
333 register unsigned char *x;
334 OBJECT p, q, s, tmp, link, entry, plink; int len;
335
336 debug3(DST, DD, "InsertSym( %s, %s, in %s )",
337 Image(xtype), str, SymName(xenclosing));
338 if( !LexLegalName(str) )
339 Error(29, 3, "invalid symbol name %s", WARN, xfpos, str);
340
341 New(s, xtype);
342 FposCopy(fpos(s), *xfpos);
343 has_body(s) = FALSE;
344 filter(s) = nilobj;
345 use_invocation(s) = nilobj;
346 imports(s) = nilobj;
347 imports_encl(s) = FALSE;
348 right_assoc(s) = TRUE;
349 precedence(s) = xprecedence;
350 indefinite(s) = xindefinite;
351 recursive(s) = xrecursive;
352 predefined(s) = xpredefined;
353 enclosing(s) = xenclosing;
354 sym_body(s) = xbody;
355 base_uses(s) = nilobj;
356 uses(s) = nilobj;
357 marker(s) = nilobj;
358 cross_sym(s) = nilobj;
359 is_extern_target(s) = FALSE;
360 uses_extern_target(s)= FALSE;
361 visible(s) = FALSE;
362 uses_galley(s) = FALSE;
363 horiz_galley(s) = ROWM;
364 has_compulsory(s) = 0;
365 is_compulsory(s) = FALSE;
366
367 uses_count(s) = 0;
368 dirty(s) = FALSE;
369 if( enclosing(s) != nilobj && type(enclosing(s)) == NPAR )
370 dirty(s) = dirty(enclosing(s)) = TRUE;
371
372 has_par(s) = FALSE;
373 has_lpar(s) = FALSE;
374 has_rpar(s) = FALSE;
375 if( is_par(type(s)) ) has_par(enclosing(s)) = TRUE;
376 if( type(s) == LPAR ) has_lpar(enclosing(s)) = TRUE;
377 if( type(s) == RPAR ) has_rpar(enclosing(s)) = TRUE;
378
379 /* assign a code letter between a and z to any NPAR symbol */
380 if( type(s) == NPAR )
381 { if( LastDown(enclosing(s)) != enclosing(s) )
382 { Child(tmp, LastDown(enclosing(s)));
383 if( type(tmp) == NPAR )
384 { if( npar_code(tmp) == 'z' || npar_code(tmp) == ' ' )
385 npar_code(s) = ' ';
386 else
387 npar_code(s) = npar_code(tmp)+1;
388 }
389 else
390 npar_code(s) = 'a';
391 }
392 else npar_code(s) = 'a';
393 }
394
395 has_target(s) = FALSE;
396 force_target(s) = FALSE;
397 if( !StringEqual(str, KW_TARGET) ) is_target(s) = FALSE;
398 else
399 { is_target(s) = has_target(enclosing(s)) = TRUE;
400
401 /* if @Target is found after @Key, take note of external target */
402 if( has_key(enclosing(s)) && xbody != nilobj && is_cross(type(xbody)) )
403 { if( LastDown(xbody) != Down(xbody) )
404 { OBJECT sym;
405 Child(sym, Down(xbody));
406 if( type(sym) == CLOSURE )
407 { is_extern_target(actual(sym)) = TRUE;
408 uses_extern_target(actual(sym)) = TRUE;
409 }
410 }
411 }
412 }
413
414 has_tag(s) = is_tag(s) = FALSE;
415 has_key(s) = is_key(s) = FALSE;
416 has_optimize(s) = is_optimize(s) = FALSE;
417 has_merge(s) = is_merge(s) = FALSE;
418 has_enclose(s) = is_enclose(s) = FALSE;
419 if( enclosing(s) != nilobj && type(enclosing(s)) == LOCAL )
420 {
421 if( StringEqual(str, KW_TAG) )
422 is_tag(s) = has_tag(enclosing(s)) = dirty(enclosing(s)) = TRUE;
423
424 if( StringEqual(str, KW_OPTIMIZE) )
425 is_optimize(s) = has_optimize(enclosing(s)) = TRUE;
426
427 if( StringEqual(str, KW_KEY) )
428 { is_key(s) = has_key(enclosing(s)) = dirty(enclosing(s)) = TRUE;
429
430 /* if @Key is found after @Target, take note of external target */
431 for( link=Down(enclosing(s)); link!=enclosing(s); link=NextDown(link) )
432 { Child(p, link);
433 if( is_target(p) && sym_body(p)!=nilobj && is_cross(type(sym_body(p))) )
434 { OBJECT sym;
435 Child(sym, Down(sym_body(p)));
436 if( type(sym) == CLOSURE )
437 { is_extern_target(actual(sym)) = TRUE;
438 uses_extern_target(actual(sym)) = TRUE;
439 }
440 }
441 }
442 }
443
444 if( StringEqual(str, KW_MERGE) )
445 is_merge(s) = has_merge(enclosing(s)) = TRUE;
446
447 if( StringEqual(str, KW_ENCLOSE) )
448 is_enclose(s) = has_enclose(enclosing(s)) = TRUE;
449 }
450
451 if( StringEqual(str, KW_FILTER) )
452 { if( type(s) != LOCAL || enclosing(s) == StartSym )
453 Error(29, 4, "%s must be a local definition", WARN, &fpos(s), str);
454 else if( !has_rpar(enclosing(s)) )
455 Error(29, 14, "%s must lie within a symbol with a right parameter",
456 WARN, &fpos(s), KW_FILTER);
457 else
458 { filter(enclosing(s)) = s;
459 precedence(enclosing(s)) = FILTER_PREC;
460 }
461 }
462
463 if( type(s) == RPAR && has_body(enclosing(s)) &&
464 (is_tag(s) || is_key(s) || is_optimize(s)) )
465 Error(29, 5, "a body parameter may not be named %s", WARN, &fpos(s), str);
466
467 if( type(s) == RPAR && has_target(enclosing(s)) &&
468 (is_tag(s) || is_key(s) || is_optimize(s)) )
469 Error(29, 6, "the right parameter of a galley may not be called %s",
470 WARN, &fpos(s), str);
471
472 len = StringLength(str);
473 hash(str, len, sum);
474
475 ifdebug(DST, D, sym_spread[sum]++; sym_count++);
476 entry = (OBJECT) &symtab[sum];
477 for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
478 { Child(p, plink);
479 if( length(p) == len && StringEqual(str, string(p)) )
480 { for( link = Down(p); link != p; link = NextDown(link) )
481 { Child(q, link);
482 if( enclosing(s) == enclosing(q) )
483 { Error(29, 7, "symbol %s previously defined at%s",
484 WARN, &fpos(s), str, EchoFilePos(&fpos(q)) );
485 if( AltErrorFormat )
486 {
487 Error(29, 13, "symbol %s previously defined here",
488 WARN, &fpos(q), str);
489 }
490 break;
491 }
492 }
493 goto wrapup;
494 }
495 }
496
497 /* need a new OBJECT as well as s */
498 NewWord(p, WORD, len, xfpos);
499 length(p) = len;
500 StringCopy(string(p), str);
501 Link(entry, p);
502
503 wrapup:
504 Link(p, s);
505 if( enclosing(s) != nilobj ) Link(enclosing(s), s);
506 debug2(DST, DD, "InsertSym Link(%s, %s) and returning.",
507 SymName(enclosing(s)), SymName(s));
508 return s;
509 } /* end InsertSym */
510
511
512 /*****************************************************************************/
513 /* */
514 /* InsertAlternativeName(str, s, xfpos) */
515 /* */
516 /* Insert an alternative name for symbol s. */
517 /* */
518 /*****************************************************************************/
519
InsertAlternativeName(FULL_CHAR * str,OBJECT s,FILE_POS * xfpos)520 void InsertAlternativeName(FULL_CHAR *str, OBJECT s, FILE_POS *xfpos)
521 { register int sum, rlen;
522 register unsigned char *x;
523 int len;
524 OBJECT entry, link, plink, p, q;
525 debug3(DST, DD, "InsertAlternativeName(%s, %s, %s)",
526 str, SymName(s), EchoFilePos(xfpos));
527
528 len = StringLength(str);
529 hash(str, len, sum);
530
531 ifdebug(DST, D, sym_spread[sum]++; sym_count++);
532 entry = (OBJECT) &symtab[sum];
533 for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
534 { Child(p, plink);
535 if( length(p) == len && StringEqual(str, string(p)) )
536 { for( link = Down(p); link != p; link = NextDown(link) )
537 { Child(q, link);
538 if( enclosing(s) == enclosing(q) )
539 { Error(29, 12, "symbol name %s previously defined at%s",
540 WARN, &fpos(s), str, EchoFilePos(&fpos(q)) );
541 break;
542 }
543 }
544 goto wrapup;
545 }
546 }
547
548 /* need a new OBJECT as well as s */
549 NewWord(p, WORD, len, xfpos);
550 length(p) = len;
551 StringCopy(string(p), str);
552 Link(entry, p);
553
554 wrapup:
555 Link(p, s);
556 /* not for copies if( enclosing(s) != nilobj ) Link(enclosing(s), s); */
557 debug0(DST, DD, "InsertAlternativeName returning.");
558 } /* end InsertAlternativeName */
559
560
561 /*@::SearchSym(), SymName()@**************************************************/
562 /* */
563 /* OBJECT SearchSym(str, len) */
564 /* */
565 /* Search the symbol table for str, with length len, and return an */
566 /* OBJECT referencing the entry if found. Otherwise return nilobj. */
567 /* */
568 /*****************************************************************************/
569
SearchSym(FULL_CHAR * str,int len)570 OBJECT SearchSym(FULL_CHAR *str, int len)
571 { register int rlen, sum;
572 register FULL_CHAR *x, *y;
573 OBJECT p, q, link, plink, entry;
574 int s;
575
576 debug2(DST, DDD, "SearchSym( %c..., %d )", str[0], len);
577
578 hash(str, len, sum);
579 rlen = len;
580 entry = (OBJECT) &symtab[sum];
581 for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
582 { Child(p, plink);
583 if( rlen == length(p) )
584 { x = str; y = string(p);
585 do; while( *x++ == *y++ && --rlen );
586 if( rlen == 0 )
587 {
588 debug1(DST, DDD, " found %s", string(p));
589 s = scope_top;
590 do
591 { s--;
592 for( link = Down(p); link != p; link = NextDown(link) )
593 { Child(q, link);
594 { debugcond4(DST, DDD, enclosing(q) == scope[s],
595 " !npars_only[s] = %s, !vis_only[s] = %s, body_ok[s] = %s, !ss = %s",
596 bool(!npars_only[s]), bool(!vis_only[s]), bool(body_ok[s]),
597 bool(!suppress_scope));
598 }
599 if( enclosing(q) == scope[s]
600 && (!npars_only[s] || type(q) == NPAR)
601 && (!vis_only[s] || visible(q) || suppress_visible )
602 && (body_ok[s] || type(q)!=RPAR || !has_body(enclosing(q))
603 || suppress_visible )
604 && (!suppress_scope || StringEqual(string(p), KW_INCLUDE) ||
605 StringEqual(string(p), KW_SYSINCLUDE))
606 )
607 { debug3(DST, DD, "SearchSym returning %s %s%%%s",
608 Image(type(q)), SymName(q), SymName(enclosing(q)));
609 return q;
610 }
611 }
612 } while( scope[s] != StartSym );
613 }
614 }
615 rlen = len;
616 }
617 debug0(DST, DDD, "SearchSym returning <nilobj>");
618 return nilobj;
619 } /* end SearchSym */
620
621
622 /*****************************************************************************/
623 /* */
624 /* FULL_CHAR *SymName(s) */
625 /* */
626 /* Return the string value of the name of symbol s. */
627 /* */
628 /*****************************************************************************/
629
SymName(OBJECT s)630 FULL_CHAR *SymName(OBJECT s)
631 { OBJECT p;
632 if( s == nilobj ) return AsciiToFull("<nilobj>");
633 Parent(p, Up(s));
634 assert( is_word(type(p)), "SymName: !is_word(type(p))!" );
635 return string(p);
636 } /* end SymName */
637
638
639 /*@::FullSymName(), ChildSym()@***********************************************/
640 /* */
641 /* FULL_CHAR *FullSymName(x, str) */
642 /* */
643 /* Return the path name of symbol x. with str separating each entry. */
644 /* */
645 /*****************************************************************************/
646
FullSymName(OBJECT x,FULL_CHAR * str)647 FULL_CHAR *FullSymName(OBJECT x, FULL_CHAR *str)
648 { OBJECT stack[20]; int i;
649 static FULL_CHAR buff[MAX_BUFF], *sname;
650 if( x == nilobj ) return AsciiToFull("<nilobj>");
651 assert( enclosing(x) != nilobj, "FullSymName: enclosing(x) == nilobj!" );
652 for( i = 0; enclosing(x) != nilobj && i < 20; i++ )
653 { stack[i] = x;
654 x = enclosing(x);
655 }
656 StringCopy(buff, STR_EMPTY);
657 for( i--; i > 0; i-- )
658 { sname = SymName(stack[i]);
659 if( StringLength(sname)+StringLength(str)+StringLength(buff) >= MAX_BUFF )
660 Error(29, 8, "full name of symbol is too long", FATAL, &fpos(x));
661 StringCat(buff, sname);
662 StringCat(buff, str);
663 }
664 sname = SymName(stack[0]);
665 if( StringLength(sname) + StringLength(buff) >= MAX_BUFF )
666 Error(29, 9, "full name of symbol is too long", FATAL, &fpos(x));
667 StringCat(buff, sname);
668 return buff;
669 } /* end FullSymName */
670
671
672 /*****************************************************************************/
673 /* */
674 /* OBJECT ChildSym(s, typ) */
675 /* */
676 /* Find the child of symbol s of type typ, either LPAR or RPAR. */
677 /* */
678 /*****************************************************************************/
679
ChildSym(OBJECT s,unsigned typ)680 OBJECT ChildSym(OBJECT s, unsigned typ)
681 { OBJECT link, y;
682 for( link = Down(s); link != s; link = NextDown(link) )
683 { Child(y, link);
684 if( type(y) == typ && enclosing(y) == s ) return y;
685 }
686 Error(29, 10, "symbol %s has missing %s", FATAL, &fpos(s),
687 SymName(s), Image(typ));
688 return nilobj;
689 } /* end ChildSym */
690
691
692 /*****************************************************************************/
693 /* */
694 /* OBJECT ChildSymWithCode(s, code) */
695 /* */
696 /* Find the child of symbol s with the given npar code, else nil. */
697 /* */
698 /*****************************************************************************/
699
ChildSymWithCode(OBJECT s,unsigned char code)700 OBJECT ChildSymWithCode(OBJECT s, unsigned char code)
701 { OBJECT link, y;
702 for( link = Down(actual(s)); link != actual(s); link = NextDown(link) )
703 { Child(y, link);
704 if( type(y) == NPAR && enclosing(y) == actual(s) && npar_code(y) == code )
705 return y;
706 }
707 Error(29, 11, "symbol %s has erroneous code %c (database out of date?)",
708 FATAL, &fpos(s), SymName(actual(s)), (char) code);
709 return nilobj;
710 } /* end ChildSym */
711
712
713 /*@::CheckSymSpread(), DeleteSymBody()@***************************************/
714 /* */
715 /* CheckSymSpread() */
716 /* */
717 /* Check the spread of symbols through the hash table. */
718 /* */
719 /*****************************************************************************/
720 #if DEBUG_ON
721
CheckSymSpread(void)722 void CheckSymSpread(void)
723 { int i, j, sum, usum; OBJECT entry, plink;
724 fprintf(stderr, "Symbol table spread (table size = %d, symbols = %d):",
725 MAX_TAB, sym_count);
726 usum = sum = 0;
727 for( i = 0; i < MAX_TAB; i++ )
728 { fprintf(stderr, "%4d: ", i);
729 for( j = 1; j <= sym_spread[i]; j++ )
730 { fprintf(stderr, ".");
731 sum += j;
732 }
733 entry = (OBJECT) &symtab[i];
734 for( plink=Down(entry), j=1; plink != entry; plink=NextDown(plink), j++ )
735 { fprintf(stderr, "+");
736 usum += j;
737 }
738 fprintf(stderr, "%s", STR_NEWLINE);
739 }
740 fprintf(stderr, "average length counting duplicate names = %.1f",
741 (float) sum / sym_count);
742 fprintf(stderr, "%s", STR_NEWLINE);
743 fprintf(stderr, "average length not counting duplicate names = %.1f",
744 (float) usum / sym_count);
745 fprintf(stderr, "%s", STR_NEWLINE);
746 } /* end CheckSymSpread */
747
748
749 /*****************************************************************************/
750 /* */
751 /* static DeleteSymBody(s) */
752 /* */
753 /* Delete the body of symbol s. */
754 /* */
755 /*****************************************************************************/
756
DeleteSymBody(OBJECT s)757 static void DeleteSymBody(OBJECT s)
758 { OBJECT t;
759 debug1(DST, DDD, "DeleteSymBody( %s )", SymName(s));
760 switch( type(s) )
761 {
762 case MACRO: while( sym_body(s) != nilobj )
763 { t = sym_body(s);
764 sym_body(s) = Delete(sym_body(s), PARENT);
765 Dispose(t);
766 }
767 break;
768
769 case LPAR:
770 case NPAR:
771 case RPAR:
772 case LOCAL: if( sym_body(s) != nilobj ) DisposeObject(sym_body(s));
773 break;
774
775 default: assert1(FALSE, "DeleteSymBody:", Image(type(s)));
776 break;
777 }
778 debug0(DST, DDD, "DeleteSymBody returning.");
779 } /* end DeleteSymBody */
780
781
782 /*@::DeleteEverySym()@********************************************************/
783 /* */
784 /* DeleteEverySym() */
785 /* */
786 /* Delete every symbol in the symbol table. */
787 /* Note that we first delete all bodies, then the symbols themselves. */
788 /* This is so that the closures within the bodies have well-defined */
789 /* actual() pointers, even while the symbol table is being disposed. */
790 /* If this is not done, debug output during the disposal gets confused. */
791 /* */
792 /*****************************************************************************/
793
DeleteEverySym(void)794 void DeleteEverySym(void)
795 { int i, j, load, cost; OBJECT p, plink, link, x, entry;
796 debug0(DST, DD, "DeleteEverySym()");
797
798 /* dispose the bodies of all symbols */
799 for( i = 0; i < MAX_TAB; i++ )
800 { entry = (OBJECT) &symtab[i];
801 for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
802 { Child(p, plink);
803 for( link = Down(p); link != p; link = NextDown(link) )
804 { Child(x, link); DeleteSymBody(x);
805 /* *** will not work now
806 while( base_uses(x) != nilobj )
807 { tmp = base_uses(x); base_uses(x) = next(tmp);
808 PutMem(tmp, USES_SIZE);
809 }
810 while( uses(x) != nilobj )
811 { tmp = uses(x); uses(x) = next(tmp);
812 PutMem(tmp, USES_SIZE);
813 }
814 *** */
815 }
816 }
817 }
818
819 /* dispose the symbol name strings, gather statistics, and print them */
820 load = cost = 0;
821 for( i = 0; i < MAX_TAB; i++ )
822 { j = 1; entry = (OBJECT) &symtab[i];
823 while( Down(entry) != entry )
824 { load += 1; cost += j; j += 1;
825 DisposeChild(Down(entry));
826 }
827 }
828 if( load > 0 )
829 { debug4(DST, DD, "size = %d, items = %d (%d%%), probes = %.1f",
830 MAX_TAB, load, (100*load)/MAX_TAB, (float) cost/load);
831 }
832 else
833 { debug1(DST, DD, "table size = %d, no entries in table", MAX_TAB);
834 }
835 debug0(DST, DD, "DeleteEverySym returning.");
836 } /* end DeleteEverySym */
837 #endif
838