*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Mon, 16 Feb 2004 11:25:04 +0100
changeset 1791 2bc8227a8b18
parent 1790 51711e3c7046
child 1792 9848e561e597
*** empty log message ***
SnapShotImage.st
SnapShotImageMemory.st
--- a/SnapShotImage.st	Fri Feb 13 12:34:50 2004 +0100
+++ b/SnapShotImage.st	Mon Feb 16 11:25:04 2004 +0100
@@ -164,6 +164,13 @@
         self fetchGlobals
     ].
     globals keysAndValuesDo:aTwoArgBlock
+!
+
+keysDo:aTwoArgBlock
+    globals isNil ifTrue:[
+        self fetchGlobals
+    ].
+    globals keysDo:aTwoArgBlock
 ! !
 
 !SnapShotImage class methodsFor:'documentation'!
--- a/SnapShotImageMemory.st	Fri Feb 13 12:34:50 2004 +0100
+++ b/SnapShotImageMemory.st	Mon Feb 16 11:25:04 2004 +0100
@@ -208,7 +208,7 @@
         nBytes := (size - (intSize * 3)).
         o := ImageByteObject new:nBytes.
         o classRef:classRef.
-size > 8000 ifTrue:[self halt].
+"/ size > 8000 ifTrue:[self halt].
         o byteSize:size.
         o bits:bits.
 
@@ -337,7 +337,7 @@
     (aClassRef isImageBehavior) ifFalse:[self halt].
     ((aClassRef byteSize // intSize) - 3) < Class instSize ifTrue:[self halt.].
 
-    nameSlot := aClassRef at:7.
+    nameSlot := aClassRef nameSlot.
     nameSlot isInteger ifTrue:[
         nameSlot := self fetchObjectAt:nameSlot
     ].
@@ -725,7 +725,7 @@
 byteSize:something
     "set the value of the instance variable 'size' (automatically generated)"
 
-something > 8000 ifTrue:[self halt].
+"/ something > 8000 ifTrue:[self halt].
     byteSize := something.
 !
 
@@ -756,10 +756,12 @@
 !SnapShotImageMemory::ImageHeader methodsFor:'queries'!
 
 category
-    |categoryPtr categoryRef category|
+    |categoryPtr categoryRef category categorySlotOffset|
 
     self isMethodOrLazyMethod ifTrue:[
-        categoryPtr := self at:6.
+        categorySlotOffset := Method instVarOffsetOf:'category'.
+        "/ categorySlotOffset := 6.
+        categoryPtr := self at:categorySlotOffset.
         categoryRef := memory fetchObjectAt:categoryPtr.
         category := memory fetchStringFor:categoryRef.
         ^ category
@@ -1509,7 +1511,7 @@
 !
 
 classVarsSlot
-    ^ self at:9
+    ^ self at:(Class instVarOffsetOf:'classvars')
 !
 
 comment
@@ -1586,7 +1588,7 @@
 !
 
 instVarsSlot
-    ^ self at:6
+    ^ self at:(Class instVarOffsetOf:'instvars')
 !
 
 methodDictionary
@@ -1646,6 +1648,9 @@
 !
 
 primitiveSpecSlot
+    (Class instVarOffsetOf:'primitiveSpec') isNil ifTrue:[
+        ^ self at:(Class instVarOffsetOf:'attributes')
+    ].
     ^ self at:(Class instVarOffsetOf:'primitiveSpec')
 !
 
@@ -1663,7 +1668,7 @@
 !
 
 revisionSlot
-    ^ self at:14
+    ^ self at:(Class instVarOffsetOf:'revision')
 !
 
 superclass
@@ -1677,7 +1682,7 @@
 !
 
 superclassSlot
-    ^ self at:1
+    ^ self at:(Class instVarOffsetOf:'superclass')
 ! !
 
 !SnapShotImageMemory::ImageClassObject methodsFor:'class protocol'!
@@ -2114,6 +2119,29 @@
     "Modified: 22.3.1997 / 16:11:56 / cg"
 !
 
+fileOutAllMethodsOn:aStream methodFilter:methodFilter
+    |collectionOfCategories|
+
+    collectionOfCategories := self class categories asSortedCollection.
+    collectionOfCategories notNil ifTrue:[
+        collectionOfCategories do:[:aCategory |
+            self class fileOutCategory:aCategory methodFilter:methodFilter on:aStream.
+            aStream cr
+        ]
+    ].
+    collectionOfCategories := self categories asSortedCollection.
+    collectionOfCategories notNil ifTrue:[
+        collectionOfCategories do:[:aCategory |
+            self fileOutCategory:aCategory methodFilter:methodFilter on:aStream.
+            aStream cr
+        ]
+    ].
+
+    self privateClassesSorted do:[:aClass |
+        aClass fileOutAllMethodsOn:aStream methodFilter:methodFilter
+    ].
+!
+
 fileOutAs:fileNameString
     "create a file consisting of all methods in myself in
      sourceForm, from which the class can be reconstructed (by filing in).
@@ -3379,13 +3407,13 @@
     myNamePrefix := myName , '::'.
     myNamePrefixLen := myNamePrefix size.
 
-    Smalltalk keysDo:[:nm |
+    memory image keysDo:[:nm |
         |cls|
 
         (nm startsWith:myNamePrefix) ifTrue:[
             (allOfThem
             or:[(nm indexOf:$: startingAt:myNamePrefixLen + 1) == 0]) ifTrue:[
-                cls := Smalltalk at:nm.
+                cls := memory image at:nm.
 
                 (cls isBehavior and:[cls isMeta not]) ifTrue:[
                     classes isNil ifTrue:[
@@ -3833,6 +3861,14 @@
 
 !SnapShotImageMemory::ImageClassObject methodsFor:'namespace protocol'!
 
+allClasses
+    |classes|
+
+    classes := IdentitySet new.
+    self allClassesDo:[:aClass | classes add:aClass].
+    ^ classes
+!
+
 allClassesDo:aBlock
     |prefix|
 
@@ -3950,9 +3986,19 @@
     ^ (self flags bitAnd:Behavior maskIndexType) == Behavior flagSignedWords.
 !
 
+isTopLevelNameSpace
+    "return true, if this is a nameSpace."
+
+    <resource:#obsolete>
+
+    ^ self isNameSpace
+!
+
 isTopLevelNamespace
     "return true, if this is a nameSpace."
 
+    <resource:#obsolete>
+
     ^ self isNameSpace
 !
 
@@ -3988,7 +4034,7 @@
     |ownerPtr owner|
 
     classRef isPrivateMeta ifFalse:[^ nil].
-    ownerPtr := classRef at:8.
+    ownerPtr := classRef at:(PrivateMetaclass instVarOffsetOf:'owningClass').
     owner := memory fetchClassObjectAt:ownerPtr.
     ^ owner
 !