--- a/SnapShotImageMemory.st Wed Feb 26 12:27:25 2014 +0100
+++ b/SnapShotImageMemory.st Tue Mar 04 13:52:42 2014 +0100
@@ -2,7 +2,7 @@
Object subclass:#SnapShotImageMemory
instanceVariableNames:'image stream msb ptrSize intSize intTag spaceInfos symbolEntries
- globalEntries addrToObjectMapping'
+ globalEntries addrToObjectMapping fetchINT hdrSize'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
@@ -136,7 +136,7 @@
fetchClassObjectAt:baseAddr
|addr classPtr size bits o classRef nInsts|
- (baseAddr bitAnd:3) ~~ 0 ifTrue:[self halt].
+ (baseAddr bitAnd:ptrSize-1) ~~ 0 ifTrue:[self halt].
o := addrToObjectMapping at:(baseAddr bitShift:-2) ifAbsent:nil.
o notNil ifTrue:[^ o].
@@ -144,12 +144,12 @@
addr := baseAddr.
classPtr := self fetchPointerAt:addr.
addr := addr + ptrSize.
- size := self fetchUnboxedIntegerAt:addr.
- addr := addr + ptrSize.
- bits := self fetchUnboxedIntegerAt:addr.
- addr := addr + ptrSize.
-
- nInsts := (size - (intSize * 3 "headerSize")) // intSize.
+ size := self fetchUnboxedInteger4At:addr.
+ addr := addr + 4.
+ bits := self fetchUnboxedInteger4At:addr.
+ addr := addr + 4.
+
+ nInsts := (size - hdrSize) // intSize.
o := ImageClassObject new:nInsts.
o memory:self.
o address:baseAddr.
@@ -159,12 +159,12 @@
self halt
].
-size > 8000 ifTrue:[self halt].
+ "/ size > 8000 ifTrue:[self halt].
o byteSize:size.
o bits:bits.
1 to:nInsts do:[:idx |
- o at:idx put:(self fetchUnboxedIntegerAt:addr).
+ o at:idx put:(fetchINT value).
"/ o at:idx put:(self fetchObjectAt:(self fetchUnboxedIntegerAt:addr)).
addr := addr + ptrSize.
].
@@ -176,18 +176,24 @@
!
fetchObjectAt:baseAddr
- |addr classPtr classRef size bits o nBytes nInsts flags indexTypeFlags imgAddr
- |
+ |addr classPtr classRef size bits o nBytes nInsts flags indexTypeFlags imgAddr|
baseAddr == 0 ifTrue:[^ nil].
(baseAddr bitAnd:1) == 1 ifTrue:[
- (baseAddr bitTest:16r80000000) ifTrue:[
- ^ (baseAddr - 16r100000000) bitShift32:-1
- ] ifFalse:[
+ "/ sign extent integer
+ ptrSize == 8 ifTrue:[
+ (baseAddr bitTest:16r8000000000000000) ifTrue:[
+ ^ (baseAddr - 16r10000000000000000) bitShift:-1
+ ].
+ ^ baseAddr bitShift:-1
+ ] ifFalse:[
+ (baseAddr bitTest:16r80000000) ifTrue:[
+ ^ (baseAddr - 16r100000000) bitShift32:-1
+ ].
^ baseAddr bitShift32:-1
- ]
+ ].
].
- (baseAddr bitAnd:3) ~~ 0 ifTrue:[self halt].
+ (baseAddr bitAnd:ptrSize-1) ~~ 0 ifTrue:[self halt].
o := addrToObjectMapping at:(baseAddr bitShift:-2) ifAbsent:nil.
o notNil ifTrue:[^ o].
@@ -195,10 +201,10 @@
addr := baseAddr.
classPtr := self fetchPointerAt:addr.
addr := addr + ptrSize.
- size := self fetchUnboxedIntegerAt:addr.
- addr := addr + ptrSize.
- bits := self fetchUnboxedIntegerAt:addr.
- addr := addr + ptrSize.
+ size := self fetchUnboxedInteger4At:addr.
+ addr := addr + 4.
+ bits := self fetchUnboxedInteger4At:addr.
+ addr := addr + 4.
(self class isPointerOOP:classPtr) ifFalse:[
self halt
@@ -206,22 +212,22 @@
classRef := self fetchClassObjectAt:classPtr.
+ imgAddr := self imageAddressOf:addr.
+ stream position:imgAddr.
+
flags := classRef flags.
indexTypeFlags := flags bitAnd:Behavior maskIndexType.
(indexTypeFlags = Behavior flagBytes) ifTrue:[
- nBytes := (size - (intSize * 3)).
+ nBytes := (size - hdrSize).
o := ImageByteObject new:nBytes.
o memory:self.
o address:baseAddr.
o classRef:classRef.
-"/ size > 8000 ifTrue:[self halt].
+ "/ size > 8000 ifTrue:[self halt].
o byteSize:size.
o bits:bits.
addrToObjectMapping at:(baseAddr bitShift:-2) put:o.
- imgAddr := self imageAddressOf:addr.
- stream position:imgAddr.
-
1 to:nBytes do:[:idx |
o at:idx put:(stream next).
addr := addr + 1.
@@ -240,7 +246,7 @@
].
].
- nInsts := (size - (intSize * 3)) // intSize.
+ nInsts := (size - hdrSize) // intSize.
(flags bitTest:Behavior flagBehavior)
"/ classRef isImageBehavior
ifTrue:[
@@ -261,7 +267,7 @@
addrToObjectMapping at:(baseAddr bitShift:-2) put:o.
1 to:nInsts do:[:idx |
- o at:idx put:(self fetchUnboxedIntegerAt:addr).
+ o at:idx put:(fetchINT value).
"/ o at:idx put:(self fetchObjectAt:(self fetchUnboxedIntegerAt:addr)).
addr := addr + ptrSize.
]
@@ -273,10 +279,10 @@
^ self fetchUnboxedIntegerAt:addr
!
-fetchUnboxedIntegerAt:addr
+fetchUnboxedInteger4At:addr
|ptr imgAddr|
- (addr bitAnd:3) ~~ 0 ifTrue:[self halt].
+ (addr bitAnd:(4-1)) ~~ 0 ifTrue:[self halt].
imgAddr := self imageAddressOf:addr.
stream position:imgAddr.
@@ -284,6 +290,17 @@
^ ptr
!
+fetchUnboxedIntegerAt:addr
+ |ptr imgAddr|
+
+ (addr bitAnd:(ptrSize-1)) ~~ 0 ifTrue:[self halt].
+
+ imgAddr := self imageAddressOf:addr.
+ stream position:imgAddr.
+ ptr := fetchINT value.
+ ^ ptr
+!
+
imageAddressOf:addr
spaceInfos do:[:eachSpace |
|byte imgAddr|
@@ -318,7 +335,7 @@
(aByteArrayRef isImageBytes) ifFalse:[self halt].
- nBytes := aByteArrayRef byteSize - (intSize * 3).
+ nBytes := aByteArrayRef byteSize - hdrSize.
^ ((ByteArray new:nBytes) replaceFrom:1 to:nBytes-1 with:aByteArrayRef startingAt:1).
!
@@ -327,8 +344,9 @@
(aStringRef isImageBytes) ifFalse:[self halt].
- nBytes := aStringRef byteSize - (intSize * 3).
- ^ ((ByteArray new:nBytes-1) replaceFrom:1 to:nBytes-1 with:aStringRef startingAt:1) asString.
+ nBytes := aStringRef byteSize - hdrSize.
+ ^ ((ByteArray new:nBytes-1)
+ replaceFrom:1 to:nBytes-1 with:aStringRef startingAt:1) asString.
!
for:aFilename
@@ -343,7 +361,7 @@
|nameSlot|
(aClassRef isImageBehavior) ifFalse:[self halt].
- ((aClassRef byteSize // intSize) - 3) < Class instSize ifTrue:[self halt.].
+ ((aClassRef byteSize - hdrSize) // intSize) < Class instSize ifTrue:[self halt.].
nameSlot := aClassRef nameSlot.
nameSlot isInteger ifTrue:[
@@ -375,12 +393,8 @@
!
printStringOfSymbol:aSymbolRef
- |nBytes|
-
(aSymbolRef isImageSymbol) ifFalse:[self halt].
^ self fetchStringFor:aSymbolRef.
-"/ nBytes := aSymbolRef size - (intSize * 3).
-"/ ^ ((ByteArray new:nBytes-1) replaceFrom:1 to:nBytes-1 with:aSymbolRef startingAt:1) asString.
!
readGlobalEntries
@@ -388,9 +402,9 @@
globalEntries := OrderedCollection new.
[
- refPointer := stream nextUnsignedLongMSB:msb.
- theSymbolPtr := stream nextUnsignedLongMSB:msb.
- theValuePtr := stream nextUnsignedLongMSB:msb.
+ refPointer := fetchINT value.
+ theSymbolPtr := fetchINT value.
+ theValuePtr := fetchINT value.
theSymbolPtr ~~ 0
] whileTrue:[
globalEntries add:(theSymbolPtr -> theValuePtr).
@@ -419,7 +433,7 @@
readHeader
"
- (self for:'stmeas.img') readHeader
+ (self for:'st.img') readHeader
(self for:'crash.img') readHeader
"
@@ -449,48 +463,68 @@
timeStamp := stream nextUnsignedLongMSB:msb.
ptrSize := stream nextByte.
ptrSize ~~ 4 ifTrue:[
- self error:'unhandled ptr format'
+ ptrSize ~~ 8 ifTrue:[
+ self error:'unhandled ptr format'
+ ].
].
stream next:7. "/ filler
intSize := stream nextUnsignedLongMSB:msb.
- intSize == 9 ifTrue:[
+ intSize == 9 "encoded as SmallInteger; i.e. with tag" ifTrue:[
intSize := 4.
intTag := 1.
] ifFalse:[
- self error:'unhandled int format'
+ intSize == 17 "encoded as SmallInteger; i.e. with tag" ifTrue:[
+ intSize := 8.
+ intTag := 1.
+ ] ifFalse:[
+ self error:'unhandled int format'
+ ].
].
-
+ hdrSize := ptrSize + 4 + 4.
+
+ intSize == 4 ifTrue:[
+ fetchINT := [stream nextUnsignedLongMSB:msb]
+ ] ifFalse:[
+ fetchINT := [stream nextUnsignedHyperMSB:msb]
+ ].
+
snapID := stream nextUnsignedLongMSB:msb.
- last_util_addr := stream next:intSize.
- hiText_addr := stream next:intSize.
- flags := stream next:intSize.
- stream next:8. "/ info, debug & filler
-
- lowData := stream nextUnsignedLongMSB:msb.
- hiData := stream nextUnsignedLongMSB:msb.
-
- charSlots := stream nextUnsignedLongMSB:msb.
- charTableSlots := stream nextUnsignedLongMSB:msb.
+ intSize == 8 ifTrue:[
+ "/ sigh - align for 8byte
+ stream next:4
+ ].
+ last_util_addr := fetchINT value.
+ hiText_addr := fetchINT value.
+ flags := fetchINT value.
+ "infoPrinting :=" stream next.
+ "debugPrinting :=" stream next.
+ stream next:6. "/ filler
+
+ lowData := fetchINT value.
+ hiData := fetchINT value.
+
+ charSlots := fetchINT value.
+ charTableSlots := fetchINT value.
version >= 8 ifTrue:[
- fixMemStart := stream nextUnsignedLongMSB:msb.
- fixMemEnd := stream nextUnsignedLongMSB:msb.
- symMemStart := stream nextUnsignedLongMSB:msb.
- symMemEnd := stream nextUnsignedLongMSB:msb.
- vmDataAddr := stream nextUnsignedLongMSB:msb.
+ fixMemStart := fetchINT value.
+ fixMemEnd := fetchINT value.
+ symMemStart := fetchINT value.
+ symMemEnd := fetchINT value.
+ vmDataAddr := fetchINT value.
].
stream next:(128 * intSize). "/ skip sharedMethodCode ptrs
stream next:(128 * intSize). "/ skip sharedBlockCode ptrs
- nContexts := stream nextUnsignedLongMSB:msb.
- contextSpace := stream nextUnsignedLongMSB:msb.
- nRegistered := stream nextUnsignedLongMSB:msb.
+ nContexts := fetchINT value.
+ contextSpace := fetchINT value.
+ nRegistered := fetchINT value.
version >= 8 ifTrue:[
version >= 9 ifTrue:[
- symbolsSeqNr := stream nextUnsignedLongMSB:msb.
+ symbolsSeqNr := fetchINT value.
version >= 10 ifTrue:[
- numCharSlots := stream nextUnsignedLongMSB:msb.
+ numCharSlots := fetchINT value.
stream next:(intSize * 30).
] ifFalse:[
stream next:(intSize * 31).
@@ -500,23 +534,23 @@
]
].
- nSpaces := stream nextUnsignedLongMSB:msb.
+ nSpaces := fetchINT value.
spaceInfos := (1 to:nSpaces) collect:[:idx | SpaceInfo new].
1 to:nSpaces do:[:i |
- (spaceInfos at:i) flags:(stream nextUnsignedLongMSB:msb).
+ (spaceInfos at:i) flags:(fetchINT value).
].
- nSpaces+1 to:32 do:[:i | stream nextUnsignedLongMSB:msb].
+ nSpaces+1 to:32 do:[:i | fetchINT value].
1 to:nSpaces do:[:i |
- (spaceInfos at:i) start:(stream nextUnsignedLongMSB:msb).
+ (spaceInfos at:i) start:(fetchINT value).
].
- nSpaces+1 to:32 do:[:i | stream nextUnsignedLongMSB:msb].
+ nSpaces+1 to:32 do:[:i | fetchINT value].
1 to:nSpaces do:[:i |
- (spaceInfos at:i) size:(stream nextUnsignedLongMSB:msb).
+ (spaceInfos at:i) size:(fetchINT value).
].
- nSpaces+1 to:32 do:[:i | stream nextUnsignedLongMSB:msb].
+ nSpaces+1 to:32 do:[:i | fetchINT value].
version >= 8 ifTrue:[
stream reset.
stream skip:4096.
@@ -661,23 +695,28 @@
className := (stream next:classNameSize) asString.
stream next. "/ 0-byte
- flags := stream nextUnsignedLongMSB:msb.
- moduleTimestamp := stream nextUnsignedLongMSB:msb.
- signature := stream nextUnsignedLongMSB:msb.
+ flags := fetchINT value.
+ moduleTimestamp := fetchINT value.
+ signature := fetchINT value.
nMethods := stream nextUnsignedLongMSB:msb.
- nMethods timesRepeat:[ stream nextUnsignedLongMSB:msb ].
+ nMethods timesRepeat:[ fetchINT value ].
nBlocks := stream nextUnsignedLongMSB:msb.
- nBlocks timesRepeat:[ stream nextUnsignedLongMSB:msb ].
- oldLitRefs := stream nextUnsignedLongMSB:msb.
+ nBlocks timesRepeat:[ fetchINT value ].
+
+ oldLitRefs := fetchINT value.
nLitRefs := stream nextUnsignedLongMSB:msb.
- nLitRefs timesRepeat:[ stream nextUnsignedLongMSB:msb ].
- stream nextUnsignedLongMSB:msb. "/ 0-litRef
- oldConstTable := stream nextUnsignedLongMSB:msb.
+ nLitRefs timesRepeat:[ fetchINT value ].
+ fetchINT value. "/ 0-litRef
+ oldConstTable := fetchINT value.
nConsts := stream nextLongMSB:msb.
nConsts > 0 ifTrue:[
- nConsts timesRepeat:[ stream nextUnsignedLongMSB:msb ].
- ]
- "/ Transcript showCR:className.
+ nConsts timesRepeat:[ fetchINT value ].
+ ].
+"/ Transcript show:className;
+"/ show:' nconsts:'; show:nConsts;
+"/ show:' nlits:'; show:nLitRefs;
+"/ show:' nMethods:'; show:nMethods;
+"/ show:' nBlocks:'; showCR:nBlocks.
].
!
@@ -687,8 +726,8 @@
symbolEntries := OrderedCollection new.
[
- refPointer := stream nextUnsignedLongMSB:msb.
- theSymbolPtr := stream nextUnsignedLongMSB:msb.
+ refPointer := fetchINT value.
+ theSymbolPtr := fetchINT value.
theSymbolPtr ~~ 0
] whileTrue:[
symbolEntries add:theSymbolPtr.
@@ -696,11 +735,16 @@
symbolEntries := symbolEntries asArray.
pos := stream position.
- symbolEntries := symbolEntries collect:[:theSymbolPtr |
+ 1 to:symbolEntries size do:[:i |
+ |theSymbolPtr|
+
+ "/ an inlined collect, to avoid allocating big array twice.
+ theSymbolPtr := symbolEntries at:i.
theSymbolRef := self fetchObjectAt:theSymbolPtr.
theSymbolRef isImageSymbol ifFalse:[
self halt
].
+ symbolEntries at:i put:theSymbolRef.
].
stream position:pos
!
@@ -709,12 +753,22 @@
|refPointer theValue|
[
- refPointer := stream nextUnsignedLongMSB:msb.
- theValue := stream nextUnsignedLongMSB:msb.
+ refPointer := fetchINT value.
+ theValue := fetchINT value.
refPointer ~~ 0
] whileTrue
! !
+!SnapShotImageMemory methodsFor:'queries'!
+
+metaClassByteSize
+ ^ Metaclass instSize * ptrSize + hdrSize
+!
+
+privateMetaClassByteSize
+ ^ PrivateMetaclass instSize * ptrSize + hdrSize
+! !
+
!SnapShotImageMemory::ImageHeader methodsFor:'accessing'!
address:something
@@ -1571,12 +1625,58 @@
^ comment
!
+commentOrDocumentationString
+ "the classes documentation-method's comment, its plain
+ comment or nil"
+
+ |cls m s|
+
+ cls := self theNonMetaclass.
+ m := cls theMetaclass compiledMethodAt:#documentation.
+ m notNil ifTrue:[
+ "/ try documentation method's comment
+ s := m comment.
+ ] ifFalse:[
+ "try classes comment"
+ s := cls comment.
+ s isString ifTrue:[
+ s isEmpty ifTrue:[
+ s := nil
+ ] ifFalse:[
+ (s includes:$") ifTrue:[
+ s := s copyReplaceAll:$" with:$'.
+ ].
+ s size > 80 ifTrue:[
+ s := s asCollectionOfSubstringsSeparatedBy:$..
+ s := s asStringCollection.
+ s := s collect:[:each | (each startsWith:Character space) ifTrue:[
+ each copyFrom:2
+ ] ifFalse:[
+ each
+ ]
+ ].
+ s := s asStringWith:('.' , Character cr).
+ ].
+ ]
+ ] ifFalse:[
+ "/ class redefines comment ?
+ s := nil
+ ].
+ ].
+ s isEmptyOrNil ifTrue:[^ s].
+ ^ s withTabsExpanded
+
+ "
+ Array commentOrDocumentationString
+ "
+!
+
commentSlot
^ self at:(Class instVarOffsetOf:'comment')
!
flags
- |flags amount|
+ |flags|
cachedFlags isNil ifTrue:[
flags := self flagsSlot.
@@ -1584,8 +1684,7 @@
(SnapShotImageMemory isSmallIntegerOOP:flags) ifFalse:[
self halt
].
- amount := -1.
- cachedFlags := flags bitShift:amount.
+ cachedFlags := flags bitShift:-1.
].
^ cachedFlags
!
@@ -4020,7 +4119,7 @@
|clsName|
thisContext isRecursive ifTrue:[^ false].
- byteSize = (Metaclass instSize * 4 + 12) ifFalse:[^ false].
+ byteSize = memory metaClassByteSize ifFalse:[^ false].
clsName := classRef name.
^ clsName = 'Metaclass' or:[clsName = 'PrivateMetaclass'].
@@ -4045,7 +4144,7 @@
isPrivateMeta
thisContext isRecursive ifTrue:[^ false].
- byteSize = (PrivateMetaclass instSize * 4 + 12) ifFalse:[^ false].
+ byteSize = memory privateMetaClassByteSize ifFalse:[^ false].
^ classRef name = 'PrivateMetaclass'
!
@@ -4206,3 +4305,4 @@
version
^ '$Header$'
! !
+