class: SnapShotImageMemory
authorClaus Gittinger <cg@exept.de>
Tue, 04 Mar 2014 14:18:51 +0100
changeset 3089 994863569542
parent 3088 5a5e9b9b5138
child 3090 ef71554ea9e9
class: SnapShotImageMemory changed: #fetchObjectAt:
SnapShotImageMemory.st
--- a/SnapShotImageMemory.st	Tue Mar 04 13:52:42 2014 +0100
+++ b/SnapShotImageMemory.st	Tue Mar 04 14:18:51 2014 +0100
@@ -261,7 +261,7 @@
         o memory:self.
         o address:baseAddr.
         o classRef:classRef.
-size > 8000 ifTrue:[self halt].
+        "/ size > 8000 ifTrue:[self halt].
         o byteSize:size.
         o bits:bits.
         addrToObjectMapping at:(baseAddr bitShift:-2) put:o.
@@ -1323,7 +1323,7 @@
 
         ^ nil
     ].
-    self halt.
+    ^ nil
 ! !
 
 !SnapShotImageMemory::ImageObject methodsFor:'methodDictionary protocol'!
@@ -1613,10 +1613,25 @@
 !
 
 comment
-    |commentRef comment|
+    |commentRef comment stream string|
 
     commentRef := self commentSlot.
     commentRef isInteger ifTrue:[
+        (SnapShotImageMemory isSmallIntegerOOP:commentRef) ifTrue:[
+            "/ comment points into file.
+            stream := self sourceStream.
+            stream notNil ifTrue:[
+                Stream positionErrorSignal handle:[:ex |
+                    ^ nil
+                ] do:[
+                    stream position:(commentRef bitShift:-1).
+                    string := String readFrom:stream.
+                    stream close.
+                ].
+                ^ string
+            ].
+            ^ nil
+        ].
         commentRef := memory fetchObjectAt:commentRef.
     ].
     commentRef notNil ifTrue:[
@@ -4304,5 +4319,9 @@
 
 version
     ^ '$Header$'
+!
+
+version_CVS
+    ^ '$Header$'
 ! !