MLKDynamicContext#+initialize: Fix various sources of crashes.

6 files changed, 78 insertions, 26 deletions

diff --git a/MLKDynamicContext.m b/MLKDynamicContext.m
index 90e237d..feceac5 100644
--- a/MLKDynamicContext.m
+++ b/MLKDynamicContext.m
@@ -18,6 +18,7 @@
 
 #import <Foundation/NSArray.h>
 #import <Foundation/NSDictionary.h>
+#import <Foundation/NSNull.h>
 #import <Foundation/NSSet.h>
 #import <Foundation/NSThread.h>
 
@@ -47,7 +48,7 @@ static MLKDynamicContext *global_context;
 @implementation MLKDynamicContext
 +(void) initialize
 {
-  NSMutableDictionary *vars = [NSMutableDictionary dictionary];
+  NSMutableDictionary *vars = [NSMutableDictionary dictionaryWithCapacity:64];
   MLKPackage *cl = [MLKPackage packageWithName:@"COMMON-LISP"
                                nicknames:[NSSet setWithObject:@"CL"]];
   MLKPackage *clUser = [MLKPackage packageWithName:@"COMMON-LISP-USER"
@@ -57,16 +58,18 @@ static MLKDynamicContext *global_context;
   MLKSymbol *t = [cl intern:@"T"];
   MLKReadtable *readtable = [[MLKReadtable alloc] init];
 
+  id NIL = [NSNull null];
+
   // FIXME: Initialise stuff.
 #define INIT(VARNAME, VALUE) [vars setObject:VALUE forKey:[cl intern:VARNAME]]
 
-  INIT(@"*BREAK-ON-SIGNALS*", nil);
-  INIT(@"*COMPILE-FILE-PATHNAME*", nil);
-  INIT(@"*COMPILE-FILE-TRUENAME*", nil);
-  INIT(@"*COMPILE-PRINT*", nil);
+  INIT(@"*BREAK-ON-SIGNALS*", NIL);
+  INIT(@"*COMPILE-FILE-PATHNAME*", NIL);
+  INIT(@"*COMPILE-FILE-TRUENAME*", NIL);
+  INIT(@"*COMPILE-PRINT*", NIL);
   INIT(@"*COMPILE-VERBOSE*", t);
   //  INIT(@"*DEBUG-IO*", );
-  INIT(@"*DEBUGGER-HOOK*", nil);
+  INIT(@"*DEBUGGER-HOOK*", NIL);
   //  INIT(@"*DEFAULT-PATHNAME-DEFAULTS*", );
   //  INIT(@"*ERROR-OUTPUT*", );
   INIT(@"*FEATURES*", [MLKCons
@@ -77,34 +80,34 @@ static MLKDynamicContext *global_context;
                                       cons:[keyword intern:@"ANSI-CL"]
                                       with:nil]]]);
   INIT(@"*GENSYM-COUNTER*", [MLKInteger integerWithInt:0]);
-  INIT(@"*LOAD-PATHNAME*", nil);
-  INIT(@"*LOAD-PRINT*", nil);
-  INIT(@"*LOAD-TRUENAME*", nil);
+  INIT(@"*LOAD-PATHNAME*", NIL);
+  INIT(@"*LOAD-PRINT*", NIL);
+  INIT(@"*LOAD-TRUENAME*", NIL);
   INIT(@"*LOAD-VERBOSE*", t);
   //  INIT(@"*MACROEXPAND-HOOK*", );
-  INIT(@"*MODULES*", nil);
+  INIT(@"*MODULES*", NIL);
   INIT(@"*PACKAGE*", clUser);
   INIT(@"*PRINT-ARRAY*", t);
   INIT(@"*PRINT-BASE*", [MLKInteger integerWithInt:10]);
   INIT(@"*PRINT-CASE*", [keyword intern:@"UPCASE"]);
-  INIT(@"*PRINT-CIRCLE*", nil);
+  INIT(@"*PRINT-CIRCLE*", NIL);
   INIT(@"*PRINT-ESCAPE*", t);
   INIT(@"*PRINT-GENSYM*", t);
-  INIT(@"*PRINT-LENGTH*", nil);
-  INIT(@"*PRINT-LEVEL*", nil);
-  INIT(@"*PRINT-LINES*", nil);
-  INIT(@"*PRINT-MISER-WIDTH*", nil);
+  INIT(@"*PRINT-LENGTH*", NIL);
+  INIT(@"*PRINT-LEVEL*", NIL);
+  INIT(@"*PRINT-LINES*", NIL);
+  INIT(@"*PRINT-MISER-WIDTH*", NIL);
   //  INIT(@"*PRINT-PPRINT-DISPATCH*", );
   INIT(@"*PRINT-PRETTY*", t);
-  INIT(@"*PRINT-RADIX*", nil);
-  INIT(@"*PRINT-READABLY*", nil);
-  INIT(@"*PRINT-RIGHT-MARGIN*", nil);
+  INIT(@"*PRINT-RADIX*", NIL);
+  INIT(@"*PRINT-READABLY*", NIL);
+  INIT(@"*PRINT-RIGHT-MARGIN*", NIL);
   //  INIT(@"*QUERY-IO*", );
   //  INIT(@"*RANDOM-STATE*", );
   INIT(@"*READ-BASE*", [MLKInteger integerWithInt:10]);
   INIT(@"*READ-DEFAULT-FLOAT-FORMAT*", [cl intern:@"SINGLE-FLOAT"]);
   INIT(@"*READ-EVAL*", t);
-  INIT(@"*READ-SUPPRESS*", nil);  //FIXME: Support in reader
+  INIT(@"*READ-SUPPRESS*", NIL);  //FIXME: Support in reader
   INIT(@"*READTABLE*", readtable);
   //  INIT(@"*STANDARD-INPUT*", );
   //  INIT(@"*STANDARD-OUTPUT*", );
diff --git a/MLKPackage.h b/MLKPackage.h
index 6b17c3e..35f8f32 100644
--- a/MLKPackage.h
+++ b/MLKPackage.h
@@ -30,6 +30,8 @@
   NSString *_name;
 }
 
++(void) initialize;
+  
 -(MLKPackage *) initWithName:(NSString *)name
                    nicknames:(NSSet *)nicknames;
 
diff --git a/MLKPackage.m b/MLKPackage.m
index d7ac803..ec74fce 100644
--- a/MLKPackage.m
+++ b/MLKPackage.m
@@ -29,18 +29,19 @@
 static NSMutableDictionary *packages = nil;
 
 
-@implementation MLKPackage : MLKLispValue
+@implementation MLKPackage
++(void) initialize
+{
+  packages = [[NSMutableDictionary alloc] init];
+}
+
 -(MLKPackage *) initWithName:(NSString *)name
                    nicknames:(NSSet *)nicknames
 {
   int i;
   NSArray *e;
 
-  self = [self init];
-
-  // FIXME: Make this thread-safe.
-  if (!packages)
-    packages = [[NSMutableDictionary alloc] init];
+  self = [super init];
 
   [packages setObject:self forKey:name];
 
diff --git a/MLKReadtable.m b/MLKReadtable.m
index 9a9b357..f31f05b 100644
--- a/MLKReadtable.m
+++ b/MLKReadtable.m
@@ -59,6 +59,7 @@ enum MLKCharacterTrait
   self = [super init];
   _syntaxTable = [[NSMutableDictionary alloc] init];
   _readerMacros = [[NSMutableDictionary alloc] init];
+  _traits = [[NSMutableDictionary alloc] init];
   _case = MLKReadtableCase_UPCASE;
   return self;
 }
@@ -68,6 +69,7 @@ enum MLKCharacterTrait
   MLKReadtable *copy = [[MLKReadtable allocWithZone:zone] initSuper];
   copy->_syntaxTable = [_syntaxTable mutableCopyWithZone:zone];
   copy->_readerMacros = [_readerMacros mutableCopyWithZone:zone];
+  copy->_traits = [_traits mutableCopyWithZone:zone];
   copy->_case = _case;
   return copy;
 }
diff --git a/MLKSymbol.h b/MLKSymbol.h
index 82526d2..3aa2a1e 100644
--- a/MLKSymbol.h
+++ b/MLKSymbol.h
@@ -18,13 +18,16 @@
 
 #import "MLKLispValue.h"
 
+#import <Foundation/NSObject.h>
+
 @class MLKPackage;
 
 
-@interface MLKSymbol : MLKLispValue
+@interface MLKSymbol : MLKLispValue <NSCopying>
 {
   NSString *name;
   MLKPackage *homePackage;
+  MLKSymbol *real_identity;
 }
 
 -(MLKSymbol *) initWithName:(id)aName package:(id)aPackage;
@@ -35,5 +38,20 @@
 
 -(NSString *)descriptionForLisp;
 
+// PLEASE DO NOT USE THIS.
+//
+// Symbols should never be copied.  MLKSymbol needs to implement
+// NSCopying as well as suitable version of isEqual: so that symbols can
+// be used as dictionary keys.  Don't call -copy on a symbol manually,
+// please.
+-(id) copyWithZone:(NSZone *)zone;
+
+// PLEASE DO NOT USE THIS.
+//
+// It uses an ugly hack for determining symbol identity in the face of
+// copying.  (The hack is called real_identity and it's an ivar of this
+// class.)  See the comment above copyWithZone: for why it even exists.
+-(BOOL) isEqual:(id)object;
+
 -(void) dealloc;
 @end
diff --git a/MLKSymbol.m b/MLKSymbol.m
index 1cab004..73d418a 100644
--- a/MLKSymbol.m
+++ b/MLKSymbol.m
@@ -27,9 +27,19 @@
   self = [super init];
   ASSIGN (name, aName);
   ASSIGN (homePackage, aPackage);
+  real_identity = nil;
   return self;
 }
 
+-(id) copyWithZone:(NSZone *)zone
+{
+  MLKSymbol *copy = [MLKSymbol allocWithZone:zone];
+  ASSIGN (copy->name, name);
+  ASSIGN (copy->homePackage, homePackage);
+  ASSIGN (copy->real_identity, self);
+  return copy;
+}
+
 -(NSString *) name
 {
   return name;
@@ -53,6 +63,22 @@
   return [NSString stringWithFormat:@"|%@|", name];
 }
 
+-(BOOL) isEqual:(id)object
+{
+  if (object == self)
+    return YES;
+
+  if (!([object isKindOfClass:[MLKSymbol class]]))
+    return NO;
+
+  return ((((MLKSymbol *)object)->real_identity
+           ? ((MLKSymbol *)object)->real_identity
+           : (MLKSymbol *)object)
+          == ((self->real_identity != nil
+               ? self->real_identity
+               : self)));
+}
+
 -(void) dealloc
 {
   RELEASE (name);