--- 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
!