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 ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
     1
'From Smalltalk/X, Version:4.1.1 on 24-Okt-2000 at 12:50:49'                    !
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
     2
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ Package: 'cg:private' }"
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
Object subclass:#SnapShotImage
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:'memory globals'
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	category:'System-Support'
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
!SnapShotImage class methodsFor:'instance creation'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
    ^ self new for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!SnapShotImage methodsFor:'private'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
fetchGlobals
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    22
    globals := IdentityDictionary new.
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
    memory globalEntries do:[:eachEntry |
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    24
        |nameSymRef valRef nameSym value|
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    26
        nameSymRef := eachEntry key.
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    27
        valRef := eachEntry value.
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    28
        nameSymRef isImageSymbol ifFalse:[self halt].
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    30
        nameSym := (memory printStringOfSymbol:nameSymRef) asSymbol.
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    31
        globals at:nameSym put:valRef
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
    memory := SnapShotImageMemory for:aFilename.
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
    memory readHeader
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
!SnapShotImage methodsFor:'smalltalk protocol'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
allClassesDo:aBlock
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    43
    self keysAndValuesDo:[:key :valRef |
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    44
        valRef isInteger ifFalse:[
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    45
            valRef ~~ true ifTrue:[
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    46
                valRef ~~ false ifTrue:[
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    47
                    valRef notNil ifTrue:[
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    48
                        valRef isImageBehavior ifTrue:[
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    49
                            aBlock value:valRef
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    50
                        ]
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    51
                    ]
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    52
                ]
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    53
            ]
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
        ]
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    58
at:aKey
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    59
    globals isNil ifTrue:[
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    60
        self fetchGlobals
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    61
    ].
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    62
    ^ globals at:aKey
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    63
!
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    64
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
keysAndValuesDo:aTwoArgBlock
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    globals isNil ifTrue:[
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
        self fetchGlobals
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
    globals keysAndValuesDo:aTwoArgBlock
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
!SnapShotImage class methodsFor:'documentation'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
version
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
    ^ '$Header$'
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
! !