The Trunk: Kernel-ar.420.mcz

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

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

Name: Kernel-ar.420
Author: ar
Time: 5 March 2010, 8:55:49.922 pm
UUID: a8de6a84-8494-b34e-bfaa-eef854ed79e6
Ancestors: Kernel-ar.419

Avoid dictionary protocol in Smalltalk.

=============== Diff against Kernel-ar.419 ===============

Item was changed:
  ----- Method: ClassBuilder>>name:inEnvironment:subclassOf:type:instanceVariableNames:classVariableNames:poolDictionaries:category:unsafe: (in category 'class definition') -----
  name: className inEnvironment: env subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe
  "Define a new class in the given environment.
  If unsafe is true do not run any validation checks.
  This facility is provided to implement important system changes."
  | oldClass instVars classVars copyOfOldClass newClass |
   
  environ := env.
  instVars := Scanner new scanFieldNames: instVarString.
  classVars := (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol].
 
  "Validate the proposed name"
  unsafe ifFalse:[(self validateClassName: className) ifFalse:[^nil]].
  oldClass := env at: className ifAbsent:[nil].
  oldClass isBehavior
  ifFalse: [oldClass := nil]  "Already checked in #validateClassName:"
  ifTrue: [
  copyOfOldClass := oldClass copy.
  copyOfOldClass superclass addSubclass: copyOfOldClass].
 
 
  [ | newCategory needNew force organization oldCategory |
  unsafe ifFalse:[
  "Run validation checks so we know that we have a good chance for recompilation"
  (self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil].
  (self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
  (self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
  (self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]].
 
  "See if we need a new subclass"
  needNew := self needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass.
  needNew == nil ifTrue:[^nil]. "some error"
 
  (needNew and:[unsafe not]) ifTrue:[
  "Make sure we don't redefine any dangerous classes"
  (self tooDangerousClasses includes: oldClass name) ifTrue:[
  self error: oldClass name, ' cannot be changed'.
  ].
  "Check if the receiver should not be redefined"
  (oldClass ~~ nil and:[oldClass shouldNotBeRedefined]) ifTrue:[
  self notify: oldClass name asText allBold,
  ' should not be redefined. \Proceed to store over it.' withCRs]].
 
  needNew ifTrue:[
  "Create the new class"
  newClass := self
  newSubclassOf: newSuper
  type: type
  instanceVariables: instVars
  from: oldClass.
  newClass == nil ifTrue:[^nil]. "Some error"
  newClass setName: className.
  ] ifFalse:[
  "Reuse the old class"
  newClass := oldClass.
  ].
 
  "Install the class variables and pool dictionaries... "
  force := (newClass declare: classVarString) | (newClass sharing: poolString).
 
  "... classify ..."
  newCategory := category asSymbol.
  organization := environ ifNotNil:[environ organization].
  oldClass isNil ifFalse: [oldCategory := (organization categoryOfElement: oldClass name) asSymbol].
  organization classify: newClass name under: newCategory.
  newClass environment: environ.
 
  "... recompile ..."
  newClass := self recompile: force from: oldClass to: newClass mutate: false.
 
  "... export if not yet done ..."
  (environ at: newClass name ifAbsent:[nil]) == newClass ifFalse:[
  [environ at: newClass name put: newClass]
  on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true].
+ environ flushClassNameCache.
- Smalltalk flushClassNameCache.
  ].
 
 
  newClass doneCompiling.
  "... notify interested clients ..."
  oldClass isNil ifTrue: [
  SystemChangeNotifier uniqueInstance classAdded: newClass inCategory: newCategory.
  ^ newClass].
  newCategory ~= oldCategory
  ifTrue: [SystemChangeNotifier uniqueInstance class: newClass recategorizedFrom: oldCategory to: category]
  ifFalse: [SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: copyOfOldClass to: newClass.].
  ] ensure:
  [copyOfOldClass ifNotNil: [copyOfOldClass superclass removeSubclass: copyOfOldClass].
  Behavior flushObsoleteSubclasses.
  ].
  ^newClass!

Item was changed:
  ----- Method: Object>>hasHaltCount (in category 'debugging-haltOnce') -----
  hasHaltCount
+ ^self class environment
- ^Smalltalk
  includesKey: #HaltCount!

Item was changed:
  ----- Method: CompiledMethod>>hasReportableSlip (in category 'testing') -----
  hasReportableSlip
  "Answer whether the receiver contains anything that should be brought
  to the attention of the author when filing out. Customize the lists here
  to suit your preferences. If slips do not get reported in spite of your
  best efforts here, make certain that the Preference 'checkForSlips' is set
  to true."
  #(#doOnlyOnce: #halt #halt: #hottest #printDirectlyToDisplay #toRemove #personal #urgent  #haltOnce #haltOnce: #haltIf: )
  do: [:aLit | (self hasLiteral: aLit)
  ifTrue: [^ true]].
  #(#Transcript #AA #BB #CC #DD #EE )
  do: [:aSymbol |
  | assoc |
+ (assoc := Smalltalk globals
- (assoc := Smalltalk
  associationAt: aSymbol
  ifAbsent: [])
  ifNotNil: [(self hasLiteral: assoc)
  ifTrue: [^ true]]].
  ^ false!

Item was changed:
  ----- Method: ClassBuilder class>>cleanupClassHierarchyFor: (in category 'cleanup obsolete classes') -----
  cleanupClassHierarchyFor: aClassDescription
 
  | myName mySuperclass |
  mySuperclass := aClassDescription superclass.
  (self isReallyObsolete: aClassDescription) ifTrue: [
 
  "Remove class >>>from SystemDictionary if it is obsolete"
  myName := aClassDescription name asString.
+ Smalltalk globals keys do: [:each |
- Smalltalk keys do: [:each |
  (each asString = myName and: [(Smalltalk at: each) == aClassDescription])
+ ifTrue: [Smalltalk globals removeKey: each]].
- ifTrue: [Smalltalk removeKey: each]].
 
  "Make class officially obsolete if it is not"
  (aClassDescription name asString beginsWith: 'AnObsolete')
  ifFalse: [aClassDescription obsolete].
 
  aClassDescription isObsolete
  ifFalse: [self error: 'Something wrong!!'].
 
  "Add class to obsoleteSubclasses of its superclass"
  mySuperclass
  ifNil: [self error: 'Obsolete subclasses of nil cannot be stored'].
  (mySuperclass obsoleteSubclasses includes: aClassDescription)
  ifFalse: [mySuperclass addObsoleteSubclass: aClassDescription].
  ] ifFalse:[
  "check if superclass has aClassDescription in its obsolete subclasses"
  mySuperclass ifNil:[mySuperclass := Class]. "nil subclasses"
  mySuperclass removeObsoleteSubclass: aClassDescription.
  ].
  "And remove its obsolete subclasses if not actual superclass"
  aClassDescription obsoleteSubclasses do:[:obs|
  obs superclass == aClassDescription ifFalse:[
  aClassDescription removeObsoleteSubclass: obs]].
  !

Item was changed:
  ----- Method: Object>>removeHaltCount (in category 'debugging-haltOnce') -----
  removeHaltCount
+ (self class environment includesKey: #HaltCount) ifTrue: [
+ self class environment removeKey: #HaltCount]!
- (Smalltalk includesKey: #HaltCount) ifTrue: [
- Smalltalk removeKey: #HaltCount]!

Item was changed:
  ----- Method: Class>>binding (in category 'compiling') -----
  binding
  "Answer a binding for the receiver, sharing if possible"
  | binding |
+ binding := self environment associationAt: name ifAbsent: [nil -> self].
- binding := Smalltalk associationAt: name ifAbsent: [nil -> self].
  ^binding value == self ifTrue:[binding] ifFalse:[nil -> self].!