"{ Package: 'cg:private' }"
Object subclass:#SnapShotImageMemory
instanceVariableNames:'stream msb ptrSize intSize intTag spaceInfos symbolEntries
globalEntries addrToObjectMapping'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
!
Object subclass:#SpaceInfo
instanceVariableNames:'start end size flags imageBase'
classVariableNames:''
poolDictionaries:''
privateIn:SnapShotImageMemory
!
Object variableSubclass:#ImageObject
instanceVariableNames:'classRef size bits'
classVariableNames:''
poolDictionaries:''
privateIn:SnapShotImageMemory
!
SnapShotImageMemory::ImageObject variableSubclass:#ImageClassObject
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:SnapShotImageMemory
!
!SnapShotImageMemory class methodsFor:'instance creation'!
for:aFilename
^ self new for:aFilename
! !
!SnapShotImageMemory class methodsFor:'private'!
isNilOOP:anOOP
^ anOOP == 0
!
isPointerOOP:anOOP
^ (anOOP bitTest:1) not
!
isSmallIntegerOOP:anOOP
^ anOOP bitTest:1
! !
!SnapShotImageMemory methodsFor:'accessing'!
globalEntries
"return the value of the instance variable 'globalEntries' (automatically generated)"
^ globalEntries!
globalEntries:something
"set the value of the instance variable 'globalEntries' (automatically generated)"
globalEntries := something.! !
!SnapShotImageMemory methodsFor:'object access'!
fetchClassObjectAt:baseAddr
|addr classPtr size bits o|
o := addrToObjectMapping at:baseAddr 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.
o := ImageClassObject new:(size - intSize - intSize - intSize).
o classRef:classPtr.
o size:size.
o bits:bits.
1 to:size // intSize do:[:idx |
o at:idx put:(self fetchUnboxedIntegerAt:addr).
addr := addr + 1.
].
addrToObjectMapping at:baseAddr put:o.
^ o
!
fetchObjectAt:baseAddr
|addr classPtr classRef size bits o|
o := addrToObjectMapping at:baseAddr 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.
(self class isPointerOOP:classPtr) ifFalse:[
self halt
].
classRef := self fetchClassObjectAt:classPtr.
classRef isImageBehavior ifFalse:[
self halt.
].
o := ImageObject new:(size - intSize - intSize - intSize).
o classRef:classRef.
o size:size.
o bits:bits.
self halt.
!
fetchObjectHeaderAt:baseAddr
|addr class size bits|
addr := baseAddr.
class := self fetchPointerAt:addr.
addr := addr + ptrSize.
size := self fetchUnboxedIntegerAt:addr.
addr := addr + ptrSize.
bits := self fetchUnboxedIntegerAt:addr.
addr := addr + ptrSize.
self halt.
!
fetchPointerAt:addr
^ self fetchUnboxedIntegerAt:addr
!
fetchUnboxedIntegerAt:addr
spaceInfos do:[:eachSpace |
|ptr imgAddr|
addr >= eachSpace start ifTrue:[
addr <= eachSpace end ifTrue:[
imgAddr := eachSpace imageBase + (addr - eachSpace start).
stream position:imgAddr.
ptr := stream nextUnsignedLongMSB:msb.
^ ptr
]
].
].
self halt:'image fetch error'.
! !
!SnapShotImageMemory methodsFor:'private'!
allClassesDo:aBlock
self allGlobalKeysDo:[:eachKey |
|val|
val := self at:eachKey.
val isBehavior ifTrue:[
aBlock value:val
]
].
!
allGlobalKeysDo:aBlock
globals isNil ifTrue:[
self readHeader.
self readGlobals.
].
!
for:aFilename
stream := aFilename asFilename readStream binary.
addrToObjectMapping := IdentityDictionary new.
!
readGlobalEntries
|refPointer theSymbol theValue|
globalEntries := OrderedCollection new.
[
refPointer := stream nextUnsignedLongMSB:msb.
theSymbol := stream nextUnsignedLongMSB:msb.
theValue := stream nextUnsignedLongMSB:msb.
theSymbol ~~ 0
] whileTrue:[
globalEntries add:(theSymbol -> theValue).
].
globalEntries := globalEntries asArray
!
readHeader
"
(self for:'stmeas.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
spaceFlags spaceBase spaceSize classNameSize|
stream next:256. "/ skip execCmd
msb := false.
order := stream nextUnsignedLongMSB:msb.
order = 16r076543210 ifTrue:[
] ifFalse:[
order = 16r01234567 ifTrue:[
msb := true.
] ifFalse:[
self error:'unhandled byteorder'
].
].
magic := (stream next:8) asString.
magic ~= 'ST/X-IMG' ifTrue:[
self error:'not an st/x image'
].
version := stream nextUnsignedLongMSB:msb.
timeStamp := stream nextUnsignedLongMSB:msb.
ptrSize := stream nextByte.
ptrSize ~~ 4 ifTrue:[
self error:'unhandled ptr format'
].
stream next:7. "/ filler
intSize := stream nextUnsignedLongMSB:msb.
intSize == 9 ifTrue:[
intSize := 4.
intTag := 1.
] ifFalse:[
self error:'unhandled int format'
].
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.
version >= 8 ifTrue:[
fixMemStart := stream nextUnsignedLongMSB:msb.
fixMemEnd := stream nextUnsignedLongMSB:msb.
symMemStart := stream nextUnsignedLongMSB:msb.
symMemEnd := stream nextUnsignedLongMSB:msb.
vmDataAddr := stream nextUnsignedLongMSB:msb.
].
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.
version >= 8 ifTrue:[
version >= 9 ifTrue:[
symbolsSeqNr := stream nextUnsignedLongMSB:msb.
stream next:(intSize * 31).
] ifFalse:[
stream next:(intSize * 32).
]
].
nSpaces := stream nextUnsignedLongMSB:msb.
spaceInfos := (1 to:nSpaces) collect:[:idx | SpaceInfo new].
spaceBase := Array new:nSpaces.
spaceSize := Array new:nSpaces.
1 to:nSpaces do:[:i |
(spaceInfos at:i) flags:(stream nextUnsignedLongMSB:msb).
].
nSpaces+1 to:32 do:[:i | stream nextUnsignedLongMSB:msb].
1 to:nSpaces do:[:i |
(spaceInfos at:i) start:(stream nextUnsignedLongMSB:msb).
].
nSpaces+1 to:32 do:[:i | stream nextUnsignedLongMSB:msb].
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 + 4096).
].
1 to:nSpaces do:[:i |
(spaceInfos at:i) end:((spaceInfos at:i) start + (spaceInfos at:i) size - 1).
].
1 to:nSpaces do:[:i |
(spaceInfos at:i) imageBase:(stream position).
stream skip:((spaceInfos at:i) size).
].
"/ registration
self readRegistrationEntries.
self readSymbolEntries.
self readGlobalEntries.
self readUGlobalEntries.
"/struct basicImageHeader {
"/ char h_execCmd[256];
"/
"/ int h_orderWord;
"/ char h_magic[8];
"/ int h_version;
"/ int h_timeStamp;
"/ char h_ptrSize;
"/ char h_filler1[7];
"/ int h_intSize;
"/ int h_snapID;
"/ INT h_last_util_addr;
"/ INT h_hiText_addr;
"/ INT h_flags;
"/ char h_infoPrinting;
"/ char h_debugPrinting;
"/ char h_filler2[6];
"/
"/ /*
"/ * these are to verify compatibility of the image with
"/ * myself ...
"/ * this is now obsolete.
"/ */
"/ INT h_lowData, h_hiData;
"/
"/ /*
"/ * base address of character- and characterTable slots
"/ */
"/ INT h_charSlots;
"/ INT h_charTableSlots;
"/
"/#if HEADER_VERSION >= 8
"/ /*
"/ * the fixBase (VMDATA address)
"/ */
"/ INT h_fixMemStart;
"/ INT h_fixMemEnd;
"/ INT h_symMemStart;
"/ INT h_symMemEnd;
"/
"/ INT h_vmDataAddr;
"/#endif
"/
"/ INT h_sharedMethodCode[128];
"/ INT h_sharedBlockCode[128];
"/
"/ /*
"/ * space needed to restore contexts
"/ */
"/ INT h_nContexts;
"/ INT h_contextSpace;
"/
"/ /*
"/ * number of class registration info records
"/ */
"/ INT h_nRegistered;
"/
"/#if HEADER_VERSION >= 8
"/ /*
"/ * reserved slots, for future versions
"/ * (can add additional info, without affecting position of following stuff)
"/ * If you add slots, you MUST DECREMENT the fillcount.
"/ */
"/# if HEADER_VERSION >= 9
"/ INT h_symbolsSeqNr;
"/ INT h_reserved[31];
"/# else
"/ INT h_reserved[32];
"/# endif
"/#endif
"/
"/ /*
"/ * number of spaces, base and size of each
"/ */
"/ INT h_nSpaces;
"/ INT h_spaceFlags[MAXSPACES];
"/ INT h_spaceBase[MAXSPACES];
"/ INT h_spaceSize[MAXSPACES];
"/
"/ /*
"/ * here come nSpaces object spaces
"/ */
"/
"/ /*
"/ * here comes registration info
"/ */
"/
"/ /*
"/ * here come nSymbols symbolEntries
"/ * followed by a zero/zero entry
"/ */
"/
"/ /*
"/ * here come nGlobal globalEntries
"/ * followed by a zero/zero entry
"/ */
"/
"/ /*
"/ * here come nUnnamedGlobal globalEntries
"/ * followed by a zero/zero entry
"/ */
"/
"/ /*
"/ * here come stack contexts
"/ */
"/};
!
readRegistrationEntries
|classNameSize|
[
classNameSize := stream nextUnsignedLongMSB:msb.
classNameSize ~~ 0
] whileTrue:[
|className flags moduleTimestamp signature nMethods nBlocks oldLitRefs nLitRefs
oldConstTable nConsts|
className := (stream next:classNameSize) asString.
stream next. "/ 0-byte
flags := stream nextUnsignedLongMSB:msb.
moduleTimestamp := stream nextUnsignedLongMSB:msb.
signature := stream nextUnsignedLongMSB:msb.
nMethods := stream nextUnsignedLongMSB:msb.
nMethods timesRepeat:[ stream nextUnsignedLongMSB:msb ].
nBlocks := stream nextUnsignedLongMSB:msb.
nBlocks timesRepeat:[ stream nextUnsignedLongMSB:msb ].
oldLitRefs := stream nextUnsignedLongMSB:msb.
nLitRefs := stream nextUnsignedLongMSB:msb.
nLitRefs timesRepeat:[ stream nextUnsignedLongMSB:msb ].
stream nextUnsignedLongMSB:msb. "/ 0-litRef
oldConstTable := stream nextUnsignedLongMSB:msb.
nConsts := stream nextUnsignedLongMSB:msb.
nConsts timesRepeat:[ stream nextUnsignedLongMSB:msb ].
Transcript showCR:className.
].
!
readSymbolEntries
|refPointer theSymbol|
symbolEntries := OrderedCollection new.
[
refPointer := stream nextUnsignedLongMSB:msb.
theSymbol := stream nextUnsignedLongMSB:msb.
theSymbol ~~ 0
] whileTrue:[
symbolEntries add:(theSymbol -> refPointer).
].
symbolEntries := symbolEntries asArray
!
readUGlobalEntries
|refPointer theValue|
[
refPointer := stream nextUnsignedLongMSB:msb.
theValue := stream nextUnsignedLongMSB:msb.
refPointer ~~ 0
] whileTrue
! !
!SnapShotImageMemory::SpaceInfo methodsFor:'accessing'!
end
"return the value of the instance variable 'end' (automatically generated)"
^ end!
end:something
"set the value of the instance variable 'end' (automatically generated)"
end := something.!
flags
"return the value of the instance variable 'flags' (automatically generated)"
^ flags!
flags:something
"set the value of the instance variable 'flags' (automatically generated)"
flags := something.!
imageBase
"return the value of the instance variable 'imageBase' (automatically generated)"
^ imageBase!
imageBase:something
"set the value of the instance variable 'imageBase' (automatically generated)"
imageBase := something.!
size
"return the value of the instance variable 'size' (automatically generated)"
^ size!
size:something
"set the value of the instance variable 'size' (automatically generated)"
size := something.!
start
"return the value of the instance variable 'start' (automatically generated)"
^ start!
start:something
"set the value of the instance variable 'start' (automatically generated)"
start := something.! !
!SnapShotImageMemory::ImageObject methodsFor:'accessing'!
bits
"return the value of the instance variable 'bits' (automatically generated)"
^ bits!
bits:something
"set the value of the instance variable 'bits' (automatically generated)"
bits := something.!
classRef
"return the value of the instance variable 'classRef' (automatically generated)"
^ classRef!
classRef:something
"set the value of the instance variable 'classRef' (automatically generated)"
classRef := something.!
size
"return the value of the instance variable 'size' (automatically generated)"
^ size!
size:something
"set the value of the instance variable 'size' (automatically generated)"
size := something.! !
!SnapShotImageMemory::ImageObject methodsFor:'queries'!
isImageBehavior
|flags|
flags := self flagsSlot.
(SnapShotImageMemory isSmallIntegerOOP:flags) ifFalse:[
self halt
].
flags := flags bitShift:-1.
^ flags bitTest:Behavior flagBehavior
!
isImageBytes
self halt.
!
isImageString
self halt.
!
isImageSymbol
self halt.
! !
!SnapShotImageMemory::ImageClassObject methodsFor:'accessing - slots'!
categorySlot
^ self at:8
!
classFilenameSlot
^ self at:12
!
classVarsSlot
^ self at:9
!
commentSlot
^ self at:10
!
flagsSlot
^ self at:2
!
flagsValue
|flags|
flags := self flagsSlot.
(SnapShotImageMemory isSmallIntegerOOP:flags) ifFalse:[
self halt
].
^ flags bitShift:-1.
!
instSizeSlot
^ self at:5
!
instVarsSlot
^ self at:6
!
methodDictionarySlot
^ self at:3
!
nameSlot
^ self at:7
!
packageSlot
^ self at:13
!
revisionSlot
^ self at:14
!
superClassSlot
^ self at:1
! !
!SnapShotImageMemory class methodsFor:'documentation'!
version
^ '$Header$'
! !