#BUGFIX by cg
authorClaus Gittinger <cg@exept.de>
Fri, 16 Sep 2016 13:05:17 +0200
changeset 3326 4ecde59f7563
parent 3325 8ce2df5fc1f7
child 3327 dd50ec5f3c86
#BUGFIX by cg class: SnapShotImageMemory changed: #fetchObjectAt:
SnapShotImageMemory.st
--- a/SnapShotImageMemory.st	Thu Sep 15 21:34:37 2016 +0200
+++ b/SnapShotImageMemory.st	Fri Sep 16 13:05:17 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "{ Package: 'stx:libtool2' }"
 
 "{ NameSpace: Smalltalk }"
@@ -45,6 +47,13 @@
 	privateIn:SnapShotImageMemory
 !
 
+SnapShotImageMemory::ImageHeader variableWordSubclass:#ImageWordObject
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:SnapShotImageMemory
+!
+
 Object subclass:#SpaceInfo
 	instanceVariableNames:'start end size flags imageBase'
 	classVariableNames:''
@@ -238,28 +247,14 @@
 "/Transcript show:'#'.
 "/Transcript show:((ByteArray new:nBytes-1) replaceFrom:1 to:nBytes-1 with:o startingAt:1) asString.
 "/Transcript cr.
-
-    ] ifFalse:[
-        (indexTypeFlags = Behavior flagNotIndexed) ifFalse:[ 
-            (indexTypeFlags ~= Behavior flagPointers) ifTrue:[
-                (indexTypeFlags ~= Behavior flagWeakPointers) ifTrue:[
-                    self halt 
-                ]
-            ].
-        ].
-
-        nInsts := (size - hdrSize) // intSize.
-        (flags bitTest:Behavior flagBehavior)
-        "/ classRef isImageBehavior 
-        ifTrue:[
-            o := ImageClassObject new:nInsts.
-        ] ifFalse:[
-            (flags bitTest:Behavior flagMethod) ifTrue:[
-                o := ImageMethodObject new:nInsts.
-            ] ifFalse:[
-                o := ImageObject new:nInsts.
-            ]
-        ].
+        ^ o
+    ].
+    (indexTypeFlags = Behavior flagWords) ifTrue:[
+        |nWords|
+        
+        nBytes := (size - hdrSize).
+        nWords := nBytes//2.
+        o := ImageWordObject new:nWords.
         o memory:self.
         o address:baseAddr.
         o classRef:classRef.
@@ -268,11 +263,49 @@
         o bits:bits.
         addrToObjectMapping at:(baseAddr bitShift:-2) put:o.
 
-        1 to:nInsts do:[:idx |
-            o at:idx put:(fetchINT value).
+        1 to:nWords do:[:idx |
+            o at:idx put:(stream nextUnsignedInt16MSB:msb).
+            addr := addr + 2.
+        ].
+
+"/Transcript show:'#'.
+"/Transcript show:((ByteArray new:nBytes-1) replaceFrom:1 to:nBytes-1 with:o startingAt:1) asString.
+"/Transcript cr.
+        ^ o
+    ].
+    
+    (indexTypeFlags = Behavior flagNotIndexed) ifFalse:[ 
+        (indexTypeFlags ~= Behavior flagPointers) ifTrue:[
+            (indexTypeFlags ~= Behavior flagWeakPointers) ifTrue:[
+                self halt 
+            ]
+        ].
+    ].
+
+    nInsts := (size - hdrSize) // intSize.
+    (flags bitTest:Behavior flagBehavior)
+    "/ classRef isImageBehavior 
+    ifTrue:[
+        o := ImageClassObject new:nInsts.
+    ] ifFalse:[
+        (flags bitTest:Behavior flagMethod) ifTrue:[
+            o := ImageMethodObject new:nInsts.
+        ] ifFalse:[
+            o := ImageObject new:nInsts.
+        ]
+    ].
+    o memory:self.
+    o address:baseAddr.
+    o classRef:classRef.
+    "/ size > 8000 ifTrue:[self halt].
+    o byteSize:size.
+    o bits:bits.
+    addrToObjectMapping at:(baseAddr bitShift:-2) put:o.
+
+    1 to:nInsts do:[:idx |
+        o at:idx put:(fetchINT value).
 "/            o at:idx put:(self fetchObjectAt:(self fetchUnboxedIntegerAt:addr)).
-            addr := addr + ptrSize.
-        ]
+        addr := addr + ptrSize.
     ].
     ^ o
 !
@@ -4260,6 +4293,12 @@
     ^ false
 ! !
 
+!SnapShotImageMemory::ImageWordObject methodsFor:'queries'!
+
+size
+    ^ byteSize // 2
+! !
+
 !SnapShotImageMemory::SpaceInfo methodsFor:'accessing'!
 
 end