--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/SnapShotImageMemory.st Mon Oct 23 19:41:18 2000 +0200
@@ -0,0 +1,657 @@
+"{ 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$'
+! !