hg/stx-libtool2: comparison SnapShotImageMemory.st

equal deleted inserted replaced

-:f9a8e3c20143
+:41ebace0f00a
 	poolDictionaries:''
 	category:'System-Support'
 !
 Object subclass:#ImageHeader
-	instanceVariableNames:'memory classRef bits byteSize'
+	instanceVariableNames:'memory address classRef bits byteSize'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:SnapShotImageMemory
 !
 "
 I represent the memory as contained in a snapshot image.
 I am not used directly; instead, via the SystemBrowsers entry:
 SystemBrowser openOnSnapShotImage:'/export/home/cg/work/stx/projects/smalltalk/st.img'
+SystemBrowser openOnSnapShotImage:'crash.img'
 [author:]
 Claus Gittinger
 "
 fetchClassObjectAt:baseAddr
 |addr classPtr size bits o classRef nInsts|
 (baseAddr bitAnd:3) ~~ 0 ifTrue:[self halt].
-o := addrToObjectMapping at:baseAddr ifAbsent:nil.
+o := addrToObjectMapping at:(baseAddr bitShift:-2) ifAbsent:nil.
 o notNil ifTrue:[^ o].
 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)) // intSize.
+nInsts := (size - (intSize * 3 "headerSize")) // intSize.
 o := ImageClassObject new:nInsts.
-addrToObjectMapping at:baseAddr put:o.
+o memory:self.
+o address:baseAddr.
+addrToObjectMapping at:(baseAddr bitShift:-2) put:o.
 (self class isPointerOOP:classPtr) ifFalse:[
 self halt
 ].
-classRef := self fetchClassObjectAt:classPtr.
-o classRef:classRef.
 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:(self fetchObjectAt:(self fetchUnboxedIntegerAt:addr)).
 addr := addr + ptrSize.
 ].
-o memory:self.
+classRef := self fetchClassObjectAt:classPtr.
+o classRef:classRef.
 ^ o
 !
 fetchObjectAt:baseAddr
 |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 bitAnd:1) == 1 ifTrue:[
-^ (baseAddr - 16r100000000) bitShift32:-1
+(baseAddr bitTest:16r80000000) ifTrue:[
-] ifFalse:[
+^ (baseAddr - 16r100000000) bitShift32:-1
-^ baseAddr bitShift32:-1
+] ifFalse:[
-]
+^ baseAddr bitShift32:-1
-].
+]
+].
 (baseAddr bitAnd:3) ~~ 0 ifTrue:[self halt].
-o := addrToObjectMapping at:baseAddr ifAbsent:nil.
+o := addrToObjectMapping at:(baseAddr bitShift:-2) ifAbsent:nil.
 o notNil ifTrue:[^ o].
 addr := baseAddr.
 classPtr := self fetchPointerAt:addr.
 addr := addr + ptrSize.
 flags := classRef flags.
 indexTypeFlags := flags bitAnd:Behavior maskIndexType.
 (indexTypeFlags = Behavior flagBytes) ifTrue:[
 nBytes := (size - (intSize * 3)).
 o := ImageByteObject new:nBytes.
+o memory:self.
+o address:baseAddr.
 o classRef:classRef.
 "/ 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 := ImageMethodObject new:nInsts.
 ] ifFalse:[
 o := ImageObject new:nInsts.
 ]
 ].
+o memory:self.
+o address:baseAddr.
 o classRef:classRef.
 size > 8000 ifTrue:[self halt].
 o byteSize:size.
 o bits:bits.
-addrToObjectMapping at:baseAddr put:o.
+addrToObjectMapping at:(baseAddr bitShift:-2) put:o.
 1 to:nInsts do:[:idx |
 o at:idx put:(self fetchUnboxedIntegerAt:addr).
 "/            o at:idx put:(self fetchObjectAt:(self fetchUnboxedIntegerAt:addr)).
 addr := addr + ptrSize.
 ]
 ].
-o memory:self.
 ^ o
 !
 fetchPointerAt:addr
 ^ self fetchUnboxedIntegerAt:addr
 for:aFilename
 stream := aFilename asFilename readStream binary.
 addrToObjectMapping := IdentityDictionary new.
-addrToObjectMapping at:(ObjectMemory addressOf:false) put:false.
+addrToObjectMapping at:((ObjectMemory addressOf:false) bitShift:-2) put:false.
-addrToObjectMapping at:(ObjectMemory addressOf:true) put:true.
+addrToObjectMapping at:((ObjectMemory addressOf:true) bitShift:-2)  put:true.
 !
 printStringOfClass:aClassRef
 |nameSlot|
 !
 readHeader
 "
 (self for:'stmeas.img') readHeader
+(self for:'crash.img') readHeader
 "
 |order magic version timeStamp snapID last_util_addr hiText_addr flags
 lowData hiData charSlots charTableSlots fixMemStart fixMemEnd
 symMemStart symMemEnd vmDataAddr sharedMethodCode sharedBlockCode
 nContexts contextSpace nRegistered symbolsSeqNr nSpaces
-classNameSize spaceSize|
+classNameSize spaceSize numCharSlots|
 stream next:256.        "/ skip execCmd
 msb := false.
 order := stream nextUnsignedLongMSB:msb.
 nRegistered := stream nextUnsignedLongMSB:msb.
 version >= 8 ifTrue:[
 version >= 9 ifTrue:[
 symbolsSeqNr := stream nextUnsignedLongMSB:msb.
-stream next:(intSize * 31).
+version >= 10 ifTrue:[
+numCharSlots := stream nextUnsignedLongMSB:msb.
+stream next:(intSize * 30).
+] ifFalse:[
+stream next:(intSize * 31).
+].
 ] ifFalse:[
 stream next:(intSize * 32).
 ]
 ].
 1 to:nSpaces do:[:i |
 (spaceInfos at:i) size:(stream nextUnsignedLongMSB:msb).
 ].
 nSpaces+1 to:32 do:[:i | stream nextUnsignedLongMSB:msb].
 version >= 8 ifTrue:[
-stream position:(stream class zeroPosition).
+stream reset.
 stream skip:4096.
 ].
 1 to:nSpaces do:[:i |
 (spaceInfos at:i) end:((spaceInfos at:i) start + (spaceInfos at:i) size - 1).
 ] whileTrue
 ! !
 !SnapShotImageMemory::ImageHeader methodsFor:'accessing'!
+address:something
+address := something.
+!
 bits
 "return the value of the instance variable 'bits' (automatically generated)"
 ^ bits
 !
 "Created: / 10.12.1995 / 16:31:25 / cg"
 "Modified: / 1.4.1997 / 16:00:33 / stefan"
 "Modified: / 3.2.2000 / 23:05:28 / cg"
 !
+fileOutCommentOn:aStream
+"append an expression on aStream, which defines my comment"
+|comment s|
+self printClassNameOn:aStream.
+aStream nextPutAll:' comment:'.
+(comment := self comment) isNil ifTrue:[
+s := ''''''
+] ifFalse:[
+s := comment storeString
+].
+aStream nextPutAllAsChunk:s.
+aStream nextPutChunkSeparator.
+aStream cr
+!
 fileOutDefinitionOn:aStream
 "append an expression on aStream, which defines myself."
 ^ self basicFileOutDefinitionOn:aStream withNameSpace:false
 !
 !
 isMeta
 |clsName|
+thisContext isRecursive ifTrue:[^ false].
+byteSize = (Metaclass instSize * 4 + 12) ifFalse:[^ false].
 clsName := classRef name.
 ^ clsName = 'Metaclass' or:[clsName = 'PrivateMetaclass'].
 "/self halt.
 "/    ^ self size == (Metaclass instSize).
 isPrivate
 ^ classRef isPrivateMeta
 !
 isPrivateMeta
+thisContext isRecursive ifTrue:[^ false].
+byteSize = (PrivateMetaclass instSize * 4 + 12) ifFalse:[^ false].
 ^ classRef name = 'PrivateMetaclass'
 !
 isSignedLongLongs
 ^ (self flags bitAnd:Behavior maskIndexType) == Behavior flagSignedLongLongs.

changeset 1864	41ebace0f00a
parent 1792	9848e561e597
child 1865	ed59f67b9fee