equal
deleted
inserted
replaced
1 "{ Package: 'stx:libtool' }" |
1 "{ Package: 'stx:libtool2' }" |
2 |
2 |
3 Object subclass:#SnapShotImage |
3 Object subclass:#SnapShotImage |
4 instanceVariableNames:'memory globals' |
4 instanceVariableNames:'memory globals' |
5 classVariableNames:'' |
5 classVariableNames:'' |
6 poolDictionaries:'' |
6 poolDictionaries:'' |
7 category:'System-Support' |
7 category:'System-Support' |
8 ! |
8 ! |
9 |
9 |
|
10 !SnapShotImage class methodsFor:'documentation'! |
|
11 |
|
12 documentation |
|
13 " |
|
14 I simulate a Smalltalk environment as present in a snapshot image. |
|
15 My protocol mimics the NameSpace (i.e. class-environment) protocol, |
|
16 and I can be used as a Browsers environment, in order to open a |
|
17 browser into an old snapShot image (st.img - file). |
|
18 |
|
19 I am not used directly; instead, via the SystemBrowsers entry: |
|
20 SystemBrowser openOnSnapShotImage:'/export/home/cg/work/stx/projects/smalltalk/st.img' |
|
21 |
|
22 [author:] |
|
23 Claus Gittinger |
|
24 " |
|
25 ! ! |
10 |
26 |
11 !SnapShotImage class methodsFor:'instance creation'! |
27 !SnapShotImage class methodsFor:'instance creation'! |
12 |
28 |
13 for:aFilename |
29 for:aFilename |
14 ^ self new for:aFilename |
30 ^ self new for:aFilename |
31 ! |
47 ! |
32 |
48 |
33 for:aFilename |
49 for:aFilename |
34 memory := SnapShotImageMemory for:aFilename. |
50 memory := SnapShotImageMemory for:aFilename. |
35 memory image:self. |
51 memory image:self. |
36 memory readHeader! ! |
52 memory readHeader |
|
53 ! ! |
37 |
54 |
38 !SnapShotImage methodsFor:'smalltalk protocol'! |
55 !SnapShotImage methodsFor:'smalltalk protocol'! |
39 |
56 |
40 allClassesDo:aBlock |
57 allClassesDo:aBlock |
41 self keysAndValuesDo:[:key :valRef | |
58 self keysAndValuesDo:[:key :valRef | |
58 |
75 |
59 coll := OrderedCollection new. |
76 coll := OrderedCollection new. |
60 self allClassesInCategory:aCategory do:[:aClass | |
77 self allClassesInCategory:aCategory do:[:aClass | |
61 coll add:aClass |
78 coll add:aClass |
62 ]. |
79 ]. |
63 ^ coll! |
80 ^ coll |
|
81 ! |
64 |
82 |
65 allClassesInCategory:aCategory do:aBlock |
83 allClassesInCategory:aCategory do:aBlock |
66 "evaluate the argument, aBlock for all classes in the aCategory; |
84 "evaluate the argument, aBlock for all classes in the aCategory; |
67 The order of the classes is not defined." |
85 The order of the classes is not defined." |
68 |
86 |
72 (aClass category = aCategory) ifTrue:[ |
90 (aClass category = aCategory) ifTrue:[ |
73 aBlock value:aClass |
91 aBlock value:aClass |
74 ] |
92 ] |
75 ] |
93 ] |
76 ] |
94 ] |
77 ]! |
95 ] |
|
96 ! |
78 |
97 |
79 at:aKey |
98 at:aKey |
80 globals isNil ifTrue:[ |
99 globals isNil ifTrue:[ |
81 self fetchGlobals |
100 self fetchGlobals |
82 ]. |
101 ]. |
85 |
104 |
86 at:aKey ifAbsent:exceptionValue |
105 at:aKey ifAbsent:exceptionValue |
87 globals isNil ifTrue:[ |
106 globals isNil ifTrue:[ |
88 self fetchGlobals |
107 self fetchGlobals |
89 ]. |
108 ]. |
90 ^ globals at:aKey ifAbsent:exceptionValue! |
109 ^ globals at:aKey ifAbsent:exceptionValue |
|
110 ! |
91 |
111 |
92 keysAndValuesDo:aTwoArgBlock |
112 keysAndValuesDo:aTwoArgBlock |
93 globals isNil ifTrue:[ |
113 globals isNil ifTrue:[ |
94 self fetchGlobals |
114 self fetchGlobals |
95 ]. |
115 ]. |