Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.1376.mcz
==================== Summary ====================
Name: System-eem.1376
Author: eem
Time: 7 December 2022, 11:43:38.359701 am
UUID: de0ccd9b-825a-4e77-9d01-ea76e1220c40
Ancestors: System-ct.1375
Make sure image segment storage doesn't mistakenly enlarge outPointers beyond the implementation limit.
=============== Diff against System-ct.1375 ===============
Item was changed:
----- Method: NativeImageSegment>>copyFromRoots:sizeHint:areUnique: (in category 'read/write segment') -----
copyFromRoots: aRootArray sizeHint: segSizeHint areUnique: areUnique
"Copy a tree of objects into a WordArray segment. The copied objects in the segment are not in the normal Squeak space.
[1] For exporting a project. Objects were enumerated by ReferenceStream and aRootArray has them all.
[2] For exporting some classes. See copyFromRootsForExport:. (Caller must hold Symbols, or they will not get registered in the target system.)
[3] For 'local segments'. outPointers are kept in the image.
If this method yields a very small segment, it is because objects just below the roots are pointed at from the outside. (See findRogueRootsImSeg: for a *destructive* diagnostic of who is pointing in.)"
| segmentWordArray outPointerArray segSize rootSet uniqueRoots |
aRootArray ifNil: [self errorWrongState].
uniqueRoots := areUnique
ifTrue: [aRootArray]
ifFalse: [rootSet := IdentitySet new: aRootArray size * 3.
uniqueRoots := OrderedCollection new.
1 to: aRootArray size do: [:ii | "Don't include any roots twice"
(rootSet includes: (aRootArray at: ii))
ifFalse: [
uniqueRoots addLast: (aRootArray at: ii).
rootSet add: (aRootArray at: ii)]
ifTrue: [userRootCnt ifNotNil: ["adjust the count"
ii <= userRootCnt ifTrue: [userRootCnt := userRootCnt - 1]]]].
uniqueRoots].
arrayOfRoots := uniqueRoots asArray.
rootSet := uniqueRoots := nil. "be clean"
userRootCnt ifNil: [userRootCnt := arrayOfRoots size].
outPointers := nil. "may have used this instance before"
+ segSize := segSizeHint > 0 ifTrue: [segSizeHint * 3 // 2] ifFalse: [50000].
- segSize := segSizeHint > 0 ifTrue: [segSizeHint *3 //2] ifFalse: [50000].
["Guess a reasonable segment size"
segmentWordArray := WordArrayForSegment new: segSize.
+ outPointerArray := [Array new: (segSize // 20 min: Smalltalk maxIdentityHash) "this is an implementation limit"] ifError:
+ [state := #tooBig. ^ self].
- outPointerArray := [Array new: segSize // 20] ifError: [
- state := #tooBig. ^ self].
"Smalltalk garbageCollect."
(self storeSegmentFor: arrayOfRoots
into: segmentWordArray
outPointers: outPointerArray) == nil]
whileTrue:
["Double the segment size and try again"
segmentWordArray := outPointerArray := nil.
segSize := segSize * 2].
segment := segmentWordArray.
outPointers := outPointerArray.
state := #activeCopy!
Item was changed:
----- Method: NativeImageSegment>>storeSegmentFor:into:outPointers: (in category 'read/write segment primitives') -----
storeSegmentFor: rootsArray into: segmentWordArray outPointers: outPointerArray
"This primitive will store a binary image segment (in the same format as the Squeak
image file) of the receiver and every object in its proper tree of subParts (ie, that is
not refered to from anywhere else outside the tree). Note: all elements of the reciever
are treated as roots in determining the extent of the tree. All pointers from within
the tree to objects outside the tree will be copied into the array of outpointers. In
their place in the image segment will be an oop equal to the offset in the outpointer
array (the first would be 4 or 8, depending on word size). but with the high bit set.
Note: the first element of the segmentWordArray (and hence the first element of
the Array answered by loadSegmentFrom:outPointers:) is the rootsArray."
"The primitive expects the array and wordArray to be more than adequately long.
In this case it returns normally, and truncates the two arrays to exactly the right size.
If either array is too small, the primitive will fail, but in no other case."
<primitive: 98 error: ec> "successful completion returns self"
+ ec == #'resource limit exceeded' ifTrue:
+ [self primitiveFailed].
+ ^nil "normal failure returns nil"!
- ^nil "failure returns nil"!
