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-cpu.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 };
  70
  71 static st_oop
  72 class_new (st_format format, st_uint instance_size)
  73 {
  74     st_oop class;
  75
  76     class = st_memory_allocate (ST_SIZE_OOPS (struct st_class));
  77
  78     ST_OBJECT_MARK (class)  = 0 | ST_MARK_TAG;
  79     ST_OBJECT_CLASS (class) = ST_NIL;
  80     st_object_set_format (class, ST_FORMAT_OBJECT);
  81     st_object_set_instance_size (class, INSTANCE_SIZE_CLASS);
  82
  83     ST_BEHAVIOR_FORMAT (class)             = st_smi_new (format);
  84     ST_BEHAVIOR_INSTANCE_SIZE (class)      = st_smi_new (instance_size);
  85     ST_BEHAVIOR_SUPERCLASS (class)         = ST_NIL;
  86     ST_BEHAVIOR_METHOD_DICTIONARY (class)  = ST_NIL;
  87     ST_BEHAVIOR_INSTANCE_VARIABLES (class) = ST_NIL;
  88
  89     ST_CLASS (class)->name = ST_NIL;
  90
  91     return class;
  92 }
  93
  94 static void
  95 add_global (const char *name, st_oop object)
  96 {
  97     st_oop symbol;
  98
  99     // sanity check for symbol interning
 100     st_assert (st_symbol_new (name) == st_symbol_new (name));
 101
 102     symbol = st_symbol_new (name);
 103     st_dictionary_at_put (ST_GLOBALS, symbol, object);
 104
 105     // sanity check for dictionary
 106     st_assert (st_dictionary_at (ST_GLOBALS, symbol) == object);
 107 }
 108
 109 static void
 110 parse_error (char *message, st_token *token)
 111 {
 112     fprintf (stderr, "error: %i: %i: %s",
 113              st_token_get_line (token), st_token_get_column (token), message);
 114     exit (1);
 115 }
 116
 117 static void
 118 initialize_class  (const char *name,
 119                    const char *super_name,
 120                    st_list    *ivarnames)
 121 {
 122     st_oop metaclass, class, superclass;
 123     st_oop names;
 124     st_uint i = 1;
 125
 126     if (streq (name, "Object") && streq (super_name, "nil")) {
 127
 128         class = st_dictionary_at (ST_GLOBALS, st_symbol_new ("Object"));
 129         st_assert (class != ST_NIL);
 130
 131         metaclass = st_object_class (class);
 132         if (metaclass == ST_NIL) {
 133             metaclass = st_object_new (ST_METACLASS_CLASS);
 134             ST_OBJECT_CLASS (class) = metaclass;
 135         }
 136
 137         ST_BEHAVIOR_SUPERCLASS (class)     = ST_NIL;
 138         ST_BEHAVIOR_INSTANCE_SIZE (class)  = st_smi_new (0);
 139         ST_BEHAVIOR_SUPERCLASS (metaclass) = st_dictionary_at (ST_GLOBALS, st_symbol_new ("Class"));
 140
 141     } else {
 142         superclass = st_global_get (super_name);
 143         if (superclass == ST_NIL)
 144             st_assert (superclass != ST_NIL);
 145
 146         class = st_global_get (name);
 147         if (class == ST_NIL)
 148             class = class_new (st_smi_value (ST_BEHAVIOR_FORMAT (superclass)), 0);
 149
 150         metaclass = ST_HEADER (class)->class;
 151         if (metaclass == ST_NIL) {
 152             metaclass = st_object_new (ST_METACLASS_CLASS);
 153             ST_OBJECT_CLASS (class) = metaclass;
 154         }
 155
 156         ST_BEHAVIOR_SUPERCLASS (class)     = superclass;
 157         ST_BEHAVIOR_SUPERCLASS (metaclass) = ST_HEADER (superclass)->class;
 158         ST_BEHAVIOR_INSTANCE_SIZE (class) = st_smi_new (st_list_length (ivarnames) +
 159                                                         st_smi_value (ST_BEHAVIOR_INSTANCE_SIZE (superclass)));
 160     }
 161
 162     names = ST_NIL;
 163     if (st_list_length (ivarnames) != 0) {
 164         names = st_object_new_arrayed (ST_ARRAY_CLASS, st_list_length (ivarnames));
 165         for (st_list *l = ivarnames; l; l = l->next)
 166             st_array_at_put (names, i++, st_symbol_new (l->data));
 167         ST_BEHAVIOR_INSTANCE_VARIABLES (class) = names;
 168     }
 169
 170     ST_BEHAVIOR_FORMAT (metaclass)             = st_smi_new (ST_FORMAT_OBJECT);
 171     ST_BEHAVIOR_METHOD_DICTIONARY (metaclass)  = st_dictionary_new ();
 172     ST_BEHAVIOR_INSTANCE_VARIABLES (metaclass) = ST_NIL;
 173     ST_BEHAVIOR_INSTANCE_SIZE (metaclass)      = st_smi_new (INSTANCE_SIZE_CLASS);
 174     ST_METACLASS_INSTANCE_CLASS (metaclass)    = class;
 175     ST_BEHAVIOR_INSTANCE_VARIABLES (class)     = names;
 176     ST_BEHAVIOR_METHOD_DICTIONARY (class)      = st_dictionary_new ();
 177     ST_CLASS_NAME (class)                      = st_symbol_new (name);
 178
 179     st_dictionary_at_put (ST_GLOBALS, st_symbol_new (name), class);
 180 }
 181
 182
 183 static bool
 184 parse_variable_names (st_lexer *lexer, st_list **varnames)
 185 {
 186     st_lexer *ivarlexer;
 187     st_token *token;
 188     char *names;
 189
 190     token = st_lexer_next_token (lexer);
 191
 192     if (st_token_get_type (token) != ST_TOKEN_STRING_CONST)
 193         return false;
 194
 195     names = st_strdup (st_token_get_text (token));
 196     ivarlexer = st_lexer_new (names);
 197     token = st_lexer_next_token (ivarlexer);
 198
 199     while (st_token_get_type (token) != ST_TOKEN_EOF) {
 200
 201         if (st_token_get_type (token) != ST_TOKEN_IDENTIFIER)
 202             parse_error (NULL, token);
 203
 204         *varnames = st_list_append (*varnames, st_strdup (st_token_get_text (token)));
 205         token = st_lexer_next_token (ivarlexer);
 206     }
 207
 208     st_free (names);
 209     st_lexer_destroy (ivarlexer);
 210
 211     return true;
 212 }
 213
 214
 215 static void
 216 parse_class (st_lexer *lexer, st_token *token)
 217 {
 218     char *class_name = NULL;
 219     char *superclass_name = NULL;
 220     st_list *ivarnames = NULL;
 221
 222     // 'Class' token
 223     if (st_token_get_type (token) != ST_TOKEN_IDENTIFIER
 224         || !streq (st_token_get_text (token), "Class"))
 225         parse_error ("expected class definition", token);
 226
 227     // `named:' token
 228     token = st_lexer_next_token (lexer);
 229     if (st_token_get_type (token) != ST_TOKEN_KEYWORD_SELECTOR
 230         || !streq (st_token_get_text (token), "named:"))
 231         parse_error ("expected 'name:'", token);
 232
 233     // class name
 234     token = st_lexer_next_token (lexer);
 235     if (st_token_get_type (token) == ST_TOKEN_STRING_CONST) {
 236         class_name = st_strdup (st_token_get_text (token));
 237     } else {
 238         parse_error ("expected string literal", token);
 239     }
 240
 241     // `superclass:' token
 242     token = st_lexer_next_token (lexer);
 243     if (st_token_get_type (token) != ST_TOKEN_KEYWORD_SELECTOR
 244         || !streq (st_token_get_text (token), "superclass:"))
 245         parse_error ("expected 'superclass:'", token);
 246
 247     // superclass name
 248     token = st_lexer_next_token (lexer);
 249     if (st_token_get_type (token) == ST_TOKEN_STRING_CONST) {
 250
 251         superclass_name = st_strdup (st_token_get_text (token));
 252
 253     } else {
 254         parse_error ("expected string literal", token);
 255     }
 256
 257     // 'instanceVariableNames:' keyword selector
 258     token = st_lexer_next_token (lexer);
 259     if (st_token_get_type (token) == ST_TOKEN_KEYWORD_SELECTOR &&
 260         streq (st_token_get_text (token), "instanceVariableNames:")) {
 261
 262         parse_variable_names (lexer, &ivarnames);
 263     } else {
 264         parse_error (NULL, token);
 265     }
 266
 267     token = st_lexer_next_token (lexer);
 268     initialize_class (class_name, superclass_name, ivarnames);
 269
 270     st_list_foreach (ivarnames, st_free);
 271     st_list_destroy (ivarnames);
 272     st_free (class_name);
 273     st_free (superclass_name);
 274
 275     return;
 276 }
 277
 278 static void
 279 parse_classes (const char *filename)
 280 {
 281     char *contents;
 282     st_lexer *lexer;
 283     st_token *token;
 284
 285     if (!st_file_get_contents (filename, &contents)) {
 286         exit (1);
 287     }
 288
 289     lexer = st_lexer_new (contents);
 290     st_assert (lexer != NULL);
 291     token = st_lexer_next_token (lexer);
 292
 293     while (st_token_get_type (token) != ST_TOKEN_EOF) {
 294
 295         while (st_token_get_type (token) == ST_TOKEN_COMMENT)
 296             token = st_lexer_next_token (lexer);
 297
 298         parse_class (lexer, token);
 299         token = st_lexer_next_token (lexer);
 300     }
 301
 302     st_free (contents);
 303     st_lexer_destroy (lexer);
 304 }
 305
 306 static void
 307 file_in_classes (void)
 308 {
 309     char *filename;
 310
 311     parse_classes ("../st/class-defs.st");
 312
 313     static const char * files[] =
 314         {
 315             "Stream.st",
 316             "PositionableStream.st",
 317             "WriteStream.st",
 318             "Collection.st",
 319             "SequenceableCollection.st",
 320             "ArrayedCollection.st",
 321             "HashedCollection.st",
 322             "Set.st",
 323             "Dictionary.st",
 324             "IdentitySet.st",
 325             "IdentityDictionary.st",
 326             "Bag.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             "List.st",
 357             "System.st",
 358             "CompiledMethod.st",
 359             "FileStream.st",
 360             "pidigits.st"
 361         };
 362
 363     for (st_uint i = 0; i < ST_N_ELEMENTS (files); i++) {
 364         filename = st_strconcat ("..", ST_DIR_SEPARATOR_S, "st", ST_DIR_SEPARATOR_S, files[i], NULL);
 365         st_compile_file_in (filename);
 366         st_free (filename);
 367     }
 368 }
 369
 370 #define NIL_SIZE_OOPS (sizeof (struct st_header) / sizeof (st_oop))
 371
 372 static st_oop
 373 create_nil_object (void)
 374 {
 375     st_oop nil;
 376
 377     nil = st_memory_allocate (NIL_SIZE_OOPS);
 378
 379     ST_OBJECT_MARK (nil)  = 0 | ST_MARK_TAG;
 380     ST_OBJECT_CLASS (nil) = nil;
 381     st_object_set_format (nil, ST_FORMAT_OBJECT);
 382     st_object_set_instance_size (nil, 0);
 383
 384     return nil;
 385 }
 386
 387 static void
 388 init_specials (void)
 389 {
 390     ST_SELECTOR_PLUS      = st_symbol_new ("+");
 391     ST_SELECTOR_MINUS     = st_symbol_new ("-");
 392     ST_SELECTOR_LT        = st_symbol_new ("<");
 393     ST_SELECTOR_GT        = st_symbol_new (">");
 394     ST_SELECTOR_LE        = st_symbol_new ("<=");
 395     ST_SELECTOR_GE        = st_symbol_new (">=");
 396     ST_SELECTOR_EQ        = st_symbol_new ("=");
 397     ST_SELECTOR_NE        = st_symbol_new ("~=");
 398     ST_SELECTOR_MUL       = st_symbol_new ("*");
 399     ST_SELECTOR_DIV       = st_symbol_new ("/");
 400     ST_SELECTOR_MOD       = st_symbol_new ("\\");
 401     ST_SELECTOR_BITSHIFT  = st_symbol_new ("bitShift:");
 402     ST_SELECTOR_BITAND    = st_symbol_new ("bitAnd:");
 403     ST_SELECTOR_BITOR     = st_symbol_new ("bitOr:");
 404     ST_SELECTOR_BITXOR    = st_symbol_new ("bitXor:");
 405     ST_SELECTOR_AT        = st_symbol_new ("at:");
 406     ST_SELECTOR_ATPUT     = st_symbol_new ("at:put:");
 407     ST_SELECTOR_SIZE      = st_symbol_new ("size");
 408     ST_SELECTOR_VALUE     = st_symbol_new ("value");
 409     ST_SELECTOR_VALUE_ARG = st_symbol_new ("value:");
 410     ST_SELECTOR_IDEQ      = st_symbol_new ("==");
 411     ST_SELECTOR_CLASS     = st_symbol_new ("class");
 412     ST_SELECTOR_NEW       = st_symbol_new ("new");
 413     ST_SELECTOR_NEW_ARG   = st_symbol_new ("new:");
 414     ST_SELECTOR_DOESNOTUNDERSTAND   = st_symbol_new ("doesNotUnderstand:");
 415     ST_SELECTOR_MUSTBEBOOLEAN       = st_symbol_new ("mustBeBoolean");
 416     ST_SELECTOR_STARTUPSYSTEM       = st_symbol_new ("startupSystem");
 417     ST_SELECTOR_CANNOTRETURN        = st_symbol_new ("cannotReturn");
 418     ST_SELECTOR_OUTOFMEMORY         = st_symbol_new ("outOfMemory");
 419 }
 420
 421 void
 422 bootstrap_universe (void)
 423 {
 424     st_oop smalltalk;
 425     st_oop st_object_class_, st_class_class_;
 426
 427     st_memory_new ();
 428
 429     ST_NIL = create_nil_object ();
 430
 431     st_object_class_          = class_new (ST_FORMAT_OBJECT, 0);
 432     ST_UNDEFINED_OBJECT_CLASS = class_new (ST_FORMAT_OBJECT, 0);
 433     ST_METACLASS_CLASS        = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_METACLASS);
 434     ST_BEHAVIOR_CLASS         = class_new (ST_FORMAT_OBJECT, 0);
 435     st_class_class_           = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_CLASS);
 436     ST_SMI_CLASS              = class_new (ST_FORMAT_OBJECT, 0);
 437     ST_LARGE_INTEGER_CLASS    = class_new (ST_FORMAT_LARGE_INTEGER, 0);
 438     ST_CHARACTER_CLASS        = class_new (ST_FORMAT_OBJECT, 0);
 439     ST_TRUE_CLASS             = class_new (ST_FORMAT_OBJECT, 0);
 440     ST_FALSE_CLASS            = class_new (ST_FORMAT_OBJECT, 0);
 441     ST_FLOAT_CLASS            = class_new (ST_FORMAT_FLOAT, 0);
 442     ST_ARRAY_CLASS            = class_new (ST_FORMAT_ARRAY, 0);
 443     ST_WORD_ARRAY_CLASS       = class_new (ST_FORMAT_WORD_ARRAY, 0);
 444     ST_FLOAT_ARRAY_CLASS      = class_new (ST_FORMAT_FLOAT_ARRAY, 0);
 445     ST_DICTIONARY_CLASS       = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_DICTIONARY);
 446     ST_SET_CLASS              = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_SET);
 447     ST_BYTE_ARRAY_CLASS       = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 448     ST_SYMBOL_CLASS           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 449     ST_STRING_CLASS           = class_new (ST_FORMAT_BYTE_ARRAY, 0);
 450     ST_WIDE_STRING_CLASS      = class_new (ST_FORMAT_WORD_ARRAY, 0);
 451     ST_ASSOCIATION_CLASS      = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_ASSOCIATION);
 452     ST_COMPILED_METHOD_CLASS  = class_new (ST_FORMAT_OBJECT, 0);
 453     ST_METHOD_CONTEXT_CLASS   = class_new (ST_FORMAT_CONTEXT, 5);
 454     ST_BLOCK_CONTEXT_CLASS    = class_new (ST_FORMAT_CONTEXT, 7);
 455     ST_SYSTEM_CLASS           = class_new (ST_FORMAT_OBJECT, INSTANCE_SIZE_SYSTEM);
 456     ST_HANDLE_CLASS           = class_new (ST_FORMAT_HANDLE, 0);
 457     ST_MESSAGE_CLASS          = class_new (ST_FORMAT_OBJECT, 2);
 458
 459     ST_OBJECT_CLASS (ST_NIL)  = ST_UNDEFINED_OBJECT_CLASS;
 460
 461     /* special objects */
 462     ST_TRUE         = st_object_new (ST_TRUE_CLASS);
 463     ST_FALSE        = st_object_new (ST_FALSE_CLASS);
 464     ST_SYMBOLS      = st_set_new_with_capacity (256);
 465     ST_GLOBALS      = st_dictionary_new_with_capacity (256);
 466     ST_SMALLTALK    = st_object_new (ST_SYSTEM_CLASS);
 467     ST_OBJECT_FIELDS (ST_SMALLTALK)[0] = ST_GLOBALS;
 468     ST_OBJECT_FIELDS (ST_SMALLTALK)[1] = ST_SYMBOLS;
 469
 470     /* add class names to symbol table */
 471     add_global ("Object", st_object_class_);
 472     add_global ("UndefinedObject", ST_UNDEFINED_OBJECT_CLASS);
 473     add_global ("Behavior", ST_BEHAVIOR_CLASS);
 474     add_global ("Class", st_class_class_);
 475     add_global ("Metaclass", ST_METACLASS_CLASS);
 476     add_global ("SmallInteger", ST_SMI_CLASS);
 477     add_global ("LargeInteger", ST_LARGE_INTEGER_CLASS);
 478     add_global ("Character", ST_CHARACTER_CLASS);
 479     add_global ("True", ST_TRUE_CLASS);
 480     add_global ("False", ST_FALSE_CLASS);
 481     add_global ("Float", ST_FLOAT_CLASS);
 482     add_global ("Array", ST_ARRAY_CLASS);
 483     add_global ("ByteArray", ST_BYTE_ARRAY_CLASS);
 484     add_global ("WordArray", ST_WORD_ARRAY_CLASS);
 485     add_global ("FloatArray", ST_FLOAT_ARRAY_CLASS);
 486     add_global ("ByteString", ST_STRING_CLASS);
 487     add_global ("ByteSymbol", ST_SYMBOL_CLASS);
 488     add_global ("WideString", ST_WIDE_STRING_CLASS);
 489     add_global ("IdentitySet", ST_SET_CLASS);
 490     add_global ("IdentityDictionary", ST_DICTIONARY_CLASS);
 491     add_global ("Association", ST_ASSOCIATION_CLASS);
 492     add_global ("CompiledMethod", ST_COMPILED_METHOD_CLASS);
 493     add_global ("MethodContext", ST_METHOD_CONTEXT_CLASS);
 494     add_global ("BlockContext", ST_BLOCK_CONTEXT_CLASS);
 495     add_global ("Handle", ST_HANDLE_CLASS);
 496     add_global ("Message", ST_MESSAGE_CLASS);
 497     add_global ("System", ST_SYSTEM_CLASS);
 498     add_global ("Smalltalk", ST_SMALLTALK);
 499
 500     init_specials ();
 501     file_in_classes ();
 502
 503     st_memory_add_root (ST_NIL);
 504     st_memory_add_root (ST_TRUE);
 505     st_memory_add_root (ST_FALSE);
 506     st_memory_add_root (ST_SMALLTALK);
 507 }
 508
 509 void
 510 st_initialize (void)
 511 {
 512     bootstrap_universe ();
 513 }
 514
 515 void
 516 st_set_verbose_mode (bool verbose)
 517 {
 518     verbose_mode = verbose;
 519 }
 520
 521 bool
 522 st_get_verbose_mode (void)
 523 {
 524     return verbose_mode;
 525 }
 526
 527