# HG changeset patch # User Claus Gittinger # Date 1091201247 -7200 # Node ID 41ebace0f00a5ba2ff30124dff836d89a9466a1a # Parent f9a8e3c20143c5b53d3261e09d280e8b0f682e65 *** empty log message *** diff -r f9a8e3c20143 -r 41ebace0f00a SnapShotImageMemory.st --- 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' !