diff -r 51711e3c7046 -r 2bc8227a8b18 SnapShotImageMemory.st --- 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." + + + + ^ self isNameSpace +! + isTopLevelNamespace "return true, if this is a nameSpace." + + ^ 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 !