[Help-smalltalk] [PATCH] Add a new shape, #word

[Paolo Bonzini]

This is necessary for a correct conversion from the old to the new 
format.  The conversion tool is coming RSN :-)

Paolo

2007-05-24  Paolo Bonzini  <address@hidden>

        * kernel/Behavior.st: Add #shape:.  Support #word shape.
        * kernel/Builtins.st: Add #shape: and instanceVariableNames: for
        Behavior.
        * kernel/Class.st: Remove #shape:.  Use #word shape.
        * kernel/Metaclass.st: Support #word shape.
        * kernel/UndefObject.st: Use #word shape.

* comparing to address@hidden/smalltalk--devo--2.2--patch-348
M  kernel/Behavior.st
M  kernel/Builtins.st
M  kernel/Class.st
M  kernel/Metaclass.st
M  kernel/UndefObject.st

* modified files

--- orig/kernel/Behavior.st
+++ mod/kernel/Behavior.st
@@ -913,6 +913,28 @@ shapes
        #double #utf32 nil nil nil #pointer)
 !
 
+shape: shape
+    "Give the provided shape to the receiver's instances.
+     The shape can be nil, or one of #byte #int8 #character #short
+     #ushort #int #uint #int64 #uint64 #utf32 #float #double or #pointer."
+
+    | realShape |
+    realShape := shape == #word
+       ifTrue: [ CSymbols.CLongSize = 4 ifTrue: [ #uint ] ifFalse: [ #uint64 ] 
]
+       ifFalse: [ shape ].
+
+    self shape == realShape ifTrue: [ ^false ].
+    realShape isNil
+       ifTrue: [ ^self updateInstanceVars: self allInstVarNames shape: nil ].
+
+    self isVariable
+       ifTrue: [
+            SystemExceptions.MutationError
+                signal: 'Cannot change shape of variable class' ].
+
+    "Changing from fixed to variable.  No need to mutate the instances."
+    self setInstanceSpec: realShape instVars: self allInstVarNames size!
+
 shape
     self isVariable ifFalse: [ ^nil ].
     ^self shapes at: (instanceSpec bitAnd: 15) + 1


--- orig/kernel/Builtins.st
+++ mod/kernel/Builtins.st
@@ -169,13 +169,17 @@ Class extend [
         comment := aString
     ]
 
-    shape: aSymbol [
-    ]
-    
     import: aString [
     ]
 ]
     
+Behavior extend [
+    instanceVariableNames: ivn [
+    ]
+    
+    shape: aSymbol [
+    ]
+]
 
 UndefinedObject extend [
     subclass: classNameString [


--- orig/kernel/Class.st
+++ mod/kernel/Class.st
@@ -323,23 +323,6 @@ extend
         withArguments: {self name asSymbol. ''. ''. ''. 'Extensions'}
 !
 
-shape: shape
-    "Give the provided shape to the receiver's instances.
-     The shape can be nil, or one of #byte #int8 #character #short
-     #ushort #int #uint #int64 #uint64 #utf32 #float #double or #pointer."
-
-    self shape == shape ifTrue: [ ^false ].
-    shape isNil
-       ifTrue: [ ^self updateInstanceVars: self allInstVarNames shape: nil ].
-
-    self isVariable
-       ifTrue: [
-            SystemExceptions.MutationError
-                signal: 'Cannot change shape of variable class' ].
-
-    "Changing from fixed to variable.  No need to mutate the instances."
-    self setInstanceSpec: shape instVars: self allInstVarNames size!
-
 subclass: classNameString
     "Define a subclass of the receiver with the given name.  If the class
      is already defined, don't modify its instance or class variables
@@ -450,7 +433,7 @@ variableWordSubclass: classNameString
            environment: Namespace current
            subclassOf: self
            instanceVariableNames: stringInstVarNames
-           shape: (CSymbols.CLongSize = 4 ifTrue: [ #uint ] ifFalse: [ #uint64 
])
+           shape: #word
            classVariableNames: stringOfClassVarNames
            poolDictionaries: stringOfPoolNames
            category: categoryNameString


--- orig/kernel/Metaclass.st
+++ mod/kernel/Metaclass.st
@@ -239,7 +239,10 @@ name: className
     "Private - create a full featured class and install it, or change an
      existing one"
 
-    | aClass needToRecompileMetaclasses needToRecompileClasses |
+    | aClass realShape needToRecompileMetaclasses needToRecompileClasses |
+    realShape := shape == #word
+        ifTrue: [ CSymbols.CLongSize = 4 ifTrue: [ #uint ] ifFalse: [ #uint64 
] ]
+        ifFalse: [ shape ].
 
     "Look for an existing metaclass"
     aClass := aNamespace hereAt: className ifAbsent: [ nil ].
@@ -248,14 +251,14 @@ name: className
            environment: aNamespace
            subclassOf: superclass
            instanceVariableArray: variableArray
-           shape: shape
+           shape: realShape
            classPool: classVarDict
            poolDictionaries: sharedPoolNames
            category: categoryName
     ].
 
-    (aClass isVariable & shape notNil) ifTrue: [
-       aClass shape == shape ifFalse: [
+    (aClass isVariable & realShape notNil) ifTrue: [
+       aClass shape == realShape ifFalse: [
            SystemExceptions.MutationError
                signal: 'Cannot change shape of variable class' ]
     ].
@@ -287,13 +290,13 @@ name: className
 
     (needToRecompileClasses := variableArray ~= aClass allInstVarNames
        | needToRecompileMetaclasses) 
-       | (aClass shape ~~ shape)
+       | (aClass shape ~~ realShape)
            ifTrue: [
                aClass instanceCount > 0
                    ifTrue: [ ObjectMemory globalGarbageCollect ].
                aClass
                    updateInstanceVars: variableArray 
-                   shape: shape
+                   shape: realShape
            ].
 
     aClass sharedPoolDictionaries isNil 


--- orig/kernel/UndefObject.st
+++ mod/kernel/UndefObject.st
@@ -341,7 +341,7 @@ variableWordSubclass: classNameString
            environment: Namespace current
            subclassOf: self
            instanceVariableNames: stringInstVarNames
-           shape: (CSymbols.CLongSize = 4 ifTrue: [ #uint ] ifFalse: [ #uint64 
])
+           shape: #word
            classVariableNames: stringOfClassVarNames
            poolDictionaries: stringOfPoolNames
            category: categoryNameString