The Trunk: Kernel-ar.418.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Kernel-ar.418.mcz

commits-2
Andreas Raab uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ar.418.mcz

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

Name: Kernel-ar.418
Author: ar
Time: 5 March 2010, 7:34:04.564 pm
UUID: 3e6da606-e78d-1b45-adaf-af57902b8b4a
Ancestors: Kernel-cmm.417

Fix some questionable messages sent to the environment of classes, including #garbageCollect, #compactClassesArray and more. All of these belong sent to Smalltalk not the local environment.

=============== Diff against Kernel-cmm.417 ===============

Item was changed:
  ----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') -----
  shouldNotBeRedefined
  "Return true if the receiver should not be redefined.
  The assumption is that compact classes,
  classes in Smalltalk specialObjects and
  Behaviors should not be redefined"
 
+ ^(Smalltalk compactClassesArray includes: self)
+ or:[(Smalltalk specialObjectsArray includes: self)
- ^(self environment compactClassesArray includes: self)
- or:[(self environment specialObjectsArray includes: self)
  or:[self isKindOf: self]]!

Item was changed:
  ----- Method: ClassDescription>>removeUninstantiatedSubclassesSilently (in category 'accessing class hierarchy') -----
  removeUninstantiatedSubclassesSilently
  "Remove the classes of any subclasses that have neither instances nor subclasses.  Answer the number of bytes reclaimed"
  "Player removeUninstantiatedSubclassesSilently"
 
  | candidatesForRemoval  oldFree |
 
+ oldFree := Smalltalk garbageCollect.
- oldFree := self environment garbageCollect.
  candidatesForRemoval :=
  self subclasses select: [:c |
  (c instanceCount = 0) and: [c subclasses size = 0]].
  candidatesForRemoval do: [:c | c removeFromSystem].
+ ^Smalltalk garbageCollect - oldFree!
- ^ self environment garbageCollect - oldFree!

Item was changed:
  ----- Method: Behavior>>becomeCompact (in category 'private') -----
  becomeCompact
  "Here are the restrictions on compact classes in order for export segments to work:  A compact class index may not be reused.  If a class was compact in a release of Squeak, no other class may use that index.  The class might not be compact later, and there should be nil in its place in the array."
  | cct index |
 
  self isWeak ifTrue:[^ self halt: 'You must not make a weak class compact'].
+ cct := Smalltalk compactClassesArray.
- cct := self environment compactClassesArray.
  (self indexIfCompact > 0 or: [cct includes: self])
  ifTrue: [^ self halt: self name , 'is already compact'].
  index := cct indexOf: nil
  ifAbsent: [^ self halt: 'compact class table is full'].
  "Install this class in the compact class table"
  cct at: index put: self.
  "Update instspec so future instances will be compact"
  format := format + (index bitShift: 11).
  "Make up new instances and become old ones into them"
  self updateInstancesFrom: self.
  "Purge any old instances"
  Smalltalk garbageCollect.!

Item was changed:
  ----- Method: Behavior>>whichSelectorsReferTo: (in category 'testing method dictionary') -----
  whichSelectorsReferTo: literal
  "Answer a Set of selectors whose methods access the argument as a
  literal."
 
  | special byte |
+ special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b | byte := b].
- special := self environment hasSpecialSelector: literal ifTrueSetByte: [:b |
- byte := b].
  ^self whichSelectorsReferTo: literal special: special byte: byte
 
  "Rectangle whichSelectorsReferTo: #+."!

Item was changed:
  ----- Method: Behavior>>allLocalCallsOn: (in category 'user interface') -----
  allLocalCallsOn: aSymbol
  "Answer a SortedCollection of all the methods that call on aSymbol, anywhere in my class hierarchy."
 
  | aSet special byte cls |
  aSet := Set new.
  cls := self theNonMetaClass.
+ special := Smalltalk hasSpecialSelector: aSymbol
- special := self environment hasSpecialSelector: aSymbol
  ifTrueSetByte: [:b | byte := b ].
  cls withAllSuperAndSubclassesDoGently: [ :class |
  (class whichSelectorsReferTo: aSymbol special: special byte: byte)
  do: [:sel |
  sel isDoIt ifFalse: [aSet add: class name , ' ', sel]]].
  cls class withAllSuperAndSubclassesDoGently: [ :class |
  (class whichSelectorsReferTo: aSymbol special: special byte: byte)
  do: [:sel |
  sel isDoIt ifFalse: [aSet add: class name , ' ', sel]]].
  ^aSet!

Item was changed:
  ----- Method: Behavior>>becomeUncompact (in category 'private') -----
  becomeUncompact
  | cct index |
+ cct := Smalltalk compactClassesArray.
- cct := self environment compactClassesArray.
  (index := self indexIfCompact) = 0
  ifTrue: [^ self].
  (cct includes: self)
  ifFalse: [^ self halt  "inconsistent state"].
  "Update instspec so future instances will not be compact"
  format := format - (index bitShift: 11).
  "Make up new instances and become old ones into them"
  self updateInstancesFrom: self.
  "Make sure there are no compact ones left around"
  Smalltalk garbageCollect.
  "Remove this class from the compact class table"
  cct at: index put: nil.
  !

Item was changed:
  ----- Method: Behavior>>becomeCompactSimplyAt: (in category 'private') -----
  becomeCompactSimplyAt: index
  "Make me compact, but don't update the instances.  For importing segments."
  "Here are the restrictions on compact classes in order for export segments to work:  A compact class index may not be reused.  If a class was compact in a release of Squeak, no other class may use that index.  The class might not be compact later, and there should be nil in its place in the array."
  | cct |
 
  self isWeak ifTrue:[^ self halt: 'You must not make a weak class compact'].
+ cct := Smalltalk compactClassesArray.
- cct := self environment compactClassesArray.
  (self indexIfCompact > 0 or: [cct includes: self])
  ifTrue: [^ self halt: self name , 'is already compact'].
  (cct at: index) ifNotNil: [^ self halt: 'compact table slot already in use'].
  "Install this class in the compact class table"
  cct at: index put: self.
  "Update instspec so future instances will be compact"
  format := format + (index bitShift: 11).
  "Caller must convert the instances"
  !