--- a/SnapShotImageMemory.st Tue Jul 13 09:13:20 2004 +0200
+++ b/SnapShotImageMemory.st Fri Jul 30 17:27:27 2004 +0200
@@ -9,7 +9,7 @@
!
Object subclass:#ImageHeader
- instanceVariableNames:'memory classRef bits byteSize'
+ instanceVariableNames:'memory address classRef bits byteSize'
classVariableNames:''
poolDictionaries:''
privateIn:SnapShotImageMemory
@@ -58,6 +58,7 @@
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
@@ -137,7 +138,7 @@
(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.
@@ -148,17 +149,16 @@
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.
@@ -168,7 +168,10 @@
"/ o at:idx put:(self fetchObjectAt:(self fetchUnboxedIntegerAt:addr)).
addr := addr + ptrSize.
].
- o memory:self.
+
+ classRef := self fetchClassObjectAt:classPtr.
+ o classRef:classRef.
+
^ o
!
@@ -177,15 +180,16 @@
|
baseAddr == 0 ifTrue:[^ nil].
- (baseAddr bitAnd:1) == 1 ifTrue:[(baseAddr bitTest:16r80000000) ifTrue:[
- ^ (baseAddr - 16r100000000) bitShift32:-1
- ] ifFalse:[
- ^ baseAddr bitShift32:-1
- ]
- ].
+ (baseAddr bitAnd:1) == 1 ifTrue:[
+ (baseAddr bitTest:16r80000000) ifTrue:[
+ ^ (baseAddr - 16r100000000) 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.
@@ -207,10 +211,13 @@
(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.
@@ -245,11 +252,13 @@
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).
@@ -257,7 +266,6 @@
addr := addr + ptrSize.
]
].
- o memory:self.
^ o
!
@@ -327,8 +335,8 @@
stream := aFilename asFilename readStream binary.
addrToObjectMapping := IdentityDictionary new.
- addrToObjectMapping at:(ObjectMemory addressOf:false) put:false.
- addrToObjectMapping at:(ObjectMemory addressOf:true) put:true.
+ addrToObjectMapping at:((ObjectMemory addressOf:false) bitShift:-2) put:false.
+ addrToObjectMapping at:((ObjectMemory addressOf:true) bitShift:-2) put:true.
!
printStringOfClass:aClassRef
@@ -412,13 +420,14 @@
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
@@ -480,7 +489,12 @@
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).
]
@@ -503,9 +517,8 @@
(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.
].
@@ -704,6 +717,10 @@
!SnapShotImageMemory::ImageHeader methodsFor:'accessing'!
+address:something
+ address := something.
+!
+
bits
"return the value of the instance variable 'bits' (automatically generated)"
@@ -2475,6 +2492,23 @@
"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."
@@ -3958,6 +3992,9 @@
isMeta
|clsName|
+ thisContext isRecursive ifTrue:[^ false].
+ byteSize = (Metaclass instSize * 4 + 12) ifFalse:[^ false].
+
clsName := classRef name.
^ clsName = 'Metaclass' or:[clsName = 'PrivateMetaclass'].
@@ -3980,6 +4017,8 @@
!
isPrivateMeta
+ thisContext isRecursive ifTrue:[^ false].
+ byteSize = (PrivateMetaclass instSize * 4 + 12) ifFalse:[^ false].
^ classRef name = 'PrivateMetaclass'
!