'From Squeak3.11alpha of 13 February 2010 [latest update: #9483] on 9 March 2010 at 11:11:23 am'! !Behavior methodsFor: 'testing' stamp: 'ar 3/5/2010 14:39'! 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) or:[self isKindOf: self]]! ! !Behavior methodsFor: 'testing method dictionary' stamp: 'ar 3/5/2010 14:39'! 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]. ^self whichSelectorsReferTo: literal special: special byte: byte "Rectangle whichSelectorsReferTo: #+."! ! !Behavior methodsFor: 'user interface' stamp: 'ar 3/5/2010 14:38'! 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 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! ! !Behavior methodsFor: 'private' stamp: 'ar 3/5/2010 14:38'! 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. (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.! ! !Behavior methodsFor: 'private' stamp: 'ar 3/5/2010 14:38'! 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. (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" ! ! !Behavior methodsFor: 'private' stamp: 'ar 3/5/2010 14:38'! becomeUncompact | cct index | cct := Smalltalk 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. ! ! !ClassDescription methodsFor: 'accessing class hierarchy' stamp: 'ar 3/5/2010 14:40'! 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. candidatesForRemoval := self subclasses select: [:c | (c instanceCount = 0) and: [c subclasses size = 0]]. candidatesForRemoval do: [:c | c removeFromSystem]. ^Smalltalk garbageCollect - oldFree! ! !Year methodsFor: 'smalltalk-80' stamp: 'brp 6/16/2008 08:41'! previous "This implementation handles leap years correctly" ^ self class year: (self year - 1)! !