The Trunk: Kernel-eem.1317.mcz

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

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

Name: Kernel-eem.1317
Author: eem
Time: 11 March 2020, 1:12:02.344414 pm
UUID: 3755843a-380e-4cbc-a498-b1f1a85f2906
Ancestors: Kernel-eem.1316

Add the core of read-only support, which will provide both for read-only literals and for efficient write-through cacheing to object databases such as gemstone.

This implementation differs slightly from Clément Béra's original implementatin for Pharo in that here ModificationForbidden always uses a mirror (either a Context or a Class) to attempt to modify the read-only
object in retryModification.

=============== Diff against Kernel-eem.1316 ===============

Item was changed:
  ----- Method: Behavior>>adoptInstance: (in category 'instance creation') -----
+ adoptInstance: anObject
+        "Change the class of anObject to me.
+        Primitive (found in Cog and new VMs)  follows the same rules as primitiveChangeClassTo:, but returns the class rather than the modified instance"
- adoptInstance: anInstance
-        "Change the class of anInstance to the receiver.
-         Primitive. Change the class of the argument anInstance into the receiver, provided
-         that the format of the receiver matches the format of the argument's class.
-         Fail if the argument is an immediate, or when the pointerness of the receiver is different
-         from the pointerness of the argument, or when the receiver is a fixed pointer class and
-         anInstance's size differs from the size that an instance of the receiver should have,
-         or when anInstance's size is not an integer multiple of the receiver's unit size."
 
         <primitive: 160 error: ec>
+        ec == #'no modification' ifTrue:
+                [^self modificationForbiddenAdopting: anObject].
+        self primitiveFailed!
-        ^self primitiveFailed!

Item was added:
+ ----- Method: Behavior>>adoptInstance:ignore: (in category 'read-only objects') -----
+ adoptInstance: anInstance ignore: ignore
+        "This method exists only to adapt to the pattern used in ModificationForbidden>>retryModification,
+         which expects all mutators to take an argument."
+        ^self adoptInstance: anInstance!

Item was added:
+ ----- Method: Behavior>>modificationForbiddenAdopting: (in category 'read-only objects') -----
+ modificationForbiddenAdopting: anObject
+        ^(ModificationForbidden new
+                mirror: self
+                object: anObject
+                index: nil
+                newValue: nil
+                retrySelector: #adoptInstance:ignore:) signal!

Item was added:
+ ----- Method: Context>>modificationForbiddenFor:at:put: (in category 'read-only objects') -----
+ modificationForbiddenFor: target at: index put: aCharacter
+        ^(ModificationForbidden new
+                mirror: self
+                object: target
+                index: index
+                newValue: aCharacter
+                retrySelector: #object:basicAt:put:) signal!

Item was added:
+ ----- Method: Context>>modificationForbiddenFor:at:putCharacter: (in category 'read-only objects') -----
+ modificationForbiddenFor: target at: index putCharacter: aCharacter
+        "eem 3/11/2020 13:09 this may be a mistake.  Instead perhaps String clients should
+         send asInteger and use modificationForbiddenFor:at:put:.  Opinions appreciated."
+        ^(ModificationForbidden new
+                mirror: self
+                object: target
+                index: index
+                newValue: (aCharacter isCharacter ifTrue: [aCharacter asInteger] ifFalse: [aCharacter])
+                retrySelector: #object:basicAt:put:) signal!

Item was added:
+ ----- Method: Context>>modificationForbiddenFor:instVarAt:put: (in category 'read-only objects') -----
+ modificationForbiddenFor: target instVarAt: index put: aCharacter
+        ^(ModificationForbidden new
+                mirror: self
+                object: target
+                index: index
+                newValue: aCharacter
+                retrySelector: #object:instVarAt:put:) signal!

Item was changed:
  ----- Method: Context>>object:basicAt:put: (in category 'mirror primitives') -----
  object: anObject basicAt: index put: value
+        "Store the last argument value in the indexable element of the argument anObject
+         indicated by index without sending anObject a message. Fail if the argument index
+         is not an Integer or is out of bounds, or if anObject is not indexable, or if anObject is
+         read-only, or if value is an inappropriate value for anObject's indexable slots.
+         This mimics the action of the VM when it indexes an object. Used to simulate
+         the execution machinery by, for example, the debugger.
-        "Store the last argument
-         value in the indexable element of the argument anObject indicated by index without sending
-         anObject a message. Fail if the argument index is not an Integer or is out of bounds, or if
-         anObject is not indexable, or if value is an inappropriate value for anObject's indexable slots.
-         This mimics the action of the VM when it indexes an object.
-         Used to simulate the execution machinery by, for example, the debugger.
          Primitive.  See Object documentation whatIsAPrimitive."
 
+        <primitive: 61 error: ec>
+        index isInteger ifTrue:
+                [(index >= 1 and: [index <= (self objectSize: anObject)])
+                        ifTrue:
+                                [ec == #'no modification' ifTrue:
+                                        [^self modificationForbiddenFor: anObject at: index put: value].
+                                 self errorImproperStore]
+                        ifFalse: [self errorSubscriptBounds: index]].
+        index isNumber ifTrue:
+                [^self object: anObject basicAt: index asInteger put: value].
+        self errorNonIntegerIndex!
-        <primitive: 61>
-        index isInteger
-                ifTrue: [(index >= 1 and: [index <= (self objectSize: anObject)])
-                                        ifTrue: [self errorImproperStore]
-                                        ifFalse: [self errorSubscriptBounds: index]].
-        index isNumber
-                ifTrue: [^self object: anObject basicAt: index asInteger put: value]
-                ifFalse: [self errorNonIntegerIndex]!

Item was changed:
  ----- Method: FutureMaker>>basicAt:put: (in category 'accessing') -----
  basicAt: index put: value
         "Primitive. Assumes receiver is indexable. Store the second argument
         value in the indexable element of the receiver indicated by index. Fail
         if the index is not an Integer or is out of bounds. Or fail if the value is
         not of the right type for this kind of collection. Answer the value that
         was stored. Essential. Do not override in a subclass. See Object
         documentation whatIsAPrimitive."
 
+        <primitive: 61 error: ec>
+        index isInteger ifTrue:
+                [(index >= 1 and: [index <= self basicSize])
+                        ifTrue:
+                                [ec == #'no modification' ifTrue:
+                                        [^thisContext modificationForbiddenFor: self at: index put: value].
+                                 self errorImproperStore]
+                        ifFalse: [self errorSubscriptBounds: index]].
+        index isNumber ifTrue:
+                [^self basicAt: index asInteger put: value].
+        self errorNonIntegerIndex!
-        <primitive: 61>
-        index isInteger
-                ifTrue: [(index >= 1 and: [index <= self size])
-                                        ifTrue: [self errorImproperStore]
-                                        ifFalse: [self errorSubscriptBounds: index]].
-        index isNumber
-                ifTrue: [^self basicAt: index asInteger put: value]
-                ifFalse: [self errorNonIntegerIndex]!

Item was changed:
  ----- Method: FutureMaker>>instVarAt:put: (in category 'accessing') -----
+ instVarAt: anInteger put: anObject
- instVarAt: anInteger put: anObject
         "Primitive. Store a value into a fixed variable in the receiver. The
         numbering of the variables corresponds to the named instance variables.
         Fail if the index is not an Integer or is not the index of a fixed variable.
         Answer the value stored as the result. Using this message violates the
         principle that each object has sovereign control over the storing of
         values into its instance variables. Essential. See Object documentation
         whatIsAPrimitive."
 
         <primitive: 174 error: ec>
+        ec == #'no modification' ifTrue:
+                [^thisContext modificationForbiddenFor: self instVarAt: anInteger value: anObject].
         self primitiveFailed!

Item was added:
+ Exception subclass: #ModificationForbidden
+        instanceVariableNames: 'mirror object fieldIndex newValue retrySelector'
+        classVariableNames: ''
+        poolDictionaries: ''
+        category: 'Kernel-Exceptions'!
+
+ !ModificationForbidden commentStamp: 'eem 3/11/2020 11:53' prior: 0!
+ This exception is raised when attempting to mutate a read-only object.
+
+ My instances have 5 fields to be able to reproduce the modification via the retryModification method.
+
+ mirror        <Context|Behavior>      the Context or Behavior that will perform the modification if modificationRetried
+ object        <Object>                                read-only object that attempted to mutate
+ index <SmallInteger | nil>    index of the field in the object mutated, relevant for the corresponding selector
+ value <Object>                                value that was attempted to be stored into the read-only object
+ selector      <Symbol>                                selector that can be used to reproduce the mutation (typically, #object:basicAt:put:, #object:instVarAt:put:, etc.)!

Item was added:
+ ----- Method: ModificationForbidden>>defaultAction (in category 'priv handling') -----
+ defaultAction
+        UnhandledError signalForException: self!

Item was added:
+ ----- Method: ModificationForbidden>>fieldIndex (in category 'accessing') -----
+ fieldIndex
+        ^ fieldIndex!

Item was added:
+ ----- Method: ModificationForbidden>>indexedMessageText (in category 'printing') -----
+ indexedMessageText
+        ^String streamContents:
+                [ :s |
+                s << ' '.
+                self printObject: object on: s.
+                s << ' is read-only, hence its field '.
+                fieldIndex printOn: s.
+                s << ' cannot be modified with '.
+                self printObject: newValue on: s]!

Item was added:
+ ----- Method: ModificationForbidden>>messageText (in category 'printing') -----
+ messageText
+        "Overwritten to initialize the message text to a standard text if it has not yet been set"
+       
+        ^ messageText ifNil: [ messageText := self standardMessageText ]!

Item was added:
+ ----- Method: ModificationForbidden>>mirror (in category 'accessing') -----
+ mirror
+        ^mirror!

Item was added:
+ ----- Method: ModificationForbidden>>mirror:object:index:newValue:retrySelector: (in category 'accessing') -----
+ mirror: aContext object: anObject index: index newValue: value retrySelector: selector
+
+        mirror := aContext.
+        object := anObject.
+        fieldIndex := index.
+        newValue := value.
+        retrySelector := selector!

Item was added:
+ ----- Method: ModificationForbidden>>newValue (in category 'accessing') -----
+ newValue
+        ^ newValue!

Item was added:
+ ----- Method: ModificationForbidden>>nonIndexedMessageText (in category 'printing') -----
+ nonIndexedMessageText
+        ^String streamContents:
+                [ :s |
+                s << ' '.
+                self printObject: object on: s.
+                s << ' is read-only, hence its selector '.
+                s << retrySelector.
+                s << ' cannot be executed with '.
+                self printObject: newValue on: s]!

Item was added:
+ ----- Method: ModificationForbidden>>object (in category 'accessing') -----
+ object
+        ^ object!

Item was added:
+ ----- Method: ModificationForbidden>>printObject:on: (in category 'printing') -----
+ printObject: obj on: s
+        [obj printOn: s]
+                on: Exception
+                do: [ :ex | s << '<cannot print object>' ]!

Item was added:
+ ----- Method: ModificationForbidden>>retryModification (in category 'retrying') -----
+ retryModification
+        fieldIndex
+                ifNotNil: [mirror perform: retrySelector with: object with: fieldIndex with: newValue]
+                ifNil: [mirror perform: retrySelector with: object with: newValue].
+        self resume: newValue!

Item was added:
+ ----- Method: ModificationForbidden>>retrySelector (in category 'accessing') -----
+ retrySelector
+        ^ retrySelector!

Item was added:
+ ----- Method: ModificationForbidden>>standardMessageText (in category 'printing') -----
+ standardMessageText
+        ^fieldIndex
+                ifNil: [self nonIndexedMessageText]
+                ifNotNil: [self indexedMessageText]!

Item was changed:
  ----- Method: Object>>at:put: (in category 'accessing') -----
+ at: index put: anObject
+        "Primitive. Assumes receiver is indexable. Store the argument anObject in
+         the indexable element of the receiver indicated by index. Fail if the  index
+         is not an Integer or is out of bounds, or if the receiver is read-only, or if
+         anObject is not of the right type for this kind of collection. Answer the
+         value (anObject) that was stored. Essential. See Object documentation
+         whatIsAPrimitive."
- at: index put: value
-        "Primitive. Assumes receiver is indexable. Store the argument value in
-        the indexable element of the receiver indicated by index. Fail if the
-        index is not an Integer or is out of bounds. Or fail if the value is not of
-        the right type for this kind of collection. Answer the value that was
-        stored. Essential. See Object documentation whatIsAPrimitive."
 
+        <primitive: 61 error: ec>
-        <primitive: 61>
         index isInteger ifTrue:
                 [self class isVariable
+                        ifTrue:
+                                [(index >= 1 and: [index <= self size])
+                                        ifTrue:
+                                                [ec == #'no modification' ifTrue:
+                                                        [^thisContext modificationForbiddenFor: self at: index put: anObject].
+                                                 self errorImproperStore]
-                        ifTrue: [(index >= 1 and: [index <= self size])
-                                        ifTrue: [self errorImproperStore]
                                         ifFalse: [self errorSubscriptBounds: index]]
                         ifFalse: [self errorNotIndexable]].
+        index isNumber ifTrue:
+                [^self at: index asInteger put: anObject].
+        self errorNonIntegerIndex!
-        index isNumber
-                ifTrue: [^self at: index asInteger put: value]
-                ifFalse: [self errorNonIntegerIndex]!

Item was added:
+ ----- Method: Object>>attemptToAssign:withIndex: (in category 'write barrier') -----
+ attemptToAssign: value withIndex: index
+        "Called by the VM when assigning an instance variable of an immutable object.
+        Upon return, executing will resume *after* the inst var assignment. If the inst var mutation has to be
+        performed, do it manually here in the call back with instVarAt:put:.
+        This method has to return *no* value by jumping to the context's sender"
+       
+        thisContext modificationForbiddenFor: self instVarAt: index put: value.
+
+        thisContext sender jump
+        "CAN'T REACH"!

Item was changed:
  ----- Method: Object>>basicAt:put: (in category 'accessing') -----
+ basicAt: index put: anObject
+        "Primitive. Assumes receiver is indexable. Store the argument anObject in
+         the indexable element of the receiver indicated by index. Fail if the  index
+         is not an Integer or is out of bounds, or if the receiver is read-only, or if
+         anObject is not of the right type for this kind of collection. Answer the
+         value (anObject) that was stored. Essential. Do not override in a subclass.
+         See Object documentation whatIsAPrimitive."
- basicAt: index put: value
-        "Primitive. Assumes receiver is indexable. Store the second argument
-        value in the indexable element of the receiver indicated by index. Fail
-        if the index is not an Integer or is out of bounds. Or fail if the value is
-        not of the right type for this kind of collection. Answer the value that
-        was stored. Essential. Do not override in a subclass. See Object
-        documentation whatIsAPrimitive."
 
+        <primitive: 61 error: ec>
+        index isInteger ifTrue:
+                [self class isVariable
+                        ifTrue:
+                                [(index >= 1 and: [index <= self basicSize])
+                                        ifTrue:
+                                                [ec == #'no modification' ifTrue:
+                                                        [^thisContext modificationForbiddenFor: self at: index put: anObject].
+                                                 self errorImproperStore]
+                                        ifFalse: [self errorSubscriptBounds: index]]
+                        ifFalse: [self errorNotIndexable]].
+        index isNumber ifTrue:
+                [^self basicAt: index asInteger put: anObject].
+        self errorNonIntegerIndex!
-        <primitive: 61>
-        index isInteger
-                ifTrue: [(index >= 1 and: [index <= self size])
-                                        ifTrue: [self errorImproperStore]
-                                        ifFalse: [self errorSubscriptBounds: index]].
-        index isNumber
-                ifTrue: [^self basicAt: index asInteger put: value]
-                ifFalse: [self errorNonIntegerIndex]!

Item was added:
+ ----- Method: Object>>beReadOnlyObject (in category 'write barrier') -----
+ beReadOnlyObject
+        "If the VM supports read-only objects it will not write to read-only objects.
+         An attempt to write to an instance variable of a read-only object will
+         cause the VM to send attemptToAssign:withIndex: to the read-only object.
+         An attempt to modify a read-only object in a primitive will cause the
+         primitive to fail with a #'no modification' error code.
+         Set the read-only flag of the receiver to true and answer the previous vaue of the flag."
+        ^self setIsReadOnlyObject: true!

Item was added:
+ ----- Method: Object>>beWritableObject (in category 'write barrier') -----
+ beWritableObject
+        "If the VM supports read-only objects it will not write to read-only objects.
+         An attempt to write to an instance variable of a read-only object will
+         cause the VM to send attemptToAssign:withIndex: to the read-only object.
+         An attempt to modify a read-only object in a primitive will cause the
+         primitive to fail with a #'no modification' error code.
+         Set the read-only flag of the receiver to false and answer the previous vaue of the flag."
+        ^self setIsReadOnlyObject: false!

Item was changed:
  ----- Method: Object>>instVarAt:put: (in category 'system primitives') -----
  instVarAt: index put: anObject
         "Primitive. Store a value into a fixed variable in an object. The numbering of the
          variables corresponds to the named instance variables, followed by the indexed
          instance variables. Fail if the index is not an Integer or is not the index of a fixed
+         or indexed variable, or if the receiver is read-only.
+         Essential. See Object documentation whatIsAPrimitive."
-         or indexed variable. Essential. See Object documentation whatIsAPrimitive."
 
         <primitive: 174 error: ec>
+        ec == #'no modification' ifTrue:
+                [^thisContext modificationForbiddenFor: self instVarAt: index put: anObject].
         self primitiveFailed!

Item was added:
+ ----- Method: Object>>isReadOnlyObject (in category 'write barrier') -----
+ isReadOnlyObject
+        "Answer if the receiver is read-only.
+         If the VM supports read-only objects it will not write to read-only objects.
+         An attempt to write to an instance variable of a read-only object will
+         cause the VM to send attemptToAssign:withIndex: to the read-only object.
+         An attempt to modify a read-only object in a primitive will cause the
+         primitive to fail with a #'no modification' error code."
+        <primitive: 163 error: ec>
+        ^self class isImmediateClass!

Item was changed:
  ----- Method: Object>>primitiveChangeClassTo: (in category 'system primitives') -----
  primitiveChangeClassTo: anObject
+        "Primitive. Change the class of the receiver into the class of the argument
+         given that the format of the receiver matches the format of the argument's
+         class. Fail if receiver or argument are immediates (SmallIntegers, Characters
+         or SmallFloat64s), or when the format of the receiver is different from the
+         format of the argument's class, or when the arguments class is fixed and
+         the receiver's size differs from the size that an instance of the argument's
+         class should have.
-        "Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have.
-        Note: The primitive will fail in most cases that you think might work. This is mostly because of a) the difference between compact and non-compact classes, and b) because of differences in the format. As an example, '(Array new: 3) primitiveChangeClassTo: Morph basicNew' would fail for three of the reasons mentioned above. Array is compact, Morph is not (failure #1). Array is variable and Morph is fixed (different format - failure #2). Morph is a fixed-field-only object and the array is too short (failure #3).
-        The facility is really provided for certain, very specific applications (mostly related to classes changing shape) and not for casual use."
 
+        Note: The primitive will fail in cases that you think might work. This is mostly
+         because of because of differences in the format. As an example,
+                '(Array new: 3) primitiveChangeClassTo: Morph basicNew'
+         would fail because Morph is a fixed-field-only object with about 6 instance
+         variables, and the array is too short (failure #3).
+
+         The facility is really provided for certain, very specific applications (mostly related to classes changing shape) and not for casual use."
+
+        <primitive: 115 error: ec>
+        ec == #'no modification' ifTrue:
+                [^anObject class modificationForbiddenAdopting: self].
-        <primitive: 115>
         self primitiveFailed!

Item was added:
+ ----- Method: Object>>setIsReadOnlyObject: (in category 'write barrier') -----
+ setIsReadOnlyObject: aBoolean
+        "If the VM supports read-only objects it will not write to read-only objects.
+         An attempt to write to an instance variable of a read-only object will
+         cause the VM to send attemptToAssign:withIndex: to the read-only object.
+         An attempt to modify a read-only object in a primitive will cause the
+         primitive to fail with a #'no modification' error code.
+         This primitive sets the read-only flag of the receiver to the given
+         value and answers the previous vaue of the flag.
+         Note: Some objects can't be read-only, currently contexts and objects related
+         to process scheduling (Processor, Process instances, Semaphore instances, ...)"
+        <primitive: 164 error: ec>
+        ^self primitiveFailed!