[Pkg] The Trunk: Kernel-ul.1098.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Apr 24 12:20:25 UTC 2017
Levente Uzonyi uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-ul.1098.mcz
==================== Summary ====================
Name: Kernel-ul.1098
Author: ul
Time: 24 April 2017, 12:59:49.967288 pm
UUID: f803e743-6f80-4bd8-9d1b-192f56d70de6
Ancestors: Kernel-eem.1097
- rewrote senders of #clone to use #shallowCopy
- Object >> #shallowCopy uses the fallback code of #clone, because that one is simpler (copying is done by #copyFrom:) and can copy CompiledMethods too.
=============== Diff against Kernel-eem.1097 ===============
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 ifNil: [^nil].
(oldClass == nil or:[oldClass isMeta not])
ifTrue:[newClass := self privateNewSubclassOf: newSuper from: oldClass]
+ ifFalse:[newClass := oldClass shallowCopy].
- 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 shallowCopy.
- newMeta := oldMeta clone.
newMeta
superclass: newSuperMeta
methodDictionary: oldMeta methodDict copy
format: (self computeFormat: oldMeta typeOfClass
instSize: oldMeta instVarNames size
forSuper: newSuperMeta);
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: EventSensor>>queueEvent: (in category 'private-I/O') -----
queueEvent: evt
"Queue the given event in the event queue (if any).
Note that the event buffer must be copied since it
will be reused later on."
self eventQueue ifNotNil: [:queue |
+ queue nextPut: evt shallowCopy].!
- queue nextPut: evt clone].!
Item was changed:
----- Method: Float>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
"Return self. Do not record me."
+ ^self shallowCopy!
- ^ self clone!
Item was changed:
----- Method: Object>>copyTwoLevel (in category 'copying') -----
copyTwoLevel
"one more level than a shallowCopy"
| newObject class index |
class := self class.
+ newObject := self shallowCopy.
- newObject := self clone.
newObject == self ifTrue: [^ self].
class isVariable
ifTrue:
[index := self basicSize.
[index > 0]
whileTrue:
[newObject basicAt: index put: (self basicAt: index) shallowCopy.
index := index - 1]].
index := class instSize.
[index > 0]
whileTrue:
[newObject instVarAt: index put: (self instVarAt: index) shallowCopy.
index := index - 1].
^newObject!
Item was changed:
----- Method: Object>>shallowCopy (in category 'copying') -----
shallowCopy
"Answer a copy of the receiver which shares the receiver's instance variables."
+
- | class newObject index |
<primitive: 148 error: ec>
+ | class newObject |
ec == #'insufficient object memory' ifFalse:
[^self primitiveFailed].
+ "If the primitive fails due to insufficient memory, instantiate via basicNew: to invoke
+ the garbage collector before retrying, and use copyFrom: to copy state."
+ newObject := (class := self class) isVariable
+ ifTrue:
+ [class isCompiledMethodClass
+ ifTrue:
+ [class newMethod: self basicSize - self initialPC + 1 header: self header]
+ ifFalse:
+ [class basicNew: self basicSize]]
+ ifFalse:
+ [class basicNew].
+ ^newObject copyFrom: self!
- class := self class.
- class isVariable
- ifTrue:
- [index := self basicSize.
- newObject := class basicNew: index.
- [index > 0] whileTrue:
- [newObject basicAt: index put: (self basicAt: index).
- index := index - 1]]
- ifFalse: [newObject := class basicNew].
- index := class instSize.
- [index > 0] whileTrue:
- [newObject instVarAt: index put: (self instVarAt: index).
- index := index - 1].
- ^newObject!
Item was changed:
----- Method: Object>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
"Copy me and the entire tree of objects I point to. An object in the tree twice is copied once, and both references point to him. deepCopier holds a dictionary of objects we have seen. Some classes refuse to be copied. Some classes are picky about which fields get deep copied."
| class index sub subAss new uc sup has mine |
deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him"
class := self class.
class isMeta ifTrue: [^ self]. "a class"
+ new := self shallowCopy.
- new := self clone.
(class isSystemDefined not and: [deepCopier newUniClasses "allowed"]) ifTrue: [
uc := deepCopier uniClasses at: class ifAbsent: [nil].
uc ifNil: [
deepCopier uniClasses at: class put: (uc := self copyUniClassWith: deepCopier).
deepCopier references at: class put: uc]. "remember"
new := uc new.
new copyFrom: self]. "copy inst vars in case any are weak"
deepCopier references at: self put: new. "remember"
(class isVariable and: [class isPointers]) ifTrue:
[index := self basicSize.
[index > 0] whileTrue:
[sub := self basicAt: index.
(subAss := deepCopier references associationAt: sub ifAbsent: [nil])
ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)]
ifNotNil: [new basicAt: index put: subAss value].
index := index - 1]].
"Ask each superclass if it wants to share (weak copy) any inst vars"
new veryDeepInner: deepCopier. "does super a lot"
"other superclasses want all inst vars deep copied"
sup := class. index := class instSize.
[has := sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil].
has := has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true].
mine := sup instVarNames.
has ifTrue: [index := index - mine size] "skip inst vars"
ifFalse: [1 to: mine size do: [:xx |
sub := self instVarAt: index.
(subAss := deepCopier references associationAt: sub ifAbsent: [nil])
"use association, not value, so nil is an exceptional value"
ifNil: [new instVarAt: index put:
(sub veryDeepCopyWith: deepCopier)]
ifNotNil: [new instVarAt: index put: subAss value].
index := index - 1]].
(sup := sup superclass) == nil] whileFalse.
new rehash. "force Sets and Dictionaries to rehash"
^ new
!
More information about the Packages
mailing list