# HG changeset patch
# User claus
# Date 773794779 -7200
# Node ID b3971c7dc7312fa42570b822f4f696aa69ffc4bd
# Parent  94259bf1f459d8534f2e90150052b373486f50b1
*** empty log message ***

diff -r 94259bf1f459 -r b3971c7dc731 Behavior.st
--- a/Behavior.st	Thu Jun 02 21:18:43 1994 +0200
+++ b/Behavior.st	Sun Jul 10 00:59:39 1994 +0200
@@ -12,7 +12,7 @@
 
 Object subclass:#Behavior
        instanceVariableNames:'superclass otherSuperclasses
-                              selectors methods
+                              selectorArray methodArray
                               instSize flags'
        classVariableNames:''
        poolDictionaries:''
@@ -42,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.16 1994-06-02 16:19:23 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.17 1994-07-09 22:59:39 claus Exp $
 "
 !
 
@@ -52,10 +52,10 @@
     so here is where most of the class messages end up being implemented.
     (to answer a FAQ: 'Point basicNew' will be done here :-)
 
-    Beginners should keep in mind, that all classes are instances of Behavior
-    thus, you will find the above mentioned 'basicNew:' method under the 'instance'-
-    methods of Behavior - NOT under the class methods ('Behavior new' will create
-    a new class).
+    Beginners should keep in mind, that all classes are instances of subclasses
+    of Behavior, therefore you will find the above mentioned 'basicNew:' method 
+    under the 'instance'-methods of Behavior - NOT under the class methods 
+    ('Behavior new' will create a new class).
 
     Behavior provides minimum support for all classes - additional stuff is
     found in ClassDescription and Class. Behaviors provides all mechanisms needed
@@ -73,8 +73,8 @@
 
         superclass        <Class>           the receivers superclass
         otherSuperclasses <Array of Class>  experimental: other superclasses
-        selectors         <Array of Symbol> the selectors for which inst-methods are defined here
-        methods           <Array of Method> the inst-methods corresponding to the selectors
+        selectorArray     <Array of Symbol> the selectors for which inst-methods are defined here
+        methodArray       <Array of Method> the inst-methods corresponding to the selectors
         instSize          <SmallInteger>    the number of instance variables
         flags             <SmallInteger>    special flag bits coded in a number
 
@@ -174,7 +174,8 @@
 basicNew
     "return an instance of myself without indexed variables.
      If the receiver-class has indexed instvars, the new object will have
-     a basicSize of zero - i.e. 'aClass basicNew' is equivalent to 'aClass basicNew:0'.
+     a basicSize of zero - 
+     i.e. 'aClass basicNew' is equivalent to 'aClass basicNew:0'.
 
      ** Do not redefine this method in any class **"
 
@@ -183,14 +184,14 @@
     OBJ new();
     REGISTER OBJ newobj;
     REGISTER char *nextPtr;
-    int instsize;
-    REGISTER int nInstVars;
+    unsigned int instsize;
+    REGISTER unsigned int nInstVars;
 
     /*
      * the following ugly code is nothing more than a new() followed
      * by a nilling of the new instance.
-     * unrolled for a bit more speed since this is one of the central object allocation
-     * methods in the system
+     * Unrolled for a bit more speed since this is one of the central object 
+     * allocation methods in the system
      */
     nInstVars = _intVal(_INST(instSize));
     instsize = OHDR_SIZE + nInstVars * sizeof(OBJ);
@@ -201,17 +202,22 @@
     /*
      * dont argue about the goto and the arrangement below - it saves 
      * an extra nil-compare and branch in the common case ...
+     * (i.e. if no GC is needed, we fall through without a branch)
      */
     if (nextPtr < newEndPtr) {
         _objPtr(newobj)->o_size = instsize;
-        /* o_allFlags(newobj) = 0;		*/
+        /* o_allFlags(newobj) = 0;              */
         /* _objPtr(newobj)->o_space = newSpace; */
         o_setAllFlags(newobj, newSpace);
+#ifdef ALIGN4
+        newNextPtr = nextPtr;
+#else
         if (instsize & (ALIGN-1)) {
             newNextPtr = (char *)newobj + (instsize & ~(ALIGN-1)) + ALIGN;
         } else {
             newNextPtr = nextPtr;
         }
+#endif
 
 ok:
         _InstPtr(newobj)->o_class = self;
@@ -220,33 +226,52 @@
 #if defined(memset4)
             memset4(_InstPtr(newobj)->i_instvars, nil, nInstVars);
 #else
-# if !defined(NEGATIVE_ADDRESSES)
             REGISTER OBJ *op;
 
             op = _InstPtr(newobj)->i_instvars;
 
+# if !defined(NEGATIVE_ADDRESSES)
             /*
              * knowing that nil is 0
              */
-#  if defined(FAST_MEMSET_DOUBLES_UNROLLED)
-	    if (nInstVars > 4) {
-                *op++ = nil;
-	        nInstVars--;
-	        while (nInstVars >= 8) {
-		    *(double *)op = 0.0;
-		    ((double *)op)[1] = 0.0;
-		    ((double *)op)[2] = 0.0;
-		    ((double *)op)[3] = 0.0;
-		    op = (OBJ *)(((char *)op) + (sizeof(double)*4));
-		    nInstVars -= 8;
-	        }
-	    }
-	    while (nInstVars) {
-	        *op++ = 0;
-	        nInstVars--;
-	    }
+#  if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
+            if (nInstVars > 8) {
+                *op++ = nil;	/* for alignment */
+                nInstVars--;
+                while (nInstVars >= 8) {
+                    *(double *)op = 0.0;
+                    ((double *)op)[1] = 0.0;
+                    ((double *)op)[2] = 0.0;
+                    ((double *)op)[3] = 0.0;
+                    op += 8;
+                    nInstVars -= 8;
+                }
+            }
+            while (nInstVars) {
+                *op++ = 0;
+                nInstVars--;
+            }
 #  else
-#   if defined(FAST_MEMSET_WORDS_UNROLLED)
+#   if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
+            if (nInstVars > 8) {
+                *op++ = nil;	/* for alignment */
+                nInstVars--;
+                while (nInstVars >= 8) {
+                    *(long long *)op = 0;
+                    ((long long *)op)[1] = 0;
+                    ((long long *)op)[2] = 0;
+                    ((long long *)op)[3] = 0;
+                    op += 8;
+                    nInstVars -= 8;
+                }
+            }
+            while (nInstVars) {
+                *op++ = 0;
+                nInstVars--;
+            }
+
+#   else
+#    if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
             while (nInstVars >= 8) {
                 *op = nil;
                 *(op+1) = nil;
@@ -259,25 +284,22 @@
                 op += 8;
                 nInstVars -= 8;
             }
-	    while (nInstVars) {
-	        *op++ = 0;
-	        nInstVars--;
-	    }
-#   else
-#    if defined(FAST_MEMSET)
+            while (nInstVars) {
+                *op++ = 0;
+                nInstVars--;
+            }
+#    else
+#     if defined(FAST_MEMSET)
             memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
-#    else
+#     else
             do {
                 *op++ = nil;
             } while (--nInstVars);
+#     endif
 #    endif
 #   endif
 #  endif
 # else /* nil could be ~~ 0 */
-            REGISTER OBJ *op;
-
-            op = _InstPtr(newobj)->i_instvars;
-    
             do {
                 *op++ = nil;
             } while (--nInstVars);
@@ -333,7 +355,9 @@
             flags = _intVal(_INST(flags)) & ARRAYMASK;
             switch (flags) {
                 case BYTEARRAY:
-                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(char);
+                    instsize = OHDR_SIZE + 
+                               nInstVars * sizeof(OBJ) 
+                               + nindexedinstvars * sizeof(char);
                     _qNew(newobj, instsize, SENDER);
                     UNPROTECT_CONTEXT
                     if (newobj == nil) {
@@ -344,7 +368,7 @@
                     /*
                      * knowing that nil is 0
                      */
-                    memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
+                    memset(_InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
 #else
                     op = _InstPtr(newobj)->i_instvars;
                     while (nInstVars--)
@@ -362,7 +386,9 @@
                     break;
 
                 case WORDARRAY:
-                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(short);
+                    instsize = OHDR_SIZE + 
+                               nInstVars * sizeof(OBJ) + 
+                               nindexedinstvars * sizeof(short);
                     _qNew(newobj, instsize, SENDER);
                     UNPROTECT_CONTEXT
                     if (newobj == nil) {
@@ -386,7 +412,9 @@
                     break;
 
                case LONGARRAY:
-                    instsize = OHDR_SIZE + nInstVars * sizeof(OBJ) + nindexedinstvars * sizeof(long);
+                    instsize = OHDR_SIZE + 
+                               nInstVars * sizeof(OBJ) + 
+                               nindexedinstvars * sizeof(long);
                     _qAlignedNew(newobj, instsize, SENDER);
                     UNPROTECT_CONTEXT
                     if (newobj == nil) {
@@ -481,10 +509,10 @@
                     /*
                      * knowing that nil is 0
                      */
-#  if defined(FAST_MEMSET_DOUBLES_UNROLLED)
+#  if defined(FAST_ARRAY_MEMSET_DOUBLES_UNROLLED)
                     op = _InstPtr(newobj)->i_instvars;
-                    if (nInstVars > 4) {
-                        *op++ = nil;
+                    if (nInstVars > 8) {
+                        *op++ = nil;	/* for alignment */
                         nInstVars--;
                         while (nInstVars >= 8) {
                             *(double *)op = 0.0;
@@ -500,18 +528,38 @@
                         nInstVars--;
                     }
 #  else
-#   if defined(FAST_MEMSET)
+#   if defined(FAST_ARRAY_MEMSET_LONGLONG_UNROLLED)
+                    op = _InstPtr(newobj)->i_instvars;
+                    if (nInstVars > 8) {
+                        *op++ = nil;	/* for alignment */
+                        nInstVars--;
+                        while (nInstVars >= 8) {
+                            *(long long *)op = 0;
+                            ((long long *)op)[1] = 0;
+                            ((long long *)op)[2] = 0;
+                            ((long long *)op)[3] = 0;
+                            op = (OBJ *)(((char *)op) + (sizeof(long long)*4));
+                            nInstVars -= 8;
+                        }
+                    }
+                    while (nInstVars) {
+                        *op++ = 0;
+                        nInstVars--;
+                    }
+#   else
+#    if defined(FAST_ARRAY_MEMSET)
                     memset(_InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
-#   else
+#    else
                     op = _InstPtr(newobj)->i_instvars;
                     while (nInstVars--)
                         *op++ = nil;
+#    endif
 #   endif
 #  endif
 # else
                     op = _InstPtr(newobj)->i_instvars;
-		    while (nInstVars--)
-			*op++ = nil;
+                    while (nInstVars--)
+                        *op++ = nil;
 # endif
 #endif
                     RETURN ( newobj );
@@ -602,7 +650,8 @@
     ].
     ^ newObject
 
-    "|s|
+    "
+     |s|
      s := WriteStream on:String new.
      #(1 2 3 4) storeOn:s.
      Object readFrom:(ReadStream on:s contents)  
@@ -615,6 +664,11 @@
      See warning in Behavior>>readFrom:"
 
     ^ self readFrom:(ReadStream on:aString)
+
+    "
+     Integer readFromString:'12345678901234567890' 
+     Point readFromString:'1@2'  
+    "
 ! !
 
 !Behavior methodsFor:'autoload check'!
@@ -633,6 +687,18 @@
     ^ self
 ! !
 
+!Behavior methodsFor:'snapshots'!
+
+preSnapshot
+    "sent by ObjectMemory, before a snapshot is written.
+     Nothing done here."
+!
+
+postSnapshot
+    "sent by ObjectMemory, after a snapshot has been written.
+     Nothing done here."
+! !
+
 !Behavior class methodsFor:'flag bit constants'!
 
 flagNotIndexed
@@ -753,6 +819,16 @@
 
 !Behavior methodsFor:'accessing'!
 
+name
+    "although behaviors have no name, we return something
+     useful here - there are many places (inspectors) where
+     a classes name is asked for.
+     Implementing this message here allows anonymous classes
+     and insptances of them to be inspected."
+
+    ^ 'someBehavior'
+!
+
 superclass
     "return the receivers superclass"
 
@@ -763,14 +839,14 @@
     "return the receivers selector array.
      Notice: this is not compatible with ST-80."
 
-    ^ selectors
+    ^ selectorArray
 !
 
 methodArray
     "return the receivers method array.
      Notice: this is not compatible with ST-80."
 
-    ^ methods
+    ^ methodArray
 !
 
 methodDictionary
@@ -780,8 +856,8 @@
     |dict|
 
     dict := IdentityDictionary new.
-    1 to:selectors size do:[:index |
-        dict at:(selectors at:index) put:(methods at:index)
+    1 to:selectorArray size do:[:index |
+        dict at:(selectorArray at:index) put:(methodArray at:index)
     ].
     ^ dict
 !
@@ -982,13 +1058,91 @@
     ].
 !
 
-selectors:selectorArray methods:methodArray
+selectors:newSelectors methods:newMethods
     "set both selector array and method array of the receiver,
      and flush caches"
 
     ObjectMemory flushCaches.
-    selectors := selectorArray.
-    methods := methodArray
+    selectorArray := newSelectors.
+    methodArray := newMethods
+!
+
+addSelector:newSelector withMethod:newMethod
+    "add the method given by 2nd argument under the selector given by
+     1st argument to the methodDictionary. Flush all caches."
+
+    |nargs|
+
+    (self primAddSelector:newSelector withLazyMethod:newMethod) ifFalse:[^ false].
+
+    nargs := newSelector nArgsIfSelector.
+
+    "
+     if I have no subclasses, all we have to flush is cached
+     data for myself ... (actually, in any case all that needs
+     to be flushed is info for myself and all of my subclasses)
+    "
+"
+    problem: this is slower; since looking for all subclasses is (currently)
+             a bit slow :-(
+             We need the hasSubclasses-info bit in Behavior; now
+
+    self withAllSubclassesDo:[:aClass |
+        ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
+        ObjectMemory flushMethodCacheFor:aClass
+    ].
+"
+
+    "
+     actually, we would do better with less flushing ...
+    "
+    ObjectMemory flushMethodCache.
+    ObjectMemory flushInlineCachesWithArgs:nargs.
+
+    ^ true
+!
+
+addSelector:newSelector withLazyMethod:newMethod
+    "add the method given by 2nd argument under the selector given by
+     1st argument to the methodDictionary. Since it does not flush
+     any caches, this is only allowed for lazy methods."
+
+    newMethod isLazy ifFalse:[
+        self error:'operation only allowed for lazy methods'.
+        ^ false
+    ].
+    ^ self primAddSelector:newSelector withLazyMethod:newMethod
+!
+
+removeSelector:aSelector
+    "remove the selector, aSelector and its associated method 
+     from the methodDictionary"
+
+    |index oldSelectorArray oldMethodArray 
+     newSelectorArray newMethodArray|
+
+    index := selectorArray identityIndexOf:aSelector startingAt:1.
+    (index == 0) ifTrue:[^ false].
+
+    newSelectorArray := selectorArray copyWithoutIndex:index.
+    newMethodArray := methodArray copyWithoutIndex:index.
+    oldSelectorArray := selectorArray.
+    oldMethodArray := methodArray.
+    selectorArray := newSelectorArray.
+    methodArray := newMethodArray.
+"
+    [
+        |nargs|
+        nargs := aSelector nArgsIfSelector.
+        ObjectMemory flushMethodCache.
+        ObjectMemory flushInlineCachesWithArgs:nargs.
+    ] value
+"
+    "
+     actually, we would do better with less flushing ...
+    "
+    ObjectMemory flushCaches.
+    ^ true
 ! !
 
 !Behavior methodsFor:'queries'!
@@ -999,8 +1153,10 @@
 
     ^ true
 
-    "True isBehavior"
-    "true isBehavior"
+    "
+     True isBehavior   
+     true isBehavior
+    "
 !
 
 canBeSubclassed
@@ -1031,7 +1187,9 @@
     ].
     ^ Array with:superclass
 
-    "String superclasses"
+    "
+     String superclasses  
+    "
 !
 
 allSuperclasses
@@ -1049,7 +1207,9 @@
     ].
     ^ aCollection
 
-    "String allSuperclasses"
+    "
+     String allSuperclasses 
+    "
 !
 
 withAllSuperclasses
@@ -1066,7 +1226,9 @@
     ].
     ^ aCollection
 
-    "String withAllSuperclasses"
+    "
+     String withAllSuperclasses 
+    "
 !
 
 subclasses
@@ -1080,7 +1242,9 @@
     ].
     ^ newColl
 
-    "Collection subclasses"
+    "
+     Collection subclasses
+    "
 !
 
 allSubclasses
@@ -1096,7 +1260,9 @@
     ].
     ^ newColl
 
-    "Collection allSubclasses"
+    "
+     Collection allSubclasses
+    "
 !
 
 allSubclassesInOrder
@@ -1111,7 +1277,9 @@
     ].
     ^ newColl
 
-    "Collection allSubclassesInOrder"
+    "
+     Collection allSubclassesInOrder
+    "
 !
 
 withAllSubclasses
@@ -1126,7 +1294,9 @@
     ].
     ^ newColl
 
-    "Collection withAllSubclasses"
+    "
+     Collection withAllSubclasses
+    "
 !
 
 isSubclassOf:aClass
@@ -1141,9 +1311,11 @@
     ].
     ^ false
 
-    "String isSubclassOf:Collection"
-    "LinkedList isSubclassOf:Array"
-    "1 isSubclassOf:Number"     "will fail since 1 is no class"
+    "
+     String isSubclassOf:Collection  
+     LinkedList isSubclassOf:Array   
+     1 isSubclassOf:Number              <- will fail since 1 is no class
+    "     
 !
 
 allInstances
@@ -1157,7 +1329,9 @@
     ].
     ^ coll 
 
-    "ScrollBar allInstances"
+    "
+     ScrollBar allInstances
+    "
 !
 
 allDerivedInstances
@@ -1174,7 +1348,9 @@
     ].
     ^ coll 
 
-    "View allDerivedInstances"
+    "
+     View allDerivedInstances
+    "
 !
 
 instanceCount
@@ -1190,7 +1366,9 @@
     ].
     ^ count
 
-    "View instanceCount"
+    "
+     View instanceCount
+    "
 !
 
 derivedInstanceCount
@@ -1206,13 +1384,15 @@
     ].
     ^ count
 
-    "View derivedInstanceCount"
+    "
+     View derivedInstanceCount
+    "
 !
 
 selectorIndex:aSelector
     "return the index in the arrays for given selector aSelector"
 
-    ^ selectors identityIndexOf:aSelector startingAt:1
+    ^ selectorArray identityIndexOf:aSelector startingAt:1
 !
 
 compiledMethodAt:aSelector
@@ -1221,12 +1401,14 @@
 
     |index|
 
-    index := selectors identityIndexOf:aSelector startingAt:1.
+    index := selectorArray identityIndexOf:aSelector startingAt:1.
     (index == 0) ifTrue:[^ nil].
-    ^ methods at:index
+    ^ methodArray at:index
 
-    "Object compiledMethodAt:#=="
-    "(Object compiledMethodAt:#==) category"
+    "
+     Object compiledMethodAt:#==
+     (Object compiledMethodAt:#==) category
+    "
 !
 
 sourceCodeAt:aSelector
@@ -1239,9 +1421,11 @@
     method isNil ifTrue:[^ nil].
     ^ method source
 
-    "True sourceCodeAt:#ifTrue:"
-    "Object sourceCodeAt:#=="
-    "Behavior sourceCodeAt:#sourceCodeAt:"
+    "
+     True sourceCodeAt:#ifTrue:
+     Object sourceCodeAt:#==
+     Behavior sourceCodeAt:#sourceCodeAt:
+    "
 !
 
 lookupMethodFor:aSelector
@@ -1288,17 +1472,21 @@
     RETURN ( lookup(self, aSelector, SENDER) );
 %}
 
-    "String cachedLookupMethodFor:#="
-    "String cachedLookupMethodFor:#asOrderedCollection"
+    "
+     String cachedLookupMethodFor:#=
+     String cachedLookupMethodFor:#asOrderedCollection
+    "
 !
 
 hasMethods
     "return true, if there are any (local) methods in this class"
 
-    ^ (methods size ~~ 0)
+    ^ (methodArray size ~~ 0)
 
-    "True hasMethods"
-    "True class hasMethods"
+    "
+     True hasMethods
+     True class hasMethods
+    "
 !
 
 implements:aSelector
@@ -1308,10 +1496,12 @@
      use #canUnderstand: on the class or #respondsTo: on the instance
      to do this."
 
-    ^ (selectors identityIndexOf:aSelector startingAt:1) ~~ 0
+    ^ (selectorArray identityIndexOf:aSelector startingAt:1) ~~ 0
 
-    "True implements:#ifTrue:"
-    "True implements:#=="
+    "
+     True implements:#ifTrue:
+     True implements:#==
+    "
 !
 
 canUnderstand:aSelector
@@ -1320,9 +1510,11 @@
 
     ^ (self lookupMethodFor:aSelector) notNil
 
-    "True canUnderstand:#ifTrue:"
-    "True canUnderstand:#=="
-    "True canUnderstand:#do:"
+    "
+     True canUnderstand:#ifTrue:
+     True canUnderstand:#==
+     True canUnderstand:#do:
+    "
 !
 
 whichClassImplements:aSelector
@@ -1349,8 +1541,10 @@
     ].
     ^ nil
 
-    "String whichClassImplements:#=="
-    "String whichClassImplements:#collect:"
+    "
+     String whichClassImplements:#==
+     String whichClassImplements:#collect:
+    "
 !
 
 inheritsFrom:aClass
@@ -1358,8 +1552,10 @@
 
     ^ self isSubclassOf:aClass
 
-    "True inheritsFrom:Object"
-    "LinkedList inheritsFrom:Array"
+    "
+     True inheritsFrom:Object
+     LinkedList inheritsFrom:Array
+    "
 !
 
 selectorForMethod:aMethod
@@ -1367,15 +1563,16 @@
 
     |index|
 
-    index := methods identityIndexOf:aMethod startingAt:1.
+    index := methodArray identityIndexOf:aMethod startingAt:1.
     (index == 0) ifTrue:[^ nil].
-    ^ selectors at:index
+    ^ selectorArray at:index
 !
 
 containsMethod:aMethod
     "Return true, if the argument, aMethod is a method of myself"
 
-    ^ (methods identityIndexOf:aMethod startingAt:1) ~~ 0
+    methodArray isNil ifTrue:[^ false].  "degenerated class"
+    ^ (methodArray identityIndexOf:aMethod startingAt:1) ~~ 0
 ! !
 
 !Behavior methodsFor:'private accessing'!
@@ -1387,8 +1584,8 @@
      Do NOT use it."
 
     superclass := sup.
-    selectors := sels.
-    methods := m.
+    selectorArray := sels.
+    methodArray := m.
     instSize := i.
     flags := f
 !
@@ -1435,7 +1632,7 @@
      and no change record written here.
      NOT for general use."
 
-    selectors := anArray
+    selectorArray := anArray
 !
 
 setMethodArray:anArray
@@ -1444,7 +1641,7 @@
      and no change record written here.
      NOT for general use."
 
-    methods := anArray
+    methodArray := anArray
 !
 
 setMethodDictionary:aDictionary
@@ -1453,19 +1650,61 @@
      method arrays and set those. For ST-80 compatibility.
      NOT for general use."
 
-    |n selArray methodArray idx|
+    |n newSelectorArray newMethodArray idx|
 
     n := aDictionary size.
-    selArray := Array new:n.
-    methodArray := Array new:n.
+    newSelectorArray := Array new:n.
+    newMethodArray := Array new:n.
     idx := 1.
     aDictionary keysAndValuesDo:[:sel :method |
-        selArray at:idx put:sel.
-        methodArray at:idx put:method.
+        newSelectorArray at:idx put:sel.
+        newMethodArray at:idx put:method.
         idx := idx + 1
     ].
-    selectors := selArray.
-    methods := methodArray
+    selectorArray := newSelectorArray.
+    methodArray := newMethodArray
+!
+
+primAddSelector:newSelector withLazyMethod:newMethod
+    "add the method given by 2nd argument under the selector given by
+     the 1st argument to the methodDictionary. 
+     Does NOT flush any caches.
+
+     Do not use this in normal situations, strange behavior will be
+     the consequence.
+     I.e. executing obsolete methods, since the old method will still 
+     be executed out of the caches."
+
+    |index oldSelectorArray oldMethodArray newSelectorArray newMethodArray|
+
+    (newSelector isMemberOf:Symbol) ifFalse:[
+        self error:'invalid selector'. 
+        ^ false
+    ].
+    newMethod isNil ifTrue:[
+        self error:'invalid method'. 
+        ^ false
+    ].
+
+    index := selectorArray identityIndexOf:newSelector startingAt:1.
+    (index == 0) ifTrue:[
+        "
+         a new selector
+        "
+        newSelectorArray := selectorArray copyWith:newSelector.
+        newMethodArray := methodArray copyWith:newMethod.
+        "
+         keep a reference so they wont go away ...
+         mhmh: this is no longer needed - try without
+        "
+        oldSelectorArray := selectorArray.
+        oldMethodArray := methodArray.
+        selectorArray := newSelectorArray.
+        methodArray := newMethodArray
+    ] ifFalse:[
+        methodArray at:index put:newMethod
+    ].
+    ^ true
 ! !
 
 !Behavior methodsFor:'compiler interface'!
@@ -1489,7 +1728,9 @@
         ]
     ]
 
-    "StandardSystemView allInstancesDo:[:v | Transcript showCr:(v name)]"
+    "
+     StandardSystemView allInstancesDo:[:v | Transcript showCr:(v name)]
+    "
 !
 
 allDerivedInstancesDo:aBlock
@@ -1501,7 +1742,9 @@
         ]
     ]
 
-    "StandardSystemView allDerivedInstancesDo:[:v | Transcript showCr:(v name)]"
+    "
+     StandardSystemView allDerivedInstancesDo:[:v | Transcript showCr:(v name)]
+    "
 !
 
 subclassesDo:aBlock
@@ -1573,7 +1816,8 @@
     ].
     ^ newObject
 
-    "|s|
+    "
+     |s|
      s := WriteStream on:ByteArray new.
      #(1 2 3 4) storeBinaryOn:s.
      Object readBinaryFrom:(ReadStream on:s contents)  
@@ -1592,6 +1836,13 @@
     myName do:[:c| 
         stream nextPut:c asciiValue
     ]
+
+    "
+     |s|
+     s := WriteStream on:ByteArray new.
+     #(1 2 3 4) storeBinaryOn:s.
+     Object readBinaryFrom:(ReadStream on:s contents)  
+    "
 !
 
 binaryDefinitionFrom:stream manager:manager