[squeak-dev] The Trunk: System-eem.1021.mcz
Eliot Miranda
eliot.miranda at gmail.com
Wed May 2 21:18:31 UTC 2018
Hi All, FYI...
On Wed, May 2, 2018 at 1:40 PM, <commits at source.squeak.org> wrote:
> 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).
>
It turns out that, at least on Mac OS X, 64-bit image segments do work in
both the debug (-O0) and the assert (-O1) VMs, both Cog and Stack VMs, but
not in the production VM (-Os). Sigh...
=============== 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)!
>
>
>
--
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20180502/e8ff10d8/attachment.html>
More information about the Squeak-dev
mailing list
|