SnapShotImage.st
author Claus Gittinger <cg@exept.de>
Tue, 24 Oct 2000 13:17:22 +0200
changeset 1417 28d6026fe30c
parent 1415 77abca16cfa3
child 1418 7466259d8bb5
permissions -rw-r--r--
*** empty log message ***

'From Smalltalk/X, Version:4.1.1 on 24-Okt-2000 at 12:50:49'                    !

"{ Package: 'cg:private' }"

Object subclass:#SnapShotImage
	instanceVariableNames:'memory globals'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Support'
!


!SnapShotImage class methodsFor:'instance creation'!

for:aFilename
    ^ self new for:aFilename
! !

!SnapShotImage methodsFor:'private'!

fetchGlobals
    globals := IdentityDictionary new.
    memory globalEntries do:[:eachEntry |
        |nameSymRef valRef nameSym value|

        nameSymRef := eachEntry key.
        valRef := eachEntry value.
        nameSymRef isImageSymbol ifFalse:[self halt].

        nameSym := (memory printStringOfSymbol:nameSymRef) asSymbol.
        globals at:nameSym put:valRef
    ].
!

for:aFilename
    memory := SnapShotImageMemory for:aFilename.
    memory readHeader
! !

!SnapShotImage methodsFor:'smalltalk protocol'!

allClassesDo:aBlock
    self keysAndValuesDo:[:key :valRef |
        valRef isInteger ifFalse:[
            valRef ~~ true ifTrue:[
                valRef ~~ false ifTrue:[
                    valRef notNil ifTrue:[
                        valRef isImageBehavior ifTrue:[
                            aBlock value:valRef
                        ]
                    ]
                ]
            ]
        ]
    ].
!

at:aKey
    globals isNil ifTrue:[
        self fetchGlobals
    ].
    ^ globals at:aKey
!

keysAndValuesDo:aTwoArgBlock
    globals isNil ifTrue:[
        self fetchGlobals
    ].
    globals keysAndValuesDo:aTwoArgBlock
! !

!SnapShotImage class methodsFor:'documentation'!

version
    ^ '$Header$'
! !