# HG changeset patch # User Claus Gittinger # Date 1393937562 -3600 # Node ID 5a5e9b9b5138f9b530388c416be5fdf38a6d7f48 # Parent bbbb798caa455d7f81cde8e019fc120db7c92ca3 class: SnapShotImageMemory 64bit fixes diff -r bbbb798caa45 -r 5a5e9b9b5138 SnapShotImageMemory.st --- 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$' ! ! +