src/st-universe.c

   1 /*
   2  * st-universe.c
   3  *
   4  * Copyright (C) 2008 Vincent Geddes
   5  *
   6  * Permission is hereby granted, free of charge, to any person obtaining a copy
   7  * of this software and associated documentation files (the "Software"), to deal
   8  * in the Software without restriction, including without limitation the rights
   9  * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  10  * copies of the Software, and to permit persons to whom the Software is
  11  * furnished to do so, subject to the following conditions:
  12  *
  13  * The above copyright notice and this permission notice shall be included in
  14  * all copies or substantial portions of the Software.
  15  *
  16  * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  17  * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18  * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  19  * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  20  * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  21  * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  22  * THE SOFTWARE.
  23 */
  24
  25 #include "st-types.h"
  26 #include "st-utils.h"
  27 #include "st-object.h"
  28 #include "st-behavior.h"
  29 #include "st-float.h"
  30 #include "st-association.h"
  31 #include "st-method.h"
  32 #include "st-array.h"
  33 #include "st-small-integer.h"
  34 #include "st-dictionary.h"
  35 #include "st-large-integer.h"
  36 #include "st-symbol.h"
  37 #include "st-universe.h"
  38 #include "st-object.h"
  39 #include "st-lexer.h"
  40 #include "st-compiler.h"
  41 #include "st-memory.h"
  42 #include "st-context.h"
  43 #include "st-processor.h"
  44
  45 #include <stdlib.h>
  46 #include <string.h>
  47 #include <stdio.h>
  48
  49 st_oop globals[34];
  50
  51 st_oop st_specials[ST_NUM_SPECIALS];
  52
  53
  54 st_oop
  55 st_global_get (const char *name)
  56 {
  57     st_oop sym;
  58
  59     st_assert (st_symbol_new (name) == st_symbol_new (name));
  60
  61     sym = st_symbol_new (name);
  62
  63     return st_dictionary_at (st_globals, sym);
  64 }
  65
  66 enum
  67 {
  68     INSTANCE_SIZE_UNDEFINED = 0,
  69     INSTANCE_SIZE_CLASS = 6,
  70     INSTANCE_SIZE_METACLASS = 6,
  71     INSTANCE_SIZE_DICTIONARY = 3,
  72     INSTANCE_SIZE_SET = 3,
  73     INSTANCE_SIZE_ASSOCIATION = 2,
  74     INSTANCE_SIZE_SYSTEM = 2,
  75 };
  76
  77 static st_oop
  78 class_new (st_format format, st_uint instance_size)
  79 {
  80     st_oop class;
  81
  82     class = st_memory_allocate (ST_SIZE_OOPS (struct st_class));
  83
  84     ST_OBJECT_MARK (class)  = 0 | ST_MARK_TAG;
  85     ST_OBJECT_HASH (class)  = st_smi_new (st_current_hash++);
  86     ST_OBJECT_CLASS (class) = st_nil;
  87     st_object_set_format (class, ST_FORMAT_OBJECT);
  88     st_object_set_instance_size (class, INSTANCE_SIZE_CLASS);
  89
  90     ST_BEHAVIOR_FORMAT (class)             = st_smi_new (format);
  91     ST_BEHAVIOR_INSTANCE_SIZE (class)      = st_smi_new (instance_size);
  92     ST_BEHAVIOR_SUPERCLASS (class)         = st_nil;
  93     ST_BEHAVIOR_METHOD_DICTIONARY (class)  = st_nil;
  94     ST_BEHAVIOR_INSTANCE_VARIABLES (class) = st_nil;
  95
  96     ST_CLASS (class)->name = st_nil;
  97
  98     return class;
  99 }
 100
 101 static void
 102 add_global (const char *name, st_oop object)
 103 {
 104     st_oop symbol;
 105
 106     // sanity check for symbol interning
 107     st_assert (st_symbol_new (name) == st_symbol_new (name));
 108
 109     symbol = st_symbol_new (name);
 110     st_dictionary_at_put (st_globals, symbol, object);
 111
 112     // sanity check for dictionary
 113     st_assert (st_dictionary_at (st_globals, symbol) == object);
 114 }
 115
 116 static void
 117 parse_error (char *message, st_token *token)
 118 {
 119     fprintf (stderr, "error: %i: %i: %s",
 120              st_token_get_line (token), st_token_get_column (token), message);
 121     exit (1);
 122 }
 123
 124 static void
 125 initialize_class  (const char *name,
 126                    const char *super_name,
 127                    st_list    *ivarnames)
 128 {
 129     st_oop metaclass, class, superclass;
 130     st_oop names;
 131     st_uint i = 1;
 132
 133     if (streq (name, "Object") && streq (super_name, "nil")) {
 134
 135         class = st_dictionary_at (st_globals, st_symbol_new ("Object"));
 136         st_assert (class != st_nil);
 137
 138         metaclass = st_object_class (class);
 139         if (metaclass == st_nil) {
 140             metaclass = st_object_new (st_metaclass_class);
 141             ST_OBJECT_CLASS (class) = metaclass;
 142         }
 143
 144         ST_BEHAVIOR_SUPERCLASS (class)     = st_nil;
 145         ST_BEHAVIOR_INSTANCE_SIZE (class)  = st_smi_new (0);
 146         ST_BEHAVIOR_SUPERCLASS (metaclass) = st_dictionary_at (st_globals, st_symbol_new ("Class"));
 147
 148     } else {
 149         superclass = st_global_get (super_name);
 150         if (superclass == st_nil)
 151             st_assert (superclass != st_nil);
 152
 153         class = st_global_get (name);
 154         if (class == st_nil)
 155             class = class_new (st_smi_value (ST_BEHAVIOR_FORMAT (superclass)), 0);
 156
 157         metaclass = ST_HEADER (class)->class;
 158         if (metaclass == st_nil) {
 159             metaclass = st_object_new (st_metaclass_class);
 160             ST_OBJECT_CLASS (class) = metaclass;
 161         }
 162
 163         ST_BEHAVIOR_SUPERCLASS (class)     = superclass;
 164         ST_BEHAVIOR_SUPERCLASS (metaclass) = ST_HEADER (superclass)->class;
 165         ST_BEHAVIOR_INSTANCE_SIZE (class) = st_smi_new (st_list_length (ivarnames) +
 166                                                         st_smi_value (ST_BEHAVIOR_INSTANCE_SIZE (superclass)));
 167     }
 168
 169     names = st_nil;
 170     if (st_list_length (ivarnames) != 0) {
 171         names = st_object_new_arrayed (st_array_class, st_list_length (ivarnames));
 172         for (st_list *l = ivarnames; l; l = l->next)
 173             st_array_at_put (names, i++, st_symbol_new (l->data));
 174         ST_BEHAVIOR_INSTANCE_VARIABLES (class) = names;
 175     }
 176
 177     ST_BEHAVIOR_FORMAT (metaclass)             = st_smi_new (ST_FORMAT_OBJECT);
 178     ST_BEHAVIOR_METHOD_DICTIONARY (metaclass)  = st_dictionary_new ();
 179     ST_BEHAVIOR_INSTANCE_VARIABLES (metaclass) = st_nil;
 180     ST_BEHAVIOR_INSTANCE_SIZE (metaclass)      = st_smi_new (INSTANCE_SIZE_CLASS);
 181     ST_METACLASS_INSTANCE_CLASS (metaclass)    = class;
 182     ST_BEHAVIOR_INSTANCE_VARIABLES (class)     = names;
 183     ST_BEHAVIOR_METHOD_DICTIONARY (class)      = st_dictionary_new ();
 184     ST_CLASS_NAME (class)                      = st_symbol_new (name);
 185
 186     st_dictionary_at_put (st_globals, st_symbol_new (name), class);
 187 }
 188
 189
 190 static bool
 191 parse_variable_names (st_lexer *lexer, st_list **varnames)
 192 {
 193     st_lexer *ivarlexer;
 194     st_token *token;
 195     char *names;
 196
 197     token = st_lexer_next_token (lexer);
 198
 199     if (st_token_get_type (token) != ST_TOKEN_STRING_CONST)
 200         return false;
 201
 202     names = st_strdup (st_token_get_text (token));
 203     ivarlexer = st_lexer_new (names); /* input valid at this stage */
 204     token = st_lexer_next_token (ivarlexer);
 205
 206     while (st_token_get_type (token) != ST_TOKEN_EOF) {
 207
 208         if (st_token_get_type (token) != ST_TOKEN_IDENTIFIER)
 209             parse_error (NULL, token);
 210
 211         *varnames = st_list_append (*varnames, st_strdup (st_token_get_text (token)));
 212         token = st_lexer_next_token (ivarlexer);
 213     }
 214
 215     st_lexer_destroy (ivarlexer);
 216
 217     return true;
 218 }
 219
 220
 221 static void
 222 parse_class (st_lexer *lexer, st_token *token)
 223 {
 224     char *class_name = NULL;
 225     char *superclass_name = NULL;
 226     st_list *ivarnames = NULL;
 227
 228     // 'Class' token
 229     if (st_token_get_type (token) != ST_TOKEN_IDENTIFIER
 230         || !streq (st_token_get_text (token), "Class"))
 231         parse_error ("expected class definition", token);
 232
 233     // `named:' token
 234     token = st_lexer_next_token (lexer);
 235     if (st_token_get_type (token) != ST_TOKEN_KEYWORD_SELECTOR
 236         || !streq (st_token_get_text (token), "named:"))
 237         parse_error ("expected 'name:'", token);
 238
 239     // class name
 240     token = st_lexer_next_token (lexer);
 241     if (st_token_get_type (token) == ST_TOKEN_STRING_CONST) {
 242         class_name = st_strdup (st_token_get_text (token));
 243     } else {
 244         parse_error ("expected string literal", token);
 245     }
 246
 247     // `superclass:' token
 248     token = st_lexer_next_token (lexer);
 249     if (st_token_get_type (token) != ST_TOKEN_KEYWORD_SELECTOR
 250         || !streq (st_token_get_text (token), "superclass:"))
 251         parse_error ("expected 'superclass:'", token);
 252
 253     // superclass name
 254     token = st_lexer_next_token (lexer);
 255     if (st_token_get_type (token) == ST_TOKEN_STRING_CONST) {
 256
 257         superclass_name = st_strdup (st_token_get_text (token));
 258
 259     } else {
 260         parse_error ("expected string literal", token);
 261     }
 262
 263     // 'instanceVariableNames:' keyword selector
 264     token = st_lexer_next_token (lexer);
 265     if (st_token_get_type (token) == ST_TOKEN_KEYWORD_SELECTOR &&
 266         streq (st_token_get_text (token), "instanceVariableNames:")) {
 267
 268         parse_variable_names (lexer, &ivarnames);
 269     } else {
 270         parse_error (NULL, token);
 271     }
 272
 273     token = st_lexer_next_token (lexer);
 274     initialize_class (class_name, superclass_name, ivarnames);
 275     st_list_destroy (ivarnames);
 276
 277     return;
 278 }
 279
 280 static void
 281 parse_classes (const char *filename)
 282 {
 283     char *contents;
 284     st_lexer *lexer;
 285     st_token *token;
 286
 287     if (!st_file_get_contents (filename, &contents)) {
 288         exit (1);
 289     }
 290
 291     lexer = st_lexer_new (contents);
 292     st_assert (lexer != NULL);
 293     token = st_lexer_next_token (lexer);
 294
 295     while (st_token_get_type (token) != ST_TOKEN_EOF) {
 296
 297         while (st_token_get_type (token) == ST_TOKEN_COMMENT)
 298             token = st_lexer_next_token (lexer);
 299
 300         parse_class (lexer, token);
 301         token = st_lexer_next_token (lexer);
 302     }
 303 }
 304
 305 static void
 306 file_in_classes (void)
 307 {
 308     char *filename;
 309
 310     parse_classes ("../st/class-defs.st");
 311
 312     static const char * files[] =
 313         {
 314             "Stream.st",
 315             "PositionableStream.st",
 316             "WriteStream.st",
 317             "Collection.st",
 318             "SequenceableCollection.st",
 319             "ArrayedCollection.st",
 320             "HashedCollection.st",
 321             "Set.st",
 322             "Dictionary.st",
 323             "IdentitySet.st",
 324             "IdentityDictionary.st",
 325             "Bag.st",
 326             "Array.st",
 327             "ByteArray.st",
 328             "WordArray.st",
 329             "FloatArray.st",
 330             "Association.st",
 331             "Magnitude.st",
 332             "Number.st",
 333             "Integer.st",
 334             "SmallInteger.st",
 335             "LargeInteger.st",
 336             "Fraction.st",
 337             "Float.st",
 338             "Object.st",
 339             "UndefinedObject.st",
 340             "String.st",
 341             "Symbol.st",
 342             "ByteString.st",
 343             "WideString.st",
 344             "Character.st",
 345             "UnicodeTables.st",
 346             "Behavior.st",
 347             "Boolean.st",
 348             "True.st",
 349             "False.st",
 350             "Behavior.st",
 351             "ContextPart.st",
 352             "BlockContext.st",
 353             "Message.st",
 354             "OrderedCollection.st",
 355             "FileStream.st",
 356             "List.st",
 357             "System.st",
 358             "CompiledMethod.st"
 359         };
 360
 361     for (st_uint i = 0; i < ST_N_ELEMENTS (files); i++) {
 362         filename = st_strconcat ("..", ST_DIR_SEPARATOR_S, "st", ST_DIR_SEPARATOR_S, files[i], NULL);
 363         st_compile_file_in (filename);
 364         st_free (filename);
 365     }
 366 }
 367
 368 #define NIL_SIZE_OOPS (sizeof (struct st_header) / sizeof (st_oop))
 369
 370 static st_oop
 371 create_nil_object (void)
 372 {
 373     st_oop nil;
 374
 375     nil = st_memory_allocate (NIL_SIZE_OOPS);
 376
 377     ST_OBJECT_MARK (nil)  = 0 | ST_MARK_TAG;
 378     ST_OBJECT_HASH (nil)  = st_smi_new (st_current_hash++);
 379     ST_OBJECT_CLASS (nil) = nil;
 380     st_object_set_format (nil, ST_FORMAT_OBJECT);
 381     st_object_set_instance_size (nil, 0);
 382
 383     return nil;
 384 }
 385
 386 static void
 387 init_specials (void)
 388 {
 389     st_specials[ST_SPECIAL_PLUS]      = st_symbol_new ("+");
 390     st_specials[ST_SPECIAL_MINUS]     = st_symbol_new ("-");
 391     st_specials[ST_SPECIAL_LT]        = st_symbol_new ("<");
 392     st_specials[ST_SPECIAL_GT]        = st_symbol_new (">");
 393     st_specials[ST_SPECIAL_LE]        = st_symbol_new ("<=");
 394     st_specials[ST_SPECIAL_GE]        = st_symbol_new (">=");
 395     st_specials[ST_SPECIAL_EQ]        = st_symbol_new ("=");
 396     st_specials[ST_SPECIAL_NE]        = st_symbol_new ("~=");
 397     st_specials[ST_SPECIAL_MUL]       = st_symbol_new ("*");
 398     st_specials[ST_SPECIAL_DIV]       = st_symbol_new ("/");
 399     st_specials[ST_SPECIAL_MOD]       = st_symbol_new ("\\");
 400     st_specials[ST_SPECIAL_BITSHIFT]  = st_symbol_new ("bitShift:");
 401     st_specials[ST_SPECIAL_BITAND]    = st_symbol_new ("bitAnd:");
 402     st_specials[ST_SPECIAL_BITOR]     = st_symbol_new ("bitOr:");
 403     st_specials[ST_SPECIAL_BITXOR]    = st_symbol_new ("bitXor:");
 404
 405     st_specials[ST_SPECIAL_AT]        = st_symbol_new ("at:");
 406     st_specials[ST_SPECIAL_ATPUT]     = st_symbol_new ("at:put:");
 407     st_specials[ST_SPECIAL_SIZE]      = st_symbol_new ("size");
 408     st_specials[ST_SPECIAL_VALUE]     = st_symbol_new ("value");
 409     st_specials[ST_SPECIAL_VALUE_ARG] = st_symbol_new ("value:");
 410     st_specials[ST_SPECIAL_IDEQ]      = st_symbol_new ("==");
 411     st_specials[ST_SPECIAL_CLASS]     = st_symbol_new ("class");
 412     st_specials[ST_SPECIAL_NEW]       = st_symbol_new ("new");
 413     st_specials[ST_SPECIAL_NEW_ARG]   = st_symbol_new ("new:");
 414
 415     st_selector_doesNotUnderstand   = st_symbol_new ("doesNotUnderstand:");
 416     st_selector_mustBeBoolean       = st_symbol_new ("mustBeBoolean");
 417     st_selector_startupSystem       = st_symbol_new ("startupSystem");
 418     st_selector_cannotReturn        = st_symbol_new ("cannotReturn");
 419     st_selector_outOfMemory         = st_symbol_new ("outOfMemory");
 420 }
 421
 422 st_memory *memory;
 423
 424 void
 425 st_bootstrap_universe (void)
 426 {
 427     st_oop smalltalk;
 428     st_oop st_object_class_, st_class_class_;
 429
 430     st_memory_new ();
 431
 432     st_nil = create_nil_object ();
 433
 434     st_object_class_          = class_new (ST_FORMAT_OBJECT, 0);
 435     st_undefined_object_class = class_new (ST_FORMAT_OBJECT, 0);
 436     st_metaclass_class        = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_METACLASS);
 437     st_behavior_class         = class_new (ST_FORMAT_OBJECT, 0);
 438     st_class_class_           = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_CLASS);
 439     st_smi_class              = class_new (ST_FORMAT_OBJECT, 0);
 440     st_large_integer_class    = class_new (ST_FORMAT_LARGE_INTEGER, 0);
 441     st_character_class        = class_new (ST_FORMAT_OBJECT, 0);
 442     st_true_class             = class_new (ST_FORMAT_OBJECT, 0);
 443     st_false_class            = class_new (ST_FORMAT_OBJECT, 0);
 444     st_float_class            = class_new (ST_FORMAT_FLOAT, 0);
 445     st_array_class            = class_new (ST_FORMAT_ARRAY, 0);
 446     st_word_array_class       = class_new (ST_FORMAT_WORD_ARRAY, 0);
 447     st_float_array_class      = class_new (ST_FORMAT_FLOAT_ARRAY, 0);
 448     st_dictionary_class       = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_DICTIONARY);
 449     st_set_class              = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_SET);
 450     st_byte_array_class       = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 451     st_symbol_class           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 452     st_string_class           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 453     st_wide_string_class      = class_new (ST_FORMAT_WORD_ARRAY, 0);
 454     st_association_class      = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_ASSOCIATION);
 455     st_compiled_method_class  = class_new (ST_FORMAT_OBJECT, 0);
 456     st_method_context_class   = class_new (ST_FORMAT_CONTEXT, 5);
 457     st_block_context_class    = class_new (ST_FORMAT_CONTEXT, 7);
 458     st_system_class           = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_SYSTEM);
 459
 460     ST_OBJECT_CLASS (st_nil)  = st_undefined_object_class;
 461
 462     /* special objects */
 463     st_true         = st_object_new (st_true_class);
 464     st_false        = st_object_new (st_false_class);
 465     st_symbols      = st_set_new_with_capacity (256);
 466     st_globals      = st_dictionary_new_with_capacity (256);
 467     st_smalltalk    = st_object_new (st_system_class);
 468     ST_OBJECT_FIELDS (st_smalltalk)[0] = st_globals;
 469     ST_OBJECT_FIELDS (st_smalltalk)[1] = st_symbols;
 470
 471     /* add class names to symbol table */
 472     add_global ("Object", st_object_class_);
 473     add_global ("UndefinedObject", st_undefined_object_class);
 474     add_global ("Behavior", st_behavior_class);
 475     add_global ("Class", st_class_class_);
 476     add_global ("Metaclass", st_metaclass_class);
 477     add_global ("SmallInteger", st_smi_class);
 478     add_global ("LargeInteger", st_large_integer_class);
 479     add_global ("Character", st_character_class);
 480     add_global ("True", st_true_class);
 481     add_global ("False", st_false_class);
 482     add_global ("Float", st_float_class);
 483     add_global ("Array", st_array_class);
 484     add_global ("ByteArray", st_byte_array_class);
 485     add_global ("WordArray", st_word_array_class);
 486     add_global ("FloatArray", st_float_array_class);
 487     add_global ("ByteString", st_string_class);
 488     add_global ("ByteSymbol", st_symbol_class);
 489     add_global ("WideString", st_wide_string_class);
 490     add_global ("IdentitySet", st_set_class);
 491     add_global ("IdentityDictionary", st_dictionary_class);
 492     add_global ("Association", st_association_class);
 493     add_global ("CompiledMethod", st_compiled_method_class);
 494     add_global ("MethodContext", st_method_context_class);
 495     add_global ("BlockContext", st_block_context_class);
 496     add_global ("System", st_system_class);
 497     add_global ("Smalltalk", st_smalltalk);
 498
 499     init_specials ();
 500     file_in_classes ();
 501
 502     st_memory_add_root (st_nil);
 503     st_memory_add_root (st_true);
 504     st_memory_add_root (st_false);
 505     st_memory_add_root (st_smalltalk);
 506 }
 507
 508 static bool verbosity;
 509
 510 void
 511 st_set_verbosity (bool verbose)
 512 {
 513     verbosity = verbose;
 514 }
 515
 516 bool
 517 st_verbose_mode (void)
 518 {
 519     return verbosity;
 520 }