1 /******************************** -*- C -*- ****************************
2 *
3 * Symbol Table module.
4 *
5 *
6 ***********************************************************************/
7
8 /***********************************************************************
9 *
10 * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,
11 * 2005,2006,2007,2008,2009 Free Software Foundation, Inc.
12 * Written by Steve Byrne.
13 *
14 * This file is part of GNU Smalltalk.
15 *
16 * GNU Smalltalk is free software; you can redistribute it and/or modify it
17 * under the terms of the GNU General Public License as published by the Free
18 * Software Foundation; either version 2, or (at your option) any later
19 * version.
20 *
21 * Linking GNU Smalltalk statically or dynamically with other modules is
22 * making a combined work based on GNU Smalltalk. Thus, the terms and
23 * conditions of the GNU General Public License cover the whole
24 * combination.
25 *
26 * In addition, as a special exception, the Free Software Foundation
27 * give you permission to combine GNU Smalltalk with free software
28 * programs or libraries that are released under the GNU LGPL and with
29 * independent programs running under the GNU Smalltalk virtual machine.
30 *
31 * You may copy and distribute such a system following the terms of the
32 * GNU GPL for GNU Smalltalk and the licenses of the other code
33 * concerned, provided that you include the source code of that other
34 * code when and as the GNU GPL requires distribution of source code.
35 *
36 * Note that people who make modified versions of GNU Smalltalk are not
37 * obligated to grant this special exception for their modified
38 * versions; it is their choice whether to do so. The GNU General
39 * Public License gives permission to release a modified version without
40 * this exception; this exception also makes it possible to release a
41 * modified version which carries forward this exception.
42 *
43 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
44 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
45 * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
46 * more details.
47 *
48 * You should have received a copy of the GNU General Public License along with
49 * GNU Smalltalk; see the file COPYING. If not, write to the Free Software
50 * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
51 *
52 ***********************************************************************/
53
54
55 #include "gstpriv.h"
56 #include "pointer-set.h"
57
58 typedef struct
59 {
60 OBJ_HEADER;
61 OOP nextLink;
62 OOP symbol;
63 }
64 *sym_link;
65
66 typedef struct symbol_list *symbol_list;
67
68 struct symbol_list
69 {
70 OOP symbol;
71 mst_Boolean readOnly;
72 int index;
73 symbol_list prevSymbol;
74 };
75
76 /* Represents all the identifiers, both arguments and temporaries,
77 which are declared in a given scope. Nested scopes result in
78 nested instances of the scope struct, with the current scope always
79 being the innermost at any point during the compilation. */
80 typedef struct scope *scope;
81 struct scope
82 {
83 scope prevScope;
84 unsigned int numArguments;
85 unsigned int numTemporaries;
86 symbol_list symbols;
87 };
88
89 /* Represents all the pools (namespaces) which are declared in the
90 current scope. This information is relatively complex to compute,
91 so it's kept cached. */
92 typedef struct pool_list *pool_list;
93 struct pool_list
94 {
95 OOP poolOOP;
96 pool_list next;
97 };
98
99
100 typedef struct symbol_info
101 {
102 OOP *symbolVar;
103 const char *value;
104 }
105 symbol_info;
106
107
108 /* These variables hold various symbols needed mostly by the compiler
109 and the C interface. It is important that these symbols are *not*
110 included in the builtin selectors list (builtins.gperf) because
111 of the way we create symbols in _gst_init_symbols_pass1. */
112
113 OOP _gst_and_symbol = NULL;
114 OOP _gst_as_scaled_decimal_radix_scale_symbol = NULL;
115 OOP _gst_bad_return_error_symbol = NULL;
116 OOP _gst_boolean_symbol = NULL;
117 OOP _gst_byte_array_out_symbol = NULL;
118 OOP _gst_byte_array_symbol = NULL;
119 OOP _gst_c_object_ptr_symbol = NULL;
120 OOP _gst_c_object_symbol = NULL;
121 OOP _gst_category_symbol = NULL;
122 OOP _gst_char_symbol = NULL;
123 OOP _gst_does_not_understand_symbol = NULL;
124 OOP _gst_double_symbol = NULL;
125 OOP _gst_false_symbol = NULL;
126 OOP _gst_float_symbol = NULL;
127 OOP _gst_if_false_if_true_symbol = NULL;
128 OOP _gst_if_false_symbol = NULL;
129 OOP _gst_if_true_if_false_symbol = NULL;
130 OOP _gst_if_true_symbol = NULL;
131 OOP _gst_int_symbol = NULL;
132 OOP _gst_long_double_symbol = NULL;
133 OOP _gst_long_symbol = NULL;
134 OOP _gst_must_be_boolean_symbol = NULL;
135 OOP _gst_nil_symbol = NULL;
136 OOP _gst_or_symbol = NULL;
137 OOP _gst_permission_symbol = NULL;
138 OOP _gst_primitive_symbol = NULL;
139 OOP _gst_repeat_symbol = NULL;
140 OOP _gst_self_smalltalk_symbol = NULL;
141 OOP _gst_self_symbol = NULL;
142 OOP _gst_short_symbol = NULL;
143 OOP _gst_smalltalk_symbol = NULL;
144 OOP _gst_smalltalk_namespace_symbol = NULL;
145 OOP _gst_start_execution_symbol = NULL;
146 OOP _gst_string_out_symbol = NULL;
147 OOP _gst_string_symbol = NULL;
148 OOP _gst_super_symbol = NULL;
149 OOP _gst_symbol_symbol = NULL;
150 OOP _gst_symbol_out_symbol = NULL;
151 OOP _gst_symbol_table = NULL;
152 OOP _gst_terminate_symbol = NULL;
153 OOP _gst_times_repeat_symbol = NULL;
154 OOP _gst_to_by_do_symbol = NULL;
155 OOP _gst_to_do_symbol = NULL;
156 OOP _gst_true_symbol = NULL;
157 OOP _gst_uchar_symbol = NULL;
158 OOP _gst_uint_symbol = NULL;
159 OOP _gst_ulong_symbol = NULL;
160 OOP _gst_ushort_symbol = NULL;
161 OOP _gst_undeclared_symbol = NULL;
162 OOP _gst_unknown_symbol = NULL;
163 OOP _gst_value_with_rec_with_args_symbol = NULL;
164 OOP _gst_variadic_smalltalk_symbol = NULL;
165 OOP _gst_variadic_symbol = NULL;
166 OOP _gst_vm_primitives_symbol = NULL;
167 OOP _gst_void_symbol = NULL;
168 OOP _gst_wchar_symbol = NULL;
169 OOP _gst_wstring_symbol = NULL;
170 OOP _gst_wstring_out_symbol = NULL;
171 OOP _gst_while_false_colon_symbol = NULL;
172 OOP _gst_while_false_symbol = NULL;
173 OOP _gst_while_true_colon_symbol = NULL;
174 OOP _gst_while_true_symbol = NULL;
175 OOP _gst_current_namespace = NULL;
176
177 OOP temporaries_dictionary = NULL;
178
179 /* The list of selectors for the send immediate bytecode. */
180 struct builtin_selector _gst_builtin_selectors[256] = {};
181
182 /* True if undeclared globals can be considered forward references. */
183 enum undeclared_strategy _gst_use_undeclared = UNDECLARED_TEMPORARIES;
184
185 /* Answer whether OOP is a Smalltalk String LEN characters long and
186 these characters match the first LEN characters of STR (which must
187 not have embedded NULs). */
188 static mst_Boolean is_same_string (const char *str,
189 OOP oop,
190 int len);
191
192 /* Allocate memory for a symbol of length LEN and whose contents are STR.
193 This function does not fill in the object's class because it is called
194 upon image loading, when the classes have not been initialized yet. */
195 static OOP alloc_symbol_oop (const char *str, int len);
196
197 /* Link SYMBOLOOP into the symbol table (using the given hash table index),
198 and fill the class slot of the symbol. */
199 static OOP alloc_symlink (OOP symbolOOP, uintptr_t index);
200
201 /* Answer whether C is considered a white space character in Smalltalk
202 programs. */
203 static mst_Boolean is_white_space (char c);
204
205 /* Free the list of symbols declared in the given SCOPE. */
206 static void free_scope_symbols (scope scope);
207
208 /* Scans a variable name (letters and digits, initial letter), and
209 return a symbol for it. PP is a pointer to a pointer to the start
210 of the string to be scanned, which may be pointing at either
211 whitespace or start of variable. At end, it points to the first
212 character after the initial whitespace, if any. ENDP instead is
213 initialized by the function to point to first character after the
214 parsed variable name, which may be NUL. */
215 static void parse_variable_name (const char ** pp,
216 const char ** endp);
217
218 /* This fills ENT's fields with the contents of its parameters. */
219 static void fill_symbol_entry (symbol_entry * ent,
220 scope_type scope,
221 mst_Boolean readOnly,
222 OOP symbol,
223 int index,
224 unsigned int scopeDistance);
225
226 /* Scans a variable name (letters and digits, initial letter), and
227 return a symbol for it. PP is a pointer to a pointer to the start
228 of the string to be scanned. May be pointing at either whitespace
229 or start of variable. At end, points to first character after the
230 parsed variable name, which may be NUL. The output is a Smalltalk
231 Symbol, _gst_nil_oop if no variable name is found. */
232 static OOP scan_name (const char ** pp);
233
234 /* This creates a Symbol containing LEN bytes starting at STR and puts
235 it in the symbol list, or returns an existing one if it is
236 found. */
237 static OOP intern_counted_string (const char *str,
238 int len);
239
240 /* This is a hack. It is the same as _gst_intern_string except that,
241 if the given symbol is pointed to by PTESTOOP, we increment
242 PTESTOOP and return the old value. This works and speeds up image
243 loading, because we are careful to create the same symbols in
244 _gst_init_symbols_passN and _gst_restore_symbols. */
245 static inline OOP
246 intern_string_fast (const char *str, OOP *pTestOOP);
247
248 /* This looks for SYMBOL among the instance variables that the current
249 class declares, and returns the index of the variable if one is
250 found. */
251 static int instance_variable_index (OOP symbol);
252
253 /* This checks if the INDEX-th instance variable among those that the
254 current class declares is read-only. Read-only index variables are
255 those that are declared by a trusted super-class of an untrusted
256 subclass. */
257 static mst_Boolean is_instance_variable_read_only (int index);
258
259 /* This looks for SYMBOL among the arguments and temporary variables
260 that the current scope sees, and returns the entry in the symbol
261 list for the variable if it is found. */
262 static symbol_list find_local_var (scope scope,
263 OOP symbol);
264
265 /* This looks for SYMBOL among the global variables that the current
266 scope sees, including superspaces if any, and returns the entry in
267 the symbol list for the variable if it is found. */
268 static OOP find_class_variable (OOP varName);
269
270 static scope cur_scope = NULL;
271 static pool_list linearized_pools = NULL;
272
273 /* This is an array of symbols which the virtual machine knows about,
274 and is used to restore the global variables upon image load. */
275 static const symbol_info sym_info[] = {
276 {&_gst_and_symbol, "and:"},
277 {&_gst_as_scaled_decimal_radix_scale_symbol, "asScaledDecimal:radix:scale:"},
278 {&_gst_bad_return_error_symbol, "badReturnError"},
279 {&_gst_byte_array_symbol, "byteArray"},
280 {&_gst_byte_array_out_symbol, "byteArrayOut"},
281 {&_gst_boolean_symbol, "boolean"},
282 {&_gst_c_object_symbol, "cObject"},
283 {&_gst_c_object_ptr_symbol, "cObjectPtr"},
284 {&_gst_category_symbol, "category:"},
285 {&_gst_char_symbol, "char"},
286 {&_gst_uchar_symbol, "uChar"},
287 {&_gst_does_not_understand_symbol, "doesNotUnderstand:"},
288 {&_gst_float_symbol, "float"},
289 {&_gst_double_symbol, "double"},
290 {&_gst_false_symbol, "false"},
291 {&_gst_if_false_if_true_symbol, "ifFalse:ifTrue:"},
292 {&_gst_if_false_symbol, "ifFalse:"},
293 {&_gst_if_true_if_false_symbol, "ifTrue:ifFalse:"},
294 {&_gst_if_true_symbol, "ifTrue:"},
295 {&_gst_int_symbol, "int"},
296 {&_gst_uint_symbol, "uInt"},
297 {&_gst_long_double_symbol, "longDouble"},
298 {&_gst_long_symbol, "long"},
299 {&_gst_ulong_symbol, "uLong"},
300 {&_gst_must_be_boolean_symbol, "mustBeBoolean"},
301 {&_gst_nil_symbol, "nil"},
302 {&_gst_or_symbol, "or:"},
303 {&_gst_primitive_symbol, "primitive:"},
304 {&_gst_repeat_symbol, "repeat"},
305 {&_gst_self_symbol, "self"},
306 {&_gst_self_smalltalk_symbol, "selfSmalltalk"},
307 {&_gst_short_symbol, "short"},
308 {&_gst_ushort_symbol, "uShort"},
309 {&_gst_smalltalk_symbol, "smalltalk"},
310 {&_gst_smalltalk_namespace_symbol, "Smalltalk"},
311 {&_gst_start_execution_symbol, "startExecution:"},
312 {&_gst_string_out_symbol, "stringOut"},
313 {&_gst_string_symbol, "string"},
314 {&_gst_super_symbol, "super"},
315 {&_gst_symbol_symbol, "symbol"},
316 {&_gst_symbol_out_symbol, "symbolOut"},
317 {&_gst_terminate_symbol, "__terminate"},
318 {&_gst_times_repeat_symbol, "timesRepeat:"},
319 {&_gst_to_by_do_symbol, "to:by:do:"},
320 {&_gst_to_do_symbol, "to:do:"},
321 {&_gst_true_symbol, "true"},
322 {&_gst_undeclared_symbol, "Undeclared"},
323 {&_gst_unknown_symbol, "unknown"},
324 {&_gst_value_with_rec_with_args_symbol, "valueWithReceiver:withArguments:"},
325 {&_gst_variadic_symbol, "variadic"},
326 {&_gst_variadic_smalltalk_symbol, "variadicSmalltalk"},
327 {&_gst_vm_primitives_symbol, "VMPrimitives"},
328 {&_gst_void_symbol, "void"},
329 {&_gst_wchar_symbol, "wchar"},
330 {&_gst_wstring_symbol, "wstring"},
331 {&_gst_wstring_out_symbol, "wstringOut"},
332 {&_gst_while_false_colon_symbol, "whileFalse:"},
333 {&_gst_while_false_symbol, "whileFalse"},
334 {&_gst_while_true_colon_symbol, "whileTrue:"},
335 {&_gst_while_true_symbol, "whileTrue"},
336 {NULL, NULL},
337 };
338
339
340 const char *
_gst_get_scope_kind(scope_type scope)341 _gst_get_scope_kind (scope_type scope)
342 {
343 switch (scope)
344 {
345 case SCOPE_TEMPORARY: return "argument";
346 case SCOPE_RECEIVER: return "instance variable";
347 case SCOPE_GLOBAL: return "global variable";
348 case SCOPE_SPECIAL: return "special variable";
349 default: abort ();
350 }
351 }
352
353 int
_gst_get_arg_count(void)354 _gst_get_arg_count (void)
355 {
356 return (cur_scope->numArguments);
357 }
358
359 int
_gst_get_temp_count(void)360 _gst_get_temp_count (void)
361 {
362 return (cur_scope->numTemporaries);
363 }
364
365 void
_gst_push_new_scope(void)366 _gst_push_new_scope (void)
367 {
368 scope newScope;
369 newScope = (scope) xmalloc (sizeof (*newScope));
370 newScope->prevScope = cur_scope;
371 newScope->symbols = NULL;
372 newScope->numArguments = 0;
373 newScope->numTemporaries = 0;
374 cur_scope = newScope;
375 }
376
377 void
_gst_pop_old_scope(void)378 _gst_pop_old_scope (void)
379 {
380 scope oldScope;
381
382 oldScope = cur_scope;
383 cur_scope = cur_scope->prevScope;
384
385 free_scope_symbols (oldScope);
386 xfree (oldScope);
387 }
388
389 void
_gst_pop_all_scopes(void)390 _gst_pop_all_scopes (void)
391 {
392 pool_list next;
393
394 while (cur_scope)
395 _gst_pop_old_scope ();
396
397 while (linearized_pools)
398 {
399 next = linearized_pools->next;
400 xfree (linearized_pools);
401 linearized_pools = next;
402 }
403 }
404
405
406 int
_gst_declare_arguments(tree_node args)407 _gst_declare_arguments (tree_node args)
408 {
409 if (args->nodeType == TREE_UNARY_EXPR)
410 return (0);
411
412 else if (args->nodeType == TREE_BINARY_EXPR)
413 _gst_declare_name (args->v_expr.expression->v_list.name, false, false);
414
415 else
416 {
417 for (args = args->v_expr.expression; args != NULL;
418 args = args->v_list.next)
419 if (_gst_declare_name (args->v_list.value->v_list.name, false, false) == -1)
420 return -1;
421 }
422
423 /* Arguments are always declared first! */
424 cur_scope->numArguments = cur_scope->numTemporaries;
425 cur_scope->numTemporaries = 0;
426 return (cur_scope->numArguments);
427 }
428
429 int
_gst_declare_temporaries(tree_node temps)430 _gst_declare_temporaries (tree_node temps)
431 {
432 int n;
433 for (n = 0; temps != NULL; n++, temps = temps->v_list.next)
434 if (_gst_declare_name (temps->v_list.name, true, false) == -1)
435 return -1;
436
437 return (n);
438 }
439
440 int
_gst_declare_block_arguments(tree_node args)441 _gst_declare_block_arguments (tree_node args)
442 {
443 for (; args != NULL; args = args->v_list.next)
444 if (_gst_declare_name (args->v_list.name, false, false) == -1)
445 return -1;
446
447 /* Arguments are always declared first! */
448 cur_scope->numArguments = cur_scope->numTemporaries;
449 cur_scope->numTemporaries = 0;
450 return (cur_scope->numArguments);
451 }
452
453 void
_gst_undeclare_name(void)454 _gst_undeclare_name (void)
455 {
456 symbol_list oldList;
457
458 oldList = cur_scope->symbols;
459 cur_scope->symbols = cur_scope->symbols->prevSymbol;
460 xfree (oldList);
461 }
462
463
464 int
_gst_declare_name(const char * name,mst_Boolean writeable,mst_Boolean allowDup)465 _gst_declare_name (const char *name,
466 mst_Boolean writeable,
467 mst_Boolean allowDup)
468 {
469 symbol_list newList;
470 OOP symbol = _gst_intern_string (name);
471
472 if (!allowDup && find_local_var (cur_scope, symbol) != NULL)
473 return -1;
474
475 newList = (symbol_list) xmalloc (sizeof (struct symbol_list));
476 newList->symbol = symbol;
477 newList->index = cur_scope->numArguments + cur_scope->numTemporaries;
478 newList->readOnly = !writeable;
479 newList->prevSymbol = cur_scope->symbols;
480
481 /* Arguments are always declared first, so we can assume it is a
482 temporary -- if it is not, _gst_declare_arguments and
483 _gst_declare_block_arguments will fix it. */
484 cur_scope->numTemporaries++;
485 cur_scope->symbols = newList;
486 return (newList->index);
487 }
488
489
490 static void
free_scope_symbols(scope scope)491 free_scope_symbols (scope scope)
492 {
493 symbol_list oldList;
494
495 for (oldList = scope->symbols; oldList != NULL;
496 oldList = scope->symbols)
497 {
498 scope->symbols = oldList->prevSymbol;
499 xfree (oldList);
500 }
501 }
502
503 /* Here are some notes on the design of the shared pool resolution order,
504 codenamed "TwistedPools".
505
506 The design should maintain a sense of containment within namespaces,
507 while still allowing reference to all inherited environments, as is
508 traditionally expected.
509
510 The fundamental problem is that when a subclass is not in the same
511 namespace as the superclass, we want to give a higher priority to
512 the symbols in the namespaces imported by the subclass, than to the
513 symbols in the superclass namespaces. As such, no simple series of
514 walks up the inheritance tree paired with pool-adds will give us a
515 good search order. Instead, we build a complete linearization of
516 the namespaces (including the superspaces) and look up a symbol in
517 each namespace locally, without looking at the superspaces.
518
519 This is the essential variable search algorithm for TwistedPools.
520
521 1. Given a class, starting with the method-owning class:
522
523 a. Search the class pool.
524
525 b. Search this class's shared pools in topological order,
526 left-to-right, skipping any pools that are any of
527 this class's namespace or superspaces.
528
529 c. Search this class's namespace and each superspace in turn
530 before first encounter of a namespace that contains, directly or
531 indirectly, the superclass. This means that if the superclass is
532 in the same namespace or a subspace, no namespaces are searched.
533
534 2. Move to the superclass, and repeat from #1.
535
536 Combination details
537 ===================
538
539 While the add-namespaces step above could be less eager to add namespaces,
540 by allowing any superclass to stop the namespace crawl, rather than
541 just the direct superclasses, it is already less eager than the shared
542 pool manager. The topological sort is an obviously good choice, but
543 why not allow superclasses' namespaces to provide deletions as well
544 as the pool-containing class? While both alternatives have benefits,
545 an eager import of all superspaces, besides those that already contain
546 the pool-containing class, would most closely match what's expected.
547
548 An argument could also be made that by adding a namespace to shared pools,
549 you expect all superspaces to be included. However, consider the usual
550 case of namespaces in shared pools: imports. While you would want it to
551 completely load an alternate namespace hierarchy, I think you would not
552 want it to inject Smalltalk early into the variable search. Consider
553 this diagram:
554
555 Smalltalk
556 |
557 MyCompany
558 / \
559 / \
560 MyProject MyLibrary
561 / / \
562 / ModA ModB
563 MyLibModule
564
565 If you were to use ModB as a pool in a class in MyLibModule, I think
566 it is most reasonable that ModB and MyLibrary be immediately imported,
567 but MyCompany and Smalltalk wait until you reach that point in the
568 namespace walk. In other words, pools only add that part of themselves,
569 which would not be otherwise reachable via the class environment.
570
571 (Note that, as a side effect, adding MyCompany as a pool will have
572 no effect).
573
574 Another argument could be made to delay further the namespace walk,
575 waiting to resolve until no superclass is contained in a given namespace,
576 based on the idea of exiting a namespace hierarchy while walking
577 superclasses, then reentering it. Disregarding the unlikelihood of such
578 an organization, it probably would be less confusing to resolve the
579 hierarchy being left first, in case the interloping hierarchy introduces
580 conflicting symbols of its own.
581
582 There is no objective argument regarding the above points of
583 contention, and no formal proofs, because convenient global name
584 resolution is entirely a matter of feeling, because a formal
585 programmer could always explicitly spell out the path to every
586 variable.
587
588 Namespaces also have imports (shared pools) of their own, thereby
589 allowing users to import external namespaces for every class in a
590 namespace, rather than each class. These shared pools should also
591 twist nicely.
592
593 Here is how I think it would best work: after searching any
594 namespace, combine its shared pools as classes' shared pools are
595 combined, removing all elements that are any of this namespace or
596 its superspaces, and search the combination from left to right.
597
598 There is one important difference between namespace-sharedpools
599 and class-sharedpools: while class sharedpools export their
600 imports to subclasses, namespaces should not reexport bindings
601 made available by way of shared pools. As such, the bindings
602 provided by a namespace are only available when compiling methods
603 that actually exist in that namespace (including its subspaces). */
604
605
606 OOP
_gst_get_class_object(OOP classOOP)607 _gst_get_class_object (OOP classOOP)
608 {
609 if (OOP_CLASS (classOOP) == _gst_metaclass_class)
610 classOOP = METACLASS_INSTANCE (classOOP);
611
612 while (OOP_CLASS (classOOP) == _gst_behavior_class
613 || OOP_CLASS (classOOP) == _gst_class_description_class)
614 classOOP = SUPERCLASS (classOOP);
615
616 return classOOP;
617 }
618
619
620 /* Add poolOOP after the node whose next pointer is in P_END. Return
621 the new next node (actually its next pointer). */
622
623 static pool_list *
add_pool(OOP poolOOP,pool_list * p_end)624 add_pool (OOP poolOOP, pool_list *p_end)
625 {
626 pool_list entry;
627 if (IS_NIL (poolOOP))
628 return p_end;
629
630 entry = xmalloc (sizeof (struct pool_list));
631 entry->poolOOP = poolOOP;
632 entry->next = NULL;
633
634 *p_end = entry;
635 return &entry->next;
636 }
637
638
639 /* Make a pointer set with POOLOOP and all of its superspaces. */
640
641 static struct pointer_set_t *
make_with_all_superspaces_set(OOP poolOOP)642 make_with_all_superspaces_set (OOP poolOOP)
643 {
644 struct pointer_set_t *pset = pointer_set_create ();
645 if (is_a_kind_of (OOP_CLASS (poolOOP), _gst_class_class))
646 poolOOP = _gst_class_variable_dictionary (poolOOP);
647
648 while (is_a_kind_of (OOP_CLASS (poolOOP), _gst_abstract_namespace_class))
649 {
650 gst_namespace pool;
651 pointer_set_insert (pset, poolOOP);
652 pool = (gst_namespace) OOP_TO_OBJ (poolOOP);
653 poolOOP = pool->superspace;
654 }
655
656 /* Add the last if not nil. */
657 if (is_a_kind_of (OOP_CLASS (poolOOP), _gst_dictionary_class))
658 pointer_set_insert (pset, poolOOP);
659 return pset;
660 }
661
662 /* predeclared for add_namespace */
663 static pool_list *combine_local_pools
664 (OOP sharedPoolsOOP, struct pointer_set_t *white, pool_list *p_end);
665
666 /* Add, after the node whose next pointer is in P_END, the namespace
667 POOLOOP and all of its superspaces except those in EXCEPT.
668 The new last node is returned (actually its next pointer). */
669
670 static pool_list *
add_namespace(OOP poolOOP,struct pointer_set_t * except,pool_list * p_end)671 add_namespace (OOP poolOOP, struct pointer_set_t *except, pool_list *p_end)
672 {
673 if (is_a_kind_of (OOP_CLASS (poolOOP), _gst_class_class))
674 poolOOP = _gst_class_variable_dictionary (poolOOP);
675
676 for (;;)
677 {
678 gst_namespace pool;
679 OOP importsOOP;
680 if (!is_a_kind_of (OOP_CLASS (poolOOP), _gst_dictionary_class))
681 return p_end;
682
683 if (!except || !pointer_set_contains (except, poolOOP))
684 p_end = add_pool (poolOOP, p_end);
685
686 /* Add imports and try to find a super-namespace */
687 if (!is_a_kind_of (OOP_CLASS (poolOOP), _gst_abstract_namespace_class))
688 return p_end;
689
690 pool = (gst_namespace) OOP_TO_OBJ (poolOOP);
691 importsOOP = pool->sharedPools;
692 if (NUM_OOPS (OOP_TO_OBJ (importsOOP)))
693 {
694 struct pointer_set_t *pset;
695 pset = make_with_all_superspaces_set (poolOOP);
696 p_end = combine_local_pools (importsOOP, pset, p_end);
697 pointer_set_destroy (pset);
698 }
699
700 poolOOP = pool->superspace;
701 }
702 }
703
704
705 /* Add POOLOOP and all of its superspaces to the list in the right order:
706
707 1. Start a new list.
708
709 2. From right to left, descend into each given pool not visited.
710
711 3. Recursively visit the superspace, then...
712
713 4. Mark this pool as visited, and add to the beginning of #1's list.
714
715 5. After all recursions exit, the list is appended at the end of the
716 linearized list of pools.
717
718 This function takes care of 3-4. These two steps implement
719 a topological sort on the reverse of the namespace tree; it is
720 explicitly modeled after CLOS class precedence. */
721
722 static void
visit_pool(OOP poolOOP,struct pointer_set_t * grey,struct pointer_set_t * white,pool_list * p_head,pool_list * p_tail)723 visit_pool (OOP poolOOP, struct pointer_set_t *grey,
724 struct pointer_set_t *white,
725 pool_list *p_head, pool_list *p_tail)
726 {
727 pool_list entry;
728
729 if (is_a_kind_of (OOP_CLASS (poolOOP), _gst_class_class))
730 poolOOP = _gst_class_variable_dictionary (poolOOP);
731 if (!is_a_kind_of (OOP_CLASS (poolOOP), _gst_dictionary_class))
732 return;
733
734 if (pointer_set_contains (white, poolOOP))
735 return;
736
737 if (pointer_set_contains (grey, poolOOP))
738 {
739 _gst_errorf ("circular dependency in pool dictionaries");
740 return;
741 }
742
743 /* Visit the super-namespace first, this amounts to processing the
744 hierarchy in reverse order (see Class>>#allSharedPoolDictionariesDo:). */
745 pointer_set_insert (grey, poolOOP);
746 if (is_a_kind_of (OOP_CLASS (poolOOP), _gst_abstract_namespace_class))
747 {
748 gst_namespace pool = (gst_namespace) OOP_TO_OBJ (poolOOP);
749 if (!IS_NIL (pool->superspace))
750 visit_pool (pool->superspace, grey, white, p_head, p_tail);
751 }
752 pointer_set_insert (white, poolOOP);
753
754 /* Add an entry for this one at the beginning of the list. We need
755 to maintain the tail too, because combine_local_pools must return
756 it. */
757 entry = xmalloc (sizeof (struct pool_list));
758 entry->poolOOP = poolOOP;
759 entry->next = *p_head;
760 *p_head = entry;
761 if (!*p_tail)
762 *p_tail = entry;
763 }
764
765 /* Run visit_pool on all the shared pools, starting with WHITE as
766 the visited set so that those are not added. The resulting
767 list is built separately, and at the end all of the namespaces
768 in the list are tacked after the node whose next pointer is
769 in P_END. The new last node is returned (actually its next pointer). */
770
771 static pool_list *
combine_local_pools(OOP sharedPoolsOOP,struct pointer_set_t * white,pool_list * p_end)772 combine_local_pools (OOP sharedPoolsOOP, struct pointer_set_t *white, pool_list *p_end)
773 {
774 struct pointer_set_t *grey = pointer_set_create ();
775 pool_list head = NULL;
776 pool_list tail = NULL;
777 int numPools, i;
778
779 /* Visit right-to-left because visit_pool adds to the beginning. */
780 numPools = NUM_OOPS (OOP_TO_OBJ (sharedPoolsOOP));
781 for (i = numPools; --i >= 0; )
782 {
783 OOP poolDictionaryOOP = ARRAY_AT (sharedPoolsOOP, i + 1);
784 visit_pool (poolDictionaryOOP, grey, white, &head, &tail);
785 }
786
787 pointer_set_destroy (grey);
788 if (head)
789 {
790 /* If anything was found, tack the list after P_END and return
791 the new tail. */
792 *p_end = head;
793 return &tail->next;
794 }
795 else
796 return p_end;
797 }
798
799
800 /* Add the list of resolved pools for CLASS_OOP. This includes:
801 1) its class pool; 2) its shared pools as added by
802 combine_local_pools, and excluding those found from the
803 environment; 3) the environment and its superspaces,
804 excluding those reachable also from the environment of
805 the superclass. */
806
807 static pool_list *
add_local_pool_resolution(OOP class_oop,pool_list * p_end)808 add_local_pool_resolution (OOP class_oop, pool_list *p_end)
809 {
810 OOP environmentOOP;
811 gst_class class;
812 struct pointer_set_t *pset;
813
814 /* First search in the class pool. */
815 p_end = add_pool (_gst_class_variable_dictionary (class_oop), p_end);
816
817 /* Then in all the imports not reachable from the environment. */
818 class = (gst_class) OOP_TO_OBJ (class_oop);
819 environmentOOP = class->environment;
820 pset = make_with_all_superspaces_set (environmentOOP);
821 p_end = combine_local_pools (class->sharedPools, pset, p_end);
822 pointer_set_destroy (pset);
823
824 /* Then search in the `environments', except those that are already
825 reachable from the superclass. */
826 class_oop = SUPERCLASS (class_oop);
827 class = (gst_class) OOP_TO_OBJ (class_oop);
828 if (!IS_NIL (class_oop))
829 pset = make_with_all_superspaces_set (class->environment);
830 else
831 pset = NULL;
832
833 p_end = add_namespace (environmentOOP, pset, p_end);
834 if (pset)
835 pointer_set_destroy (pset);
836 return p_end;
837 }
838
839 OOP
find_class_variable(OOP varName)840 find_class_variable (OOP varName)
841 {
842 pool_list pool;
843 OOP assocOOP;
844
845 if (!linearized_pools)
846 {
847 pool_list *p_end = &linearized_pools;
848 OOP myClass;
849
850 /* Add pools separately for each class. */
851 for (myClass = _gst_get_class_object (_gst_this_class); !IS_NIL (myClass);
852 myClass = SUPERCLASS (myClass))
853 p_end = add_local_pool_resolution (myClass, p_end);
854 }
855
856 for (pool = linearized_pools; pool; pool = pool->next)
857 {
858 assocOOP =
859 dictionary_association_at (pool->poolOOP, varName);
860
861 if (!IS_NIL (assocOOP))
862 return (assocOOP);
863 }
864
865 return (_gst_nil_oop);
866 }
867
868
869 int
_gst_set_undeclared(enum undeclared_strategy new)870 _gst_set_undeclared (enum undeclared_strategy new)
871 {
872 enum undeclared_strategy old = _gst_use_undeclared;
873 if (new != UNDECLARED_CURRENT)
874 _gst_use_undeclared = new;
875 return old;
876 }
877
878 OOP
_gst_push_temporaries_dictionary(void)879 _gst_push_temporaries_dictionary (void)
880 {
881 OOP old = temporaries_dictionary;
882 temporaries_dictionary = _gst_dictionary_new (8);
883 _gst_register_oop (temporaries_dictionary);
884 return old;
885 }
886
887 void
_gst_pop_temporaries_dictionary(OOP dictionaryOOP)888 _gst_pop_temporaries_dictionary (OOP dictionaryOOP)
889 {
890 _gst_unregister_oop (temporaries_dictionary);
891 temporaries_dictionary = dictionaryOOP;
892 }
893
894
895 tree_node
_gst_find_variable_binding(tree_node list)896 _gst_find_variable_binding (tree_node list)
897 {
898 OOP symbol, root, assocOOP;
899 tree_node elt;
900
901 symbol = _gst_intern_string (list->v_list.name);
902 assocOOP = find_class_variable (symbol);
903
904 for (elt = list; assocOOP != _gst_nil_oop && (elt = elt->v_list.next); )
905 {
906 root = ASSOCIATION_VALUE (assocOOP);
907 symbol = _gst_intern_string (elt->v_list.name);
908 assocOOP = _gst_namespace_association_at (root, symbol);
909 }
910
911 if (!IS_NIL (assocOOP))
912 return _gst_make_oop_constant (&list->location, assocOOP);
913
914 else if (_gst_use_undeclared == UNDECLARED_GLOBALS
915 && !elt->v_list.next
916 && isupper (*STRING_OOP_CHARS (symbol)))
917 {
918 OOP dictOOP = dictionary_at (_gst_smalltalk_dictionary,
919 _gst_undeclared_symbol);
920 assocOOP = _gst_namespace_association_at (dictOOP, symbol);
921 if (IS_NIL (assocOOP))
922 assocOOP = NAMESPACE_AT_PUT (dictOOP, symbol, _gst_nil_oop);
923 return _gst_make_oop_constant (&list->location, assocOOP);
924 }
925
926 /* For temporaries, make a deferred binding so that we can try using
927 a global variable. Unlike namespaces, the temporaries dictionary
928 does not know anything about Undeclared. */
929 else if (_gst_use_undeclared == UNDECLARED_TEMPORARIES)
930 return _gst_make_deferred_binding_constant (&list->location, list);
931
932 else
933 return NULL;
934 }
935
936 OOP
_gst_get_undeclared_dictionary()937 _gst_get_undeclared_dictionary ()
938 {
939 assert (_gst_use_undeclared == UNDECLARED_TEMPORARIES);
940 return temporaries_dictionary;
941 }
942
943 mst_Boolean
_gst_find_variable(symbol_entry * se,tree_node list)944 _gst_find_variable (symbol_entry * se,
945 tree_node list)
946 {
947 tree_node resolved;
948 int index;
949 unsigned int scopeDistance;
950 scope scope;
951 symbol_list s;
952 OOP varAssoc;
953 OOP symbol;
954
955 symbol = _gst_intern_string (list->v_list.name);
956 if (symbol == _gst_self_symbol || symbol == _gst_super_symbol)
957 {
958 fill_symbol_entry (se, SCOPE_SPECIAL, true, symbol, RECEIVER_INDEX,
959 0);
960 return (true);
961 }
962 else if (symbol == _gst_true_symbol)
963 {
964 fill_symbol_entry (se, SCOPE_SPECIAL, true, symbol, TRUE_INDEX, 0);
965 return (true);
966 }
967 else if (symbol == _gst_false_symbol)
968 {
969 fill_symbol_entry (se, SCOPE_SPECIAL, true, symbol, FALSE_INDEX,
970 0);
971 return (true);
972 }
973 else if (symbol == _gst_nil_symbol)
974 {
975 fill_symbol_entry (se, SCOPE_SPECIAL, true, symbol, NIL_INDEX, 0);
976 return (true);
977 }
978 else if (symbol == _gst_builtin_selectors[THIS_CONTEXT_SPECIAL].symbol)
979 {
980 fill_symbol_entry (se, SCOPE_SPECIAL, true, symbol,
981 THIS_CONTEXT_INDEX, 0);
982 return (true);
983 }
984
985 for (scope = cur_scope, scopeDistance = 0; scope != NULL;
986 scope = scope->prevScope, scopeDistance++)
987 {
988 s = find_local_var (scope, symbol);
989 if (s)
990 {
991 fill_symbol_entry (se, SCOPE_TEMPORARY,
992 s->readOnly, symbol, s->index,
993 scopeDistance);
994 return (true);
995 }
996 }
997
998 index = instance_variable_index (symbol);
999 if (index >= 0)
1000 {
1001 fill_symbol_entry (se, SCOPE_RECEIVER,
1002 is_instance_variable_read_only (index),
1003 symbol, index, 0);
1004 return (true);
1005 }
1006
1007 resolved = _gst_find_variable_binding (list);
1008 if (!resolved)
1009 return (false);
1010
1011 varAssoc = _gst_make_constant_oop (resolved);
1012 index = _gst_add_forced_object (varAssoc);
1013
1014 fill_symbol_entry (se, SCOPE_GLOBAL,
1015 _gst_untrusted_methods && !IS_OOP_UNTRUSTED (varAssoc),
1016 varAssoc, index, 0);
1017 return (true);
1018 }
1019
1020 static mst_Boolean
is_instance_variable_read_only(int index)1021 is_instance_variable_read_only (int index)
1022 {
1023 int numVars;
1024 OOP class_oop;
1025
1026 if (!_gst_untrusted_methods)
1027 return (false);
1028
1029 for (class_oop = _gst_this_class; IS_OOP_UNTRUSTED (class_oop);
1030 class_oop = SUPERCLASS (class_oop))
1031 ;
1032
1033 numVars = CLASS_FIXED_FIELDS (class_oop);
1034 return index + 1 <= numVars;
1035 }
1036
1037 static int
instance_variable_index(OOP symbol)1038 instance_variable_index (OOP symbol)
1039 {
1040 OOP arrayOOP;
1041 int index, numVars;
1042
1043 arrayOOP = _gst_instance_variable_array (_gst_this_class);
1044 numVars = NUM_OOPS (OOP_TO_OBJ (arrayOOP));
1045
1046 for (index = numVars; index >= 1; index--)
1047 if (ARRAY_AT (arrayOOP, index) == symbol)
1048 return (index - 1);
1049
1050 return (-1);
1051 }
1052
1053
1054 static symbol_list
find_local_var(scope scope,OOP symbol)1055 find_local_var (scope scope,
1056 OOP symbol)
1057 {
1058 symbol_list s;
1059
1060 for (s = scope->symbols; s != NULL && symbol != s->symbol;
1061 s = s->prevSymbol);
1062
1063 return (s);
1064 }
1065
1066 static void
fill_symbol_entry(symbol_entry * ent,scope_type scope,mst_Boolean readOnly,OOP symbol,int index,unsigned int scopeDistance)1067 fill_symbol_entry (symbol_entry * ent,
1068 scope_type scope,
1069 mst_Boolean readOnly,
1070 OOP symbol,
1071 int index,
1072 unsigned int scopeDistance)
1073 {
1074 ent->scope = scope;
1075 ent->readOnly = readOnly;
1076 ent->symbol = symbol;
1077 ent->varIndex = index;
1078 ent->scopeDistance = scopeDistance;
1079 }
1080
1081 void
_gst_print_symbol_entry(symbol_entry * ent)1082 _gst_print_symbol_entry (symbol_entry * ent)
1083 {
1084 printf ("%#O", ent->symbol);
1085 switch (ent->scope)
1086 {
1087 case SCOPE_RECEIVER:
1088 printf (" (inst.var. #%d)", ent->varIndex);
1089 break;
1090
1091 case SCOPE_GLOBAL:
1092 printf (" (global)");
1093 break;
1094
1095 case SCOPE_TEMPORARY:
1096 printf (" (temp.var. #");
1097 if (ent->scopeDistance)
1098 printf ("%d.", ent->scopeDistance);
1099
1100 printf ("%d)", ent->varIndex);
1101 break;
1102
1103 case SCOPE_SPECIAL:
1104 printf (" (special)");
1105 break;
1106 }
1107 }
1108
1109
1110
1111 OOP
_gst_find_pragma_handler(OOP classOOP,OOP symbolOOP)1112 _gst_find_pragma_handler (OOP classOOP,
1113 OOP symbolOOP)
1114 {
1115 OOP class_oop, myClass;
1116
1117 myClass = _gst_get_class_object (_gst_this_class);
1118
1119 /* Now search in the class pools */
1120 for (class_oop = myClass; !IS_NIL (class_oop);
1121 class_oop = SUPERCLASS (class_oop))
1122 {
1123 gst_class class = (gst_class) OOP_TO_OBJ (class_oop);
1124 OOP handlerOOP;
1125
1126 if (IS_NIL (class->pragmaHandlers))
1127 continue;
1128
1129 handlerOOP = _gst_identity_dictionary_at (class->pragmaHandlers,
1130 symbolOOP);
1131 if (!IS_NIL (handlerOOP))
1132 return handlerOOP;
1133 }
1134
1135 return (_gst_nil_oop);
1136 }
1137
1138 OOP
_gst_make_instance_variable_array(OOP superclassOOP,const char * variableString)1139 _gst_make_instance_variable_array (OOP superclassOOP,
1140 const char * variableString)
1141 {
1142 OOP arrayOOP, superArrayOOP, name;
1143 int index, numInstanceVars, superInstanceVars;
1144 const char *p;
1145 inc_ptr incPtr;
1146 gst_object array;
1147
1148 if (variableString == NULL)
1149 variableString = "";
1150
1151 if (IS_NIL (superclassOOP))
1152 {
1153 superArrayOOP = _gst_nil_oop;
1154 superInstanceVars = numInstanceVars = 0;
1155 }
1156 else
1157 {
1158 superArrayOOP = _gst_instance_variable_array (superclassOOP);
1159 superInstanceVars = numInstanceVars =
1160 NUM_OOPS (OOP_TO_OBJ (superArrayOOP));
1161 }
1162
1163 for (p = variableString; *p;)
1164 {
1165 /* skip intervening whitespace */
1166 name = scan_name (&p);
1167 if (!IS_NIL (name))
1168 numInstanceVars++;
1169 }
1170
1171 if (numInstanceVars == 0)
1172 return (_gst_nil_oop); /* no instances here */
1173
1174 incPtr = INC_SAVE_POINTER ();
1175
1176 array = instantiate_with (_gst_array_class, numInstanceVars, &arrayOOP);
1177 INC_ADD_OOP (arrayOOP);
1178
1179 /* inherit variables from parent */
1180 for (index = 1; index <= superInstanceVars; index++)
1181 array->data[index - 1] = ARRAY_AT (superArrayOOP, index);
1182
1183 /* now add our own variables */
1184 for (p = variableString; *p; index++)
1185 {
1186 /* skip intervening whitespace */
1187 name = scan_name (&p);
1188 /* don't need to add name to incubator -- it's a symbol so it's
1189 already held onto */
1190
1191 array = OOP_TO_OBJ (arrayOOP);
1192 if (!IS_NIL (name))
1193 array->data[index - 1] = name;
1194 }
1195
1196 INC_RESTORE_POINTER (incPtr);
1197 return (arrayOOP);
1198 }
1199
1200 OOP
_gst_make_class_variable_dictionary(const char * variableNames,OOP classOOP)1201 _gst_make_class_variable_dictionary (const char *variableNames,
1202 OOP classOOP)
1203 {
1204 OOP dictionaryOOP, name;
1205 const char *p;
1206 inc_ptr incPtr;
1207
1208 if (variableNames == NULL)
1209 variableNames = "";
1210
1211 incPtr = INC_SAVE_POINTER ();
1212
1213 dictionaryOOP = _gst_nil_oop;
1214 for (p = variableNames; *p;)
1215 {
1216 name = scan_name (&p);
1217 if (!IS_NIL (name))
1218 {
1219 if (IS_NIL (dictionaryOOP))
1220 {
1221 dictionaryOOP = _gst_binding_dictionary_new (8, classOOP);
1222 INC_ADD_OOP (dictionaryOOP);
1223 }
1224
1225 /* ### error if already exists */
1226 /* don't need to add name to incubator -- it's a symbol so
1227 it's already held onto */
1228 NAMESPACE_AT_PUT (dictionaryOOP, name, _gst_nil_oop);
1229 }
1230 }
1231
1232 INC_RESTORE_POINTER (incPtr);
1233 return (dictionaryOOP);
1234 }
1235
1236 OOP
_gst_make_pool_array(const char * poolNames)1237 _gst_make_pool_array (const char * poolNames)
1238 {
1239 OOP poolsOOP, name;
1240 gst_object pools;
1241 int numPools, i;
1242 const char *p, *e;
1243 inc_ptr incPtr;
1244
1245 if (poolNames == NULL)
1246 poolNames = (char *) "";
1247
1248 /* count the number of new pool names */
1249 for (p = poolNames, numPools = 0; *p;)
1250 {
1251 parse_variable_name (&p, &e);
1252 if (p != e)
1253 {
1254 numPools++;
1255 p = e;
1256 }
1257 }
1258
1259 incPtr = INC_SAVE_POINTER ();
1260
1261 poolsOOP = _gst_nil_oop; /* ### maybe change this to leave empty
1262 array */
1263
1264 for (p = poolNames, i = 0; *p; i++)
1265 {
1266 name = scan_name (&p);
1267 if (!IS_NIL (name))
1268 {
1269 /* don't need to add name to incubator -- it's a symbol so
1270 it's already held onto. */
1271
1272 /* ### error if already exists in parent?, or if value isn't
1273 a dictionary */
1274 /* ### should I keep these as names? or associations? Should
1275 I look up the names somewhere other than in the smalltalk
1276 dictionary? Need to check for undefineds? */
1277 if (poolsOOP == _gst_nil_oop)
1278 {
1279 instantiate_with (_gst_array_class, numPools, &poolsOOP);
1280 INC_ADD_OOP (poolsOOP);
1281 }
1282
1283 pools = OOP_TO_OBJ (poolsOOP);
1284 pools->data[i] = dictionary_at (_gst_smalltalk_dictionary,
1285 name);
1286 }
1287 }
1288
1289
1290 INC_RESTORE_POINTER (incPtr);
1291 return (poolsOOP);
1292 }
1293
1294
1295
1296 static OOP
scan_name(const char ** pp)1297 scan_name (const char ** pp)
1298 {
1299 const char *end;
1300 char *str;
1301 size_t len;
1302
1303 parse_variable_name (pp, &end);
1304 len = end - *pp;
1305 if (len == 0)
1306 return (_gst_nil_oop);
1307
1308 str = (char *) alloca (len + 1);
1309 strncpy (str, *pp, len);
1310 str[len] = '\0';
1311
1312 *pp = end;
1313
1314 return (_gst_intern_string (str));
1315 }
1316
1317 static void
parse_variable_name(const char ** pp,const char ** endp)1318 parse_variable_name (const char ** pp,
1319 const char ** endp)
1320 {
1321 const char *p, *e;
1322
1323 p = *pp;
1324 while (is_white_space (*p))
1325 p++;
1326 *pp = p;
1327
1328 /* check for non-null here and not alnum; we've jammed on a bogus
1329 char and it's an error */
1330
1331 if (isalpha (*p)) {
1332 /* variable name extends from p to e-1 */
1333 for (e = p; *e; e++)
1334 if (!isalnum (*e) && *e != '_')
1335 break;
1336
1337 *endp = e;
1338 } else
1339 *endp = p;
1340 }
1341
1342 static mst_Boolean
is_white_space(char c)1343 is_white_space (char c)
1344 {
1345 return (c == ' ' || c == '\r' || c == '\t' || c == '\n' || c == '\f');
1346 }
1347
1348
1349
1350 OOP
_gst_intern_string_oop(OOP stringOOP)1351 _gst_intern_string_oop (OOP stringOOP)
1352 {
1353 unsigned int len;
1354 char copyBuf[100], *copyPtr;
1355 OOP symbolOOP;
1356
1357 len = _gst_string_oop_len (stringOOP);
1358
1359 /* do this slightly more complicated bit of code because: 1) we don't
1360 want to call malloc/free if we can help it 2) if we just used
1361 STRING_OOP_CHARS (as we used to), we pass the *dereferenced* value
1362 of the stringOOP. intern_counted_string can do allocations. If
1363 it allocates, and the gc runs, stringOOP can move, meaning the
1364 dereferenced set of chars becomes invalid. So instead we make a
1365 non-moving copy and use that. */
1366 if (len < sizeof (copyBuf))
1367 copyPtr = copyBuf;
1368 else
1369 copyPtr = (char *) xmalloc (len);
1370
1371 memcpy (copyPtr, STRING_OOP_CHARS (stringOOP), len);
1372
1373 symbolOOP = intern_counted_string (copyPtr, len);
1374
1375 if (len >= sizeof (copyBuf))
1376 xfree (copyPtr);
1377
1378 return symbolOOP;
1379 }
1380
1381 OOP
_gst_intern_string(const char * str)1382 _gst_intern_string (const char *str)
1383 {
1384 int len;
1385
1386 len = strlen (str);
1387 return (intern_counted_string (str, len));
1388 }
1389
1390 static uintptr_t
hash_symbol(const char * str,int len)1391 hash_symbol (const char *str, int len)
1392 {
1393 uintptr_t index = scramble (_gst_hash_string (str, len));
1394 return (index & (SYMBOL_TABLE_SIZE - 1)) + 1;
1395 }
1396
1397 static OOP
alloc_symlink(OOP symbolOOP,uintptr_t index)1398 alloc_symlink (OOP symbolOOP, uintptr_t index)
1399 {
1400 gst_symbol symbol;
1401 sym_link link;
1402 OOP linkOOP;
1403
1404 symbol = (gst_symbol) OOP_TO_OBJ (symbolOOP);
1405 symbol->objClass = _gst_symbol_class;
1406
1407 link = (sym_link) new_instance (_gst_sym_link_class, &linkOOP);
1408 link->nextLink = ARRAY_AT (_gst_symbol_table, index);
1409 link->symbol = symbolOOP;
1410 ARRAY_AT_PUT (_gst_symbol_table, index, linkOOP);
1411
1412 return (symbolOOP);
1413 }
1414
1415 static OOP
intern_counted_string(const char * str,int len)1416 intern_counted_string (const char *str,
1417 int len)
1418 {
1419 uintptr_t index;
1420 OOP symbolOOP, linkOOP;
1421 sym_link link;
1422 inc_ptr incPtr;
1423
1424 index = hash_symbol (str, len);
1425 for (linkOOP = ARRAY_AT (_gst_symbol_table, index); !IS_NIL (linkOOP);
1426 linkOOP = link->nextLink)
1427 {
1428 link = (sym_link) OOP_TO_OBJ (linkOOP);
1429 if (is_same_string (str, link->symbol, len))
1430 return (link->symbol);
1431 }
1432
1433 /* no match, have to add it to head of list */
1434 #ifdef HAVE_READLINE
1435 _gst_add_symbol_completion (str, len);
1436 #endif
1437
1438 incPtr = INC_SAVE_POINTER ();
1439 symbolOOP = alloc_symbol_oop (str, len);
1440 INC_ADD_OOP (symbolOOP);
1441
1442 alloc_symlink (symbolOOP, index);
1443 INC_RESTORE_POINTER (incPtr);
1444
1445 return (symbolOOP);
1446 }
1447
1448 static OOP
alloc_symbol_oop(const char * str,int len)1449 alloc_symbol_oop (const char *str, int len)
1450 {
1451 int numBytes, alignedBytes;
1452 gst_symbol symbol;
1453 OOP symbolOOP;
1454
1455 numBytes = sizeof(gst_object_header) + len;
1456 alignedBytes = ROUNDED_BYTES (numBytes);
1457 symbol = (gst_symbol) _gst_alloc_obj (alignedBytes, &symbolOOP);
1458 INIT_UNALIGNED_OBJECT (symbolOOP, alignedBytes - numBytes);
1459
1460 memcpy (symbol->symString, str, len);
1461 symbolOOP->flags |= F_READONLY;
1462 return symbolOOP;
1463 }
1464
1465 static mst_Boolean
is_same_string(const char * str,OOP oop,int len)1466 is_same_string (const char *str,
1467 OOP oop,
1468 int len)
1469 {
1470 if (_gst_string_oop_len (oop) == len)
1471 return (strncmp
1472 (str, ((gst_symbol) OOP_TO_OBJ (oop))->symString,
1473 len) == 0);
1474
1475 return (false);
1476 }
1477
1478 int
_gst_string_oop_len(OOP oop)1479 _gst_string_oop_len (OOP oop)
1480 {
1481 return (OOP_SIZE_BYTES (oop) - (oop->flags & EMPTY_BYTES));
1482 }
1483
1484 uintptr_t
_gst_hash_string(const char * str,int len)1485 _gst_hash_string (const char *str,
1486 int len)
1487 {
1488 uintptr_t hashVal = 1497032417; /* arbitrary value */
1489
1490 while (len--)
1491 {
1492 hashVal += *str++;
1493 hashVal += (hashVal << 10);
1494 hashVal ^= (hashVal >> 6);
1495 }
1496
1497 return hashVal & MAX_ST_INT;
1498 }
1499
1500
1501 void
_gst_check_symbol_chain(void)1502 _gst_check_symbol_chain (void)
1503 {
1504 int i;
1505
1506 for (i = 1; i <= SYMBOL_TABLE_SIZE; i++)
1507 {
1508 sym_link link;
1509 OOP linkOOP;
1510 for (linkOOP = ARRAY_AT (_gst_symbol_table, i); !IS_NIL (linkOOP);
1511 linkOOP = link->nextLink)
1512 {
1513 link = (sym_link) OOP_TO_OBJ (linkOOP);
1514 if (OOP_CLASS (linkOOP) != _gst_sym_link_class ||
1515 OOP_CLASS (link->symbol) != _gst_symbol_class)
1516 {
1517 printf ("Bad symbol %p\n", linkOOP);
1518 abort ();
1519 }
1520 }
1521 }
1522 }
1523
1524 #ifdef HAVE_READLINE
1525 void
_gst_add_all_symbol_completions(void)1526 _gst_add_all_symbol_completions (void)
1527 {
1528 int i;
1529
1530 for (i = 1; i <= SYMBOL_TABLE_SIZE; i++)
1531 {
1532 sym_link link;
1533 OOP linkOOP;
1534 char *string;
1535 int len;
1536 for (linkOOP = ARRAY_AT (_gst_symbol_table, i); !IS_NIL (linkOOP);
1537 linkOOP = link->nextLink)
1538 {
1539 link = (sym_link) OOP_TO_OBJ (linkOOP);
1540 string = _gst_to_cstring (link->symbol);
1541 len = _gst_string_oop_len (link->symbol);
1542 _gst_add_symbol_completion (string, len);
1543 xfree (string);
1544 }
1545 }
1546 }
1547 #endif
1548
1549
1550
1551 int
_gst_selector_num_args(OOP symbolOOP)1552 _gst_selector_num_args (OOP symbolOOP)
1553 {
1554 char *bytes;
1555 int numArgs, len;
1556
1557 len = _gst_string_oop_len (symbolOOP);
1558 bytes = (char *) (OOP_TO_OBJ (symbolOOP)->data);
1559 if ((bytes[0] >= 'A' && bytes[0] <= 'Z')
1560 || (bytes[0] >= 'a' && bytes[0] <= 'z')
1561 || bytes[0] == '_')
1562 {
1563 for (numArgs = 0; len;)
1564 if (bytes[--len] == ':')
1565 numArgs++;
1566 }
1567 else
1568 numArgs = 1;
1569
1570 return (numArgs);
1571 }
1572
1573 #include "builtins.inl"
1574
1575 void
_gst_init_symbols_pass1(void)1576 _gst_init_symbols_pass1 (void)
1577 {
1578 const symbol_info *si;
1579 struct builtin_selector *bs;
1580
1581 for (si = sym_info; si->symbolVar; si++)
1582 *si->symbolVar = alloc_symbol_oop (si->value, strlen (si->value));
1583
1584 /* Complete gperf's generated table with each symbol's OOP,
1585 and prepare a kind of reverse mapping from the 256 bytecodes
1586 to the hash table entries. */
1587 for (bs = _gst_builtin_selectors_hash;
1588 bs - _gst_builtin_selectors_hash <
1589 sizeof (_gst_builtin_selectors_hash) / sizeof (_gst_builtin_selectors_hash[0]);
1590 bs++)
1591 if (bs->offset != -1)
1592 {
1593 const char *name = bs->offset + _gst_builtin_selectors_names;
1594 bs->symbol = alloc_symbol_oop (name, strlen (name));
1595 _gst_builtin_selectors[bs->bytecode] = *bs;
1596 }
1597 }
1598
1599 void
_gst_init_symbols_pass2(void)1600 _gst_init_symbols_pass2 (void)
1601 {
1602 const symbol_info *si;
1603 struct builtin_selector *bs;
1604
1605 for (si = sym_info; si->symbolVar; si++)
1606 alloc_symlink (*si->symbolVar, hash_symbol (si->value, strlen (si->value)));
1607
1608 /* Complete gperf's generated table with each symbol's OOP,
1609 and prepare a kind of reverse mapping from the 256 bytecodes
1610 to the hash table entries. */
1611 for (bs = _gst_builtin_selectors_hash;
1612 bs - _gst_builtin_selectors_hash <
1613 sizeof (_gst_builtin_selectors_hash) / sizeof (_gst_builtin_selectors_hash[0]);
1614 bs++)
1615 if (bs->offset != -1)
1616 {
1617 const char *name = bs->offset + _gst_builtin_selectors_names;
1618 alloc_symlink (bs->symbol, hash_symbol (name, strlen (name)));
1619 }
1620 }
1621
1622 static inline OOP
intern_string_fast(const char * str,OOP * pTestOOP)1623 intern_string_fast (const char *str, OOP *pTestOOP)
1624 {
1625 int len = strlen (str);
1626 OOP testOOP = *pTestOOP;
1627
1628 if (is_same_string (str, testOOP, len))
1629 {
1630 (*pTestOOP)++;
1631 return testOOP;
1632 }
1633 else
1634 return intern_counted_string (str, len);
1635 }
1636
1637 void
_gst_restore_symbols(void)1638 _gst_restore_symbols (void)
1639 {
1640 const symbol_info *si;
1641 struct builtin_selector *bs;
1642 OOP currentOOP = _gst_symbol_table + 1;
1643
1644 for (si = sym_info; si->symbolVar; si++)
1645 *si->symbolVar = intern_string_fast (si->value, ¤tOOP);
1646
1647 /* Complete gperf's generated table with each symbol's OOP,
1648 and prepare a kind of reverse mapping from the 256 bytecodes
1649 to the hash table entries. */
1650 for (bs = _gst_builtin_selectors_hash;
1651 bs - _gst_builtin_selectors_hash <
1652 sizeof (_gst_builtin_selectors_hash) / sizeof (_gst_builtin_selectors_hash[0]);
1653 bs++)
1654 if (bs->offset != -1)
1655 {
1656 const char *name = bs->offset + _gst_builtin_selectors_names;
1657 bs->symbol = intern_string_fast (name, ¤tOOP);
1658 _gst_builtin_selectors[bs->bytecode] = *bs;
1659 }
1660 }
1661