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-array.h"
  34 #include "st-array.h"
  35 #include "st-array.h"
  36 #include "st-small-integer.h"
  37 #include "st-hashed-collection.h"
  38 #include "st-large-integer.h"
  39 #include "st-symbol.h"
  40 #include "st-universe.h"
  41 #include "st-object.h"
  42 #include "st-lexer.h"
  43 #include "st-descriptor.h"
  44 #include "st-compiler.h"
  45 #include "st-memory.h"
  46 #include "st-context.h"
  47 #include "st-processor.h"
  48
  49 #include <stdlib.h>
  50 #include <string.h>
  51 #include <stdio.h>
  52
  53 st_oop globals[32];
  54
  55 st_oop st_specials[ST_NUM_SPECIALS];
  56
  57
  58 st_oop
  59 st_global_get (const char *name)
  60 {
  61     return st_dictionary_at (st_smalltalk, st_symbol_new (name));
  62 }
  63
  64 enum
  65 {
  66     INSTANCE_SIZE_UNDEFINED = 0,
  67     INSTANCE_SIZE_CLASS = 6,
  68     INSTANCE_SIZE_METACLASS = 6,
  69     INSTANCE_SIZE_DICTIONARY = 2,
  70     INSTANCE_SIZE_SET = 2,
  71     INSTANCE_SIZE_ASSOCIATION = 2,
  72 };
  73
  74 static st_oop
  75 class_new (st_format format, st_uint instance_size)
  76 {
  77     st_oop class;
  78
  79     class = st_memory_allocate (ST_SIZE_OOPS (struct st_class));
  80
  81     ST_HEADER (class)->mark = 0 | ST_MARK_TAG;
  82     ST_HEADER (class)->hash  = st_smi_new (st_current_hash++);
  83     ST_HEADER (class)->class = st_nil;
  84     st_object_set_format (class, ST_FORMAT_OBJECT);
  85     st_object_set_instance_size (class, INSTANCE_SIZE_CLASS);
  86
  87     ST_BEHAVIOR (class)->format             = st_smi_new (format);
  88     ST_BEHAVIOR (class)->instance_size      = st_smi_new (instance_size);
  89     ST_BEHAVIOR (class)->superclass         = st_nil;
  90     ST_BEHAVIOR (class)->method_dictionary  = st_nil;
  91     ST_BEHAVIOR (class)->instance_variables = st_nil;
  92
  93     ST_CLASS (class)->name = st_nil;
  94
  95     return class;
  96 }
  97
  98 static void
  99 add_global (const char *name, st_oop object)
 100 {
 101     st_oop symbol;
 102
 103     // sanity check for symbol interning
 104     st_assert (st_symbol_new (name) == st_symbol_new (name));
 105
 106     symbol = st_symbol_new (name);
 107     st_dictionary_at_put (st_smalltalk, symbol, object);
 108
 109     // sanity check for dictionary
 110     st_assert (st_dictionary_at (st_smalltalk, symbol) == object);
 111 }
 112
 113 static void
 114 parse_error (char *message, st_token *token)
 115 {
 116     fprintf (stderr, "error: %i: %i: %s",
 117              st_token_get_line (token), st_token_get_column (token), message);
 118     exit (1);
 119 }
 120
 121 static void
 122 initialize_class  (const char *name,
 123                    const char *super_name,
 124                    st_list    *ivarnames)
 125 {
 126     st_oop metaclass, class, superclass;
 127
 128     if (streq (name, "Object") && streq (super_name, "nil")) {
 129
 130         class = st_dictionary_at (st_smalltalk, st_symbol_new ("Object"));
 131         st_assert (class != st_nil);
 132
 133         metaclass = st_object_class (class);
 134         if (metaclass == st_nil) {
 135             metaclass = st_object_new (st_metaclass_class);
 136             ST_HEADER (class)->class = metaclass;
 137         }
 138
 139         ST_BEHAVIOR (class)->superclass     = st_nil;
 140         ST_BEHAVIOR (class)->instance_size  = st_smi_new (0);
 141         ST_BEHAVIOR (metaclass)->superclass = st_dictionary_at (st_smalltalk, st_symbol_new ("Class"));
 142
 143     } else {
 144
 145         superclass = st_global_get (super_name);
 146         if (superclass == st_nil)
 147             st_assert (superclass != st_nil);
 148
 149         class = st_global_get (name);
 150         if (class == st_nil)
 151             class = class_new (st_smi_value (ST_BEHAVIOR (superclass)->format), 0);
 152
 153         metaclass = ST_HEADER (class)->class;
 154         if (metaclass == st_nil) {
 155             metaclass = st_object_new (st_metaclass_class);
 156             ST_HEADER (class)->class = metaclass;
 157         }
 158
 159         ST_BEHAVIOR (class)->superclass     = superclass;
 160         ST_BEHAVIOR (metaclass)->superclass = ST_HEADER (superclass)->class;
 161
 162         ST_BEHAVIOR (class)->instance_size = st_smi_new (st_list_length (ivarnames) +
 163                                                          st_smi_value (ST_BEHAVIOR (superclass)->instance_size));
 164     }
 165
 166     ST_BEHAVIOR (metaclass)->format             = st_smi_new (ST_FORMAT_OBJECT);
 167     ST_BEHAVIOR (metaclass)->method_dictionary  = st_dictionary_new ();
 168     ST_BEHAVIOR (metaclass)->instance_variables = st_nil;
 169     ST_BEHAVIOR (metaclass)->instance_size      = st_smi_new (INSTANCE_SIZE_CLASS);
 170     ST_METACLASS (metaclass)->instance_class    = class;
 171
 172     if (st_list_length (ivarnames) != 0) {
 173         st_oop names;
 174         st_uint i = 1;
 175         names = st_object_new_arrayed (st_array_class, st_list_length (ivarnames));
 176         for (st_list *l = ivarnames; l; l = l->next)
 177             st_array_at_put (names, i++, st_symbol_new (l->data));
 178         ST_BEHAVIOR (class)->instance_variables = names;
 179
 180     } else {
 181         ST_BEHAVIOR (class)->instance_variables = st_nil;
 182     }
 183
 184     ST_BEHAVIOR (class)->method_dictionary = st_dictionary_new ();
 185     ST_CLASS (class)->name = st_symbol_new (name);
 186
 187     st_dictionary_at_put (st_smalltalk, st_symbol_new (name), class);
 188 }
 189
 190
 191 static bool
 192 parse_variable_names (st_lexer *lexer, st_list **varnames)
 193 {
 194     st_lexer *ivarlexer;
 195     st_token *token;
 196     char *names;
 197
 198     token = st_lexer_next_token (lexer);
 199
 200     if (st_token_get_type (token) != ST_TOKEN_STRING_CONST)
 201         return false;
 202
 203     names = st_strdup (st_token_get_text (token));
 204     ivarlexer = st_lexer_new (names); /* input valid at this stage */
 205     token = st_lexer_next_token (ivarlexer);
 206
 207     while (st_token_get_type (token) != ST_TOKEN_EOF) {
 208
 209         if (st_token_get_type (token) != ST_TOKEN_IDENTIFIER)
 210             parse_error (NULL, token);
 211
 212         *varnames = st_list_append (*varnames, st_strdup (st_token_get_text (token)));
 213         token = st_lexer_next_token (ivarlexer);
 214     }
 215
 216     st_lexer_destroy (ivarlexer);
 217
 218     return true;
 219 }
 220
 221
 222 static void
 223 parse_class (st_lexer *lexer, st_token *token)
 224 {
 225     char *class_name = NULL;
 226     char *superclass_name = 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     st_list *ivarnames = NULL;
 264
 265     // 'instanceVariableNames:' keyword selector
 266     token = st_lexer_next_token (lexer);
 267     if (st_token_get_type (token) == ST_TOKEN_KEYWORD_SELECTOR &&
 268         streq (st_token_get_text (token), "instanceVariableNames:")) {
 269
 270         parse_variable_names (lexer, &ivarnames);
 271
 272     } else {
 273         parse_error (NULL, token);
 274     }
 275
 276     token = st_lexer_next_token (lexer);
 277
 278     initialize_class (class_name, superclass_name, ivarnames);
 279
 280     st_list_destroy (ivarnames);
 281
 282     return;
 283 }
 284
 285 static void
 286 parse_classes (const char *filename)
 287 {
 288     char *contents;
 289     st_lexer *lexer;
 290     st_token *token;
 291
 292     if (!st_file_get_contents (filename, &contents)) {
 293         exit (1);
 294     }
 295
 296     lexer = st_lexer_new (contents);
 297     st_assert (lexer != NULL);
 298     token = st_lexer_next_token (lexer);
 299
 300     while (st_token_get_type (token) != ST_TOKEN_EOF) {
 301
 302         while (st_token_get_type (token) == ST_TOKEN_COMMENT)
 303             token = st_lexer_next_token (lexer);
 304
 305         parse_class (lexer, token);
 306         token = st_lexer_next_token (lexer);
 307     }
 308 }
 309
 310 static void
 311 file_in_classes (void)
 312 {
 313     char *filename;
 314
 315     parse_classes ("../st/class-defs.st");
 316
 317     static const char * files[] =
 318         {
 319             "Stream.st",
 320             "PositionableStream.st",
 321             "WriteStream.st",
 322             "Collection.st",
 323             "SequenceableCollection.st",
 324             "ArrayedCollection.st",
 325 //          "HashedCollection.st",
 326 //          "Set.st",
 327             "Array.st",
 328             "ByteArray.st",
 329             "WordArray.st",
 330             "FloatArray.st",
 331             "Association.st",
 332             "Magnitude.st",
 333             "Number.st",
 334             "Integer.st",
 335             "SmallInteger.st",
 336             "LargeInteger.st",
 337             "Fraction.st",
 338             "Float.st",
 339             "Object.st",
 340             "UndefinedObject.st",
 341             "String.st",
 342             "Symbol.st",
 343             "ByteString.st",
 344             "WideString.st",
 345             "Character.st",
 346             "UnicodeTables.st",
 347             "Behavior.st",
 348             "Boolean.st",
 349             "True.st",
 350             "False.st",
 351             "Behavior.st",
 352             "ContextPart.st",
 353             "BlockContext.st",
 354             "Message.st",
 355             "OrderedCollection.st"
 356         };
 357
 358     for (st_uint i = 0; i < ST_N_ELEMENTS (files); i++) {
 359         filename = st_strconcat("..", ST_DIR_SEPARATOR_S, "st", ST_DIR_SEPARATOR_S, files[i], NULL);
 360         st_compile_file_in (filename);
 361         st_free (filename);
 362     }
 363 }
 364
 365 #define NIL_SIZE_OOPS (sizeof (struct st_header) / sizeof (st_oop))
 366
 367 static st_oop
 368 create_nil_object (void)
 369 {
 370     st_oop nil;
 371
 372     nil = st_memory_allocate (NIL_SIZE_OOPS);
 373
 374     ST_HEADER (nil)->mark = 0 | ST_MARK_TAG;
 375     ST_HEADER (nil)->hash = st_smi_new (st_current_hash++);
 376     ST_HEADER (nil)->class = nil;
 377     st_object_set_format (nil, ST_FORMAT_OBJECT);
 378     st_object_set_instance_size (nil, 0);
 379
 380     return nil;
 381 }
 382
 383 static void
 384 init_specials (void)
 385 {
 386     st_specials[ST_SPECIAL_PLUS]      = st_symbol_new ("+");
 387     st_specials[ST_SPECIAL_MINUS]     = st_symbol_new ("-");
 388     st_specials[ST_SPECIAL_LT]        = st_symbol_new ("<");
 389     st_specials[ST_SPECIAL_GT]        = st_symbol_new (">");
 390     st_specials[ST_SPECIAL_LE]        = st_symbol_new ("<=");
 391     st_specials[ST_SPECIAL_GE]        = st_symbol_new (">=");
 392     st_specials[ST_SPECIAL_EQ]        = st_symbol_new ("=");
 393     st_specials[ST_SPECIAL_NE]        = st_symbol_new ("~=");
 394     st_specials[ST_SPECIAL_MUL]       = st_symbol_new ("*");
 395     st_specials[ST_SPECIAL_DIV]       = st_symbol_new ("/");
 396     st_specials[ST_SPECIAL_MOD]       = st_symbol_new ("\\");
 397     st_specials[ST_SPECIAL_BITSHIFT]  = st_symbol_new ("bitShift:");
 398     st_specials[ST_SPECIAL_BITAND]    = st_symbol_new ("bitAnd:");
 399     st_specials[ST_SPECIAL_BITOR]     = st_symbol_new ("bitOr:");
 400     st_specials[ST_SPECIAL_BITXOR]    = st_symbol_new ("bitXor:");
 401
 402     st_specials[ST_SPECIAL_AT]        = st_symbol_new ("at:");
 403     st_specials[ST_SPECIAL_ATPUT]     = st_symbol_new ("at:put:");
 404     st_specials[ST_SPECIAL_SIZE]      = st_symbol_new ("size");
 405     st_specials[ST_SPECIAL_VALUE]     = st_symbol_new ("value");
 406     st_specials[ST_SPECIAL_VALUE_ARG] = st_symbol_new ("value:");
 407     st_specials[ST_SPECIAL_IDEQ]      = st_symbol_new ("==");
 408     st_specials[ST_SPECIAL_CLASS]     = st_symbol_new ("class");
 409     st_specials[ST_SPECIAL_NEW]       = st_symbol_new ("new");
 410     st_specials[ST_SPECIAL_NEW_ARG]   = st_symbol_new ("new:");
 411
 412     st_selector_doesNotUnderstand   = st_symbol_new ("doesNotUnderstand:");
 413     st_selector_mustBeBoolean       = st_symbol_new ("mustBeBoolean");
 414     st_selector_startupSystem       = st_symbol_new ("startupSystem");
 415     st_selector_cannotReturn        = st_symbol_new ("cannotReturn");
 416     st_selector_outOfMemory         = st_symbol_new ("outOfMemory");
 417 }
 418
 419 st_memory *memory;
 420
 421 void
 422 st_bootstrap_universe (void)
 423 {
 424     st_oop st_object_class_, st_class_class_;
 425
 426     st_memory_new ();
 427
 428     /* setup format descriptors */
 429     st_descriptors[ST_FORMAT_OBJECT]        = st_object_descriptor        ();
 430     st_descriptors[ST_FORMAT_ARRAY]         = st_array_descriptor         ();
 431     st_descriptors[ST_FORMAT_BYTE_ARRAY]    = st_byte_array_descriptor    ();
 432     st_descriptors[ST_FORMAT_WORD_ARRAY]    = st_word_array_descriptor    ();
 433     st_descriptors[ST_FORMAT_FLOAT_ARRAY]   = st_float_array_descriptor   ();
 434     st_descriptors[ST_FORMAT_FLOAT]         = st_float_descriptor         ();
 435     st_descriptors[ST_FORMAT_LARGE_INTEGER] = st_large_integer_descriptor ();
 436     st_descriptors[ST_FORMAT_CONTEXT]       = st_context_descriptor       ();
 437
 438     st_nil = create_nil_object ();
 439
 440     st_object_class_          = class_new (ST_FORMAT_OBJECT, 0);
 441     st_undefined_object_class = class_new (ST_FORMAT_OBJECT, 0);
 442     st_metaclass_class        = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_METACLASS);
 443     st_behavior_class         = class_new (ST_FORMAT_OBJECT, 0);
 444     st_class_class_           = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_CLASS);
 445     st_smi_class              = class_new (ST_FORMAT_OBJECT, 0);
 446     st_large_integer_class    = class_new (ST_FORMAT_LARGE_INTEGER, 0);
 447     st_character_class        = class_new (ST_FORMAT_OBJECT, 0);
 448     st_true_class             = class_new (ST_FORMAT_OBJECT, 0);
 449     st_false_class            = class_new (ST_FORMAT_OBJECT, 0);
 450     st_float_class            = class_new (ST_FORMAT_FLOAT, 0);
 451     st_array_class            = class_new (ST_FORMAT_ARRAY, 0);
 452     st_word_array_class       = class_new (ST_FORMAT_WORD_ARRAY, 0);
 453     st_float_array_class      = class_new (ST_FORMAT_FLOAT_ARRAY, 0);
 454     st_dictionary_class       = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_DICTIONARY);
 455     st_set_class              = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_SET);
 456     st_byte_array_class       = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 457     st_symbol_class           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 458     st_string_class           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 459     st_wide_string_class      = class_new (ST_FORMAT_WORD_ARRAY, 0);
 460     st_association_class      = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_ASSOCIATION);
 461     st_compiled_method_class  = class_new (ST_FORMAT_OBJECT, 0);
 462     st_method_context_class   = class_new (ST_FORMAT_CONTEXT, 5);
 463     st_block_context_class    = class_new (ST_FORMAT_CONTEXT, 7);
 464
 465     ST_HEADER (st_nil)->class = st_undefined_object_class;
 466
 467     /* special objects */
 468     st_true         = st_object_new (st_true_class);
 469     st_false        = st_object_new (st_false_class);
 470     st_symbol_table = st_set_new_with_capacity (75);
 471     st_smalltalk    = st_dictionary_new_with_capacity (75);
 472
 473     /* add class names to symbol table */
 474     add_global ("Object", st_object_class_);
 475     add_global ("UndefinedObject", st_undefined_object_class);
 476     add_global ("Behavior", st_behavior_class);
 477     add_global ("Class", st_class_class_);
 478     add_global ("Metaclass", st_metaclass_class);
 479     add_global ("SmallInteger", st_smi_class);
 480     add_global ("LargeInteger", st_large_integer_class);
 481     add_global ("Character", st_character_class);
 482     add_global ("True", st_true_class);
 483     add_global ("False", st_false_class);
 484     add_global ("Float", st_float_class);
 485     add_global ("Array", st_array_class);
 486     add_global ("ByteArray", st_byte_array_class);
 487     add_global ("WordArray", st_word_array_class);
 488     add_global ("FloatArray", st_float_array_class);
 489     add_global ("ByteString", st_string_class);
 490     add_global ("ByteSymbol", st_symbol_class);
 491     add_global ("WideString", st_wide_string_class);
 492     add_global ("Set", st_set_class);
 493     add_global ("Dictionary", st_dictionary_class);
 494     add_global ("Association", st_association_class);
 495     add_global ("CompiledMethod", st_compiled_method_class);
 496     add_global ("MethodContext", st_method_context_class);
 497     add_global ("BlockContext", st_block_context_class);
 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     st_memory_add_root (st_symbol_table);
 507 }
 508
 509 static bool verbosity;
 510
 511 void
 512 st_set_verbosity (bool verbose)
 513 {
 514     verbosity = verbose;
 515 }
 516
 517 bool
 518 st_verbose_mode (void)
 519 {
 520     return verbosity;
 521 }