SnapShotImageMemory.st
changeset 1551 6d0cb201dc8a
parent 1550 6ca23298d888
child 1552 298232956ca8
equal deleted inserted replaced
1550:6ca23298d888 1551:6d0cb201dc8a
   291 ! !
   291 ! !
   292 
   292 
   293 !SnapShotImageMemory methodsFor:'private'!
   293 !SnapShotImageMemory methodsFor:'private'!
   294 
   294 
   295 allClassesDo:aBlock
   295 allClassesDo:aBlock
   296     self allGlobalKeysDo:[:eachKey |
   296     globalEntries do:[:eachGlobal |
   297         |val|
   297         |val|
   298 
   298 
   299         val := self at:eachKey.
   299         val := eachGlobal value.
   300         val isBehavior ifTrue:[
   300         (val notNil     
       
   301         and:[(val isKindOf:ImageHeader)
       
   302         and:[val isImageBehavior]]) ifTrue:[
   301             aBlock value:val
   303             aBlock value:val
   302         ] ifFalse:[
   304         ].
   303             self halt.
       
   304         ].
       
   305     ].
       
   306 !
       
   307 
       
   308 allGlobalKeysDo:aBlock
       
   309     globalEntries isNil ifTrue:[
       
   310         self readHeader.
       
   311         self readGlobals.
       
   312     ].
   305     ].
   313 !
   306 !
   314 
   307 
   315 fetchByteArrayFor:aByteArrayRef
   308 fetchByteArrayFor:aByteArrayRef
   316     |nBytes|
   309     |nBytes|
  3818     sc notNil ifTrue:[
  3811     sc notNil ifTrue:[
  3819         sc withAllSuperclassesDo:aBlock.
  3812         sc withAllSuperclassesDo:aBlock.
  3820     ]
  3813     ]
  3821 ! !
  3814 ! !
  3822 
  3815 
       
  3816 !SnapShotImageMemory::ImageClassObject methodsFor:'namespace protocol'!
       
  3817 
       
  3818 allClassesDo:aBlock
       
  3819     |prefix|
       
  3820 
       
  3821     self isNameSpace ifFalse:[ self error ].
       
  3822     prefix := self name , '::'.
       
  3823 
       
  3824     memory image allClassesDo:[:cls |
       
  3825         (cls name startsWith:prefix) ifTrue:[
       
  3826             aBlock value:cls
       
  3827         ]
       
  3828     ]
       
  3829 !
       
  3830 
       
  3831 at:aKey
       
  3832     |fullName|
       
  3833 
       
  3834     aKey isSymbol ifFalse:[
       
  3835         ^ super at:aKey
       
  3836     ].
       
  3837 
       
  3838     self isNameSpace ifFalse:[ self error ].
       
  3839     fullName := self name , '::' , aKey.
       
  3840     ^ memory image at:fullName asSymbol
       
  3841 ! !
       
  3842 
       
  3843 !SnapShotImageMemory::ImageClassObject methodsFor:'printing'!
       
  3844 
       
  3845 printOn:aStream
       
  3846     aStream nextPutAll:'img-'.
       
  3847     aStream nextPutAll:self name.
       
  3848 ! !
       
  3849 
  3823 !SnapShotImageMemory::ImageClassObject methodsFor:'queries'!
  3850 !SnapShotImageMemory::ImageClassObject methodsFor:'queries'!
  3824 
  3851 
  3825 categories
  3852 categories
  3826     |newList|
  3853     |newList|
  3827 
  3854 
  3873 isMeta
  3900 isMeta
  3874     ^ self size == (Metaclass instSize).
  3901     ^ self size == (Metaclass instSize).
  3875 "/    ^ classRef classRef name = 'Metaclass'
  3902 "/    ^ classRef classRef name = 'Metaclass'
  3876 !
  3903 !
  3877 
  3904 
       
  3905 isNameSpace
       
  3906     "return true, if this is a nameSpace."
       
  3907 
       
  3908     |superclass|
       
  3909 
       
  3910     superclass := self superclass.
       
  3911     ^ superclass notNil
       
  3912       and:[ superclass name = 'NameSpace' ].
       
  3913 !
       
  3914 
  3878 isPrivate
  3915 isPrivate
  3879     ^ classRef isPrivateMeta 
  3916     ^ classRef isPrivateMeta 
  3880 !
  3917 !
  3881 
  3918 
  3882 isPrivateMeta
  3919 isPrivateMeta
  3893 
  3930 
  3894 isSignedWords
  3931 isSignedWords
  3895     ^ (self flags bitAnd:Behavior maskIndexType) == Behavior flagSignedWords.
  3932     ^ (self flags bitAnd:Behavior maskIndexType) == Behavior flagSignedWords.
  3896 !
  3933 !
  3897 
  3934 
       
  3935 isTopLevelNamespace
       
  3936     "return true, if this is a nameSpace."
       
  3937 
       
  3938     ^ self isNameSpace
       
  3939 !
       
  3940 
  3898 isVariable
  3941 isVariable
  3899     ^ (self flags bitAnd:Behavior maskIndexType) ~= 0.
  3942     ^ (self flags bitAnd:Behavior maskIndexType) ~= 0.
  3900 !
  3943 !
  3901 
  3944 
  3902 isVisualStartable
  3945 isVisualStartable
  3909 
  3952 
  3910 nameSpace
  3953 nameSpace
  3911     |env name idx nsName|
  3954     |env name idx nsName|
  3912 
  3955 
  3913 "/    (env := self environment) notNil ifTrue:[^ env].
  3956 "/    (env := self environment) notNil ifTrue:[^ env].
  3914     env := Smalltalk. "/ default
  3957     env := memory image at:#Smalltalk. "/ default
  3915     name := self name.
  3958     name := self name.
  3916     idx := name lastIndexOf:$:.
  3959     idx := name lastIndexOf:$:.
  3917     idx ~~ 0 ifTrue:[
  3960     idx ~~ 0 ifTrue:[
  3918         (name at:idx-1) == $: ifTrue:[
  3961         (name at:idx-1) == $: ifTrue:[
  3919             nsName := name copyTo:(idx - 2).
  3962             nsName := name copyTo:(idx - 2).
  3920             env := Smalltalk at:nsName asSymbol.
  3963             env := memory image at:nsName asSymbol.
  3921         ]
  3964         ]
  3922     ].
  3965     ].
  3923     ^ env
  3966     ^ env
  3924 !
  3967 !
  3925 
  3968