1 /******************************** -*- C -*- ****************************
2 *
3 * Dictionary Support Module.
4 *
5 *
6 ***********************************************************************/
7
8 /***********************************************************************
9 *
10 * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2005,2006,2007,2008,2009
11 * 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
57 /* this must be big enough that the Smalltalk dictionary does not have to
58 grow between the time gst_dictionary is loaded and the time the kernel is
59 initialized. Otherwise some of the methods needed to grow the dictionary
60 might not be defined yet!! */
61 #define INITIAL_SMALLTALK_SIZE 512
62
63 typedef struct class_definition
64 {
65 OOP *classVar;
66 OOP *superClassPtr;
67 intptr_t instanceSpec;
68 mst_Boolean reloadAddress;
69 int numFixedFields;
70 const char *name;
71 const char *instVarNames;
72 const char *classVarNames;
73 const char *sharedPoolNames;
74 }
75 class_definition;
76
77 /* Primary class variables. These variables hold the class objects for
78 most of the builtin classes in the system */
79 OOP _gst_abstract_namespace_class = NULL;
80 OOP _gst_array_class = NULL;
81 OOP _gst_arrayed_collection_class = NULL;
82 OOP _gst_association_class = NULL;
83 OOP _gst_behavior_class = NULL;
84 OOP _gst_binding_dictionary_class = NULL;
85 OOP _gst_block_closure_class = NULL;
86 OOP _gst_block_context_class = NULL;
87 OOP _gst_boolean_class = NULL;
88 OOP _gst_byte_array_class = NULL;
89 OOP _gst_c_callable_class = NULL;
90 OOP _gst_c_callback_descriptor_class = NULL;
91 OOP _gst_c_func_descriptor_class = NULL;
92 OOP _gst_c_object_class = NULL;
93 OOP _gst_c_type_class = NULL;
94 OOP _gst_callin_process_class = NULL;
95 OOP _gst_char_class = NULL;
96 OOP _gst_character_array_class = NULL;
97 OOP _gst_class_class = NULL;
98 OOP _gst_class_description_class = NULL;
99 OOP _gst_collection_class = NULL;
100 OOP _gst_compiled_block_class = NULL;
101 OOP _gst_compiled_code_class = NULL;
102 OOP _gst_compiled_method_class = NULL;
103 OOP _gst_context_part_class = NULL;
104 OOP _gst_continuation_class = NULL;
105 OOP _gst_date_class = NULL;
106 OOP _gst_deferred_variable_binding_class = NULL;
107 OOP _gst_dictionary_class = NULL;
108 OOP _gst_directed_message_class = NULL;
109 OOP _gst_false_class = NULL;
110 OOP _gst_file_descriptor_class = NULL;
111 OOP _gst_file_segment_class = NULL;
112 OOP _gst_file_stream_class = NULL;
113 OOP _gst_float_class = NULL;
114 OOP _gst_floatd_class = NULL;
115 OOP _gst_floate_class = NULL;
116 OOP _gst_floatq_class = NULL;
117 OOP _gst_fraction_class = NULL;
118 OOP _gst_hashed_collection_class = NULL;
119 OOP _gst_homed_association_class = NULL;
120 OOP _gst_identity_dictionary_class = NULL;
121 OOP _gst_identity_set_class = NULL;
122 OOP _gst_integer_class = NULL;
123 OOP _gst_interval_class = NULL;
124 OOP _gst_iterable_class = NULL;
125 OOP _gst_large_integer_class = NULL;
126 OOP _gst_large_negative_integer_class = NULL;
127 OOP _gst_large_positive_integer_class = NULL;
128 OOP _gst_large_zero_integer_class = NULL;
129 OOP _gst_link_class = NULL;
130 OOP _gst_linked_list_class = NULL;
131 OOP _gst_lookup_key_class = NULL;
132 OOP _gst_lookup_table_class = NULL;
133 OOP _gst_magnitude_class = NULL;
134 OOP _gst_memory_class = NULL;
135 OOP _gst_message_class = NULL;
136 OOP _gst_metaclass_class = NULL;
137 OOP _gst_method_context_class = NULL;
138 OOP _gst_method_dictionary_class = NULL;
139 OOP _gst_method_info_class = NULL;
140 OOP _gst_namespace_class = NULL;
141 OOP _gst_number_class = NULL;
142 OOP _gst_object_class = NULL;
143 OOP _gst_object_memory_class = NULL;
144 OOP _gst_ordered_collection_class = NULL;
145 OOP _gst_permission_class = NULL;
146 OOP _gst_positionable_stream_class = NULL;
147 OOP _gst_process_class = NULL;
148 OOP _gst_processor_scheduler_class = NULL;
149 OOP _gst_read_stream_class = NULL;
150 OOP _gst_read_write_stream_class = NULL;
151 OOP _gst_root_namespace_class = NULL;
152 OOP _gst_security_policy_class = NULL;
153 OOP _gst_semaphore_class = NULL;
154 OOP _gst_sequenceable_collection_class = NULL;
155 OOP _gst_set_class = NULL;
156 OOP _gst_small_integer_class = NULL;
157 OOP _gst_smalltalk_dictionary = NULL;
158 OOP _gst_sorted_collection_class = NULL;
159 OOP _gst_stream_class = NULL;
160 OOP _gst_string_class = NULL;
161 OOP _gst_sym_link_class = NULL;
162 OOP _gst_symbol_class = NULL;
163 OOP _gst_system_dictionary_class = NULL;
164 OOP _gst_time_class = NULL;
165 OOP _gst_true_class = NULL;
166 OOP _gst_undefined_object_class = NULL;
167 OOP _gst_unicode_character_class = NULL;
168 OOP _gst_unicode_string_class = NULL;
169 OOP _gst_variable_binding_class = NULL;
170 OOP _gst_weak_array_class = NULL;
171 OOP _gst_weak_set_class = NULL;
172 OOP _gst_weak_key_dictionary_class = NULL;
173 OOP _gst_weak_value_lookup_table_class = NULL;
174 OOP _gst_weak_identity_set_class = NULL;
175 OOP _gst_weak_key_identity_dictionary_class = NULL;
176 OOP _gst_weak_value_identity_dictionary_class = NULL;
177 OOP _gst_write_stream_class = NULL;
178 OOP _gst_processor_oop = NULL;
179
180 /* Answer the number of slots that are in a dictionary of
181 OLDNUMFIELDS items after growing it. */
182 static size_t new_num_fields (size_t oldNumFields);
183
184 /* Instantiate the OOPs that are created before the first classes
185 (true, false, nil, the Smalltalk dictionary, the symbol table
186 and Processor, the sole instance of ProcessorScheduler. */
187 static void init_proto_oops (void);
188
189 /* Look for the index at which KEYOOP resides in IDENTITYDICTIONARYOOP
190 and answer it or, if not found, answer -1. */
191 static ssize_t identity_dictionary_find_key (OOP identityDictionaryOOP,
192 OOP keyOOP);
193
194 /* Look for the index at which KEYOOP resides in IDENTITYDICTIONARYOOP
195 or, if not found, find a nil slot which can be replaced by that
196 key. */
197 static size_t identity_dictionary_find_key_or_nil (OOP identityDictionaryOOP,
198 OOP keyOOP);
199
200 /* assume the value is an integer already or key does not exist, increase the
201 value by inc or set the value to inc */
202 static int _gst_identity_dictionary_at_inc (OOP identityDictionaryOOP,
203 OOP keyOOP,
204 int inc);
205
206 /* Create a new instance of CLASSOOP (an IdentityDictionary subclass)
207 and answer it. */
208 static OOP identity_dictionary_new (OOP classOOP,
209 int size);
210
211 /* Create a new instance of Namespace with the given SIZE, NAME and
212 superspace (SUPERSPACEOOP). */
213 static OOP namespace_new (int size,
214 const char *name,
215 OOP superspaceOOP);
216
217 /* Create new class whose instances have a shape defined by CI. */
218 static void create_class (const class_definition *ci);
219
220 /* Create a new metaclass for CLASS_OOP; reserve space for NUMSUBCLASSES
221 classes in the instance variable "subclasses" of the class, and for
222 NUMMETACLASSSUBCLASSES in the instance variable "subclasses" of the
223 metaclass. */
224 static void create_metaclass (OOP class_oop,
225 int numSubClasses,
226 int numMetaclassSubClasses);
227
228 /* Finish initializing the metaclass METACLASSOOP. */
229 static void init_metaclass (OOP metaclassOOP);
230
231 /* Finish initializing the class CLASSOOP, using information from CI. */
232 static void init_class (OOP classOOP, const class_definition *ci);
233
234 /* This creates the SystemDictionary called Smalltalk and initializes
235 some of the variables in it. */
236 static void init_smalltalk_dictionary (void);
237
238 /* This fills MAP so that it associates primitive numbers in the saved
239 image to primitive numbers in this VM. */
240 static void prepare_primitive_numbers_table (void);
241
242 /* Add a global named GLOBALNAME and give it the value GLOBALVALUE.
243 Return GLOBALVALUE. */
244 static OOP add_smalltalk (const char *globalName,
245 OOP globalValue);
246
247 /* Create N class objects described in the array starting at CI,
248 establishing the instance shape and the link between a class
249 and its superclass. */
250 static void create_classes_pass1 (const class_definition *ci,
251 int n);
252
253 /* Create the subclasses variable of the N classes described in the
254 array starting at CI (which being an Array must be created after
255 the class objects are stored in the global variables). Also
256 create the metaclass hierarchy and make the class objects point
257 to it. */
258 static void create_classes_pass2 (const class_definition *ci,
259 int n);
260
261 /* Add a subclass SUBCLASSOOP to the subclasses array of
262 SUPERCLASSOOP. Subclasses are stored from the last index to the
263 first, and the first slot of the Array indicates the index of the
264 last free slot. */
265 static void add_subclass (OOP superClassOOP,
266 OOP subClassOOP);
267
268 /* Adds to Smalltalk a global named FILEOBJECTNAME which is a
269 FileStream referring to file descriptor FD. */
270 static void add_file_stream_object (int fd,
271 int access,
272 const char *fileObjectName);
273
274 /* Creates the Symbols that the VM knows about, and initializes
275 the globals in the Smalltalk dictionary. */
276 static void init_runtime_objects (void);
277
278 /* Creates the VMPrimitives dictionary, which maps primitive names
279 to primitive numbers. */
280 static void init_primitives_dictionary (void);
281
282 /* Creates the CSymbols pool dictionary, which gives access from
283 Smalltalk to some definitions in float.h and config.h. */
284 static void init_c_symbols (void);
285
286 static const char *feature_strings[] = {
287 #ifdef ENABLE_DLD
288 "DLD",
289 #endif
290 NULL
291 };
292
293
294
295 /* The class definition structure. From this structure, the initial
296 set of Smalltalk classes are defined. */
297
298 static const class_definition class_info[] = {
299 {&_gst_object_class, &_gst_nil_oop,
300 GST_ISP_FIXED, true, 0,
301 "Object", NULL, "Dependencies FinalizableObjects", "VMPrimitives" },
302
303 {&_gst_object_memory_class, &_gst_object_class,
304 GST_ISP_FIXED, true, 34,
305 "ObjectMemory", "bytesPerOOP bytesPerOTE "
306 "edenSize survSpaceSize oldSpaceSize fixedSpaceSize "
307 "edenUsedBytes survSpaceUsedBytes oldSpaceUsedBytes "
308 "fixedSpaceUsedBytes rememberedTableEntries "
309 "numScavenges numGlobalGCs numCompactions numGrowths "
310 "numOldOOPs numFixedOOPs numWeakOOPs numOTEs numFreeOTEs "
311 "timeBetweenScavenges timeBetweenGlobalGCs timeBetweenGrowths "
312 "timeToScavenge timeToCollect timeToCompact "
313 "reclaimedBytesPerScavenge tenuredBytesPerScavenge "
314 "reclaimedBytesPerGlobalGC reclaimedPercentPerScavenge "
315 "allocFailures allocMatches allocSplits allocProbes", NULL, NULL },
316
317 {&_gst_message_class, &_gst_object_class,
318 GST_ISP_FIXED, true, 2,
319 "Message", "selector args", NULL, NULL },
320
321 {&_gst_directed_message_class, &_gst_message_class,
322 GST_ISP_FIXED, false, 1,
323 "DirectedMessage", "receiver", NULL, NULL },
324
325 {&_gst_magnitude_class, &_gst_object_class,
326 GST_ISP_FIXED, false, 0,
327 "Magnitude", NULL, NULL, NULL },
328
329 {&_gst_char_class, &_gst_magnitude_class,
330 GST_ISP_FIXED, true, 1,
331 "Character", "codePoint", "Table UpperTable LowerTable", NULL },
332
333 {&_gst_unicode_character_class, &_gst_char_class,
334 GST_ISP_FIXED, true, 0,
335 "UnicodeCharacter", NULL, NULL, NULL },
336
337 {&_gst_time_class, &_gst_magnitude_class,
338 GST_ISP_FIXED, false, 1,
339 "Time", "seconds",
340 "SecondClockAdjustment ClockOnStartup ClockOnImageSave", NULL },
341
342 {&_gst_date_class, &_gst_magnitude_class,
343 GST_ISP_FIXED, false, 4,
344 "Date", "days day month year",
345 "DayNameDict MonthNameDict", NULL },
346
347 {&_gst_number_class, &_gst_magnitude_class,
348 GST_ISP_FIXED, false, 0,
349 "Number", NULL, NULL, NULL },
350
351 {&_gst_float_class, &_gst_number_class,
352 GST_ISP_UCHAR, true, 0,
353 "Float", NULL, NULL, "CSymbols" },
354
355 {&_gst_floatd_class, &_gst_float_class,
356 GST_ISP_UCHAR, true, 0,
357 "FloatD", NULL, NULL, "CSymbols" },
358
359 {&_gst_floate_class, &_gst_float_class,
360 GST_ISP_UCHAR, true, 0,
361 "FloatE", NULL, NULL, "CSymbols" },
362
363 {&_gst_floatq_class, &_gst_float_class,
364 GST_ISP_UCHAR, true, 0,
365 "FloatQ", NULL, NULL, "CSymbols" },
366
367 {&_gst_fraction_class, &_gst_number_class,
368 GST_ISP_FIXED, false, 2,
369 "Fraction", "numerator denominator", "Zero One", NULL },
370
371 {&_gst_integer_class, &_gst_number_class,
372 GST_ISP_FIXED, true, 0,
373 "Integer", NULL, NULL, "CSymbols" },
374
375 {&_gst_small_integer_class, &_gst_integer_class,
376 GST_ISP_FIXED, true, 0,
377 "SmallInteger", NULL, NULL, NULL },
378
379 {&_gst_large_integer_class, &_gst_integer_class, /* these four
380 classes
381 added by */
382 GST_ISP_UCHAR, true, 0, /* pb Sep 10 18:06:49 1998 */
383 "LargeInteger", NULL,
384 "Zero One ZeroBytes OneBytes LeadingZeros TrailingZeros", NULL },
385
386 {&_gst_large_positive_integer_class, &_gst_large_integer_class,
387 GST_ISP_UCHAR, true, 0,
388 "LargePositiveInteger", NULL, NULL, NULL },
389
390 {&_gst_large_zero_integer_class, &_gst_large_positive_integer_class,
391 GST_ISP_UCHAR, true, 0,
392 "LargeZeroInteger", NULL, NULL, NULL },
393
394 {&_gst_large_negative_integer_class, &_gst_large_integer_class,
395 GST_ISP_UCHAR, true, 0,
396 "LargeNegativeInteger", NULL, NULL, NULL },
397
398 {&_gst_lookup_key_class, &_gst_magnitude_class,
399 GST_ISP_FIXED, true, 1,
400 "LookupKey", "key", NULL, NULL },
401
402 {&_gst_deferred_variable_binding_class, &_gst_lookup_key_class,
403 GST_ISP_FIXED, true, 4,
404 "DeferredVariableBinding", "class defaultDictionary association path",
405 NULL, NULL },
406
407 {&_gst_association_class, &_gst_lookup_key_class,
408 GST_ISP_FIXED, true, 1,
409 "Association", "value", NULL, NULL },
410
411 {&_gst_homed_association_class, &_gst_association_class,
412 GST_ISP_FIXED, false, 1,
413 "HomedAssociation", "environment", NULL, NULL },
414
415 {&_gst_variable_binding_class, &_gst_homed_association_class,
416 GST_ISP_FIXED, true, 0,
417 "VariableBinding", NULL, NULL, NULL },
418
419 {&_gst_link_class, &_gst_object_class,
420 GST_ISP_FIXED, false, 1,
421 "Link", "nextLink", NULL, NULL },
422
423 {&_gst_process_class, &_gst_link_class,
424 GST_ISP_FIXED, true, 7,
425 "Process",
426 "suspendedContext priority myList name environment interrupts interruptLock",
427 NULL, NULL },
428
429 {&_gst_callin_process_class, &_gst_process_class,
430 GST_ISP_FIXED, true, 1,
431 "CallinProcess",
432 "returnedValue",
433 NULL, NULL },
434
435 {&_gst_sym_link_class, &_gst_link_class,
436 GST_ISP_FIXED, true, 1,
437 "SymLink", "symbol", NULL, NULL },
438
439 {&_gst_iterable_class, &_gst_object_class,
440 GST_ISP_FIXED, false, 0,
441 "Iterable", NULL, NULL, NULL },
442
443 {&_gst_collection_class, &_gst_iterable_class,
444 GST_ISP_FIXED, false, 0,
445 "Collection", NULL, NULL, NULL },
446
447 {&_gst_sequenceable_collection_class, &_gst_collection_class,
448 GST_ISP_FIXED, false, 0,
449 "SequenceableCollection", NULL, NULL, NULL },
450
451 {&_gst_linked_list_class, &_gst_sequenceable_collection_class,
452 GST_ISP_FIXED, false, 2,
453 "LinkedList", "firstLink lastLink", NULL, NULL },
454
455 {&_gst_semaphore_class, &_gst_linked_list_class,
456 GST_ISP_FIXED, true, 2,
457 "Semaphore", "signals name", NULL, NULL },
458
459 {&_gst_arrayed_collection_class, &_gst_sequenceable_collection_class,
460 GST_ISP_POINTER, false, 0,
461 "ArrayedCollection", NULL, NULL, NULL },
462
463 {&_gst_array_class, &_gst_arrayed_collection_class,
464 GST_ISP_POINTER, true, 0,
465 "Array", NULL, NULL, NULL },
466
467 {&_gst_weak_array_class, &_gst_array_class,
468 GST_ISP_FIXED, false, 2,
469 "WeakArray", "values nilValues", NULL, NULL },
470
471 {&_gst_character_array_class, &_gst_arrayed_collection_class,
472 GST_ISP_ULONG, false, 0,
473 "CharacterArray", NULL, NULL, NULL },
474
475 {&_gst_string_class, &_gst_character_array_class,
476 GST_ISP_CHARACTER, true, 0,
477 "String", NULL, NULL, NULL },
478
479 {&_gst_unicode_string_class, &_gst_character_array_class,
480 GST_ISP_UTF32, true, 0,
481 "UnicodeString", NULL, NULL, NULL },
482
483 {&_gst_symbol_class, &_gst_string_class,
484 GST_ISP_CHARACTER, true, 0,
485 "Symbol", NULL, NULL, NULL },
486
487 {&_gst_byte_array_class, &_gst_arrayed_collection_class,
488 GST_ISP_UCHAR, true, 0,
489 "ByteArray", NULL, NULL, "CSymbols" },
490
491 {&_gst_compiled_code_class, &_gst_arrayed_collection_class,
492 GST_ISP_UCHAR, false, 2,
493 "CompiledCode", "literals header",
494 NULL, NULL },
495
496 {&_gst_compiled_block_class, &_gst_compiled_code_class,
497 GST_ISP_UCHAR, true, 1,
498 "CompiledBlock", "method",
499 NULL, NULL },
500
501 {&_gst_compiled_method_class, &_gst_compiled_code_class,
502 GST_ISP_UCHAR, true, 1,
503 "CompiledMethod", "descriptor ",
504 NULL, NULL },
505
506 {&_gst_interval_class, &_gst_arrayed_collection_class,
507 GST_ISP_FIXED, true, 3,
508 "Interval", "start stop step", NULL, NULL },
509
510 {&_gst_ordered_collection_class, &_gst_sequenceable_collection_class,
511 GST_ISP_POINTER, false, 2,
512 "OrderedCollection", "firstIndex lastIndex", NULL, NULL },
513
514 {&_gst_sorted_collection_class, &_gst_ordered_collection_class,
515 GST_ISP_POINTER, false, 3,
516 "SortedCollection", "lastOrdered sorted sortBlock",
517 "DefaultSortBlock",
518 NULL },
519
520 {&_gst_hashed_collection_class, &_gst_collection_class,
521 GST_ISP_POINTER, false, 1,
522 "HashedCollection", "tally", NULL, NULL },
523
524 {&_gst_set_class, &_gst_hashed_collection_class,
525 GST_ISP_POINTER, false, 0,
526 "Set", NULL, NULL, NULL },
527
528 {&_gst_weak_set_class, &_gst_set_class,
529 GST_ISP_POINTER, false, 0,
530 "WeakSet", NULL, NULL, NULL },
531
532 {&_gst_identity_set_class, &_gst_set_class,
533 GST_ISP_POINTER, false, 0,
534 "IdentitySet", NULL, NULL, NULL },
535
536 {&_gst_weak_identity_set_class, &_gst_weak_set_class,
537 GST_ISP_POINTER, false, 0,
538 "WeakIdentitySet", NULL, NULL, NULL },
539
540 {&_gst_dictionary_class, &_gst_hashed_collection_class,
541 GST_ISP_POINTER, true, 0,
542 "Dictionary", NULL, NULL, NULL },
543
544 {&_gst_weak_key_dictionary_class, &_gst_dictionary_class,
545 GST_ISP_POINTER, false, 1,
546 "WeakKeyDictionary", "keys", NULL, NULL },
547
548 {&_gst_weak_key_identity_dictionary_class, &_gst_weak_key_dictionary_class,
549 GST_ISP_POINTER, false, 0,
550 "WeakKeyIdentityDictionary", NULL, NULL, NULL },
551
552 {&_gst_lookup_table_class, &_gst_dictionary_class,
553 GST_ISP_POINTER, false, 0,
554 "LookupTable", NULL, NULL, NULL },
555
556 {&_gst_weak_value_lookup_table_class, &_gst_lookup_table_class,
557 GST_ISP_POINTER, false, 1,
558 "WeakValueLookupTable", "values", NULL, NULL },
559
560 {&_gst_weak_value_identity_dictionary_class, &_gst_weak_value_lookup_table_class,
561 GST_ISP_POINTER, false, 0,
562 "WeakValueIdentityDictionary", NULL, NULL, NULL },
563
564 {&_gst_identity_dictionary_class, &_gst_lookup_table_class,
565 GST_ISP_POINTER, true, 0,
566 "IdentityDictionary", NULL, NULL, NULL },
567
568 {&_gst_method_dictionary_class, &_gst_identity_dictionary_class,
569 GST_ISP_POINTER, true, 0,
570 "MethodDictionary", NULL, NULL, NULL },
571
572 /* These five MUST have the same structure as dictionary; they're
573 used interchangeably within the C portion of the system */
574 {&_gst_binding_dictionary_class, &_gst_dictionary_class,
575 GST_ISP_POINTER, true, 1,
576 "BindingDictionary", "environment", NULL, NULL },
577
578 {&_gst_abstract_namespace_class, &_gst_binding_dictionary_class,
579 GST_ISP_POINTER, true, 3,
580 "AbstractNamespace", "name subspaces sharedPools", NULL, NULL },
581
582 {&_gst_root_namespace_class, &_gst_abstract_namespace_class,
583 GST_ISP_POINTER, false, 0,
584 "RootNamespace", NULL, NULL, NULL },
585
586 {&_gst_namespace_class, &_gst_abstract_namespace_class,
587 GST_ISP_POINTER, true, 0,
588 "Namespace", NULL, "Current", NULL },
589
590 {&_gst_system_dictionary_class, &_gst_root_namespace_class,
591 GST_ISP_POINTER, false, 0,
592 "SystemDictionary", NULL, NULL, NULL },
593
594 {&_gst_stream_class, &_gst_iterable_class,
595 GST_ISP_FIXED, false, 0,
596 "Stream", NULL, NULL, NULL },
597
598 {&_gst_positionable_stream_class, &_gst_stream_class,
599 GST_ISP_FIXED, false, 4,
600 "PositionableStream", "collection ptr endPtr access", NULL, NULL },
601
602 {&_gst_read_stream_class, &_gst_positionable_stream_class,
603 GST_ISP_FIXED, false, 0,
604 "ReadStream", NULL, NULL, NULL },
605
606 {&_gst_write_stream_class, &_gst_positionable_stream_class,
607 GST_ISP_FIXED, false, 0,
608 "WriteStream", NULL, NULL, NULL },
609
610 {&_gst_read_write_stream_class, &_gst_write_stream_class,
611 GST_ISP_FIXED, false, 0,
612 "ReadWriteStream", NULL, NULL, NULL },
613
614 {&_gst_file_descriptor_class, &_gst_stream_class,
615 GST_ISP_FIXED, true, 6,
616 "FileDescriptor", "access fd file isPipe atEnd peek", "AllOpenFiles", NULL },
617
618 {&_gst_file_stream_class, &_gst_file_descriptor_class,
619 GST_ISP_FIXED, true, 5,
620 "FileStream", "collection ptr endPtr writePtr writeEnd", "Verbose Record Includes", NULL },
621
622 {&_gst_undefined_object_class, &_gst_object_class,
623 GST_ISP_FIXED, true, 0,
624 "UndefinedObject", NULL, NULL, NULL },
625
626 {&_gst_boolean_class, &_gst_object_class,
627 GST_ISP_FIXED, true, 0,
628 "Boolean", NULL, NULL, NULL },
629
630 {&_gst_false_class, &_gst_boolean_class,
631 GST_ISP_FIXED, true, 1,
632 "False", "truthValue", NULL, NULL },
633
634 {&_gst_true_class, &_gst_boolean_class,
635 GST_ISP_FIXED, true, 1,
636 "True", "truthValue", NULL, NULL },
637
638 {&_gst_processor_scheduler_class, &_gst_object_class,
639 GST_ISP_FIXED, false, 6,
640 "ProcessorScheduler",
641 "processLists activeProcess idleTasks processTimeslice gcSemaphore gcArray",
642 NULL, NULL },
643
644 /* Change this, classDescription, or gst_class, and you must change
645 the implementaion of new_metaclass some */
646 {&_gst_behavior_class, &_gst_object_class,
647 GST_ISP_FIXED, true, 5,
648 "Behavior",
649 "superClass methodDictionary instanceSpec subClasses instanceVariables",
650 NULL, NULL },
651
652 {&_gst_class_description_class, &_gst_behavior_class,
653 GST_ISP_FIXED, true, 0,
654 "ClassDescription", NULL, NULL, NULL },
655
656 {&_gst_class_class, &_gst_class_description_class,
657 GST_ISP_FIXED, true, 8,
658 "Class",
659 "name comment category environment classVariables sharedPools "
660 "securityPolicy pragmaHandlers",
661 NULL, NULL },
662
663 {&_gst_metaclass_class, &_gst_class_description_class,
664 GST_ISP_FIXED, true, 1,
665 "Metaclass", "instanceClass", NULL, NULL },
666
667 {&_gst_context_part_class, &_gst_object_class,
668 GST_ISP_POINTER, true, 6,
669 "ContextPart", "parent nativeIP ip sp receiver method ",
670 NULL, NULL },
671
672 {&_gst_method_context_class, &_gst_context_part_class,
673 GST_ISP_POINTER, true, 1,
674 "MethodContext", "flags ", NULL, NULL },
675
676 {&_gst_block_context_class, &_gst_context_part_class,
677 GST_ISP_POINTER, true, 1,
678 "BlockContext", "outerContext ", NULL, NULL },
679
680 {&_gst_continuation_class, &_gst_object_class,
681 GST_ISP_FIXED, true, 1,
682 "Continuation", "stack ", NULL, NULL },
683
684 {&_gst_block_closure_class, &_gst_object_class,
685 GST_ISP_FIXED, true, 3,
686 "BlockClosure", "outerContext block receiver", NULL, NULL },
687
688 {&_gst_permission_class, &_gst_object_class,
689 GST_ISP_FIXED, true, 4,
690 "Permission", "name actions target positive", NULL, NULL },
691
692 {&_gst_security_policy_class, &_gst_object_class,
693 GST_ISP_FIXED, true, 2,
694 "SecurityPolicy", "dictionary owner", NULL, NULL },
695
696 {&_gst_c_object_class, &_gst_object_class,
697 GST_ISP_ULONG, true, 2,
698 "CObject", "type storage", NULL, "CSymbols" },
699
700 {&_gst_c_type_class, &_gst_object_class,
701 GST_ISP_FIXED, true, 1,
702 "CType", "cObjectType", NULL, NULL },
703
704 {&_gst_c_callable_class, &_gst_c_object_class,
705 GST_ISP_ULONG, true, 2,
706 "CCallable",
707 "returnType argTypes",
708 NULL, NULL },
709
710 {&_gst_c_func_descriptor_class, &_gst_c_callable_class,
711 GST_ISP_ULONG, false, 1,
712 "CFunctionDescriptor",
713 "cFunctionName",
714 NULL, NULL },
715
716 {&_gst_c_callback_descriptor_class, &_gst_c_callable_class,
717 GST_ISP_ULONG, true, 1,
718 "CCallbackDescriptor",
719 "block",
720 NULL, NULL },
721
722 {&_gst_memory_class, &_gst_object_class,
723 GST_ISP_FIXED, false, 0,
724 "Memory", NULL, NULL, NULL },
725
726 {&_gst_method_info_class, &_gst_object_class,
727 GST_ISP_POINTER, true, 4,
728 "MethodInfo", "sourceCode category class selector", NULL, NULL },
729
730 {&_gst_file_segment_class, &_gst_object_class,
731 GST_ISP_FIXED, true, 3,
732 "FileSegment", "file startPos size", NULL, NULL }
733
734 /* Classes not defined here (like Point/Rectangle/RunArray) are
735 defined after the kernel has been fully initialized. */
736 };
737
738 signed char _gst_log2_sizes[32] = {
739 0, -1, 0, -1, 0, -1,
740 1, -1, 1, -1,
741 2, -1, 2, -1, 2, -1,
742 3, -1, 3, -1, 3, -1,
743 2, -1,
744 -1, -1, -1, -1, -1, -1,
745 sizeof (long) == 4 ? 2 : 3, -1
746 };
747
748
749
750
751
752 void
init_proto_oops()753 init_proto_oops()
754 {
755 gst_namespace smalltalkDictionary;
756 gst_object symbolTable, processorScheduler;
757 int numWords;
758
759 /* We can do this now that the classes are defined */
760 _gst_init_builtin_objects_classes ();
761
762 /* Also finish the creation of the OOPs with reserved indices in
763 oop.h */
764
765 /* the symbol table ... */
766 numWords = OBJ_HEADER_SIZE_WORDS + SYMBOL_TABLE_SIZE;
767 symbolTable = _gst_alloc_words (numWords);
768 SET_OOP_OBJECT (_gst_symbol_table, symbolTable);
769
770 symbolTable->objClass = _gst_array_class;
771 nil_fill (symbolTable->data,
772 numWords - OBJ_HEADER_SIZE_WORDS);
773
774 /* 5 is the # of fixed instvars in gst_namespace */
775 numWords = OBJ_HEADER_SIZE_WORDS + INITIAL_SMALLTALK_SIZE + 5;
776
777 /* ... now the Smalltalk dictionary ... */
778 smalltalkDictionary = (gst_namespace) _gst_alloc_words (numWords);
779 SET_OOP_OBJECT (_gst_smalltalk_dictionary, smalltalkDictionary);
780
781 smalltalkDictionary->objClass = _gst_system_dictionary_class;
782 smalltalkDictionary->tally = FROM_INT(0);
783 smalltalkDictionary->name = _gst_smalltalk_namespace_symbol;
784 smalltalkDictionary->superspace = _gst_nil_oop;
785 smalltalkDictionary->subspaces = _gst_nil_oop;
786 smalltalkDictionary->sharedPools = _gst_nil_oop;
787 nil_fill (smalltalkDictionary->assoc,
788 INITIAL_SMALLTALK_SIZE);
789
790 /* ... and finally Processor */
791 numWords = sizeof (struct gst_processor_scheduler) / sizeof (PTR);
792 processorScheduler = _gst_alloc_words (numWords);
793 SET_OOP_OBJECT (_gst_processor_oop, processorScheduler);
794
795 processorScheduler->objClass = _gst_processor_scheduler_class;
796 nil_fill (processorScheduler->data,
797 numWords - OBJ_HEADER_SIZE_WORDS);
798 }
799
800 void
_gst_init_dictionary(void)801 _gst_init_dictionary (void)
802 {
803 memcpy (_gst_primitive_table, _gst_default_primitive_table,
804 sizeof (_gst_primitive_table));
805
806 /* The order of this must match the indices defined in oop.h!! */
807 _gst_smalltalk_dictionary = alloc_oop (NULL, _gst_mem.active_flag);
808 _gst_processor_oop = alloc_oop (NULL, _gst_mem.active_flag);
809 _gst_symbol_table = alloc_oop (NULL, _gst_mem.active_flag);
810
811 _gst_init_symbols_pass1 ();
812
813 create_classes_pass1 (class_info, sizeof (class_info) / sizeof (class_info[0]));
814
815 init_proto_oops();
816 _gst_init_symbols_pass2 ();
817 init_smalltalk_dictionary ();
818
819 create_classes_pass2 (class_info, sizeof (class_info) / sizeof (class_info[0]));
820
821 init_runtime_objects ();
822 _gst_tenure_all_survivors ();
823 }
824
825 void
create_classes_pass1(const class_definition * ci,int n)826 create_classes_pass1 (const class_definition *ci,
827 int n)
828 {
829 OOP superClassOOP;
830 int nilSubclasses;
831 gst_class classObj, superclass;
832
833 for (nilSubclasses = 0; n--; ci++)
834 {
835 superClassOOP = *ci->superClassPtr;
836 create_class (ci);
837
838 if (IS_NIL (superClassOOP))
839 nilSubclasses++;
840 else
841 {
842 superclass = (gst_class) OOP_TO_OBJ (superClassOOP);
843 superclass->subClasses =
844 FROM_INT (TO_INT (superclass->subClasses) + 1);
845 }
846 }
847
848 /* Object class being a subclass of gst_class is not an apparent link,
849 and so the index which is the number of subclasses of the class
850 is off by the number of subclasses of nil. We correct that here.
851
852 On the other hand, we don't want the meta class to have a subclass
853 (`Class class' and `Class' are unique in that they don't have the
854 same number of subclasses), so since we have the information here,
855 we special case the Class class and create its metaclass here. */
856 classObj = (gst_class) OOP_TO_OBJ (_gst_class_class);
857 create_metaclass (_gst_class_class,
858 TO_INT (classObj->subClasses),
859 TO_INT (classObj->subClasses) + nilSubclasses);
860 }
861
862 void
create_classes_pass2(const class_definition * ci,int n)863 create_classes_pass2 (const class_definition *ci,
864 int n)
865 {
866 OOP class_oop;
867 gst_class class;
868 int numSubclasses;
869
870 for (; n--; ci++)
871 {
872 class_oop = *ci->classVar;
873 class = (gst_class) OOP_TO_OBJ (class_oop);
874
875 if (!class->objClass)
876 {
877 numSubclasses = TO_INT (class->subClasses);
878 create_metaclass (class_oop, numSubclasses, numSubclasses);
879 }
880
881 init_metaclass (class->objClass);
882 init_class (class_oop, ci);
883 }
884 }
885
886 void
create_metaclass(OOP class_oop,int numMetaclassSubClasses,int numSubClasses)887 create_metaclass (OOP class_oop,
888 int numMetaclassSubClasses,
889 int numSubClasses)
890 {
891 gst_class class;
892 gst_metaclass metaclass;
893 gst_object subClasses;
894
895 class = (gst_class) OOP_TO_OBJ (class_oop);
896 metaclass = (gst_metaclass) new_instance (_gst_metaclass_class,
897 &class->objClass);
898
899 metaclass->instanceClass = class_oop;
900
901 subClasses = new_instance_with (_gst_array_class, numSubClasses,
902 &class->subClasses);
903 if (numSubClasses > 0)
904 subClasses->data[0] = FROM_INT (numSubClasses);
905
906 subClasses = new_instance_with (_gst_array_class, numMetaclassSubClasses,
907 &metaclass->subClasses);
908 if (numMetaclassSubClasses > 0)
909 subClasses->data[0] = FROM_INT (numMetaclassSubClasses);
910 }
911
912 void
init_metaclass(OOP metaclassOOP)913 init_metaclass (OOP metaclassOOP)
914 {
915 gst_metaclass metaclass;
916 OOP class_oop, superClassOOP;
917
918 metaclass = (gst_metaclass) OOP_TO_OBJ (metaclassOOP);
919 class_oop = metaclass->instanceClass;
920 superClassOOP = SUPERCLASS (class_oop);
921
922 if (IS_NIL (superClassOOP))
923 /* Object case: make this be gst_class to close the circularity */
924 metaclass->superclass = _gst_class_class;
925 else
926 metaclass->superclass = OOP_CLASS (superClassOOP);
927
928 add_subclass (metaclass->superclass, metaclassOOP);
929
930 /* the specifications here should match what a class should have:
931 instance variable names, the right number of instance variables,
932 etc. We could take three passes, and use the instance variable
933 spec for classes once it's established, but it's easier to create
934 them here by hand */
935 metaclass->instanceVariables =
936 _gst_make_instance_variable_array (_gst_nil_oop,
937 "superClass methodDictionary instanceSpec subClasses "
938 "instanceVariables name comment category environment "
939 "classVariables sharedPools securityPolicy "
940 "pragmaHandlers");
941
942 metaclass->instanceSpec = GST_ISP_INTMARK | GST_ISP_FIXED |
943 (((sizeof (struct gst_class) -
944 sizeof (gst_object_header)) /
945 sizeof (OOP)) << ISP_NUMFIXEDFIELDS);
946
947 metaclass->methodDictionary = _gst_nil_oop;
948 }
949
950 void
init_class(OOP class_oop,const class_definition * ci)951 init_class (OOP class_oop, const class_definition *ci)
952 {
953 gst_class class;
954
955 class = (gst_class) OOP_TO_OBJ (class_oop);
956 class->name = _gst_intern_string (ci->name);
957 add_smalltalk (ci->name, class_oop);
958
959 if (!IS_NIL (class->superclass))
960 add_subclass (class->superclass, class_oop);
961
962 class->environment = _gst_smalltalk_dictionary;
963 class->instanceVariables =
964 _gst_make_instance_variable_array (class->superclass, ci->instVarNames);
965 class->classVariables =
966 _gst_make_class_variable_dictionary (ci->classVarNames, class_oop);
967
968 class->sharedPools = _gst_make_pool_array (ci->sharedPoolNames);
969
970 /* Other fields are set by the Smalltalk code. */
971 class->methodDictionary = _gst_nil_oop;
972 class->comment = _gst_nil_oop;
973 class->category = _gst_nil_oop;
974 class->securityPolicy = _gst_nil_oop;
975 class->pragmaHandlers = _gst_nil_oop;
976 }
977
978 void
add_subclass(OOP superClassOOP,OOP subClassOOP)979 add_subclass (OOP superClassOOP,
980 OOP subClassOOP)
981 {
982 gst_class_description superclass;
983 int index;
984
985 superclass = (gst_class_description) OOP_TO_OBJ (superClassOOP);
986
987 #ifndef OPTIMIZE
988 if (NUM_WORDS (OOP_TO_OBJ (superclass->subClasses)) == 0)
989 {
990 _gst_errorf ("Attempt to add subclass to zero sized class");
991 abort ();
992 }
993 #endif
994
995 index = TO_INT (ARRAY_AT (superclass->subClasses, 1));
996 ARRAY_AT_PUT (superclass->subClasses, 1, FROM_INT (index - 1));
997 ARRAY_AT_PUT (superclass->subClasses, index, subClassOOP);
998 }
999
1000 void
init_smalltalk_dictionary(void)1001 init_smalltalk_dictionary (void)
1002 {
1003 OOP featuresArrayOOP;
1004 gst_object featuresArray;
1005 char fullVersionString[200];
1006 int i, numFeatures;
1007
1008 _gst_current_namespace = _gst_smalltalk_dictionary;
1009 for (numFeatures = 0; feature_strings[numFeatures]; numFeatures++);
1010
1011 featuresArray = new_instance_with (_gst_array_class, numFeatures,
1012 &featuresArrayOOP);
1013
1014 for (i = 0; i < numFeatures; i++)
1015 featuresArray->data[i] = _gst_intern_string (feature_strings[i]);
1016
1017 sprintf (fullVersionString, "GNU Smalltalk version %s",
1018 VERSION PACKAGE_GIT_REVISION);
1019
1020 add_smalltalk ("Smalltalk", _gst_smalltalk_dictionary);
1021 add_smalltalk ("Version", _gst_string_new (fullVersionString));
1022 add_smalltalk ("KernelFilePath", _gst_string_new (_gst_kernel_file_path));
1023 add_smalltalk ("KernelInitialized", _gst_false_oop);
1024 add_smalltalk ("SymbolTable", _gst_symbol_table);
1025 add_smalltalk ("Processor", _gst_processor_oop);
1026 add_smalltalk ("Features", featuresArrayOOP);
1027
1028 /* Add subspaces */
1029 add_smalltalk ("CSymbols",
1030 namespace_new (32, "CSymbols", _gst_smalltalk_dictionary));
1031
1032 init_primitives_dictionary ();
1033
1034 add_smalltalk ("Undeclared",
1035 namespace_new (32, "Undeclared", _gst_nil_oop));
1036 add_smalltalk ("SystemExceptions",
1037 namespace_new (32, "SystemExceptions", _gst_smalltalk_dictionary));
1038 add_smalltalk ("NetClients",
1039 namespace_new (32, "NetClients", _gst_smalltalk_dictionary));
1040 add_smalltalk ("VFS",
1041 namespace_new (32, "VFS", _gst_smalltalk_dictionary));
1042
1043 _gst_init_process_system ();
1044 }
1045
1046 static OOP
add_smalltalk(const char * globalName,OOP globalValue)1047 add_smalltalk (const char *globalName,
1048 OOP globalValue)
1049 {
1050 NAMESPACE_AT_PUT (_gst_smalltalk_dictionary,
1051 _gst_intern_string (globalName), globalValue);
1052
1053 return globalValue;
1054 }
1055
1056 static OOP
relocate_path_oop(const char * s)1057 relocate_path_oop (const char *s)
1058 {
1059 OOP resultOOP;
1060 char *path = _gst_relocate_path (s);
1061 if (path)
1062 resultOOP = _gst_string_new (path);
1063 else
1064 resultOOP = _gst_nil_oop;
1065
1066 free (path);
1067 return resultOOP;
1068 }
1069
1070 void
init_runtime_objects(void)1071 init_runtime_objects (void)
1072 {
1073 add_smalltalk ("UserFileBasePath", _gst_string_new (_gst_user_file_base_path));
1074
1075 add_smalltalk ("SystemKernelPath", relocate_path_oop (KERNEL_PATH));
1076 add_smalltalk ("ModulePath", relocate_path_oop (MODULE_PATH));
1077 add_smalltalk ("LibexecPath", relocate_path_oop (LIBEXEC_PATH));
1078 add_smalltalk ("Prefix", relocate_path_oop (PREFIX));
1079 add_smalltalk ("ExecPrefix", relocate_path_oop (EXEC_PREFIX));
1080 add_smalltalk ("ImageFilePath", _gst_string_new (_gst_image_file_path));
1081 add_smalltalk ("ExecutableFileName", _gst_string_new (_gst_executable_path));
1082 add_smalltalk ("ImageFileName", _gst_string_new (_gst_binary_image_name));
1083 add_smalltalk ("OutputVerbosity", FROM_INT (_gst_verbosity));
1084 add_smalltalk ("RegressionTesting",
1085 _gst_regression_testing ? _gst_true_oop : _gst_false_oop);
1086
1087 #ifdef WORDS_BIGENDIAN
1088 add_smalltalk ("Bigendian", _gst_true_oop);
1089 #else
1090 add_smalltalk ("Bigendian", _gst_false_oop);
1091 #endif
1092
1093 add_file_stream_object (0, O_RDONLY, "stdin");
1094 add_file_stream_object (1, O_WRONLY, "stdout");
1095 add_file_stream_object (2, O_WRONLY, "stderr");
1096
1097 init_c_symbols ();
1098
1099 /* Add the root among the roots :-) to the root set */
1100 _gst_register_oop (_gst_smalltalk_dictionary);
1101 }
1102
1103 void
init_c_symbols()1104 init_c_symbols ()
1105 {
1106 OOP cSymbolsOOP = dictionary_at (_gst_smalltalk_dictionary,
1107 _gst_intern_string ("CSymbols"));
1108
1109 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("HostSystem"),
1110 _gst_string_new (HOST_SYSTEM));
1111
1112 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CIntSize"),
1113 FROM_INT (sizeof (int)));
1114 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CShortSize"),
1115 FROM_INT (sizeof (short)));
1116 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongSize"),
1117 FROM_INT (sizeof (long)));
1118 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatSize"),
1119 FROM_INT (sizeof (float)));
1120 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleSize"),
1121 FROM_INT (sizeof (double)));
1122 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleSize"),
1123 FROM_INT (sizeof (long double)));
1124 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CPtrSize"),
1125 FROM_INT (sizeof (PTR)));
1126
1127 #ifndef INFINITY
1128 #define INFINITY LDBL_MAX * 2
1129 #endif
1130 #ifndef NAN
1131 #define NAN (0.0 / 0.0)
1132 #endif
1133
1134 #if defined WIN32 && !defined __CYGWIN__
1135 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("PathSeparator"),
1136 CHAR_OOP_AT ('\\'));
1137 #else
1138 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("PathSeparator"),
1139 CHAR_OOP_AT ('/'));
1140 #endif
1141
1142 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleMin"),
1143 floatd_new (DBL_MIN));
1144 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleMax"),
1145 floatd_new (DBL_MAX));
1146 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoublePInf"),
1147 floatd_new ((double) INFINITY));
1148 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleNInf"),
1149 floatd_new ((double) -INFINITY));
1150 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleNaN"),
1151 floatd_new ((double) NAN));
1152 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleDigits"),
1153 FROM_INT (ceil (DBL_MANT_DIG * 0.301029995663981)));
1154 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleBinaryDigits"),
1155 FROM_INT (DBL_MANT_DIG));
1156 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleMinExp"),
1157 FROM_INT (DBL_MIN_EXP));
1158 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleMaxExp"),
1159 FROM_INT (DBL_MAX_EXP));
1160 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CDoubleAlignment"),
1161 FROM_INT (ALIGNOF_DOUBLE));
1162 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongLongAlignment"),
1163 FROM_INT (ALIGNOF_LONG_LONG));
1164
1165 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatPInf"),
1166 floate_new ((float) INFINITY));
1167 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatNInf"),
1168 floate_new ((float) -INFINITY));
1169 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatNaN"),
1170 floate_new ((float) NAN));
1171 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatMin"),
1172 floate_new (FLT_MIN));
1173 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatMax"),
1174 floate_new (FLT_MAX));
1175 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatDigits"),
1176 FROM_INT (ceil (FLT_MANT_DIG * 0.301029995663981)));
1177 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatBinaryDigits"),
1178 FROM_INT (FLT_MANT_DIG));
1179 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatMinExp"),
1180 FROM_INT (FLT_MIN_EXP));
1181 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatMaxExp"),
1182 FROM_INT (FLT_MAX_EXP));
1183 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CFloatAlignment"),
1184 FROM_INT (sizeof (float)));
1185
1186 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoublePInf"),
1187 floatq_new ((long double) INFINITY));
1188 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleNInf"),
1189 floatq_new ((long double) -INFINITY));
1190 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleNaN"),
1191 floatq_new ((long double) NAN));
1192 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleMin"),
1193 floatq_new (LDBL_MIN));
1194 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleMax"),
1195 floatq_new (LDBL_MAX));
1196 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleDigits"),
1197 FROM_INT (ceil (LDBL_MANT_DIG * 0.301029995663981)));
1198 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleBinaryDigits"),
1199 FROM_INT (LDBL_MANT_DIG));
1200 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleMinExp"),
1201 FROM_INT (LDBL_MIN_EXP));
1202 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleMaxExp"),
1203 FROM_INT (LDBL_MAX_EXP));
1204 NAMESPACE_AT_PUT (cSymbolsOOP, _gst_intern_string ("CLongDoubleAlignment"),
1205 FROM_INT (ALIGNOF_LONG_DOUBLE));
1206 }
1207
1208 void
init_primitives_dictionary()1209 init_primitives_dictionary ()
1210 {
1211 OOP primDictionaryOOP = _gst_dictionary_new (512);
1212 int i;
1213
1214 add_smalltalk ("VMPrimitives", primDictionaryOOP);
1215 for (i = 0; i < NUM_PRIMITIVES; i++)
1216 {
1217 prim_table_entry *pte = _gst_get_primitive_attributes (i);
1218
1219 if (pte->name)
1220 {
1221 OOP keyOOP = _gst_intern_string (pte->name);
1222 OOP valueOOP = FROM_INT (i);
1223 DICTIONARY_AT_PUT (primDictionaryOOP, keyOOP, valueOOP);
1224 }
1225 }
1226 }
1227
1228 void
add_file_stream_object(int fd,int access,const char * fileObjectName)1229 add_file_stream_object (int fd,
1230 int access,
1231 const char *fileObjectName)
1232 {
1233 OOP fileStreamOOP;
1234 OOP keyOOP;
1235
1236 keyOOP = _gst_intern_string (fileObjectName);
1237 fileStreamOOP = dictionary_at (_gst_smalltalk_dictionary, keyOOP);
1238 if (IS_NIL (fileStreamOOP))
1239 instantiate (_gst_file_stream_class, &fileStreamOOP);
1240
1241 _gst_set_file_stream_file (fileStreamOOP, fd,
1242 _gst_string_new (fileObjectName),
1243 _gst_is_pipe (fd), access, true);
1244
1245 add_smalltalk (fileObjectName, fileStreamOOP);
1246 }
1247
1248 void
create_class(const class_definition * ci)1249 create_class (const class_definition *ci)
1250 {
1251 gst_class class;
1252 intptr_t superInstanceSpec;
1253 OOP classOOP, superClassOOP;
1254 int numFixedFields;
1255
1256 numFixedFields = ci->numFixedFields;
1257 superClassOOP = *ci->superClassPtr;
1258 if (!IS_NIL (superClassOOP))
1259 {
1260 /* adjust the number of instance variables to account for
1261 inheritance */
1262 superInstanceSpec = CLASS_INSTANCE_SPEC (superClassOOP);
1263 numFixedFields += superInstanceSpec >> ISP_NUMFIXEDFIELDS;
1264 }
1265
1266 class = (gst_class) _gst_alloc_obj (sizeof (struct gst_class), &classOOP);
1267
1268 class->objClass = NULL;
1269 class->superclass = superClassOOP;
1270 class->instanceSpec = GST_ISP_INTMARK
1271 | ci->instanceSpec
1272 | (numFixedFields << ISP_NUMFIXEDFIELDS);
1273
1274 class->subClasses = FROM_INT (0);
1275
1276 *ci->classVar = classOOP;
1277 }
1278
1279
1280 mst_Boolean
_gst_init_dictionary_on_image_load(mst_Boolean prim_table_matches)1281 _gst_init_dictionary_on_image_load (mst_Boolean prim_table_matches)
1282 {
1283 const class_definition *ci;
1284
1285 _gst_smalltalk_dictionary = OOP_AT (SMALLTALK_OOP_INDEX);
1286 _gst_processor_oop = OOP_AT (PROCESSOR_OOP_INDEX);
1287 _gst_symbol_table = OOP_AT (SYM_TABLE_OOP_INDEX);
1288
1289 if (IS_NIL (_gst_processor_oop) || IS_NIL (_gst_symbol_table)
1290 || IS_NIL (_gst_smalltalk_dictionary))
1291 return (false);
1292
1293 _gst_restore_symbols ();
1294
1295 for (ci = class_info;
1296 ci < class_info + sizeof(class_info) / sizeof(class_definition);
1297 ci++)
1298 if (ci->reloadAddress)
1299 {
1300 *ci->classVar = dictionary_at (_gst_smalltalk_dictionary,
1301 _gst_intern_string (ci->name));
1302 if UNCOMMON (IS_NIL (*ci->classVar))
1303 return (false);
1304 }
1305
1306 _gst_current_namespace =
1307 dictionary_at (_gst_class_variable_dictionary (_gst_namespace_class),
1308 _gst_intern_string ("Current"));
1309
1310 _gst_init_builtin_objects_classes ();
1311
1312 /* Important: this is called *after* _gst_init_symbols
1313 fills in _gst_vm_primitives_symbol! */
1314 if (prim_table_matches)
1315 memcpy (_gst_primitive_table, _gst_default_primitive_table,
1316 sizeof (_gst_primitive_table));
1317 else
1318 prepare_primitive_numbers_table ();
1319
1320 init_runtime_objects ();
1321 return (true);
1322 }
1323
1324 void
prepare_primitive_numbers_table()1325 prepare_primitive_numbers_table ()
1326 {
1327 int i;
1328 OOP primitivesDictionaryOOP;
1329
1330 primitivesDictionaryOOP = dictionary_at (_gst_smalltalk_dictionary,
1331 _gst_vm_primitives_symbol);
1332
1333 for (i = 0; i < NUM_PRIMITIVES; i++)
1334 _gst_set_primitive_attributes (i, NULL);
1335
1336 for (i = 0; i < NUM_PRIMITIVES; i++)
1337 {
1338 prim_table_entry *pte = _gst_get_primitive_attributes (i);
1339 OOP symbolOOP, valueOOP;
1340 int old_index;
1341
1342 if (!pte->name)
1343 continue;
1344
1345 symbolOOP = _gst_intern_string (pte->name);
1346 valueOOP = dictionary_at (primitivesDictionaryOOP, symbolOOP);
1347
1348 /* Do nothing if the primitive is unknown to the image. */
1349 if (IS_NIL (valueOOP))
1350 continue;
1351
1352 old_index = TO_INT (valueOOP);
1353 _gst_set_primitive_attributes (old_index, pte);
1354 }
1355 }
1356
1357
1358
1359 OOP
_gst_get_class_symbol(OOP class_oop)1360 _gst_get_class_symbol (OOP class_oop)
1361 {
1362 gst_class class;
1363
1364 class = (gst_class) OOP_TO_OBJ (class_oop);
1365 return (class->name);
1366 /* this is the case when we have a metaclass, ??? I don't think that
1367 this is right, but I don't know what else to do here */
1368 }
1369
1370
1371
1372 OOP
_gst_find_class(OOP classNameOOP)1373 _gst_find_class (OOP classNameOOP)
1374 {
1375 return (dictionary_at (_gst_smalltalk_dictionary, classNameOOP));
1376 }
1377
1378
1379
1380 OOP
_gst_valid_class_method_dictionary(OOP class_oop)1381 _gst_valid_class_method_dictionary (OOP class_oop)
1382 {
1383 gst_class class;
1384
1385 /* ??? check for non-class objects */
1386 class = (gst_class) OOP_TO_OBJ (class_oop);
1387 if (IS_NIL (class->methodDictionary))
1388 {
1389 OOP identDict;
1390 identDict = identity_dictionary_new (_gst_method_dictionary_class, 32);
1391 class = (gst_class) OOP_TO_OBJ (class_oop);
1392 class->methodDictionary = identDict;
1393 }
1394
1395 return (class->methodDictionary);
1396 }
1397
1398 OOP
_gst_find_class_method(OOP class_oop,OOP selector)1399 _gst_find_class_method (OOP class_oop,
1400 OOP selector)
1401 {
1402 gst_class class;
1403 gst_identity_dictionary methodDictionary;
1404 OOP method_dictionary_oop;
1405 int index;
1406
1407 class = (gst_class) OOP_TO_OBJ (class_oop);
1408 method_dictionary_oop = class->methodDictionary;
1409 if (IS_NIL (method_dictionary_oop))
1410 return (_gst_nil_oop);
1411
1412 index =
1413 identity_dictionary_find_key (method_dictionary_oop,
1414 selector);
1415
1416 if (index < 0)
1417 return (_gst_nil_oop);
1418
1419 methodDictionary =
1420 (gst_identity_dictionary) OOP_TO_OBJ (method_dictionary_oop);
1421
1422 return (methodDictionary->keys[index]);
1423 }
1424
1425 OOP
_gst_class_variable_dictionary(OOP class_oop)1426 _gst_class_variable_dictionary (OOP class_oop)
1427 {
1428 gst_class class;
1429
1430 /* ??? check for non-class objects */
1431 class = (gst_class) OOP_TO_OBJ (class_oop);
1432 return (class->classVariables);
1433 }
1434
1435 OOP
_gst_instance_variable_array(OOP class_oop)1436 _gst_instance_variable_array (OOP class_oop)
1437 {
1438 gst_class class;
1439
1440 /* ??? check for non-class objects */
1441 class = (gst_class) OOP_TO_OBJ (class_oop);
1442 return (class->instanceVariables);
1443 }
1444
1445 OOP
_gst_shared_pool_dictionary(OOP class_oop)1446 _gst_shared_pool_dictionary (OOP class_oop)
1447 {
1448 gst_class class;
1449
1450 /* ??? check for non-class objects */
1451 class = (gst_class) OOP_TO_OBJ (class_oop);
1452 return (class->sharedPools);
1453 }
1454
1455
1456 OOP
_gst_namespace_association_at(OOP poolOOP,OOP symbol)1457 _gst_namespace_association_at (OOP poolOOP,
1458 OOP symbol)
1459 {
1460 OOP assocOOP;
1461 gst_namespace pool;
1462
1463 if (is_a_kind_of (OOP_CLASS (poolOOP), _gst_class_class))
1464 poolOOP = _gst_class_variable_dictionary (poolOOP);
1465
1466 for (;;)
1467 {
1468 if (!is_a_kind_of (OOP_CLASS (poolOOP), _gst_dictionary_class))
1469 return (_gst_nil_oop);
1470
1471 assocOOP = dictionary_association_at (poolOOP, symbol);
1472 if (!IS_NIL (assocOOP))
1473 return (assocOOP);
1474
1475 /* Try to find a super-namespace */
1476 if (!is_a_kind_of (OOP_CLASS (poolOOP), _gst_abstract_namespace_class))
1477 return (_gst_nil_oop);
1478
1479 pool = (gst_namespace) OOP_TO_OBJ (poolOOP);
1480 poolOOP = pool->superspace;
1481 }
1482 }
1483
1484 OOP
_gst_namespace_at(OOP poolOOP,OOP symbol)1485 _gst_namespace_at (OOP poolOOP,
1486 OOP symbol)
1487 {
1488 OOP assocOOP = _gst_namespace_association_at (poolOOP, symbol);
1489 if (IS_NIL (assocOOP))
1490 return assocOOP;
1491 else
1492 return ASSOCIATION_VALUE (assocOOP);
1493 }
1494
1495
1496 size_t
new_num_fields(size_t oldNumFields)1497 new_num_fields (size_t oldNumFields)
1498 {
1499 /* Find a power of two that is larger than oldNumFields */
1500
1501 int n = 1;
1502
1503 /* Already a power of two? duplicate the size */
1504 if COMMON ((oldNumFields & (oldNumFields - 1)) == 0)
1505 return oldNumFields * 2;
1506
1507 /* Find the next power of two by setting all bits to the right of
1508 the leftmost 1 bit to 1, and then incrementing. */
1509 for (; oldNumFields & (oldNumFields + 1); n <<= 1)
1510 oldNumFields |= oldNumFields >> n;
1511
1512 return oldNumFields + 1;
1513 }
1514
1515 static int
find_key_or_nil(OOP dictionaryOOP,OOP keyOOP)1516 find_key_or_nil (OOP dictionaryOOP,
1517 OOP keyOOP)
1518 {
1519 size_t count, numFields, numFixedFields;
1520 intptr_t index;
1521 gst_object dictionary;
1522 OOP associationOOP;
1523 gst_association association;
1524
1525 dictionary = (gst_object) OOP_TO_OBJ (dictionaryOOP);
1526 numFixedFields = OOP_FIXED_FIELDS (dictionaryOOP);
1527 numFields = NUM_WORDS (dictionary) - numFixedFields;
1528 index = scramble (OOP_INDEX (keyOOP));
1529 count = numFields;
1530
1531 for (; count; count--)
1532 {
1533 index &= numFields - 1;
1534 associationOOP = dictionary->data[numFixedFields + index];
1535 if COMMON (IS_NIL (associationOOP))
1536 return (index);
1537
1538 association = (gst_association) OOP_TO_OBJ (associationOOP);
1539
1540 if (association->key == keyOOP)
1541 return (index);
1542
1543 /* linear reprobe -- it is simple and guaranteed */
1544 index++;
1545 }
1546
1547 _gst_errorf
1548 ("Error - searching dictionary for nil, but it is full!\n");
1549
1550 abort ();
1551 }
1552
1553 gst_object
_gst_grow_dictionary(OOP oldDictionaryOOP)1554 _gst_grow_dictionary (OOP oldDictionaryOOP)
1555 {
1556 gst_object oldDictionary, dictionary;
1557 size_t oldNumFields, numFields, i, index, numFixedFields;
1558 OOP associationOOP;
1559 gst_association association;
1560 OOP dictionaryOOP;
1561
1562 oldDictionary = OOP_TO_OBJ (oldDictionaryOOP);
1563 numFixedFields = OOP_FIXED_FIELDS (oldDictionaryOOP);
1564 oldNumFields = NUM_WORDS (oldDictionary) - numFixedFields;
1565
1566 numFields = new_num_fields (oldNumFields);
1567
1568 /* no need to use the incubator here. We are instantiating just one
1569 object, the new dictionary itself */
1570
1571 dictionary = instantiate_with (OOP_CLASS (oldDictionaryOOP),
1572 numFields, &dictionaryOOP);
1573 memcpy (dictionary->data, oldDictionary->data, sizeof (PTR) * numFixedFields);
1574 oldDictionary = OOP_TO_OBJ (oldDictionaryOOP);
1575
1576 /* rehash all associations from old dictionary into new one */
1577 for (i = 0; i < oldNumFields; i++)
1578 {
1579 associationOOP = oldDictionary->data[numFixedFields + i];
1580 if COMMON (!IS_NIL (associationOOP))
1581 {
1582 association = (gst_association) OOP_TO_OBJ (associationOOP);
1583 index = find_key_or_nil (dictionaryOOP, association->key);
1584 dictionary->data[numFixedFields + index] = associationOOP;
1585 }
1586 }
1587
1588 _gst_swap_objects (dictionaryOOP, oldDictionaryOOP);
1589 return (OOP_TO_OBJ (oldDictionaryOOP));
1590 }
1591
1592 gst_identity_dictionary
_gst_grow_identity_dictionary(OOP oldIdentityDictionaryOOP)1593 _gst_grow_identity_dictionary (OOP oldIdentityDictionaryOOP)
1594 {
1595 gst_identity_dictionary oldIdentityDictionary, identityDictionary;
1596 OOP key, identityDictionaryOOP;
1597 size_t oldNumFields, numFields, i, index;
1598
1599 oldIdentityDictionary =
1600 (gst_identity_dictionary) OOP_TO_OBJ (oldIdentityDictionaryOOP);
1601 oldNumFields =
1602 (NUM_WORDS (oldIdentityDictionary) - 1) / 2;
1603
1604 numFields = new_num_fields (oldNumFields);
1605
1606 identityDictionary = (gst_identity_dictionary)
1607 instantiate_with (OOP_CLASS (oldIdentityDictionaryOOP), numFields * 2,
1608 &identityDictionaryOOP);
1609
1610 oldIdentityDictionary =
1611 (gst_identity_dictionary) OOP_TO_OBJ (oldIdentityDictionaryOOP);
1612
1613 identityDictionary->tally = oldIdentityDictionary->tally;
1614
1615 /* rehash all associations from old dictionary into new one */
1616 for (i = 0; i < oldNumFields; i++)
1617 {
1618 key = oldIdentityDictionary->keys[i * 2];
1619 if COMMON (!IS_NIL (key))
1620 {
1621 index =
1622 identity_dictionary_find_key_or_nil (identityDictionaryOOP,
1623 key);
1624 identityDictionary->keys[index - 1] = key;
1625 identityDictionary->keys[index] = oldIdentityDictionary->keys[i*2+1];
1626 }
1627 }
1628
1629 _gst_swap_objects (identityDictionaryOOP, oldIdentityDictionaryOOP);
1630 return ((gst_identity_dictionary) OOP_TO_OBJ (oldIdentityDictionaryOOP));
1631 }
1632
1633
1634 ssize_t
identity_dictionary_find_key(OOP identityDictionaryOOP,OOP keyOOP)1635 identity_dictionary_find_key (OOP identityDictionaryOOP,
1636 OOP keyOOP)
1637 {
1638 gst_identity_dictionary identityDictionary;
1639 size_t index, count, numFields;
1640
1641 identityDictionary =
1642 (gst_identity_dictionary) OOP_TO_OBJ (identityDictionaryOOP);
1643
1644 numFields = NUM_WORDS (identityDictionary) - 1;
1645 index = scramble (OOP_INDEX (keyOOP)) * 2;
1646 count = numFields / 2;
1647 /* printf ("%d %d %O\n", count, index & numFields - 1, keyOOP); */
1648 while (count--)
1649 {
1650 index &= numFields - 1;
1651
1652 if COMMON (IS_NIL (identityDictionary->keys[index]))
1653 return (-1);
1654
1655 if COMMON (identityDictionary->keys[index] == keyOOP)
1656 return (index + 1);
1657
1658 /* linear reprobe -- it is simple and guaranteed */
1659 index += 2;
1660 }
1661
1662 _gst_errorf
1663 ("Error - searching IdentityDictionary for nil, but it is full!\n");
1664
1665 abort ();
1666 }
1667
1668
1669
1670 size_t
identity_dictionary_find_key_or_nil(OOP identityDictionaryOOP,OOP keyOOP)1671 identity_dictionary_find_key_or_nil (OOP identityDictionaryOOP,
1672 OOP keyOOP)
1673 {
1674 gst_identity_dictionary identityDictionary;
1675 size_t index, count, numFields;
1676
1677 identityDictionary =
1678 (gst_identity_dictionary) OOP_TO_OBJ (identityDictionaryOOP);
1679
1680 numFields = NUM_WORDS (identityDictionary) - 1;
1681 index = scramble (OOP_INDEX (keyOOP)) * 2;
1682 count = numFields / 2;
1683 /* printf ("%d %d %O\n", count, index & numFields - 1, keyOOP); */
1684 while (count--)
1685 {
1686 index &= numFields - 1;
1687
1688 if COMMON (IS_NIL (identityDictionary->keys[index]))
1689 return (index + 1);
1690
1691 if COMMON (identityDictionary->keys[index] == keyOOP)
1692 return (index + 1);
1693
1694 /* linear reprobe -- it is simple and guaranteed */
1695 index += 2;
1696 }
1697
1698 _gst_errorf
1699 ("Error - searching IdentityDictionary for nil, but it is full!\n");
1700
1701 abort ();
1702 }
1703
1704 OOP
identity_dictionary_new(OOP classOOP,int size)1705 identity_dictionary_new (OOP classOOP, int size)
1706 {
1707 gst_identity_dictionary identityDictionary;
1708 OOP identityDictionaryOOP;
1709
1710 size = new_num_fields (size);
1711
1712 identityDictionary = (gst_identity_dictionary)
1713 instantiate_with (classOOP, size * 2, &identityDictionaryOOP);
1714
1715 identityDictionary->tally = FROM_INT (0);
1716 return (identityDictionaryOOP);
1717 }
1718
1719 OOP
_gst_identity_dictionary_at_put(OOP identityDictionaryOOP,OOP keyOOP,OOP valueOOP)1720 _gst_identity_dictionary_at_put (OOP identityDictionaryOOP,
1721 OOP keyOOP,
1722 OOP valueOOP)
1723 {
1724 gst_identity_dictionary identityDictionary;
1725 intptr_t index;
1726 OOP oldValueOOP;
1727
1728 identityDictionary =
1729 (gst_identity_dictionary) OOP_TO_OBJ (identityDictionaryOOP);
1730
1731 /* Never make dictionaries too full! For simplicity, we do this even
1732 if the key is present in the dictionary (because it will most
1733 likely resolve some collisions and make things faster). */
1734
1735 if UNCOMMON (TO_INT (identityDictionary->tally) >=
1736 TO_INT (identityDictionary->objSize) * 3 / 8)
1737 identityDictionary =
1738 _gst_grow_identity_dictionary (identityDictionaryOOP);
1739
1740 index =
1741 identity_dictionary_find_key_or_nil (identityDictionaryOOP, keyOOP);
1742
1743 if COMMON (IS_NIL (identityDictionary->keys[index - 1]))
1744 identityDictionary->tally = INCR_INT (identityDictionary->tally);
1745
1746 identityDictionary->keys[index - 1] = keyOOP;
1747 oldValueOOP = identityDictionary->keys[index];
1748 identityDictionary->keys[index] = valueOOP;
1749
1750 return (oldValueOOP);
1751 }
1752
1753 OOP
_gst_identity_dictionary_at(OOP identityDictionaryOOP,OOP keyOOP)1754 _gst_identity_dictionary_at (OOP identityDictionaryOOP,
1755 OOP keyOOP)
1756 {
1757 gst_identity_dictionary identityDictionary;
1758 intptr_t index;
1759
1760 identityDictionary =
1761 (gst_identity_dictionary) OOP_TO_OBJ (identityDictionaryOOP);
1762
1763 index =
1764 identity_dictionary_find_key_or_nil (identityDictionaryOOP, keyOOP);
1765
1766 return identityDictionary->keys[index];
1767 }
1768
1769 OOP
namespace_new(int size,const char * name,OOP superspaceOOP)1770 namespace_new (int size, const char *name, OOP superspaceOOP)
1771 {
1772 gst_namespace ns;
1773 OOP namespaceOOP, classOOP;
1774
1775 size = new_num_fields (size);
1776 classOOP = IS_NIL (superspaceOOP)
1777 ? _gst_root_namespace_class : _gst_namespace_class;
1778
1779 ns = (gst_namespace) instantiate_with (classOOP, size, &namespaceOOP);
1780
1781 ns->tally = FROM_INT (0);
1782 ns->superspace = superspaceOOP;
1783 ns->subspaces = _gst_nil_oop;
1784 ns->name = _gst_intern_string (name);
1785
1786 return (namespaceOOP);
1787 }
1788
1789 OOP
_gst_dictionary_new(int size)1790 _gst_dictionary_new (int size)
1791 {
1792 gst_dictionary dictionary;
1793 OOP dictionaryOOP;
1794
1795 size = new_num_fields (size);
1796 dictionary = (gst_dictionary)
1797 instantiate_with (_gst_dictionary_class, size, &dictionaryOOP);
1798
1799 dictionary->tally = FROM_INT (0);
1800
1801 return (dictionaryOOP);
1802 }
1803
1804 OOP
_gst_binding_dictionary_new(int size,OOP environmentOOP)1805 _gst_binding_dictionary_new (int size, OOP environmentOOP)
1806 {
1807 gst_binding_dictionary dictionary;
1808 OOP dictionaryOOP;
1809
1810 size = new_num_fields (size);
1811 dictionary = (gst_binding_dictionary)
1812 instantiate_with (_gst_binding_dictionary_class, size, &dictionaryOOP);
1813
1814 dictionary->tally = FROM_INT (0);
1815 dictionary->environment = environmentOOP;
1816
1817 return (dictionaryOOP);
1818 }
1819
1820 OOP
_gst_dictionary_add(OOP dictionaryOOP,OOP associationOOP)1821 _gst_dictionary_add (OOP dictionaryOOP,
1822 OOP associationOOP)
1823 {
1824 intptr_t index;
1825 gst_association association;
1826 gst_object dictionary;
1827 gst_dictionary dict;
1828 OOP value;
1829 inc_ptr incPtr; /* I'm not sure clients are protecting
1830 association OOP */
1831
1832 incPtr = INC_SAVE_POINTER ();
1833 INC_ADD_OOP (associationOOP);
1834
1835 association = (gst_association) OOP_TO_OBJ (associationOOP);
1836 dictionary = OOP_TO_OBJ (dictionaryOOP);
1837 dict = (gst_dictionary) dictionary;
1838 if UNCOMMON (TO_INT (dict->tally) >=
1839 TO_INT (dict->objSize) * 3 / 4)
1840 {
1841 dictionary = _gst_grow_dictionary (dictionaryOOP);
1842 dict = (gst_dictionary) dictionary;
1843 }
1844
1845 index = find_key_or_nil (dictionaryOOP, association->key);
1846 index += OOP_FIXED_FIELDS (dictionaryOOP);
1847 if COMMON (IS_NIL (dictionary->data[index]))
1848 {
1849 dict->tally = INCR_INT (dict->tally);
1850 dictionary->data[index] = associationOOP;
1851 }
1852 else
1853 {
1854 value = ASSOCIATION_VALUE (associationOOP);
1855 associationOOP = dictionary->data[index];
1856 SET_ASSOCIATION_VALUE (associationOOP, value);
1857 }
1858
1859 INC_RESTORE_POINTER (incPtr);
1860 return (associationOOP);
1861 }
1862
1863
1864 OOP
_gst_object_copy(OOP oop)1865 _gst_object_copy (OOP oop)
1866 {
1867 gst_object old, new;
1868 OOP newOOP;
1869 size_t numFields;
1870
1871 if UNCOMMON (IS_INT(oop) || IS_BUILTIN_OOP (oop))
1872 return (oop);
1873
1874 numFields = NUM_INDEXABLE_FIELDS (oop);
1875
1876 new = instantiate_with (OOP_CLASS (oop), numFields, &newOOP);
1877 old = OOP_TO_OBJ (oop);
1878 memcpy (new, old, SIZE_TO_BYTES (TO_INT (old->objSize)));
1879
1880 newOOP->flags |= (oop->flags & F_CONTEXT);
1881 return (newOOP);
1882 }
1883
1884
1885
1886 OOP
_gst_new_string(size_t len)1887 _gst_new_string (size_t len)
1888 {
1889 OOP stringOOP;
1890
1891 new_instance_with (_gst_string_class, len, &stringOOP);
1892 return (stringOOP);
1893 }
1894
1895 OOP
_gst_string_new(const char * s)1896 _gst_string_new (const char *s)
1897 {
1898 gst_string string;
1899 size_t len;
1900 OOP stringOOP;
1901
1902 if (s)
1903 {
1904 len = strlen (s);
1905 string = (gst_string) new_instance_with (_gst_string_class, len,
1906 &stringOOP);
1907
1908 memcpy (string->chars, s, len);
1909 }
1910 else
1911 string = (gst_string) new_instance_with (_gst_string_class, 0,
1912 &stringOOP);
1913 return (stringOOP);
1914 }
1915
1916 OOP
_gst_unicode_string_new(const wchar_t * s)1917 _gst_unicode_string_new (const wchar_t *s)
1918 {
1919 int i;
1920 gst_unicode_string string;
1921 size_t len;
1922 OOP stringOOP;
1923
1924 if (s)
1925 {
1926 len = wcslen (s);
1927 string = (gst_unicode_string)
1928 new_instance_with (_gst_unicode_string_class, len, &stringOOP);
1929
1930 if (sizeof (wchar_t) == sizeof (string->chars[0]))
1931 memcpy (string->chars, s, len * sizeof (wchar_t));
1932 else
1933 for (i = 0; i < len; i++)
1934 string->chars[i] = *s++;
1935 }
1936 else
1937 string = (gst_unicode_string)
1938 new_instance_with (_gst_unicode_string_class, 0, &stringOOP);
1939
1940 return (stringOOP);
1941 }
1942
1943 OOP
_gst_counted_string_new(const char * s,size_t len)1944 _gst_counted_string_new (const char *s,
1945 size_t len)
1946 {
1947 gst_string string;
1948 OOP stringOOP;
1949
1950 string = (gst_string) new_instance_with (_gst_string_class, len,
1951 &stringOOP);
1952
1953 if (len)
1954 memcpy (string->chars, s, len);
1955
1956 return (stringOOP);
1957 }
1958
1959 void
_gst_set_oopstring(OOP stringOOP,const char * s)1960 _gst_set_oopstring (OOP stringOOP,
1961 const char *s)
1962 {
1963 OOP newStringOOP;
1964
1965 newStringOOP = _gst_string_new (s);
1966 _gst_swap_objects (stringOOP, newStringOOP);
1967 }
1968
1969 void
_gst_set_oop_unicode_string(OOP unicodeStringOOP,const wchar_t * s)1970 _gst_set_oop_unicode_string (OOP unicodeStringOOP,
1971 const wchar_t *s)
1972 {
1973 OOP newStringOOP;
1974
1975 newStringOOP = _gst_unicode_string_new (s);
1976 _gst_swap_objects (unicodeStringOOP, newStringOOP);
1977 }
1978
1979 char *
_gst_to_cstring(OOP stringOOP)1980 _gst_to_cstring (OOP stringOOP)
1981 {
1982 char *result;
1983 size_t len;
1984 gst_string string;
1985
1986 string = (gst_string) OOP_TO_OBJ (stringOOP);
1987 len = oop_num_fields (stringOOP);
1988 result = (char *) xmalloc (len + 1);
1989 memcpy (result, string->chars, len);
1990 result[len] = '\0';
1991
1992 return (result);
1993 }
1994
1995 wchar_t *
_gst_to_wide_cstring(OOP stringOOP)1996 _gst_to_wide_cstring (OOP stringOOP)
1997 {
1998 wchar_t *result, *p;
1999 size_t len;
2000 gst_unicode_string string;
2001 int i;
2002
2003 string = (gst_unicode_string) OOP_TO_OBJ (stringOOP);
2004 len = oop_num_fields (stringOOP);
2005 result = (wchar_t *) xmalloc (len + 1);
2006 if (sizeof (wchar_t) == 4)
2007 memcpy (result, string->chars, len * sizeof (wchar_t));
2008 else
2009 for (p = result, i = 0; i < len; i++)
2010 *p++ = string->chars[i];
2011 result[len] = '\0';
2012
2013 return (result);
2014 }
2015
2016 OOP
_gst_byte_array_new(const gst_uchar * bytes,size_t len)2017 _gst_byte_array_new (const gst_uchar * bytes,
2018 size_t len)
2019 {
2020 gst_byte_array byteArray;
2021 OOP byteArrayOOP;
2022
2023 byteArray = (gst_byte_array) new_instance_with (_gst_byte_array_class,
2024 len, &byteArrayOOP);
2025
2026 memcpy (byteArray->bytes, bytes, len);
2027 return (byteArrayOOP);
2028 }
2029
2030
2031
2032 gst_uchar *
_gst_to_byte_array(OOP byteArrayOOP)2033 _gst_to_byte_array (OOP byteArrayOOP)
2034 {
2035 gst_uchar *result;
2036 size_t len;
2037 gst_byte_array byteArray;
2038
2039 byteArray = (gst_byte_array) OOP_TO_OBJ (byteArrayOOP);
2040 len = oop_num_fields (byteArrayOOP);
2041 result = (gst_uchar *) xmalloc (len);
2042 memcpy (result, byteArray->bytes, len);
2043
2044 return (result);
2045 }
2046
2047 void
_gst_set_oop_bytes(OOP byteArrayOOP,gst_uchar * bytes)2048 _gst_set_oop_bytes (OOP byteArrayOOP,
2049 gst_uchar * bytes)
2050 {
2051 gst_byte_array byteArray;
2052 size_t len;
2053
2054 len = oop_num_fields (byteArrayOOP);
2055 byteArray = (gst_byte_array) OOP_TO_OBJ (byteArrayOOP);
2056 memcpy (byteArray->bytes, bytes, len);
2057 }
2058
2059
2060
2061 OOP
_gst_message_new_args(OOP selectorOOP,OOP argsArray)2062 _gst_message_new_args (OOP selectorOOP,
2063 OOP argsArray)
2064 {
2065 gst_message message;
2066 OOP messageOOP;
2067
2068 message = (gst_message) new_instance (_gst_message_class,
2069 &messageOOP);
2070
2071 message->selector = selectorOOP;
2072 message->args = argsArray;
2073
2074 return (messageOOP);
2075 }
2076
2077 OOP
_gst_c_object_new_base(OOP baseOOP,uintptr_t cObjOfs,OOP typeOOP,OOP defaultClassOOP)2078 _gst_c_object_new_base (OOP baseOOP,
2079 uintptr_t cObjOfs,
2080 OOP typeOOP,
2081 OOP defaultClassOOP)
2082 {
2083 gst_cobject cObject;
2084 gst_ctype cType;
2085 OOP cObjectOOP;
2086 OOP classOOP;
2087
2088 if (!IS_NIL (typeOOP))
2089 {
2090 cType = (gst_ctype) OOP_TO_OBJ (typeOOP);
2091 classOOP = ASSOCIATION_VALUE (cType->cObjectType);
2092 }
2093 else
2094 classOOP = defaultClassOOP;
2095
2096 cObject = (gst_cobject) instantiate_with (classOOP, 1, &cObjectOOP);
2097 cObject->type = typeOOP;
2098 cObject->storage = baseOOP;
2099 SET_COBJECT_OFFSET_OBJ (cObject, cObjOfs);
2100
2101 return (cObjectOOP);
2102 }
2103
2104
2105 void
_gst_free_cobject(OOP cObjOOP)2106 _gst_free_cobject (OOP cObjOOP)
2107 {
2108 gst_cobject cObject;
2109
2110 cObject = (gst_cobject) OOP_TO_OBJ (cObjOOP);
2111 if (!IS_NIL (cObject->storage))
2112 cObject->storage = _gst_nil_oop;
2113 else
2114 xfree ((PTR) COBJECT_OFFSET_OBJ (cObject));
2115
2116 /* make it not point to falsely valid storage */
2117 SET_COBJECT_OFFSET_OBJ (cObject, NULL);
2118 }
2119
2120 void
_gst_set_file_stream_file(OOP fileStreamOOP,int fd,OOP fileNameOOP,mst_Boolean isPipe,int access,mst_Boolean buffered)2121 _gst_set_file_stream_file (OOP fileStreamOOP,
2122 int fd,
2123 OOP fileNameOOP,
2124 mst_Boolean isPipe,
2125 int access,
2126 mst_Boolean buffered)
2127 {
2128 gst_file_stream fileStream;
2129
2130 fileStream = (gst_file_stream) OOP_TO_OBJ (fileStreamOOP);
2131
2132 switch (access & O_ACCMODE)
2133 {
2134 case O_RDONLY:
2135 fileStream->access = FROM_INT (1);
2136 break;
2137 case O_WRONLY:
2138 fileStream->access = FROM_INT (2);
2139 break;
2140 case O_RDWR:
2141 fileStream->access = FROM_INT (3);
2142 break;
2143 }
2144
2145 if (buffered)
2146 {
2147 char buffer[1024];
2148 memset (buffer, 0, sizeof (buffer));
2149 fileStream->collection =
2150 _gst_counted_string_new (buffer, sizeof (buffer));
2151 fileStream->ptr = FROM_INT (1);
2152 fileStream->endPtr = FROM_INT (0);
2153 fileStream->writePtr = _gst_nil_oop;
2154 fileStream->writeEnd = _gst_nil_oop;
2155 }
2156
2157 fileStream->fd = FROM_INT (fd);
2158 fileStream->file = fileNameOOP;
2159 fileStream->isPipe =
2160 isPipe == -1 ? _gst_nil_oop :
2161 isPipe ? _gst_true_oop : _gst_false_oop;
2162 }
2163
2164 /* Profiling callback. The profiler use a simple data structure
2165 to store the cost and the call graph, which is a 2 level
2166 IdentityDictionary. First level keys are the CompiledMethod or
2167 CompiledBlock, and the second level key is the CompiledMethod or
2168 CompiledBlock that it calls. Values are the number of calls made. There
2169 is a special key "true" in the second level whose corresponding value
2170 is the accumulative cost for this method. */
2171
2172 void
_gst_record_profile(OOP oldMethod,OOP newMethod,int ipOffset)2173 _gst_record_profile (OOP oldMethod, OOP newMethod, int ipOffset)
2174 {
2175 OOP profile;
2176 inc_ptr incPtr;
2177
2178 /* Protect oldMethod from GC here to avoid complicating the fast path
2179 in interp-bc.inl. */
2180 incPtr = INC_SAVE_POINTER ();
2181 INC_ADD_OOP (oldMethod);
2182
2183 profile = _gst_identity_dictionary_at (_gst_raw_profile, oldMethod);
2184 if UNCOMMON (IS_NIL (profile))
2185 {
2186 profile = identity_dictionary_new (_gst_identity_dictionary_class, 6);
2187 _gst_identity_dictionary_at_put (_gst_raw_profile, oldMethod,
2188 profile);
2189 }
2190
2191 _gst_identity_dictionary_at_inc (profile, _gst_true_oop,
2192 _gst_bytecode_counter
2193 - _gst_saved_bytecode_counter);
2194 _gst_saved_bytecode_counter = _gst_bytecode_counter;
2195
2196 /* if ipOffset is 0 then it is a callin and not a return, so we also record
2197 the call. */
2198 if (ipOffset == 0)
2199 _gst_identity_dictionary_at_inc (profile, newMethod, 1);
2200
2201 INC_RESTORE_POINTER (incPtr);
2202 }
2203
2204 /* Assume the value for KEYOOP is an integer already or the key does not exist;
2205 increase the value by INC or set it to INC if it does not exist. */
2206 int
_gst_identity_dictionary_at_inc(OOP identityDictionaryOOP,OOP keyOOP,int inc)2207 _gst_identity_dictionary_at_inc (OOP identityDictionaryOOP,
2208 OOP keyOOP,
2209 int inc)
2210 {
2211 gst_identity_dictionary identityDictionary;
2212 intptr_t index;
2213 int oldValue;
2214
2215 identityDictionary =
2216 (gst_identity_dictionary) OOP_TO_OBJ (identityDictionaryOOP);
2217
2218 /* Never make dictionaries too full! For simplicity, we do this even
2219 if the key is present in the dictionary (because it will most
2220 likely resolve some collisions and make things faster). */
2221
2222 if UNCOMMON (TO_INT (identityDictionary->tally) >=
2223 TO_INT (identityDictionary->objSize) * 3 / 8)
2224 identityDictionary =
2225 _gst_grow_identity_dictionary (identityDictionaryOOP);
2226
2227 index =
2228 identity_dictionary_find_key_or_nil (identityDictionaryOOP, keyOOP);
2229
2230 if UNCOMMON (IS_NIL (identityDictionary->keys[index - 1]))
2231 {
2232 identityDictionary->tally = INCR_INT (identityDictionary->tally);
2233 oldValue = 0;
2234 }
2235 else
2236 oldValue = TO_INT(identityDictionary->keys[index]);
2237
2238 identityDictionary->keys[index - 1] = keyOOP;
2239 identityDictionary->keys[index] = FROM_INT(inc+oldValue);
2240
2241 return (oldValue);
2242 }
2243