The Trunk: System-ul.947.mcz

Levente Uzonyi uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ul.947.mcz

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

Name: System-ul.947
Author: ul
Time: 24 April 2017, 1:15:54.622643 pm
UUID: 58e89632-762c-42f4-a3d0-55c1d1dd9dba
Ancestors: System-eem.946

- rewrote senders of #clone to use #shallowCopy

=============== Diff against System-eem.946 ===============

Item was changed:
  ----- Method: DeepCopier>>mapUniClasses (in category 'like fullCopy') -----
  mapUniClasses
  "For new Uniclasses, map their class vars to the new objects.  And their additional class instance vars.  (scripts slotInfo) and cross references like (player321)."
  "Players also refer to each other using associations in the References dictionary.  Search the methods of our Players for those.  Make new entries in References and point to them."
  | pp newKey |
 
  newUniClasses ifFalse: [^ self]. "All will be siblings.  uniClasses is empty"
  "Uniclasses use class vars to hold onto siblings who are referred to in code"
  pp := (Smalltalk at: #Player ifAbsent:[^self]) class superclass instSize.
  uniClasses do: [:playersClass | "values = new ones"
  playersClass classPool associationsDo: [:assoc |
  assoc value: (assoc value veryDeepCopyWith: self)].
  playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self). "pp+1"
  "(pp+2) slotInfo was deepCopied in copyUniClass and that's all it needs"
  pp+3 to: playersClass class instSize do: [:ii |
  playersClass instVarAt: ii put:
  ((playersClass instVarAt: ii) veryDeepCopyWith: self)].
  ].
 
  "Make new entries in References and point to them."
  References keys "copy" do: [:playerName | | oldPlayer |
  oldPlayer := References at: playerName.
  (references includesKey: oldPlayer) ifTrue: [
  newKey := (references at: oldPlayer) "new player" uniqueNameForReference.
  "now installed in References"
  (references at: oldPlayer) renameTo: newKey]].
  uniClasses "values" do: [:newClass | | newSelList oldSelList |
  oldSelList := OrderedCollection new.   newSelList := OrderedCollection new.
  newClass selectorsAndMethodsDo: [:sel :m |
  m literals do: [:assoc | | newAssoc |
  assoc isVariableBinding ifTrue: [
  (References associationAt: assoc key ifAbsent: [nil]) == assoc ifTrue: [
  newKey := (references at: assoc value ifAbsent: [assoc value])
  externalName asSymbol.
  (assoc key ~= newKey) & (References includesKey: newKey) ifTrue: [
  newAssoc := References associationAt: newKey.
  newClass methodDictionary at: sel put:
+ (newClass compiledMethodAt: sel) shallowCopy. "were sharing it"
- (newClass compiledMethodAt: sel) clone. "were sharing it"
  (newClass compiledMethodAt: sel)
  literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc)
  put: newAssoc.
  (oldSelList includes: assoc key) ifFalse: [
  oldSelList add: assoc key.  newSelList add: newKey]]]]]].
  oldSelList with: newSelList do: [:old :new |
  newClass replaceSilently: old to: new]]. "This is text replacement and can be wrong"!

Item was changed:
  ----- Method: Project class>>sweep: (in category 'squeaklet on server') -----
  sweep: aServerDirectory
  | repository list parts ind entry projectName versions |
  "On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'"
  "Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone
  directory: '/vol0/people/dani/Squeaklets/2.7')"
 
  "Ensure the 'older' directory"
  (aServerDirectory includesKey: 'older')
  ifFalse: [aServerDirectory createDirectory: 'older'].
+ repository := aServerDirectory shallowCopy directory: aServerDirectory directory, '/older'.
- repository := aServerDirectory clone directory: aServerDirectory directory, '/older'.
 
  "Collect each name, and decide on versions"
  list := aServerDirectory fileNames.
  list isString ifTrue: [^ self inform: 'server is unavailable' translated].
  list sort.
  parts := list collect: [:en | Project parseProjectFileName: en].
  parts := parts select: [:en | en third = 'pr'].
  ind := 1.
  [entry := list at: ind.
  projectName := entry first asLowercase.
  versions := OrderedCollection new.  versions add: entry.
  [(ind := ind + 1) > list size
  ifFalse: [(parts at: ind) first asLowercase = projectName
  ifTrue: [versions add: (parts at: ind).  true]
  ifFalse: [false]]
  ifTrue: [false]] whileTrue.
  aServerDirectory moveYoungest: 3 in: versions to: repository.
  ind > list size] whileFalse.
  !

Item was changed:
  ----- Method: Project>>enter:revert:saveForRevert: (in category 'enter') -----
  enter: returningFlag revert: revertFlag saveForRevert: saveForRevert
  "Install my ChangeSet, Transcript, and scheduled views as current globals. If returningFlag is true, we will return to the project from whence the current project was entered; don't change its previousProject link in this case.
  If saveForRevert is true, save the ImageSegment of the project being left.
  If revertFlag is true, make stubs for the world of the project being left.
  If revertWithoutAsking is true in the project being left, then always revert."
 
  | leavingProject forceRevert response seg |
 
  self isIncompletelyLoaded
  ifTrue: [^ self loadFromServer: true].
  self isCurrentProject
  ifTrue: [^ self].
 
  forceRevert := false.
  CurrentProject rawParameters
  ifNil: [revertFlag ifTrue: [^ self inform: 'nothing to revert to' translated]]
  ifNotNil: [saveForRevert ifFalse: [
  forceRevert := CurrentProject projectParameters
  at: #revertWithoutAsking ifAbsent: [false]]].
  forceRevert not & revertFlag ifTrue: [
  response := (UIManager default chooseFrom: {
  'Revert to saved version' translated.
  'Cancel' translated.
  } title: 'Are you sure you want to destroy this Project\ and revert to an older version?\\(From the parent project, click on this project''s thumbnail.)' translated withCRs) = 1.
  response ifFalse: [^ self]].
 
  revertFlag | forceRevert
  ifTrue: [seg := CurrentProject projectParameters at: #revertToMe ifAbsent: [
  ^ self inform: 'nothing to revert to' translated]]
  ifFalse: [
  CurrentProject makeThumbnail.
  returningFlag == #specialReturn
  ifTrue:
  [ProjectHistory forget: CurrentProject. "this guy is irrelevant"
  Project forget: CurrentProject]
  ifFalse:
  [ProjectHistory remember: CurrentProject]].
 
  (revertFlag | saveForRevert | forceRevert) ifFalse: [
  (Preferences valueOfFlag: #projectsSentToDisk)
  ifTrue: [
  self inform: 'Project serialization via image segments\does not work at the moment. Disabling the\preference #projectsSentToDisk now...' withCRs.
  Preferences disable: #projectsSentToDisk.
  "self storeToMakeRoom"]].
 
  "Update display depth for leaving and entring project."
  CurrentProject displayDepth: Display depth.
  displayDepth == nil ifTrue: [displayDepth := Display depth].
  self installNewDisplay: Display extent depth: displayDepth.
 
  returningFlag == #specialReturn ifTrue: [
  CurrentProject removeChangeSetIfPossible. "keep this stuff from accumulating"
  nextProject := nil
  ] ifFalse: [
  returningFlag
  ifTrue: [nextProject := CurrentProject]
  ifFalse: [previousProject := CurrentProject].
  ].
 
  CurrentProject world triggerEvent: #aboutToLeaveWorld.
  CurrentProject abortResourceLoading.
  CurrentProject finalExitActions: self.
  CurrentProject saveState.
 
  "********** SWITCHING CURRENT PROJECT **********"
  leavingProject := CurrentProject.
  CurrentProject := self.
  ProjectHistory remember: self.
  "********** SWITCHING CURRENT PROJECT **********"
 
  self loadState.
  self finalEnterActions: leavingProject.
  self addDeferredUIMessage: [self startResourceLoading].
  self world triggerEvent: #aboutToEnterWorld.
 
  "Save project for revert."
  saveForRevert ifTrue: [
  Smalltalk garbageCollect. "let go of pointers"
  leavingProject storeSegment.
  "result :=" leavingProject world isInMemory
  ifTrue: ['Can''t seem to write the project.']
  ifFalse: [leavingProject projectParameters at: #revertToMe put:
+ leavingProject world xxxSegment shallowCopy].
- leavingProject world xxxSegment clone].
  'Project written.'].
  "original is for coming back in and continuing."
  revertFlag | forceRevert ifTrue: [
+ seg shallowCopy revert]. "non-cloned one is for reverting again later"
- seg clone revert]. "non-cloned one is for reverting again later"
  self removeParameter: #exportState.
 
  "Now that everything is set up, we can show zoom animation."
  self showZoom
  ifTrue: [self displayZoom: leavingProject parent ~~ self "Entering?"]
  ifFalse: [self restore].
 
  "Update processes at last."
  self scheduleProcessForEnter.
  leavingProject terminateProcessForLeave.
  !

Item was changed:
  ----- Method: ResourceManager>>installResource:from:locator: (in category 'loading') -----
  installResource: aResource from: aStream locator: loc
  | repl |
  aResource ifNil:[^false]. "it went away, so somebody might have deleted it"
  (aStream == nil or:[aStream size = 0]) ifTrue:[^false]. "error?!!"
+ repl := aResource shallowCopy readResourceFrom: aStream asUnZippedStream.
- repl := aResource clone readResourceFrom: aStream asUnZippedStream.
  repl ifNotNil:[
  aResource replaceByResource: repl.
  unloaded remove: loc.
  loaded add: loc.
  ^true
  ].
  ^false!