*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Mon, 18 Feb 2002 17:21:04 +0100
changeset 1551 6d0cb201dc8a
parent 1550 6ca23298d888
child 1552 298232956ca8
*** empty log message ***
SnapShotImageMemory.st
--- a/SnapShotImageMemory.st	Fri Feb 15 14:04:45 2002 +0100
+++ b/SnapShotImageMemory.st	Mon Feb 18 17:21:04 2002 +0100
@@ -293,25 +293,18 @@
 !SnapShotImageMemory methodsFor:'private'!
 
 allClassesDo:aBlock
-    self allGlobalKeysDo:[:eachKey |
+    globalEntries do:[:eachGlobal |
         |val|
 
-        val := self at:eachKey.
-        val isBehavior ifTrue:[
+        val := eachGlobal value.
+        (val notNil     
+        and:[(val isKindOf:ImageHeader)
+        and:[val isImageBehavior]]) ifTrue:[
             aBlock value:val
-        ] ifFalse:[
-            self halt.
         ].
     ].
 !
 
-allGlobalKeysDo:aBlock
-    globalEntries isNil ifTrue:[
-        self readHeader.
-        self readGlobals.
-    ].
-!
-
 fetchByteArrayFor:aByteArrayRef
     |nBytes|
 
@@ -3820,6 +3813,40 @@
     ]
 ! !
 
+!SnapShotImageMemory::ImageClassObject methodsFor:'namespace protocol'!
+
+allClassesDo:aBlock
+    |prefix|
+
+    self isNameSpace ifFalse:[ self error ].
+    prefix := self name , '::'.
+
+    memory image allClassesDo:[:cls |
+        (cls name startsWith:prefix) ifTrue:[
+            aBlock value:cls
+        ]
+    ]
+!
+
+at:aKey
+    |fullName|
+
+    aKey isSymbol ifFalse:[
+        ^ super at:aKey
+    ].
+
+    self isNameSpace ifFalse:[ self error ].
+    fullName := self name , '::' , aKey.
+    ^ memory image at:fullName asSymbol
+! !
+
+!SnapShotImageMemory::ImageClassObject methodsFor:'printing'!
+
+printOn:aStream
+    aStream nextPutAll:'img-'.
+    aStream nextPutAll:self name.
+! !
+
 !SnapShotImageMemory::ImageClassObject methodsFor:'queries'!
 
 categories
@@ -3875,6 +3902,16 @@
 "/    ^ classRef classRef name = 'Metaclass'
 !
 
+isNameSpace
+    "return true, if this is a nameSpace."
+
+    |superclass|
+
+    superclass := self superclass.
+    ^ superclass notNil
+      and:[ superclass name = 'NameSpace' ].
+!
+
 isPrivate
     ^ classRef isPrivateMeta 
 !
@@ -3895,6 +3932,12 @@
     ^ (self flags bitAnd:Behavior maskIndexType) == Behavior flagSignedWords.
 !
 
+isTopLevelNamespace
+    "return true, if this is a nameSpace."
+
+    ^ self isNameSpace
+!
+
 isVariable
     ^ (self flags bitAnd:Behavior maskIndexType) ~= 0.
 !
@@ -3911,13 +3954,13 @@
     |env name idx nsName|
 
 "/    (env := self environment) notNil ifTrue:[^ env].
-    env := Smalltalk. "/ default
+    env := memory image at:#Smalltalk. "/ default
     name := self name.
     idx := name lastIndexOf:$:.
     idx ~~ 0 ifTrue:[
         (name at:idx-1) == $: ifTrue:[
             nsName := name copyTo:(idx - 2).
-            env := Smalltalk at:nsName asSymbol.
+            env := memory image at:nsName asSymbol.
         ]
     ].
     ^ env