SnapShotImage.st
author Claus Gittinger <cg@exept.de>
Fri, 26 Oct 2001 16:46:11 +0200
changeset 1515 ef8a4a252a99
parent 1483 f27b959005c9
child 1560 453fa7d78437
permissions -rw-r--r--
checkin from browser
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
     1
"{ Package: 'stx:libtool2' }"
1415
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
1482
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
     4
	instanceVariableNames:'memory globals cachedBehaviors'
1415
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
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    10
!SnapShotImage class methodsFor:'documentation'!
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    11
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    12
documentation
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    13
"
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    14
    I simulate a Smalltalk environment as present in a snapshot image.
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    15
    My protocol mimics the NameSpace (i.e. class-environment) protocol,
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    16
    and I can be used as a Browsers environment, in order to open a
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    17
    browser into an old snapShot image (st.img - file).
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    18
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    19
    I am not used directly; instead, via the SystemBrowsers entry:
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    20
        SystemBrowser openOnSnapShotImage:'/export/home/cg/work/stx/projects/smalltalk/st.img'
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    21
1483
f27b959005c9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1482
diff changeset
    22
        SystemBrowser openOnSnapShotImage:'st.img'
f27b959005c9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1482
diff changeset
    23
f27b959005c9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1482
diff changeset
    24
    This enables a standard browser to peek into a snapshot image... (well, almost)
f27b959005c9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1482
diff changeset
    25
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    26
    [author:]
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    27
        Claus Gittinger
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    28
"
1470
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    29
!
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    30
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    31
examples
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    32
"
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    33
    |i m|
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    34
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    35
    i := self for:'st.img'.
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    36
    m := i memory.
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    37
    m  fetchObjectAt:16r38000000
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    38
"
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    39
! !
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
!SnapShotImage class methodsFor:'instance creation'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
    ^ self new for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
1470
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    47
!SnapShotImage methodsFor:'accessing'!
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    48
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    49
memory
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    50
    ^ memory
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    51
! !
7b20694c92e7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1448
diff changeset
    52
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
!SnapShotImage methodsFor:'private'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
fetchGlobals
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    56
    globals := IdentityDictionary new.
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
    memory globalEntries do:[:eachEntry |
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    58
        |nameSymRef valRef nameSym value|
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    60
        nameSymRef := eachEntry key.
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    61
        valRef := eachEntry value.
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    62
        nameSymRef isImageSymbol ifFalse:[self halt].
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    64
        nameSym := (memory printStringOfSymbol:nameSymRef) asSymbol.
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    65
        globals at:nameSym put:valRef
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
for:aFilename
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
    memory := SnapShotImageMemory for:aFilename.
1418
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
    71
    memory image:self.
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    72
    memory readHeader
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
    73
! !
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
!SnapShotImage methodsFor:'smalltalk protocol'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
allClassesDo:aBlock
1482
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    78
    cachedBehaviors isNil ifTrue:[
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    79
        cachedBehaviors := OrderedCollection new.
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    80
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    81
        self keysAndValuesDo:[:key :valRef |
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    82
            valRef isInteger ifFalse:[
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    83
                valRef ~~ true ifTrue:[
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    84
                    valRef ~~ false ifTrue:[
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    85
                        valRef notNil ifTrue:[
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    86
                            valRef isImageBehavior ifTrue:[
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    87
                                cachedBehaviors add:valRef
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    88
                            ]
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    89
                        ]
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    90
                    ]
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    91
                ]
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
    92
            ]
1482
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    93
        ].
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
    ].
1482
13fe76a0986b more caching (faster now)
Claus Gittinger <cg@exept.de>
parents: 1476
diff changeset
    95
    cachedBehaviors do:aBlock
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
1418
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
    98
allClassesInCategory:aCategory
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
    99
    |coll|
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   100
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   101
    coll := OrderedCollection new.
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   102
    self allClassesInCategory:aCategory do:[:aClass |
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   103
        coll add:aClass
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   104
    ].
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
   105
    ^ coll
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
   106
!
1418
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   107
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   108
allClassesInCategory:aCategory do:aBlock
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   109
    "evaluate the argument, aBlock for all classes in the aCategory;
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   110
     The order of the classes is not defined."
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   111
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   112
    aCategory notNil ifTrue:[
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   113
        self allClassesDo:[:aClass |
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   114
            aClass isMeta ifFalse:[
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   115
                (aClass category = aCategory) ifTrue:[
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   116
                    aBlock value:aClass
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   117
                ]
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   118
            ]
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   119
        ]
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
   120
    ]
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
   121
!
1418
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   122
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
   123
at:aKey
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
   124
    globals isNil ifTrue:[
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
   125
        self fetchGlobals
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
   126
    ].
1476
b6b941f16e63 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1470
diff changeset
   127
    ^ globals at:aKey ifAbsent:nil
1417
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
   128
!
28d6026fe30c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1415
diff changeset
   129
1418
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   130
at:aKey ifAbsent:exceptionValue
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   131
    globals isNil ifTrue:[
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   132
        self fetchGlobals
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   133
    ].
1448
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
   134
    ^ globals at:aKey ifAbsent:exceptionValue
42ec8770d09f comment added
Claus Gittinger <cg@exept.de>
parents: 1422
diff changeset
   135
!
1418
7466259d8bb5 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1417
diff changeset
   136
1415
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
keysAndValuesDo:aTwoArgBlock
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
    globals isNil ifTrue:[
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
        self fetchGlobals
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
    ].
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
    globals keysAndValuesDo:aTwoArgBlock
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
! !
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
!SnapShotImage class methodsFor:'documentation'!
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
version
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
    ^ '$Header$'
77abca16cfa3 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
! !