diff -r 77abca16cfa3 -r eec0911414fe SnapShotImageMemory.st
--- /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$'
+! !