The Trunk: System-eem.1021.mcz

Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.1021.mcz

==================== Summary ====================

Name: System-eem.1021
Author: eem
Time: 2 May 2018, 1:39:55.407326 pm
UUID: 727d275e-a337-4208-9616-f887d8fd4576
Ancestors: System-eem.1020

Move more NativeImageSegment methods up to ImageSegment.  Provide a hack accessor for testing that a segment can be loaded (forFile:outPointers:, which may get deleted once 64-bit native image segments work).

=============== Diff against System-eem.1020 ===============

Item was added:
+ ----- Method: ImageSegment class>>folder (in category 'fileIn/Out') -----
+ folder
+       | im |
+       "Full path name of segments folder.  Be sure to duplicate and rename the folder when you duplicate and rename an image.  Is $_ legal in all file systems?"
+
+       im := Smalltalk imageName.
+       ^ (im copyFrom: 1 to: im size - 6 "'.image' size"), '_segs'!

Item was added:
+ ----- Method: ImageSegment>>errorWrongState (in category 'testing') -----
+ errorWrongState
+
+       ^ self error: 'wrong state'!

Item was added:
+ ----- Method: ImageSegment>>forFile:outPointers: (in category 'testing') -----
+ forFile: aFileName outPointers: outPointerArray
+       "An accessor for testing to set up a new image segment to be in a state to load from aFileName.  After this send install to load."
+       fileName := aFileName.
+       state := #onFile.
+       outPointers := outPointerArray!

Item was added:
+ ----- Method: ImageSegment>>install (in category 'read/write segment') -----
+ install
+       "This operation retrieves the segment if necessary from file storage, installs it in memory, and replaces (using become:) all the root stubs with the reconstructed roots of the segment."
+
+       | allObjectsInSegment newRoots |
+       state = #onFile ifTrue: [self readFromFile].
+       state = #onFileWithSymbols ifTrue:
+               [self readFromFileWithSymbols].
+       (state = #active) | (state = #imported) ifFalse: [self errorWrongState].
+       allObjectsInSegment := self loadSegmentFrom: segment outPointers: outPointers.
+       newRoots := allObjectsInSegment first.
+       self checkAndReportLoadError.
+       (state = #imported "just came in from exported file" or: [arrayOfRoots isNil "testing..."])
+               ifTrue: [arrayOfRoots := newRoots]
+               ifFalse: [arrayOfRoots elementsForwardIdentityTo: newRoots].
+       state := #inactive.
+       Beeper beepPrimitive!

Item was changed:
  ----- Method: ImageSegment>>loadSegmentFrom:outPointers: (in category 'read/write segment') -----
  loadSegmentFrom: segment outPointers: outPointers
        "Attempt to load the segment into memory (reify the objects in segment
         as real objects), using outPointers to bind references to objects not in the
         segment.  Answer a collection of all the objects in the segment."
        | segmentFormat |
+       (state == #imported or: [state == #active]) ifTrue:
+               [segmentFormat := self segmentFormatFrom: segment first.
-       state == #imported ifTrue:
-               [segmentFormat := segment first bitAnd: 16rFFFFFF.
                 segmentFormat = 6502 ifTrue:
                        [LegacyImageSegment adoptInstance: self.
                         ^self loadSegmentFrom: segment outPointers: outPointers].
                 segmentFormat = Smalltalk imageFormatVersion ifTrue:
                        [NativeImageSegment adoptInstance: self.
                         ^self loadSegmentFrom: segment outPointers: outPointers].
                 self error: 'no handling for format ', segmentFormat asString. ' in a ', Smalltalk imageFormatVersion asString, ' image.'].
        self subclassResponsibility!

Item was added:
+ ----- Method: ImageSegment>>localName (in category 'read/write segment') -----
+ localName
+       | segs ind sep |
+       "Return the current file name for this segment, a local name in the segments directory."
+
+       fileName ifNil: [^ nil].
+       "^ fileName"   
+
+       "The following is for backward compatibility.  Remove this part after June 2000.
+       Check if the fileName is a full path, and make it local.  Regardless of current or previous file system delimiter."
+
+       segs := self class folder copyLast: 4.  ":=segs"
+       ind := 1.
+       [ind := fileName findString: segs startingAt: ind+1 caseSensitive: false.
+               ind = 0 ifTrue: [^ fileName].
+               sep := fileName at: ind + (segs size).
+               sep isAlphaNumeric ] whileTrue.         "sep is letter or digit, not a separator"
+
+       ^ fileName := fileName copyFrom: ind+(segs size)+1 "delimiter" to: fileName size!

Item was added:
+ ----- Method: ImageSegment>>readFromFile (in category 'read/write segment') -----
+ readFromFile
+       "Read in a simple segment.  Use folder of this image, even if remembered as previous location of this image"
+
+       | ff realName |
+       realName := self class folder, FileDirectory slash, self localName.
+       ff := FileStream readOnlyFileNamed: realName.
+       segment := ff nextWordsInto: (WordArrayForSegment new: ff size//4).
+       ff close.
+       state := #active!

Item was added:
+ ----- Method: ImageSegment>>segmentFormatFrom: (in category 'private') -----
+ segmentFormatFrom: a32BitWord
+       "The first two words of a segment array contain the image format version of the system upon which the segment was generated, along with a top byte that is either $d or $s (from the 'does' in #doesNotUnderstand:).  But this may be encoded either in big-endian or little-endian format.  Since endianness may or may not have been changed, determining what the segment format is takes care."
+       | msc lsc |
+       msc := Character value: ((a32BitWord bitShift: -24) bitAnd: 255).
+       lsc := Character value: (a32BitWord bitAnd: 255).
+       (('ds' includes: msc)
+        and: ['ds' includes: lsc]) ifTrue:
+               [self error: 'ambiguous segment format'].
+       ('ds' includes: msc) ifTrue:
+               [^a32BitWord bitAnd: 16rFFFFFF].
+       ^((a32BitWord bitShift: -24) bitAnd: 16rFF)
+       + ((a32BitWord bitShift: -8) bitAnd: 16rFF00)
+       + ((a32BitWord bitShift: 8) bitAnd: 16rFF0000)!

Item was added:
+ ----- Method: LegacyImageSegment>>aComment (in category 'compact classes') -----
+ aComment
+       "Compact classes are a potential problem because a pointer to the class would not ordinarily show up in the outPointers.  We add the classes of all compact classes to outPointers, both for local and export segments.
+       Compact classes are never allowed as roots.  No compact class may be in an Environment that is written out to disk.  (In local segments, the compact classes array should never have an ImageSegmentRootStub in it.  For export, fileIn the class first, then load a segment with instances of it.  The fileIn code can be pasted onto the front of the .extSeg file)
+       For local segments, a class may become compact while its instances are out on the disk.  Or it may become un-compact.  A compact class may change shape while some of its instances are on disk.  All three cases go through (ClassDescription updateInstancesFrom:).  If it can't rule out an instance being in the segment, it reads it in to fix the instances. 
+       See Behavior.becomeCompact for the rules on Compact classes.  Indexes may not be reused.  This is so that an incoming export segment has its index available.  (Changes may be needed in the way indexes are assigned.)
+       For export segments, a compact class may have a different shape.  The normal class reshape mechanism will catch this.  During the installation of the segment, objects will have the wrong version of their class momentarily.  We will change them back before we get caught.
+       For export segments, the last two items in outPointers are the number 1717 and an array of the compact classes used in this segment.  (The classes in the array are converted from DiskProxies by SmartRefStream.)  If that class is not compact in the new image, the instances are recopied.
+       "!

Item was removed:
- ----- Method: NativeImageSegment class>>folder (in category 'fileIn/Out') -----
- folder
-       | im |
-       "Full path name of segments folder.  Be sure to duplicate and rename the folder when you duplicate and rename an image.  Is $_ legal in all file systems?"
-
-       im := Smalltalk imageName.
-       ^ (im copyFrom: 1 to: im size - 6 "'.image' size"), '_segs'!

Item was changed:
  ----- Method: NativeImageSegment>>aComment (in category 'compact classes') -----
  aComment
+       "Spur does not use compact classes, so an effort has been made to excise their use from the code.  The previous comment was:
-       "Spur does not use compact classes, so an effort has been made to excise their use from the code.  Thew previous comment was:

        Compact classes are a potential problem because a pointer to the class would not ordinarily show up in the outPointers.  We add the classes of all compact classes to outPointers, both for local and export segments.
        Compact classes are never allowed as roots.  No compact class may be in an Environment that is written out to disk.  (In local segments, the compact classes array should never have an ImageSegmentRootStub in it.  For export, fileIn the class first, then load a segment with instances of it.  The fileIn code can be pasted onto the front of the .extSeg file)
        For local segments, a class may become compact while its instances are out on the disk.  Or it may become un-compact.  A compact class may change shape while some of its instances are on disk.  All three cases go through (ClassDescription updateInstancesFrom:).  If it can't rule out an instance being in the segment, it reads it in to fix the instances. 
        See Behavior.becomeCompact for the rules on Compact classes.  Indexes may not be reused.  This is so that an incoming export segment has its index available.  (Changes may be needed in the way indexes are assigned.)
        For export segments, a compact class may have a different shape.  The normal class reshape mechanism will catch this.  During the installation of the segment, objects will have the wrong version of their class momentarily.  We will change them back before we get caught.
+       For export segments, the last two items in outPointers are the number 1717 and an array of the compact classes used in this segment.  (The classes in the array are converted from DiskProxies by SmartRefStream.)  If that class is not compact in the new image, the instances are recopied."!
-       For export segments, the last two items in outPointers are the number 1717 and an array of the compact classes used in this segment.  (The classes in the array are converted from DiskProxies by SmartRefStream.)  If that class is not compact in the new image, the instances are recopied.
-       "!

Item was removed:
- ----- Method: NativeImageSegment>>errorWrongState (in category 'testing') -----
- errorWrongState
-
-       ^ self error: 'wrong state'!

Item was removed:
- ----- Method: NativeImageSegment>>install (in category 'read/write segment') -----
- install
-       "This operation retrieves the segment if necessary from file storage, installs it in memory, and replaces (using become:) all the root stubs with the reconstructed roots of the segment."
-
-       | allObjectsInSegment newRoots |
-       state = #onFile ifTrue: [self readFromFile].
-       state = #onFileWithSymbols ifTrue:
-               [self readFromFileWithSymbols].
-       (state = #active) | (state = #imported) ifFalse: [self errorWrongState].
-       allObjectsInSegment := self loadSegmentFrom: segment outPointers: outPointers.
-       newRoots := allObjectsInSegment first.
-       self checkAndReportLoadError.
-       state = #imported "just came in from exported file"
-               ifTrue: [arrayOfRoots := newRoots]
-               ifFalse: [arrayOfRoots elementsForwardIdentityTo: newRoots].
-       state := #inactive.
-       Beeper beepPrimitive!

Item was removed:
- ----- Method: NativeImageSegment>>localName (in category 'read/write segment') -----
- localName
-       | segs ind sep |
-       "Return the current file name for this segment, a local name in the segments directory."
-
-       fileName ifNil: [^ nil].
-       "^ fileName"   
-
-       "The following is for backward compatibility.  Remove this part after June 2000.
-       Check if the fileName is a full path, and make it local.  Regardless of current or previous file system delimiter."
-
-       segs := self class folder copyLast: 4.  ":=segs"
-       ind := 1.
-       [ind := fileName findString: segs startingAt: ind+1 caseSensitive: false.
-               ind = 0 ifTrue: [^ fileName].
-               sep := fileName at: ind + (segs size).
-               sep isAlphaNumeric ] whileTrue.         "sep is letter or digit, not a separator"
-
-       ^ fileName := fileName copyFrom: ind+(segs size)+1 "delimiter" to: fileName size!

Item was removed:
- ----- Method: NativeImageSegment>>readFromFile (in category 'read/write segment') -----
- readFromFile
-       "Read in a simple segment.  Use folder of this image, even if remembered as previous location of this image"
-
-       | ff realName |
-       realName := self class folder, FileDirectory slash, self localName.
-       ff := FileStream readOnlyFileNamed: realName.
-       segment := ff nextWordsInto: (WordArrayForSegment new: ff size//4).
-       ff close.
-       state := #active!

Item was removed:
- ----- Method: NativeImageSegment>>segmentFormatFrom: (in category 'private') -----
- segmentFormatFrom: a32BitWord
-       "The first two words of a segment array contain the image format version of the system upon which the segment was generated, along with a top byte that is either $d or $s (from the 'does' in #doesNotUnderstand:).  But this may be encoded either in big-endian or little-endian format.  Since endianness may or may not have been changed, determining what the segment format is takes care."
-       | msc lsc |
-       msc := Character value: ((a32BitWord bitShift: -24) bitAnd: 255).
-       lsc := Character value: (a32BitWord bitAnd: 255).
-       (('ds' includes: msc)
-        and: ['ds' includes: lsc]) ifTrue:
-               [self error: 'ambiguous segment format'].
-       ('ds' includes: msc) ifTrue:
-               [^a32BitWord bitAnd: 16rFFFFFF].
-       ^((a32BitWord bitShift: -24) bitAnd: 16rFF)
-       + ((a32BitWord bitShift: -8) bitAnd: 16rFF00)
-       + ((a32BitWord bitShift: 8) bitAnd: 16rFF0000)!