The Trunk: Kernel-eem.944.mcz

Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.944.mcz

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

Name: Kernel-eem.944
Author: eem
Time: 22 August 2015, 10:14:01.562 am
UUID: 2398e31e-ac36-4423-b2d3-3aafa53bb339
Ancestors: Kernel-ul.943

Nuke the compact class support in Kernel and the ClassBuilder.  Spur has a regular 64-bit object header format with no special cases.

Fix CompiledMethod>>at:ifAbsent: to work with the initialPC to endPC range and run the ifAbsent: block for indices outside this range.

Categorize isCompiledMethodClass correctly.

=============== Diff against Kernel-ul.943 ===============

Item was removed:
- ----- 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.
- (self isCompact 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 removed:
- ----- 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.
- (self isCompact 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"
- !

Item was removed:
- ----- Method: Behavior>>becomeUncompact (in category 'private') -----
- 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.
- !

Item was removed:
- ----- Method: Behavior>>indexIfCompact (in category 'private') -----
- indexIfCompact
- "Backward compatibility with the Squeak V3 object format.
- Spur does not have a distinction between compact and non-compact classes."
- ^0!

Item was removed:
- ----- Method: Behavior>>isCompact (in category 'testing') -----
- isCompact
-
- ^self indexIfCompact ~= 0!

Item was changed:
+ ----- Method: Behavior>>isCompiledMethodClass (in category 'testing') -----
- ----- Method: Behavior>>isCompiledMethodClass (in category 'as yet unclassified') -----
  isCompiledMethodClass
  "Answer whether the receiver has compiled method instances that mix pointers and bytes."
  ^self instSpec >= 24!

Item was added:
+ ----- Method: ClassBuilder>>computeFormat:instSize:forSuper: (in category 'class format') -----
+ computeFormat: type instSize: newInstSize forSuper: newSuper
+ "Compute the new format for making oldClass a subclass of newSuper.
+ Answer the format or nil if there is any problem."
+ | instSize isVar isWords isPointers isWeak |
+ type == #compiledMethod ifTrue:
+ [newInstSize > 0 ifTrue:
+ [self error: 'A compiled method class cannot have named instance variables'.
+ ^nil].
+ ^CompiledMethod format].
+ instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ instSize > 65535 ifTrue:
+ [self error: 'Class has too many instance variables (', instSize printString,')'.
+ ^nil].
+ type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
+ type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
+ type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
+ type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
+ type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ (isPointers not and: [instSize > 0]) ifTrue:
+ [self error: 'A non-pointer class cannot have named instance variables'.
+ ^nil].
+ ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was removed:
- ----- Method: ClassBuilder>>computeFormat:instSize:forSuper:ccIndex: (in category 'class format') -----
- computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
- "Compute the new format for making oldClass a subclass of newSuper.
- Answer the format or nil if there is any problem."
- | instSize isVar isWords isPointers isWeak |
- type == #compiledMethod ifTrue:
- [newInstSize > 0 ifTrue:
- [self error: 'A compiled method class cannot have named instance variables'.
- ^nil].
- ^CompiledMethod format].
- instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- instSize > 65535 ifTrue:
- [self error: 'Class has too many instance variables (', instSize printString,')'.
- ^nil].
- type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
- type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
- type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
- type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
- type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
- type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
- type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
- (isPointers not and: [instSize > 0]) ifTrue:
- [self error: 'A non-pointer class cannot have named instance variables'.
- ^nil].
- ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was changed:
  ----- Method: ClassBuilder>>needsSubclassOf:type:instanceVariables:from: (in category 'class definition') -----
  needsSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass
  "Answer whether we need a new subclass to conform to the requested changes"
  | newFormat |
  "Compute the format of the new class"
+ newFormat := self computeFormat: type instSize: instVars size forSuper: newSuper.
+ newFormat ifNil: [^nil].
- newFormat :=
- self computeFormat: type
- instSize: instVars size
- forSuper: newSuper
- ccIndex: (oldClass ifNil:[0] ifNotNil:[oldClass indexIfCompact]).
- newFormat == nil ifTrue:[^nil].
 
  "Check if we really need a new subclass"
  oldClass ifNil:[^true]. "yes, it's a new class"
  newSuper == oldClass superclass ifFalse:[^true]. "yes, it's a superclass change"
  newFormat = oldClass format ifFalse:[^true]. "yes, it's a format change"
  instVars = oldClass instVarNames ifFalse:[^true]. "yes, it's an iVar change"
 
  ^false
  !

Item was changed:
  ----- Method: ClassBuilder>>newSubclassOf:type:instanceVariables:from: (in category 'class definition') -----
  newSubclassOf: newSuper type: type instanceVariables: instVars from: oldClass
  "Create a new subclass of the given superclass with the given specification."
  | newFormat newClass |
  "Compute the format of the new class"
+ newFormat := self computeFormat: type instSize: instVars size forSuper: newSuper.
- newFormat :=
- self computeFormat: type
- instSize: instVars size
- forSuper: newSuper
- ccIndex: (oldClass ifNil:[0] ifNotNil:[oldClass indexIfCompact]).
 
+ newFormat ifNil: [^nil].
- newFormat == nil ifTrue:[^nil].
 
  (oldClass == nil or:[oldClass isMeta not])
  ifTrue:[newClass := self privateNewSubclassOf: newSuper from: oldClass]
  ifFalse:[newClass := oldClass clone].
 
  newClass
  superclass: newSuper
  methodDictionary: (oldClass ifNil: [MethodDictionary new] ifNotNil: [oldClass methodDict copy])
  format: newFormat;
  setInstVarNames: instVars.
 
  oldClass ifNotNil:[
  newClass organization: oldClass organization.
  "Recompile the new class"
  oldClass hasMethods
  ifTrue:[newClass compileAllFrom: oldClass].
 
  oldClass hasTraitComposition ifTrue: [
  newClass setTraitComposition: oldClass traitComposition copyTraitExpression ].
  oldClass class hasTraitComposition ifTrue: [
  newClass class setTraitComposition: oldClass class traitComposition copyTraitExpression ].
 
  self recordClass: oldClass replacedBy: newClass.
  ].
 
  (oldClass == nil or:[oldClass isObsolete not])
  ifTrue:[newSuper addSubclass: newClass]
  ifFalse:[newSuper addObsoleteSubclass: newClass].
 
  ^newClass!

Item was changed:
  ----- Method: ClassBuilder>>privateNewSubclassOf:from: (in category 'private') -----
  privateNewSubclassOf: newSuper from: oldClass
  "Create a new meta and non-meta subclass of newSuper using oldClass as template"
  "WARNING: This method does not preserve the superclass/subclass invariant!!"
  | newSuperMeta oldMeta newMeta |
  oldClass ifNil:[^self privateNewSubclassOf: newSuper].
  newSuperMeta := newSuper ifNil:[Class] ifNotNil:[newSuper class].
  oldMeta := oldClass class.
  newMeta := oldMeta clone.
  newMeta
  superclass: newSuperMeta
  methodDictionary: oldMeta methodDict copy
  format: (self computeFormat: oldMeta typeOfClass
  instSize: oldMeta instVarNames size
+ forSuper: newSuperMeta);
- forSuper: newSuperMeta
- ccIndex: 0);
  setInstVarNames: oldMeta instVarNames;
  organization: oldMeta organization.
  "Recompile the meta class"
  oldMeta hasMethods
  ifTrue:[newMeta compileAllFrom: oldMeta].
  "Record the meta class change"
  self recordClass: oldMeta replacedBy: newMeta.
  "And create a new instance"
  ^newMeta adoptInstance: oldClass from: oldMeta!

Item was changed:
  ----- Method: ClassBuilder>>reshapeClass:toSuper: (in category 'class mutation') -----
  reshapeClass: oldClass toSuper: newSuper
  "Reshape the given class to the new super class. Recompile all the methods in the newly created class. Answer the new class."
  | instVars |
+ instVars := instVarMap at: oldClass name ifAbsent: [oldClass instVarNames].
 
- "ar 9/22/2002: The following is a left-over from some older code.
- I do *not* know why we uncompact oldClass here. If you do, then
- please let me know so I can put a comment here..."
- oldClass becomeUncompact.
-
- instVars := instVarMap at: oldClass name ifAbsent:[oldClass instVarNames].
-
  ^self newSubclassOf: newSuper
  type: oldClass typeOfClass
  instanceVariables: instVars
  from: oldClass!

Item was added:
+ ----- Method: CompiledMethod>>at:ifAbsent: (in category 'accessing') -----
+ at: index ifAbsent: exceptionBlock
+ "Answer the element at my position index. If I do not contain an element
+ at index, answer the result of evaluating the argument, exceptionBlock."
+
+ (index <= self size  and: [self initialPC <= index]) ifTrue: [^self at: index].
+ ^exceptionBlock value!

Item was removed:
- ----- Method: Object>>indexIfCompact (in category 'objects from disk') -----
- indexIfCompact
-
- ^0 "helps avoid a #respondsTo: in publishing"!