SnapShotImage.st
author Claus Gittinger <cg@exept.de>
Mon, 23 Oct 2000 19:41:18 +0200
changeset 1416 eec0911414fe
parent 1415 77abca16cfa3
child 1417 28d6026fe30c
permissions -rw-r--r--
initial checkin
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'cg:private' }"
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
Object subclass:#SnapShotImage
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:'memory globals'
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	category:'System-Support'
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
!SnapShotImage class methodsFor:'instance creation'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
    ^ self new for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
!SnapShotImage methodsFor:'private'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
fetchGlobals
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
    memory globalEntries do:[:eachEntry |
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
        |pNameSym pVal nameSym value|
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
        pNameSym := eachEntry key.
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
        pVal := eachEntry value.
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
        nameSym := memory fetchObjectAt:pNameSym.
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
        value := memory fetchObjectAt:pVal.
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
        self halt.
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
    memory := SnapShotImageMemory for:aFilename.
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
    memory readHeader
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
!SnapShotImage methodsFor:'smalltalk protocol'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
allClassesDo:aBlock
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
    self keysAndValuesDo:[:key :val |
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
        val isBehavior ifTrue:[
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
            aBlock value:val
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
        ]
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
keysAndValuesDo:aTwoArgBlock
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
    globals isNil ifTrue:[
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
        self fetchGlobals
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    globals keysAndValuesDo:aTwoArgBlock
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
!SnapShotImage class methodsFor:'documentation'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
version
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
    ^ '$Header$'
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
! !