VM Maker: VMMaker.oscog-eem.2556.mcz

 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2556.mcz

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

Name: VMMaker.oscog-eem.2556
Author: eem
Time: 6 September 2019, 3:03:10.794964 pm
UUID: 4981a174-0196-4d71-8937-a69b4c271462
Ancestors: VMMaker.oscog-eem.2555

Make primitiveDoMixedArithmetic persist in the image header as bit 6 of the flags.
Make it g/settable via Smalltalk vmParameterAt: 48.
Nicolas, I'll leave it up to you whether you want to keep parameter 75 as an alternative way of setting it.

=============== Diff against VMMaker.oscog-eem.2555 ===============

Item was changed:
  ----- Method: CoInterpreter>>getCogVMFlags (in category 'internal interpreter access') -----
  getCogVMFlags
        "Answer an array of flags indicating various properties of the Cog VM.
         These are the same as the image header flags shifted right two bits (excluding float order and full screen flags).
         Bit 0: specific to CoInterpreterMT
         Bit 1: if set, methods that are interpreted will have the flag bit set in their header
         Bit 2: if set, implies preempting a process does not put it to the back of its run queue
         Bit 3: specific to CoInterpreterMT
         Bit 4: if set, implies the new finalization scheme where WeakArrays are queued
+        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events
+        Bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)"
-        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events"
        ^objectMemory integerObjectOf: (flagInterpretedMethods ifTrue: [2] ifFalse: [0])
                                                                        + (preemptionYields ifTrue: [0] ifFalse: [4])
                                                                        + (newFinalization ifTrue: [16] ifFalse: [0])
                                                                        + (sendWheelEvents ifTrue: [32] ifFalse: [0])
+                                                                       + (primitiveDoMixedArithmetic ifTrue: [0] ifFalse: [64])
+                                                                       + (imageHeaderFlags >> 2 bitClear: 2 + 4 + 16 + 32 + 64)!
-                                                                       + (imageHeaderFlags >> 2 bitClear: 2 + 4 + 16 + 32)!

Item was changed:
  ----- Method: CoInterpreter>>getImageHeaderFlags (in category 'image save/restore') -----
  getImageHeaderFlags
        "Answer the flags that are contained in the 7th long of the image header."
        ^fullScreenFlag "0 or 1"
        + (VMBIGENDIAN ifTrue: [0] ifFalse: [2]) "this is the imageFloatsLittleEndian flag"
        + (flagInterpretedMethods ifTrue: [8] ifFalse: [0])
        + (preemptionYields ifTrue: [0] ifFalse: [16r10])
        + (newFinalization ifTrue: [16r40] ifFalse: [0])
        + (sendWheelEvents ifTrue: [16r80] ifFalse: [0])
+       + (primitiveDoMixedArithmetic ifTrue: [0] ifFalse: [16r100])
+       + (imageHeaderFlags bitClear: 16r1DB) "these are any flags we do not recognize"!
-       + (imageHeaderFlags bitClear: 16rDB) "these are any flags we do not recognize"!

Item was changed:
  ----- Method: CoInterpreter>>setCogVMFlags: (in category 'internal interpreter access') -----
  setCogVMFlags: flags
        "Set an array of flags indicating various properties of the Cog VM.
         Bit 0: if set, implies the image's Process class has threadId as its 3rd inst var (zero relative)
         Bit 1: if set, methods that are interpreted will have the flag bit set in their header
         Bit 2: if set, implies preempting a process does not put it to the back of its run queue
         Bit 3: if set, implies a threaded VM will not dosown the VM if owned by the GUI thread
         Bit 4: if set, implies the new finalization scheme where WeakArrays are queued
+        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events
+        Bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)"
+       flags asUnsignedInteger > 127 ifTrue:
-        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events"
-       flags asUnsignedInteger > 63 ifTrue:
                [^self primitiveFailFor: PrimErrUnsupported].
        "processHasThreadId := flags anyMask: 1. specific to CoInterpreterMT"
        flagInterpretedMethods := flags anyMask: 2.
        preemptionYields := flags noMask: 4.
        "noThreadingOfGUIThread := flags anyMask: 8.. specific to CoInterpreterMT"
        newFinalization := flags anyMask: 16.
+       sendWheelEvents := flags anyMask: 32.
+       primitiveDoMixedArithmetic := flags noMask: 64!
-       sendWheelEvents := flags anyMask: 32!

Item was changed:
  ----- Method: CoInterpreter>>setImageHeaderFlagsFrom: (in category 'image save/restore') -----
  setImageHeaderFlagsFrom: headerFlags
        "Set the flags that are contained in the 7th long of the image header."
        imageHeaderFlags := headerFlags. "so as to preserve unrecognised flags."
        fullScreenFlag := headerFlags bitAnd: 1.
        imageFloatsBigEndian := (headerFlags noMask: 2) ifTrue: [1] ifFalse: [0].
        "processHasThreadId := headerFlags anyMask: 4. specific to CoInterpreterMT"
        flagInterpretedMethods := headerFlags anyMask: 8.
        preemptionYields := headerFlags noMask: 16.
        "noThreadingOfGUIThread := headerFlags anyMask: 32. specific to CoInterpreterMT"
        newFinalization := headerFlags anyMask: 64.
+       sendWheelEvents := headerFlags anyMask: 128.
+       primitiveDoMixedArithmetic := headerFlags noMask: 256!
-       sendWheelEvents := headerFlags anyMask: 128!

Item was changed:
  ----- Method: CoInterpreterMT>>getCogVMFlags (in category 'internal interpreter access') -----
  getCogVMFlags
        "Answer an array of flags indicating various properties of the Cog VM.
         These are the same as the image header flags shifted right two bits (excluding float order and full screen flags).
         Bit 0: implies the image's Process class has threadId as its 3rd inst var (zero relative)
         Bit 1: if set, methods that are interpreted will have the flag bit set in their header
         Bit 2: if set, implies preempting a process does not put it to the back of its run queue
         Bit 3: if set, implies the GUI will run on the first thread and event queues will not be accessed from other threads
         Bit 4: if set, implies the new finalization scheme where WeakArrays are queued
+        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events
+        Bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)"
-        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events"
        ^objectMemory integerObjectOf: (processHasThreadId ifTrue: [1] ifFalse: [0])
                                                                        + (flagInterpretedMethods ifTrue: [2] ifFalse: [0])
                                                                        + (preemptionYields ifTrue: [0] ifFalse: [4])
                                                                        + (noThreadingOfGUIThread ifTrue: [8] ifFalse: [0])
                                                                        + (newFinalization ifTrue: [16] ifFalse: [0])
+                                                                       + (sendWheelEvents ifTrue: [32] ifFalse: [0])
+                                                                       + (primitiveDoMixedArithmetic ifTrue: [0] ifFalse: [64])
+                                                                       + (imageHeaderFlags >> 2 bitClear: 1 + 2 + 4 + 8 + 16 + 32 + 64)!
-                                                                       + (imageHeaderFlags >> 2 bitClear: 1 + 2 + 4 + 8 + 16)!

Item was changed:
  ----- Method: CoInterpreterMT>>getImageHeaderFlags (in category 'image save/restore') -----
  getImageHeaderFlags
        "Answer the flags that are contained in the 7th long of the image header."
        ^fullScreenFlag "0 or 1"
        + (VMBIGENDIAN ifTrue: [0] ifFalse: [2]) "this is the imageFloatsLittleEndian flag"
        + (processHasThreadId ifTrue: [4] ifFalse: [0])
        + (flagInterpretedMethods ifTrue: [8] ifFalse: [0])
        + (preemptionYields ifTrue: [0] ifFalse: [16r10])
        + (noThreadingOfGUIThread ifTrue: [16r20] ifFalse: [0])
        + (newFinalization ifTrue: [16r40] ifFalse: [0])
        + (sendWheelEvents ifTrue: [16r80] ifFalse: [0])
+       + (primitiveDoMixedArithmetic ifTrue: [0] ifFalse: [16r100])
+       + (imageHeaderFlags bitClear: 16r1FF) "these are any flags we do not recognize"!
-       + (imageHeaderFlags bitClear: 16rFF) "these are any flags we do not recognize"!

Item was changed:
  ----- Method: CoInterpreterMT>>setCogVMFlags: (in category 'internal interpreter access') -----
  setCogVMFlags: flags
        "Set an array of flags indicating various properties of the Cog VM.
         Bit 0: if set, implies the image's Process class has threadId as its 3rd inst var (zero relative)
         Bit 1: if set, methods that are interpreted will have the flag bit set in their header
         Bit 2: if set, implies preempting a process does not put it to the back of its run queue
         Bit 3: if set, implies a threaded VM will not dosown the VM if owned by the GUI thread
         Bit 4: if set, implies the new finalization scheme where WeakArrays are queued
+        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events
+        Bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)"
+       flags asUnsignedInteger > 127 ifTrue:
-        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events"
-       flags asUnsignedInteger > 63 ifTrue:
                [^self primitiveFailFor: PrimErrUnsupported].
        processHasThreadId := flags anyMask: 1.
        flagInterpretedMethods := flags anyMask: 2.
        preemptionYields := flags noMask: 4.
        noThreadingOfGUIThread := flags anyMask: 8.
        newFinalization := flags anyMask: 16.
+       sendWheelEvents := flags anyMask: 32.
+       primitiveDoMixedArithmetic := flags noMask: 64!
-       sendWheelEvents := flags anyMask: 32!

Item was changed:
  ----- Method: CoInterpreterMT>>setImageHeaderFlagsFrom: (in category 'image save/restore') -----
  setImageHeaderFlagsFrom: headerFlags
        "Set the flags that are contained in the 7th long of the image header."
        imageHeaderFlags := headerFlags. "so as to preserve unrecognised flags."
        fullScreenFlag := headerFlags bitAnd: 1.
        imageFloatsBigEndian := (headerFlags noMask: 2) ifTrue: [1] ifFalse: [0].
        processHasThreadId := headerFlags anyMask: 4.
        flagInterpretedMethods := headerFlags anyMask: 8.
        preemptionYields := headerFlags noMask: 16.
        noThreadingOfGUIThread := headerFlags anyMask: 32.
        newFinalization := headerFlags anyMask: 64.
        sendWheelEvents := headerFlags anyMask: 128.
+       primitiveDoMixedArithmetic := headerFlags noMask: 256.

        processHasThreadId ifFalse:
                [self print: 'warning, processHasThreadId flag is unset; cannot function as a threaded VM if so.'; cr]!

Item was changed:
  ----- Method: StackInterpreter>>getCogVMFlags (in category 'internal interpreter access') -----
  getCogVMFlags
        "Answer an array of flags indicating various properties of the Cog VM.
         These are the same as the image header flags shifted right two bits (excluding float order and full screen flags).
         Bit 0: specific to CoInterpreterMT
         Bit 1: specific to CoInterpreter
         Bit 2: if set, implies preempting a process does not put it to the back of its run queue
         Bit 3: specific to CoInterpreterMT
         Bit 4: if set, implies the new finalization scheme where WeakArrays are queued
+        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events
+        Bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)"
-        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events"
        ^objectMemory integerObjectOf: (preemptionYields ifTrue: [0] ifFalse: [4])
                                                                        + (newFinalization ifTrue: [16] ifFalse: [0])
                                                                        + (sendWheelEvents ifTrue: [32] ifFalse: [0])
+                                                                       + (primitiveDoMixedArithmetic ifTrue: [0] ifFalse: [64])
+                                                                       + (imageHeaderFlags >> 2 bitClear: 4 + 16 + 32 + 64)!
-                                                                       + (imageHeaderFlags >> 2 bitClear: 4 + 16 + 32)!

Item was changed:
  ----- Method: StackInterpreter>>getImageHeaderFlags (in category 'image save/restore') -----
  getImageHeaderFlags
        "Answer the flags that are contained in the 7th long of the image header."
        ^fullScreenFlag "0 or 1"
        + (VMBIGENDIAN ifTrue: [0] ifFalse: [2]) "this is the imageFloatsLittleEndian flag"
        + (preemptionYields ifTrue: [0] ifFalse: [16r10])
        + (newFinalization ifTrue: [16r40] ifFalse: [0])
        + (sendWheelEvents ifTrue: [16r80] ifFalse: [0])
+       + (primitiveDoMixedArithmetic ifTrue: [0] ifFalse: [16r100])
+       + (imageHeaderFlags bitClear: 16r1D3) "these are any flags we do not recognize"!
-       + (imageHeaderFlags bitClear: 16rD3) "these are any flags we do not recognize"!

Item was changed:
  ----- Method: StackInterpreter>>setCogVMFlags: (in category 'internal interpreter access') -----
  setCogVMFlags: flags
        "Set an array of flags indicating various properties of the Cog VM.
         Bit 2: if set, implies preempting a process does not put it to the back of its run queue
         Bit 4: if set, implies the new finalization scheme where WeakArrays are queued
+        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events
+        Bit 6: if set, implies arithmetic primitives will fail if given arguments of different types (float vs int)"
+       flags asUnsignedInteger > 127 ifTrue:
-        Bit 5: if set, implies wheel events will be delivered as such and not mapped to arrow key events"
-       flags asUnsignedInteger > 63 ifTrue:
                [^self primitiveFailFor: PrimErrUnsupported].
        "processHasThreadId := flags anyMask: 1. specific to CoInterpreterMT"
        "flagInterpretedMethods := flags anyMask: 2. specific to CoInterpreter"
        preemptionYields := flags noMask: 4.
        "noThreadingOfGUIThread := flags anyMask: 8.. specific to CoInterpreterMT"
        newFinalization := flags anyMask: 16.
+       sendWheelEvents := flags anyMask: 32.
+       primitiveDoMixedArithmetic := flags noMask: 64!
-       sendWheelEvents := flags anyMask: 32!

Item was changed:
  ----- Method: StackInterpreter>>setImageHeaderFlagsFrom: (in category 'image save/restore') -----
  setImageHeaderFlagsFrom: headerFlags
        "Set the flags that are contained in the 7th long of the image header."
        imageHeaderFlags := headerFlags. "so as to preserve unrecognised flags."
        fullScreenFlag := headerFlags bitAnd: 1.
        imageFloatsBigEndian := (headerFlags noMask: 2) ifTrue: [1] ifFalse: [0].
        "processHasThreadId := headerFlags anyMask: 4. specific to CoInterpreterMT"
        "flagInterpretedMethods := headerFlags anyMask: 8. specific to CoInterpreter"
        preemptionYields := headerFlags noMask: 16.
        "noThreadingOfGUIThread := headerFlags anyMask: 32. specific to CoInterpreterMT"
        newFinalization := headerFlags anyMask: 64.
+       sendWheelEvents := headerFlags anyMask: 128.
+       primitiveDoMixedArithmetic := headerFlags noMask: 256!
-       sendWheelEvents := headerFlags anyMask: 128!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveSetVMParameter:arg: (in category 'system control primitives') -----
  primitiveSetVMParameter: index arg: argOop
        "See primitiveVMParameter method comment"
        | arg result |

        "argOop read & checks; in most cases this is an integer parameter.  In some it is either an integer or a Float"
        index = 75
                ifTrue:
                        [ arg := objectMemory booleanValueOf: argOop.
                        self failed ifTrue: [^self primitiveFailFor: PrimErrBadArgument]]
                ifFalse: [(index = 17 or: [index = 55 or: [index = 68]])
                        ifTrue:
                                [((objectMemory isFloatInstance: argOop)
                                 or: [objectMemory isIntegerObject: argOop]) ifFalse:
                                        [^self primitiveFailFor: PrimErrBadArgument]]
                        ifFalse: [(objectMemory isIntegerObject: argOop) ifFalse:
                                        [^self primitiveFailFor: PrimErrBadArgument].
                                 arg := objectMemory integerValueOf: argOop]].

        "assume failure, then set success for handled indices"
        self primitiveFailFor: PrimErrBadArgument.
        index caseOf: {
                [5] ->  [objectMemory hasSpurMemoryManagerAPI ifFalse:
                                        ["Was:
                                                        result := allocationsBetweenGCs.
                                                        allocationsBetweenGCs := arg."
                                                "Ignore for now, because old images won't start up otherwise.
                                                 See 45 for eden size setting."
                                         result := objectMemory nilObject.
                                         self initPrimCall]].
                [6] ->  [result := objectMemory integerObjectOf: objectMemory tenuringThreshold.
                                 primFailCode := objectMemory tenuringThreshold: arg].
                [11] -> [arg >= 0 ifTrue:
                                        [result := objectMemory integerObjectOf: objectMemory statTenures.
                                         objectMemory statTenures: arg.
                                         self initPrimCall]].
                [17] -> [(SistaVM and: [self isCog]) ifTrue:
                                        [result := objectMemory floatObjectOf: self getCogCodeZoneThreshold.
                                         primFailCode := self setCogCodeZoneThreshold: (self noInlineLoadFloatOrIntFrom: argOop)]].
                [23] -> [result := objectMemory integerObjectOf: extraVMMemory.
                                 extraVMMemory := arg.
                                 self initPrimCall].
                [24] -> [arg > 0 ifTrue:
                                        [result := objectMemory integerObjectOf: objectMemory shrinkThreshold.
                                         objectMemory shrinkThreshold: arg.
                                         self initPrimCall]].
                [25] -> [arg > 0 ifTrue:
                                        [result := objectMemory integerObjectOf: objectMemory growHeadroom.
                                         objectMemory growHeadroom: arg.
                                         self initPrimCall]].
                [26] -> [arg >= 0 ifTrue: "0 turns off the heartbeat"
                                        [result := objectMemory integerObjectOf: self ioHeartbeatMilliseconds.
                                         self ioSetHeartbeatMilliseconds: arg.
                                         self initPrimCall]].
                [34] -> [(objectMemory hasSpurMemoryManagerAPI "was statAllocationCount; now statAllocatedBytes"
                                  and: [arg >= 0]) ifTrue:
                                        [result := objectMemory positive64BitIntegerFor: objectMemory currentAllocatedBytes.
                                         objectMemory setCurrentAllocatedBytesTo: arg.
                                         self initPrimCall]].
                [43] -> [(arg between: 0 and: 65535) ifTrue:
                                        [result := objectMemory integerObjectOf: desiredNumStackPages.
                                         desiredNumStackPages := arg.
                                         self initPrimCall]].
                [45] -> [arg >= 0 ifTrue:
                                        [result := objectMemory integerObjectOf: desiredEdenBytes.
                                         desiredEdenBytes := arg.
                                         self initPrimCall]].
                [47] -> [(self isCog
                                  and: [arg between: 0 and: self maxCogCodeSize]) ifTrue:
                                        [result := objectMemory integerObjectOf: self getDesiredCogCodeSize.
                                         self setDesiredCogCodeSize: arg.
                                         self initPrimCall]].
                [48] -> [arg >= 0 ifTrue:
+                                       [| oldPrimitiveDoMixedArithmetic |
+                                        oldPrimitiveDoMixedArithmetic := primitiveDoMixedArithmetic.
+                                        result := objectMemory integerObjectOf: self getCogVMFlags.
-                                       [result := objectMemory integerObjectOf: self getCogVMFlags.
                                         self initPrimCall. "i.e. setCogVMFlags: can fail"
+                                        self setCogVMFlags: arg.
+                                        (primFailCode = 0
+                                         and: [oldPrimitiveDoMixedArithmetic ~= primitiveDoMixedArithmetic]) ifTrue:
+                                               [self flushMethodCache.
+                                                self flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
+                                                "NOT REACHED (in CoInterpreter)"]]].
-                                        self setCogVMFlags: arg]].
                [49] -> [(arg between: 0 and: 65535) ifTrue:
                                        [result := objectMemory integerObjectOf: self ioGetMaxExtSemTableSize.
                                         self initPrimCall. "i.e. ioSetMaxExtSemTableSize: is allowed to fail"
                                         self setMaxExtSemSizeTo: arg]].
                [55] -> [objectMemory hasSpurMemoryManagerAPI ifTrue:
                                        [result := objectMemory floatObjectOf: objectMemory getHeapGrowthToSizeGCRatio.
                                         primFailCode := objectMemory setHeapGrowthToSizeGCRatio: (self noInlineLoadFloatOrIntFrom: argOop)]].
                [67] -> [(arg >= 0
                                  and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue:
                                        [result := objectMemory integerObjectOf: objectMemory maxOldSpaceSize.
                                         primFailCode := objectMemory setMaxOldSpaceSize: arg]].
                [68] -> [result := objectMemory floatObjectOf: stackPages statAverageLivePagesWhenMapping.
                                 self initPrimCall. "i.e. statAverageLivePagesWhenMapping: is allowed to fail"
                                 stackPages statAverageLivePagesWhenMapping: (self noInlineLoadFloatOrIntFrom: argOop)].
                [69] -> [arg >= 0 ifTrue:
                                        [result := objectMemory integerObjectOf: stackPages statMaxPageCountWhenMapping.
                                         stackPages statMaxPageCountWhenMapping: arg.
                                         self initPrimCall]].
                [74] -> [(arg >= 0
                                  and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue:
                                        [result := objectMemory integerObjectOf: objectMemory statMaxAllocSegmentTime + 500 // 1000.
                                         stackPages statMaxAllocSegmentTime: arg. "usually 0"
                                         self initPrimCall]].
                [75] -> [| mustFlush |
                                 result := objectMemory booleanObjectOf: self primitiveDoMixedArithmetic.
                                 self initPrimCall.
                                 mustFlush := primitiveDoMixedArithmetic ~= arg.
                                 primitiveDoMixedArithmetic := arg.
                                 mustFlush ifTrue:
                                        [self flushMethodCache.
                                         self flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
                                         "NOT REACHED (in CoInterpreter)"]] }
                otherwise: [].

        self successful
                ifTrue: [self methodReturnValue: result]  "return old value"
                ifFalse: [self primitiveFailFor: PrimErrInappropriate] "attempting to write a read-only or non-existent parameter"!