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-machine.h"
  44
  45 #include <stdlib.h>
  46 #include <string.h>
  47 #include <stdio.h>
  48
  49 static bool verbose_mode = false;
  50
  51 st_memory *memory = NULL;
  52
  53 st_oop
  54 st_global_get (const char *name)
  55 {
  56     st_assert (name != NULL);
  57     return st_dictionary_at (ST_GLOBALS, st_symbol_new (name));
  58 }
  59
  60 enum
  61 {
  62     INSTANCE_SIZE_UNDEFINED = 0,
  63     INSTANCE_SIZE_CLASS = 6,
  64     INSTANCE_SIZE_METACLASS = 6,
  65     INSTANCE_SIZE_DICTIONARY = 3,
  66     INSTANCE_SIZE_SET = 3,
  67     INSTANCE_SIZE_ASSOCIATION = 2,
  68     INSTANCE_SIZE_SYSTEM = 2,
  69     INSTANCE_SIZE_METHOD_CONTEXT = 5,
  70     INSTANCE_SIZE_BLOCK_CONTEXT = 6
  71 };
  72
  73 static st_oop
  74 class_new (st_format format, st_uint instance_size)
  75 {
  76     st_oop class;
  77
  78     class = st_memory_allocate (ST_SIZE_OOPS (struct st_class));
  79
  80     ST_OBJECT_MARK (class)  = 0 | ST_MARK_TAG;
  81     ST_OBJECT_CLASS (class) = ST_NIL;
  82     st_object_set_format (class, ST_FORMAT_OBJECT);
  83     st_object_set_instance_size (class, INSTANCE_SIZE_CLASS);
  84
  85     ST_BEHAVIOR_FORMAT (class)             = st_smi_new (format);
  86     ST_BEHAVIOR_INSTANCE_SIZE (class)      = st_smi_new (instance_size);
  87     ST_BEHAVIOR_SUPERCLASS (class)         = ST_NIL;
  88     ST_BEHAVIOR_METHOD_DICTIONARY (class)  = ST_NIL;
  89     ST_BEHAVIOR_INSTANCE_VARIABLES (class) = ST_NIL;
  90
  91     ST_CLASS (class)->name = ST_NIL;
  92
  93     return class;
  94 }
  95
  96 static void
  97 add_global (const char *name, st_oop object)
  98 {
  99     st_oop symbol;
 100
 101     // sanity check for symbol interning
 102     st_assert (st_symbol_new (name) == st_symbol_new (name));
 103
 104     symbol = st_symbol_new (name);
 105     st_dictionary_at_put (ST_GLOBALS, symbol, object);
 106
 107     // sanity check for dictionary
 108     st_assert (st_dictionary_at (ST_GLOBALS, symbol) == object);
 109 }
 110
 111 static void
 112 parse_error (char *message, st_token *token)
 113 {
 114     fprintf (stderr, "error: %i: %i: %s",
 115              st_token_get_line (token), st_token_get_column (token), message);
 116     exit (1);
 117 }
 118
 119 static void
 120 initialize_class  (const char *name,
 121                    const char *super_name,
 122                    st_list    *ivarnames)
 123 {
 124     st_oop metaclass, class, superclass;
 125     st_oop names;
 126     st_uint i = 1;
 127
 128     if (streq (name, "Object") && streq (super_name, "nil")) {
 129
 130         class = st_dictionary_at (ST_GLOBALS, 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_OBJECT_CLASS (class) = metaclass;
 137         }
 138
 139         ST_BEHAVIOR_SUPERCLASS (class)     = ST_NIL;
 140         ST_BEHAVIOR_INSTANCE_SIZE (class)  = st_smi_new (0);
 141         ST_BEHAVIOR_SUPERCLASS (metaclass) = st_dictionary_at (ST_GLOBALS, st_symbol_new ("Class"));
 142
 143     } else {
 144         superclass = st_global_get (super_name);
 145         if (superclass == ST_NIL)
 146             st_assert (superclass != ST_NIL);
 147
 148         class = st_global_get (name);
 149         if (class == ST_NIL)
 150             class = class_new (st_smi_value (ST_BEHAVIOR_FORMAT (superclass)), 0);
 151
 152         metaclass = ST_HEADER (class)->class;
 153         if (metaclass == ST_NIL) {
 154             metaclass = st_object_new (ST_METACLASS_CLASS);
 155             ST_OBJECT_CLASS (class) = metaclass;
 156         }
 157
 158         ST_BEHAVIOR_SUPERCLASS (class)     = superclass;
 159         ST_BEHAVIOR_SUPERCLASS (metaclass) = ST_HEADER (superclass)->class;
 160         ST_BEHAVIOR_INSTANCE_SIZE (class) = st_smi_new (st_list_length (ivarnames) +
 161                                                         st_smi_value (ST_BEHAVIOR_INSTANCE_SIZE (superclass)));
 162     }
 163
 164     names = ST_NIL;
 165     if (st_list_length (ivarnames) != 0) {
 166         names = st_object_new_arrayed (ST_ARRAY_CLASS, st_list_length (ivarnames));
 167         for (st_list *l = ivarnames; l; l = l->next)
 168             st_array_at_put (names, i++, st_symbol_new (l->data));
 169         ST_BEHAVIOR_INSTANCE_VARIABLES (class) = names;
 170     }
 171
 172     ST_BEHAVIOR_FORMAT (metaclass)             = st_smi_new (ST_FORMAT_OBJECT);
 173     ST_BEHAVIOR_METHOD_DICTIONARY (metaclass)  = st_dictionary_new ();
 174     ST_BEHAVIOR_INSTANCE_VARIABLES (metaclass) = ST_NIL;
 175     ST_BEHAVIOR_INSTANCE_SIZE (metaclass)      = st_smi_new (INSTANCE_SIZE_CLASS);
 176     ST_METACLASS_INSTANCE_CLASS (metaclass)    = class;
 177     ST_BEHAVIOR_INSTANCE_VARIABLES (class)     = names;
 178     ST_BEHAVIOR_METHOD_DICTIONARY (class)      = st_dictionary_new ();
 179     ST_CLASS_NAME (class)                      = st_symbol_new (name);
 180
 181     st_dictionary_at_put (ST_GLOBALS, st_symbol_new (name), class);
 182 }
 183
 184
 185 static bool
 186 parse_variable_names (st_lexer *lexer, st_list **varnames)
 187 {
 188     st_lexer *ivarlexer;
 189     st_token *token;
 190     char *names;
 191
 192     token = st_lexer_next_token (lexer);
 193
 194     if (st_token_get_type (token) != ST_TOKEN_STRING_CONST)
 195         return false;
 196
 197     names = st_strdup (st_token_get_text (token));
 198     ivarlexer = st_lexer_new (names);
 199     token = st_lexer_next_token (ivarlexer);
 200
 201     while (st_token_get_type (token) != ST_TOKEN_EOF) {
 202
 203         if (st_token_get_type (token) != ST_TOKEN_IDENTIFIER)
 204             parse_error (NULL, token);
 205
 206         *varnames = st_list_append (*varnames, st_strdup (st_token_get_text (token)));
 207         token = st_lexer_next_token (ivarlexer);
 208     }
 209
 210     st_free (names);
 211     st_lexer_destroy (ivarlexer);
 212
 213     return true;
 214 }
 215
 216
 217 static void
 218 parse_class (st_lexer *lexer, st_token *token)
 219 {
 220     char *class_name = NULL;
 221     char *superclass_name = NULL;
 222     st_list *ivarnames = NULL;
 223
 224     // 'Class' token
 225     if (st_token_get_type (token) != ST_TOKEN_IDENTIFIER
 226         || !streq (st_token_get_text (token), "Class"))
 227         parse_error ("expected class definition", token);
 228
 229     // `named:' token
 230     token = st_lexer_next_token (lexer);
 231     if (st_token_get_type (token) != ST_TOKEN_KEYWORD_SELECTOR
 232         || !streq (st_token_get_text (token), "named:"))
 233         parse_error ("expected 'name:'", token);
 234
 235     // class name
 236     token = st_lexer_next_token (lexer);
 237     if (st_token_get_type (token) == ST_TOKEN_STRING_CONST) {
 238         class_name = st_strdup (st_token_get_text (token));
 239     } else {
 240         parse_error ("expected string literal", token);
 241     }
 242
 243     // `superclass:' token
 244     token = st_lexer_next_token (lexer);
 245     if (st_token_get_type (token) != ST_TOKEN_KEYWORD_SELECTOR
 246         || !streq (st_token_get_text (token), "superclass:"))
 247         parse_error ("expected 'superclass:'", token);
 248
 249     // superclass name
 250     token = st_lexer_next_token (lexer);
 251     if (st_token_get_type (token) == ST_TOKEN_STRING_CONST) {
 252
 253         superclass_name = st_strdup (st_token_get_text (token));
 254
 255     } else {
 256         parse_error ("expected string literal", token);
 257     }
 258
 259     // 'instanceVariableNames:' keyword selector
 260     token = st_lexer_next_token (lexer);
 261     if (st_token_get_type (token) == ST_TOKEN_KEYWORD_SELECTOR &&
 262         streq (st_token_get_text (token), "instanceVariableNames:")) {
 263
 264         parse_variable_names (lexer, &ivarnames);
 265     } else {
 266         parse_error (NULL, token);
 267     }
 268
 269     token = st_lexer_next_token (lexer);
 270     initialize_class (class_name, superclass_name, ivarnames);
 271
 272     st_list_foreach (ivarnames, st_free);
 273     st_list_destroy (ivarnames);
 274     st_free (class_name);
 275     st_free (superclass_name);
 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     st_free (contents);
 305     st_lexer_destroy (lexer);
 306 }
 307
 308 static void
 309 file_in_classes (void)
 310 {
 311     char *filename;
 312
 313     parse_classes ("../st/class-defs.st");
 314
 315     static const char * files[] =
 316         {
 317             "Stream.st",
 318             "PositionableStream.st",
 319             "WriteStream.st",
 320             "Collection.st",
 321             "SequenceableCollection.st",
 322             "ArrayedCollection.st",
 323             "HashedCollection.st",
 324             "Set.st",
 325             "Dictionary.st",
 326             "IdentitySet.st",
 327             "IdentityDictionary.st",
 328             "Bag.st",
 329             "Array.st",
 330             "ByteArray.st",
 331             "WordArray.st",
 332             "FloatArray.st",
 333             "Association.st",
 334             "Magnitude.st",
 335             "Number.st",
 336             "Integer.st",
 337             "SmallInteger.st",
 338             "LargeInteger.st",
 339             "Fraction.st",
 340             "Float.st",
 341             "Object.st",
 342             "UndefinedObject.st",
 343             "String.st",
 344             "Symbol.st",
 345             "ByteString.st",
 346             "WideString.st",
 347             "Character.st",
 348             "Behavior.st",
 349             "Boolean.st",
 350             "True.st",
 351             "False.st",
 352             "Behavior.st",
 353             "ContextPart.st",
 354             "BlockContext.st",
 355             "Message.st",
 356             "OrderedCollection.st",
 357             "List.st",
 358             "System.st",
 359             "CompiledMethod.st",
 360             "FileStream.st",
 361             "pidigits.st"
 362         };
 363
 364     for (st_uint i = 0; i < ST_N_ELEMENTS (files); i++) {
 365         filename = st_strconcat ("..", ST_DIR_SEPARATOR_S, "st", ST_DIR_SEPARATOR_S, files[i], NULL);
 366         st_compile_file_in (filename);
 367         st_free (filename);
 368     }
 369 }
 370
 371 #define NIL_SIZE_OOPS (sizeof (struct st_header) / sizeof (st_oop))
 372
 373 static st_oop
 374 create_nil_object (void)
 375 {
 376     st_oop nil;
 377
 378     nil = st_memory_allocate (NIL_SIZE_OOPS);
 379
 380     ST_OBJECT_MARK (nil)  = 0 | ST_MARK_TAG;
 381     ST_OBJECT_CLASS (nil) = nil;
 382     st_object_set_format (nil, ST_FORMAT_OBJECT);
 383     st_object_set_instance_size (nil, 0);
 384
 385     return nil;
 386 }
 387
 388 static void
 389 init_specials (void)
 390 {
 391     ST_SELECTOR_PLUS      = st_symbol_new ("+");
 392     ST_SELECTOR_MINUS     = st_symbol_new ("-");
 393     ST_SELECTOR_LT        = st_symbol_new ("<");
 394     ST_SELECTOR_GT        = st_symbol_new (">");
 395     ST_SELECTOR_LE        = st_symbol_new ("<=");
 396     ST_SELECTOR_GE        = st_symbol_new (">=");
 397     ST_SELECTOR_EQ        = st_symbol_new ("=");
 398     ST_SELECTOR_NE        = st_symbol_new ("~=");
 399     ST_SELECTOR_MUL       = st_symbol_new ("*");
 400     ST_SELECTOR_DIV       = st_symbol_new ("/");
 401     ST_SELECTOR_MOD       = st_symbol_new ("\\");
 402     ST_SELECTOR_BITSHIFT  = st_symbol_new ("bitShift:");
 403     ST_SELECTOR_BITAND    = st_symbol_new ("bitAnd:");
 404     ST_SELECTOR_BITOR     = st_symbol_new ("bitOr:");
 405     ST_SELECTOR_BITXOR    = st_symbol_new ("bitXor:");
 406     ST_SELECTOR_AT        = st_symbol_new ("at:");
 407     ST_SELECTOR_ATPUT     = st_symbol_new ("at:put:");
 408     ST_SELECTOR_SIZE      = st_symbol_new ("size");
 409     ST_SELECTOR_VALUE     = st_symbol_new ("value");
 410     ST_SELECTOR_VALUE_ARG = st_symbol_new ("value:");
 411     ST_SELECTOR_IDEQ      = st_symbol_new ("==");
 412     ST_SELECTOR_CLASS     = st_symbol_new ("class");
 413     ST_SELECTOR_NEW       = st_symbol_new ("new");
 414     ST_SELECTOR_NEW_ARG   = st_symbol_new ("new:");
 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 void
 423 bootstrap_universe (void)
 424 {
 425     st_oop smalltalk;
 426     st_oop st_object_class_, st_class_class_;
 427
 428     st_memory_new ();
 429
 430     ST_NIL = create_nil_object ();
 431
 432     st_object_class_          = class_new (ST_FORMAT_OBJECT, 0);
 433     ST_UNDEFINED_OBJECT_CLASS = class_new (ST_FORMAT_OBJECT, 0);
 434     ST_METACLASS_CLASS        = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_METACLASS);
 435     ST_BEHAVIOR_CLASS         = class_new (ST_FORMAT_OBJECT, 0);
 436     st_class_class_           = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_CLASS);
 437     ST_SMI_CLASS              = class_new (ST_FORMAT_OBJECT, 0);
 438     ST_LARGE_INTEGER_CLASS    = class_new (ST_FORMAT_LARGE_INTEGER, 0);
 439     ST_CHARACTER_CLASS        = class_new (ST_FORMAT_OBJECT, 0);
 440     ST_TRUE_CLASS             = class_new (ST_FORMAT_OBJECT, 0);
 441     ST_FALSE_CLASS            = class_new (ST_FORMAT_OBJECT, 0);
 442     ST_FLOAT_CLASS            = class_new (ST_FORMAT_FLOAT, 0);
 443     ST_ARRAY_CLASS            = class_new (ST_FORMAT_ARRAY, 0);
 444     ST_WORD_ARRAY_CLASS       = class_new (ST_FORMAT_WORD_ARRAY, 0);
 445     ST_FLOAT_ARRAY_CLASS      = class_new (ST_FORMAT_FLOAT_ARRAY, 0);
 446     ST_DICTIONARY_CLASS       = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_DICTIONARY);
 447     ST_SET_CLASS              = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_SET);
 448     ST_BYTE_ARRAY_CLASS       = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 449     ST_SYMBOL_CLASS           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 450     ST_STRING_CLASS           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 451     ST_WIDE_STRING_CLASS      = class_new (ST_FORMAT_WORD_ARRAY, 0);
 452     ST_ASSOCIATION_CLASS      = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_ASSOCIATION);
 453     ST_COMPILED_METHOD_CLASS  = class_new (ST_FORMAT_OBJECT, 0);
 454     ST_METHOD_CONTEXT_CLASS   = class_new (ST_FORMAT_CONTEXT, INSTANCE_SIZE_METHOD_CONTEXT);
 455     ST_BLOCK_CONTEXT_CLASS    = class_new (ST_FORMAT_CONTEXT, INSTANCE_SIZE_BLOCK_CONTEXT);
 456     ST_SYSTEM_CLASS           = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_SYSTEM);
 457     ST_HANDLE_CLASS           = class_new (ST_FORMAT_HANDLE, 0);
 458     ST_MESSAGE_CLASS          = class_new (ST_FORMAT_OBJECT, 2);
 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 ("Handle", ST_HANDLE_CLASS);
 497     add_global ("Message", ST_MESSAGE_CLASS);
 498     add_global ("System", ST_SYSTEM_CLASS);
 499     add_global ("Smalltalk", ST_SMALLTALK);
 500
 501     init_specials ();
 502     file_in_classes ();
 503
 504     st_memory_add_root (ST_NIL);
 505     st_memory_add_root (ST_TRUE);
 506     st_memory_add_root (ST_FALSE);
 507     st_memory_add_root (ST_SMALLTALK);
 508 }
 509
 510 void
 511 st_initialize (void)
 512 {
 513     bootstrap_universe ();
 514 }
 515
 516 void
 517 st_set_verbose_mode (bool verbose)
 518 {
 519     verbose_mode = verbose;
 520 }
 521
 522 bool
 523 st_get_verbose_mode (void)
 524 {
 525     return verbose_mode;
 526 }
 527
 528