library/Trylon_.c

   1 /* Trylon_.c */
   2
   3 #include "Trylon_.h"
   4 #include <stdio.h>
   5 #include <string.h>
   6 #include <stdlib.h>
   7 #include <limits.h>
   8 #ifdef SYMBOL_DISPATCH_
   9         #include <stdarg.h>
  10 #endif
  11 #ifdef OSX_FINK
  12         #include "gc.h"
  13 #else
  14         #include "gc/gc.h"
  15 #endif
  16
  17 #if PTRDIFF_MAX < INT_MAX
  18         #define TAGGED_INT_MAX  (PTRDIFF_MAX >> 1)
  19         #define TAGGED_INT_MIN  (PTRDIFF_MIN >> 1)
  20 #else
  21         #define TAGGED_INT_MAX  (INT_MAX >> 1)
  22         #define TAGGED_INT_MIN  (INT_MIN >> 1)
  23 #endif
  24
  25
  26 #ifdef SYMBOL_DISPATCH_
  27 // Not thread-safe!  We'll need to move this to thread-local storage if we
  28 // support threads.
  29 static obj_ unhandledMessage = nil;
  30 #endif
  31
  32 static obj_ SendMessageNotUnderstood_(obj_ object, ...);
  33
  34
  35 fn_ptr_ Dispatch_(dispatch_selector_ selectorIn, obj_ object)
  36 {
  37 #ifdef NIL_OBJECT_
  38         if (object == nil)
  39                 object = &nil__Standard;
  40 #endif
  41 #if defined(NIL_OBJECT_) && defined(TAGGED_INTS_)
  42         else
  43 #endif
  44 #ifdef TAGGED_INTS_
  45         if (IsTaggedInt_(object))
  46                 object = &SmallInt__CImplementation__Standard;
  47 #endif
  48
  49 #ifdef SYMBOL_DISPATCH_
  50         selector_ selector =
  51                 ((struct Standard__Symbol__internal*) selectorIn)->selector;
  52 #else
  53         int selector = selectorIn;
  54 #endif
  55
  56         // First, try to get it from the dispatch table.
  57         struct RDTableEntry_* entry =
  58                 &dispatchTable_[selector + ClassNumFor_(object)];
  59         if (entry->selector == selector)
  60                 return entry->method;
  61
  62 #if defined(SUPPORT_NEW_METHODS_) && defined(SYMBOL_DISPATCH_)
  63         // Next, try the "newMethods" dictionaries for this and all superclasses, and
  64         // the dispatch tables of the superclasses too.
  65         struct ClassInfo* classInfo = object->class_;
  66         for (;;) {
  67                 if (classInfo->newMethods) {
  68                         UsingMethod_(at_co_)
  69                         obj_ method_ptr = Call_(at_co_, classInfo->newMethods, selectorIn);
  70                         if (method_ptr)
  71                                 return (fn_ptr_) BytePtrValue_(method_ptr);
  72                         }
  73                 if (classInfo->superclass == nil)
  74                         break;
  75                 classInfo = classInfo->superclass->class_;
  76                 entry = &dispatchTable_[selector + classInfo->classNum];
  77                 if (entry->selector == selector)
  78                         return entry->method;
  79                 }
  80 #endif
  81
  82         // Message not understood.
  83         // Send 'message-not-understood:arguments:' instead.
  84 #ifdef SYMBOL_DISPATCH_
  85         unhandledMessage = selectorIn;
  86 #endif
  87         return (fn_ptr_) &SendMessageNotUnderstood_;
  88 }
  89
  90
  91 obj_ RespondsTo_(obj_ object, dispatch_selector_ selectorIn)
  92 {
  93 #ifdef NIL_OBJECT_
  94         if (object == nil)
  95                 object = &nil__Standard;
  96 #endif
  97 #if defined(NIL_OBJECT_) && defined(TAGGED_INTS_)
  98         else
  99 #endif
 100 #ifdef TAGGED_INTS_
 101         if (IsTaggedInt_(object))
 102                 object = &SmallInt__CImplementation__Standard;
 103 #endif
 104
 105 #ifdef SYMBOL_DISPATCH_
 106         selector_ selector =
 107                 ((struct Standard__Symbol__internal*) selectorIn)->selector;
 108 #else
 109         selector_ selector = selectorIn;
 110 #endif
 111
 112         // First, try the dispatch table.
 113         struct RDTableEntry_* entry =
 114                 &dispatchTable_[selector + ClassNumFor_(object)];
 115         if (entry->selector == selector)
 116                 return true_;
 117
 118 #if defined(SUPPORT_NEW_METHODS_) && defined(SYMBOL_DISPATCH_)
 119         // Next, try the "newMethods" dictionaries for this and all superclasses, and
 120         // the dispatch tables of the superclasses too.
 121         struct ClassInfo* classInfo = object->class_;
 122         for (;;) {
 123                 if (classInfo->newMethods) {
 124                         UsingMethod_(at_co_)
 125                         obj_ method_ptr = Call_(at_co_, classInfo->newMethods, selectorIn);
 126                         if (method_ptr)
 127                                 return true_;
 128                         }
 129                 if (classInfo->superclass == nil)
 130                         break;
 131                 classInfo = classInfo->superclass->class_;
 132                 entry = &dispatchTable_[selector + classInfo->classNum];
 133                 if (entry->selector == selector)
 134                         return true_;
 135                 }
 136 #endif
 137
 138         return nil;
 139 }
 140
 141
 142 #ifdef SUPPORT_NEW_METHODS_
 143 fn_ptr_* MethodLocation_(obj_ object, dispatch_selector_ selectorIn)
 144 {
 145 #ifdef NIL_OBJECT_
 146         if (object == nil)
 147                 object = &nil__Standard;
 148 #endif
 149 #if defined(NIL_OBJECT_) && defined(TAGGED_INTS_)
 150         else
 151 #endif
 152 #ifdef TAGGED_INTS_
 153         if (IsTaggedInt_(object))
 154                 object = &SmallInt__CImplementation__Standard;
 155 #endif
 156
 157 #ifdef SYMBOL_DISPATCH_
 158         selector_ selector =
 159                 ((struct Standard__Symbol__internal*) selectorIn)->selector;
 160 #else
 161         selector_ selector = selectorIn;
 162 #endif
 163
 164         struct RDTableEntry_* entry =
 165                 &dispatchTable_[selector + ClassNumFor_(object)];
 166
 167         if (entry->selector == selector)
 168                 return &entry->method;
 169
 170         return nil;
 171 }
 172 #endif
 173
 174
 175 static obj_ SendMessageNotUnderstood_(obj_ object, ...)
 176 {
 177 #ifdef SYMBOL_DISPATCH_
 178
 179         UsingMethod_(characters) UsingMethod_(iterator)
 180         UsingMethod_(is_done) UsingMethod_(current_item) UsingMethod_(go_forward)
 181         UsingMethod_(message_not_understood_co_arguments_co_);
 182         int num_args = 0, which_arg;
 183         char c;
 184         va_list arg_list;
 185         obj_ args_tuple;
 186
 187         // How many arguments are there?
 188         // We can find out by counting the number of colons in the selector.
 189         obj_ characters = Call_(characters, unhandledMessage);
 190         ForStart_(1, characters, char_obj)
 191                 c = IntValue_(char_obj);
 192                 if (c == ':')
 193                         num_args += 1;
 194                 ForEnd_(1)
 195
 196         // Gather the arguments into a tuple.
 197         args_tuple = NewTuple_(num_args);
 198         va_start(arg_list, object);
 199         for (which_arg = 0; which_arg < num_args; ++which_arg) {
 200                 obj_ arg = va_arg(arg_list, obj_);
 201                 TuplePut_(args_tuple, which_arg, arg);
 202                 }
 203         va_end(arg_list);
 204
 205         // Call 'message-not-understood:arguments:'.
 206         return
 207                 Call_(
 208                         message_not_understood_co_arguments_co_,
 209                         object, unhandledMessage, args_tuple);
 210
 211 #else   // !SYMBOL_DISPATCH_
 212
 213         // If 'symbol-dispatch' isn't on, we don't have a good way of knowing what
 214         // message was sent.
 215         UsingMethod_(message_not_understood);
 216         return Call_(message_not_understood, object);
 217
 218 #endif
 219 }
 220
 221
 222 obj_ AllocObjFromClassInfo_(struct ClassInfo* classInfo)
 223 {
 224         obj_ object =
 225                 (obj_) GC_MALLOC(
 226                         sizeof(classref_) + classInfo->numSlots * sizeof(obj_));
 227         object->class_ = classInfo;
 228         return object;
 229 }
 230
 231
 232 static ExceptionCatcher_* currentExceptionCatcher = NULL;
 233 obj_ currentException_ = NULL;
 234
 235 void PushException_(ExceptionCatcher_* catcher)
 236 {
 237         catcher->nextCatcher = currentExceptionCatcher;
 238         currentExceptionCatcher = catcher;
 239 }
 240
 241
 242 void Throw_(obj_ object)
 243 {
 244         if (currentExceptionCatcher == NULL) {
 245                 // Catastrophic failure!
 246                 printf("\n**** Uncaught exception! ****\n\n");
 247                 exit(1);
 248                 }
 249
 250         currentException_ = object;
 251         longjmp(currentExceptionCatcher->jumpBuf, 1);
 252 }
 253
 254
 255 void PopException_()
 256 {
 257         if (currentExceptionCatcher == NULL) {
 258                 // Catastrophic failure, and it's probably the compiler's fault!
 259                 printf("\n**** Compiler error: generated bad _PopException_()! ***\n\n");
 260                 exit(1);
 261                 }
 262
 263         currentExceptionCatcher = currentExceptionCatcher->nextCatcher;
 264 }
 265
 266
 267 static void FinalizeObject_(void* obj, void* clientData)
 268 {
 269         UsingMethod_(destroy);
 270         Call_(destroy, (obj_) obj);
 271 }
 272
 273
 274 void RegisterFinalizer_(obj_ object)
 275 {
 276         GC_finalization_proc oldProc;
 277         void* oldData;
 278         GC_REGISTER_FINALIZER(object, &FinalizeObject_, NULL, &oldProc, &oldData);
 279 }
 280
 281
 282
 283 #ifdef TAGGED_INTS_
 284 int IntValue_(obj_ obj)
 285 {
 286         if (((ptrdiff_t) obj & 0x01) != 0)
 287                 return (ptrdiff_t) obj >> 1;
 288         return (((struct Standard__Int__internal*) obj)->value);
 289 }
 290 #endif
 291
 292
 293 obj_ BuildInt_(int value)
 294 {
 295 #ifdef TAGGED_INTS_
 296         if (value <= TAGGED_INT_MAX && value >= TAGGED_INT_MIN)
 297                 return SmallInt_(value);
 298 #endif
 299
 300         struct Standard__Int__internal* result =
 301                 (struct Standard__Int__internal*)
 302                         GC_MALLOC(sizeof(struct Standard__Int__internal));
 303         result->class_ = StdClassRef_(Int);
 304         result->value = value;
 305         return (obj_) result;
 306 }
 307
 308
 309 obj_ BuildFloat_(double value)
 310 {
 311         struct Standard__Float__internal* result =
 312                 (struct Standard__Float__internal*)
 313                         GC_MALLOC(sizeof(struct Standard__Float__internal));
 314         result->class_ = StdClassRef_(Float);
 315         result->value = value;
 316         return (obj_) result;
 317 }
 318
 319
 320 obj_ BuildBytePtr_(void* value)
 321 {
 322         struct Standard__BytePtr__internal* result =
 323                 (struct Standard__BytePtr__internal*)
 324                         GC_MALLOC(sizeof(struct Standard__BytePtr__internal));
 325         result->class_ = StdClassRef_(BytePtr);
 326         result->value = value;
 327         return (obj_) result;
 328 }
 329
 330
 331 obj_ BuildString_(const char* cString)
 332 {
 333         unsigned int    length;
 334         char*           heapString;
 335         obj_            start, stopper;
 336         struct Standard__String__internal* strObj;
 337
 338         // Copy the string to the heap.
 339         length = strlen(cString);
 340         heapString = (char*) GC_MALLOC_ATOMIC(length + 1);
 341         memcpy(heapString, cString, length + 1);
 342
 343         // Build the string object.
 344         strObj =
 345                 (struct Standard__String__internal*)
 346                         GC_MALLOC(sizeof(struct Standard__String__internal));
 347         strObj->class_ = StdClassRef_(String);
 348         strObj->start = BuildBytePtr_((byte_ptr_) heapString);
 349         strObj->stopper = BuildBytePtr_((byte_ptr_) heapString + length);
 350         return (obj_) strObj;
 351 }
 352
 353
 354 obj_ BuildStringOfLength_(const char* cString, unsigned int length)
 355 {
 356         char*   heapString;
 357         struct Standard__String__internal* strObj;
 358
 359         // Copy the string to the heap.
 360         heapString = (char*) GC_MALLOC(length + 1);
 361         memcpy(heapString, cString, length + 1);
 362
 363         // Build the string object.
 364         strObj =
 365                 (struct Standard__String__internal*)
 366                         GC_MALLOC(sizeof(struct Standard__String__internal));
 367         strObj->class_ = StdClassRef_(String);
 368         strObj->start = BuildBytePtr_((byte_ptr_) heapString);
 369         strObj->stopper = BuildBytePtr_((byte_ptr_) heapString + length);
 370         return (obj_) strObj;
 371 }
 372
 373
 374 obj_ BuildStringStartStopper_(const char* start, const char* stopper)
 375 {
 376         struct Standard__String__internal* strObj;
 377
 378         // Build the string object.
 379         strObj =
 380                 (struct Standard__String__internal*)
 381                         GC_MALLOC(sizeof(struct Standard__String__internal));
 382         strObj->class_ = StdClassRef_(String);
 383         strObj->start = BuildBytePtr_((byte_ptr_) start);
 384         strObj->stopper = BuildBytePtr_((byte_ptr_) stopper);
 385         return (obj_) strObj;
 386 }
 387
 388
 389 char* CString_(obj_ str)
 390 {
 391         struct Standard__String__internal* strObj =
 392                 (struct Standard__String__internal*) str;
 393         char*           start;
 394         unsigned int    length;
 395         char*           cString;
 396
 397         start = StringStart_(strObj);
 398         length = StringStopper_(strObj) - start;
 399         cString = GC_MALLOC_ATOMIC(length + 1);
 400         memcpy(cString, start, length);
 401         cString[length] = 0;
 402         return cString;
 403 }
 404
 405
 406 void* Allocate_(int numBytes)
 407 {
 408         return GC_MALLOC(numBytes);
 409 }
 410
 411
 412 void* AllocNonPtr_(int numBytes)
 413 {
 414         return GC_MALLOC_ATOMIC(numBytes);
 415 }
 416
 417
 418 obj_ NewTuple_(int numItems)
 419 {
 420         extern obj_ new_co___Tuple__Standard(obj_, obj_);
 421         return new_co___Tuple__Standard(Proto_(Tuple__Standard), BuildInt_(numItems));
 422 }
 423
 424
 425 obj_ TupleAt_(obj_ tuple, int index)
 426 {
 427         return tuple->fields[index + 1];
 428 }
 429
 430
 431 void TuplePut_(obj_ tuple, int index, obj_ value)
 432 {
 433         tuple->fields[index + 1] = value;
 434 }
 435
 436
 437 obj_ CloneObj_(obj_ object)
 438 {
 439         return AllocObjFromClassInfo_(object->class_);
 440 }
 441
 442
 443 obj_ CloneObjExtra_(obj_ object, int numExtraFields)
 444 {
 445         size_t size =
 446                 sizeof(classref_) +
 447                 (object->class_->numSlots + numExtraFields) * sizeof(obj_);
 448         obj_ newObject = (obj_) GC_MALLOC(size);
 449         newObject->class_ = object->class_;
 450         return newObject;
 451 }
 452
 453
 454 int SymToEnum_(
 455         obj_ symbol, const EnumDictEntry_* dict, int dictSize, int notFoundValue)
 456 {
 457         /* The dictionary is sorted by symbol name, and the symbol objects are sorted
 458            in memory, so we can use a binary search. */
 459         unsigned int low = 0;
 460         unsigned int high = dictSize - 1;
 461         while (low <= high) {
 462                 unsigned int mid = (low + high) / 2;
 463                 const EnumDictEntry_* entry = &dict[mid];
 464                 if (entry->symbol > symbol)
 465                         high = mid - 1;
 466                 else if (entry->symbol < symbol)
 467                         low = mid + 1;
 468                 else
 469                         return entry->value;
 470                 }
 471
 472         /* Not found. */
 473         return notFoundValue;
 474 }
 475
 476
 477 int BitFlagsFromSyms_(obj_ symbols, const EnumDictEntry_* dict, int dictSize)
 478 {
 479         int flags = 0;
 480         if (symbols) {
 481                 ForStart_(1, symbols, symbol)
 482                         flags |= SymToEnum_(symbol, dict, dictSize, 0);
 483                         ForEnd_(1)
 484                 }
 485         return flags;
 486 }
 487
 488
 489 obj_ EnumToSym_(int value, const EnumDictEntry_* dict, int dictSize)
 490 {
 491         /* Linear search. */
 492         const EnumDictEntry_* entry = dict;
 493         const EnumDictEntry_* stopper = &dict[dictSize];
 494         for (; entry < stopper; ++entry) {
 495                 if (entry->value == value)
 496                         return entry->symbol;
 497                 }
 498         return nil;
 499 }
 500
 501
 502
 503 int main(int argc, char* argv[])
 504 {
 505         obj_ args, result;
 506         int whichArg;
 507         extern obj_ main_co___Main(obj_ this_, obj_ args);
 508         extern obj_ new__List__Standard(obj_ this_);
 509         UsingMethod_(append_co_)
 510         UsingClass_(Main) UsingClass_(List__Standard)
 511
 512         GC_INIT();
 513
 514         // Build the list of args.
 515         args = new__List__Standard(Proto_(List__Standard));
 516         for (whichArg = 0; whichArg < argc; ++whichArg)
 517                 Call_(append_co_, args, BuildString_(argv[whichArg]));
 518
 519         // Call the main function.
 520         Try_ {
 521                 result = main_co___Main(Proto_(Main), args);
 522                 }
 523         TryElse_ {
 524                 UsingMethod_(send_co_) UsingMethod_(message)
 525                 obj_ message = Call_(message, exception);
 526                 Call_(send_co_, Proto_(Standard), message);
 527                 result = BuildInt_(1);
 528                 }
 529         EndTry_
 530
 531         // Return the result.
 532         if (result == nil)
 533                 return 0;
 534 #ifdef TAGGED_INTS_
 535         else if (IsTaggedInt_(result))
 536                 return IntValue_(result);
 537 #endif
 538         else if (result->class_ == StdClassRef_(Int))
 539                 return IntValue_(result);
 540         else
 541                 return 1;
 542 }
 543
 544
 545
 546 /* Debugging */
 547
 548 const char* className_(obj_ object)
 549 {
 550         if (object == NULL)
 551                 return "NULL";
 552
 553         return StringStart_(object->class_->name);
 554 }
 555
 556
 557 obj_ showObj_(obj_ object)
 558 {
 559         obj_ str;
 560         UsingMethod_(debug_write)
 561
 562         if (object == NULL)
 563                 return NULL;
 564
 565         str = Call_(debug_write, object);
 566         return object;
 567 }
 568
 569
 570
 571 /*
 572         Copyright 2005 - 2007 Steve Folta.
 573         See the License file.
 574 */
 575