The Trunk: System-dtl.1172.mcz

David T. Lewis uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-dtl.1172.mcz

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

Name: System-dtl.1172
Author: dtl
Time: 15 September 2020, 11:51:49.283423 am
UUID: ff268fb9-4fff-4981-bc66-1b0f2a5e2589
Ancestors: System-mt.1170

Fix Etoys project loading. Update ImageSegment>>reshapeClasses:refStream: to accomodate the elementsForwardIdentityTo: changes from Collections-eem.885.

Also update other methods in ImageSegment and NativeImageSegment similarly on the (untested) assumption that the behavior should remain consistent for image segments. Note that Binding class>>convertInstances in package Environments may require similar attention.

Replaces System-dtl.1171 from inbox (moved to treated)

=============== Diff against System-mt.1170 ===============

Item was changed:
  ----- 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 elementsForwardIdentityAndHashTo: newRoots].
- ifFalse: [arrayOfRoots elementsForwardIdentityTo: newRoots].
  state := #inactive.
  Beeper beepPrimitive!

Item was changed:
  ----- Method: ImageSegment>>reshapeClasses:refStream: (in category 'fileIn') -----
  reshapeClasses: mapFakeClassesToReal refStream: smartRefStream
 
  | bads allVarMaps partials in out perfect |
 
  self flag: #bobconv.
 
  partials := OrderedCollection new.
  bads := OrderedCollection new.
  allVarMaps := IdentityDictionary new.
  mapFakeClassesToReal keysAndValuesDo: [ :aFakeClass :theRealClass |
  aFakeClass allInstances do: [ :misShapen |
  perfect := smartRefStream convert1: misShapen to: theRealClass allVarMaps: allVarMaps.
  bads
  detect: [ :x | x == misShapen]
  ifNone: [
  bads add: misShapen.
  partials add: perfect
  ].
  ].
  ].
  bads isEmpty ifFalse: [
+ bads asArray elementsForwardIdentityAndHashTo: partials asArray
- bads asArray elementsForwardIdentityTo: partials asArray
  ].
 
  in := OrderedCollection new.
  out := OrderedCollection new.
  partials do: [ :each |
  perfect := smartRefStream convert2: each allVarMaps: allVarMaps.
  in
  detect: [ :x | x == each]
  ifNone: [
  in add: each.
  out add: perfect
  ]
  ].
  in isEmpty ifFalse: [
+ in asArray elementsForwardIdentityAndHashTo: out asArray
- in asArray elementsForwardIdentityTo: out asArray
  ].
  !

Item was changed:
  ----- Method: NativeImageSegment>>extract (in category 'read/write segment') -----
  extract
  "This operation replaces (using become:) all the original roots of a segment with segmentRootStubs.  Thus the original objects will be reclaimed, and the root stubs will remain to bring the segment back in if it is needed."
 
  Cursor write showWhile: [
  state = #inactive ifTrue: [self copyFromRoots: arrayOfRoots sizeHint: 0].
  state = #activeCopy ifFalse: [self errorWrongState].
+ arrayOfRoots elementsForwardIdentityAndHashTo:
- arrayOfRoots elementsForwardIdentityTo:
  (arrayOfRoots collect: [:r | r rootStubInImageSegment: self]).
  state := #active].!

Item was changed:
  ----- Method: NativeImageSegment>>extractThenInstall (in category 'read/write segment') -----
  extractThenInstall
  "For testing only"
 
  | allObjectsInSegment newRoots |
  state = #activeCopy ifFalse: [self errorWrongState].
+ arrayOfRoots elementsForwardIdentityAndHashTo:
- arrayOfRoots elementsForwardIdentityTo:
  (arrayOfRoots collect: [:r | r rootStubInImageSegment: self]).
  state := #active.
  allObjectsInSegment := self loadSegmentFrom: segment outPointers: outPointers.
  newRoots := allObjectsInSegment first.
  state := #inactive.
+ arrayOfRoots elementsForwardIdentityAndHashTo: newRoots.!
- arrayOfRoots elementsForwardIdentityTo: newRoots.!

Item was changed:
  ----- Method: NativeImageSegment>>revert (in category 'read/write segment') -----
  revert
  "Pretend this segment was never brought in.  Check that it has a fileName.  Replace (using become:) all the original roots of a segment with segmentRootStubs.  Thus the original objects will be reclaimed, and the root stubs will remain to bring the segment back in if it is needed.
  How to use revert:  In the project, choose 'save for reverting'.
 
  ReEnter the project.  Make changes.
  Either exit normally, and change will be kept, or
  Choose 'Revert to saved version'."
 
  fileName ifNil: [^ self].
  (state = #inactive) | (state = #onFile) ifFalse: [^ self].
  Cursor write showWhile: [
+ arrayOfRoots elementsForwardIdentityAndHashTo:
- arrayOfRoots elementsForwardIdentityTo:
  (arrayOfRoots collect: [:r | r rootStubInImageSegment: self]).
  state := #onFile.
  segment := nil]
 
  "Old version:
  How to use revert:  In the project, execute
  (Project current projectParameters at: #frozen put: true)
  Leave the project.  Check that the project went out to disk (it is gray in the Jump to Project list).
  ReEnter the project.  Hear a plink as it comes in from disk.  Make a change.
  Exit the project.  Choose 'Revert to previous version' in the dialog box.
  Check that the project went out to disk (it is gray in the Jump to Project list).
  ReEnter the project and see that it is in the original state."!