I moved System-dtl.1208 to treated, and replaced it with a new version in the inbox.

My "fix" sendMouseWheelEvents was due to an off-by-one error in my brain.
It's right again now in System-dtl.1209 in the inbox.

In my defence, I'll note that Integer>>bitAt: is one-based, whereas the
documentation of bit fields in vmParameterAt: is zero-based. We should
probably pick one convention or the other.

Dave


On Thu, Dec 24, 2020 at 01:43:11PM -0500, David T. Lewis wrote:
> This tidies up the code a bit and provides a no-overhead way to supply
> default vmParameter values for parameters that may be out of range on
> some VMs.  The change to sendMouseWheelEvents fixes an existing bug.
> 
> Dave
> 
> On Thu, Dec 24, 2020 at 06:36:16PM +0000, commits at source.squeak.org wrote:
> > A new version of System was added to project The Inbox:
> > http://source.squeak.org/inbox/System-dtl.1208.mcz
> > 
> > ==================== Summary ====================
> > 
> > Name: System-dtl.1208
> > Author: dtl
> > Time: 24 December 2020, 1:34:26.591143 pm
> > UUID: 2d7b8483-72c8-4f51-ab7d-83e5aeaad51e
> > Ancestors: System-eem.1207
> > 
> > Provide vmParameterAt:default: to handle primitive failure on reading VM parameters.
> > Fix sendMouseWheelEvents, should test bit 5 not bit 6.
> > Supply default parameter values to mock possibly missing elements in the parameters array.
> > Remove two unnecessary isRunningCog checks and an ifNotNil:
> > Remove inappropriate halt in sendMouseWheelEvents:
> > Let supportsMultipleBytecodeSets and supportsReadOnlyObjects work on any VM.
> > 
> > =============== Diff against System-eem.1207 ===============
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>isRunningCog (in category 'system attributes') -----
> >   isRunningCog
> >   	"Answers if we're running on a Cog VM (JIT or StackInterpreter)"
> >   
> > + 	^(self vmParameterAt: 42 default: nil)
> > - 	^(self vmParameterAt: 42)
> >   		ifNil: [false]
> >   		ifNotNil: [:numStackPages| numStackPages > 0]!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>isRunningCogit (in category 'system attributes') -----
> >   isRunningCogit
> >   	"Answers if we're running on the Cog JIT"
> >   
> > + 	^(self vmParameterAt: 46 default: nil)
> > - 	^(self vmParameterAt: 46)
> >   		ifNil: [false]
> >   		ifNotNil: [:machineCodeZoneSize| machineCodeZoneSize > 0]!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>lowSpaceThreshold (in category 'memory space') -----
> >   lowSpaceThreshold 
> >   	"Answer the low space threshold. When the amount of free memory (after garbage collection)
> >   	 falls below this limit, the system is in serious danger of completely exhausting memory and
> >   	 crashing. This limit should be made high enough to allow the user open a debugger to diagnose
> >   	 a problem or to save the image.  In a stack-based VM such as Cog contexts for activations in
> >   	 the stack zone will have to be created as the debugger opens, requiring additional headroom."
> >   
> >   	| slotsForDebugger slotsForContextsOnStackPages |
> >   	slotsForDebugger := 65536. "Arbitrary guess"
> >   	slotsForContextsOnStackPages :=
> > + 		(self vmParameterAt: 42 default: nil)
> > - 		(self vmParameterAt: 42)
> >   			ifNil: [0]
> >   			ifNotNil:
> >   				[:numStackPages| | headerSize numActivationsPerPage maxContextSize |
> >   				numActivationsPerPage := 40. "Design goal of the Cog & Stack VMs"
> >   				headerSize := 8 / self wordSize. "64-bits for Spur"
> >   				maxContextSize := thisContext class instSize + CompiledMethod fullFrameSize + headerSize.
> >   				numStackPages * numActivationsPerPage * maxContextSize].
> >   	^slotsForDebugger + slotsForContextsOnStackPages * self wordSize!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>maxExternalSemaphores (in category 'vm parameters') -----
> >   maxExternalSemaphores
> > + 	"The size of table where external semaphores are registered. Only in Cog,
> > + 	other VMs are expected to answer nil if present in the parameters array."
> > + 	^self vmParameterAt: 49 default: nil!
> > - 	"The size of table where external semaphores are registered. Only in Cog"
> > - 	self isRunningCog ifFalse: [^nil].
> > - 	^self vmParameterAt: 49!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>maxExternalSemaphores: (in category 'vm parameters') -----
> >   maxExternalSemaphores: aSize
> >   	"Changes the size of table where external semaphores are registered. 
> >   	The size can only grow, and will always be the next power of two larger than the parameter.
> >   	
> >   	Setting this at any time other than start-up can potentially lose requests.
> >   	 i.e. during the realloc new storage is allocated,
> >   	the old contents are copied and then pointers are switched. 
> >   	 Requests occurring during copying won't be seen if they occur to indices already copied. 
> >   	The intended use is to set the table to some adequate maximum at start-up"
> >   	
> > - 	self isRunningCog ifFalse: [^0].
> >   	"The vm-header field is a short, maximum 64k entries. Well, on most platforms anyways "
> >   	(aSize < 0 or: [aSize > 16rFFFF]) ifTrue: [^self error: 'maxExternalSemaphores: is limited to 16rFFFF'].
> > + 	^[self vmParameterAt: 49 put: aSize] on: Error do: [0].!
> > - 	^self vmParameterAt: 49 put: aSize!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>processPreemptionYields (in category 'system attributes') -----
> >   processPreemptionYields
> >   	"Answer whether the VM causes a process to yield on process preemption,
> >   	 i.e. to put a preempted process at the back of its run queue.  If the parameter
> >   	 is unavailable (non-Cog VMs) or bit 2 (4) is 0 then preemption yields."
> >   
> > + 	^((self vmParameterAt: 48 default: [^true]) allMask: 4) not
> > + !
> > - 	^(([self vmParameterAt: 48]
> > - 			on: Error
> > - 			do: [:ex| ^true]) allMask: 4) not!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>sendMouseWheelEvents (in category 'system attributes') -----
> >   sendMouseWheelEvents
> >   	"The Cog VM can be instructed to deliver mouse wheel events as mouse wheel events.
> >   	 By default mouse wheel events are mapped to arrow events.
> >   	 This flag persists across snapshots, stored in the image header."
> >   
> > + 	^(self vmParameterAt: 48 default: 0) allMask: 16 "bit 5"
> > + 
> > + !
> > - 	^(self vmParameterAt: 48) anyMask: 32!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>supportsMultipleBytecodeSets (in category 'system attributes') -----
> >   supportsMultipleBytecodeSets
> >   	"Answer whether the VM supports multiple bytecodeSets."
> >   	"SmalltalkImage current supportsMultipleBytecodeSets"
> >   
> > + 	^(self vmParameterAt: 65 default: nil)
> > - 	^(self vmParameterAt: 65)
> >   		ifNil: [false]
> >   		ifNotNil:
> >   			[:param| "In older VMs this is a boolean answering the vm-internal MULTIPLE_BYTECODE_SETS define"
> >   			 param isInteger "In newer VMs it is a set of integer flags, bit 0 of which is the vm-internal MULTIPLE_BYTECODE_SETS define"
> >   				ifTrue: [param anyMask: 1]
> >   				ifFalse: [param]]!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>supportsQueueingFinalization (in category 'system attributes') -----
> >   supportsQueueingFinalization
> >   	"Answer whether the VM queues individual weak arrays for finalization, instead
> >   	 of signalling the finalization semaphore once for all arrays and having the
> >   	 WeakRegistry mechanism finalize all weak arrays, whether they need to or not."
> >   	"SmalltalkImage current supportsQueueingFinalization"
> >   
> > + 	^(self vmParameterAt: 48 default: 0) anyMask: 16!
> > - 	^(self vmParameterAt: 48) anyMask: 16!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>supportsReadOnlyObjects (in category 'system attributes') -----
> >   supportsReadOnlyObjects
> >   	"Answer whether the VM observes the per-object read-only flag and consequently aborts
> >   	 writes to inst vars of, and fails primitives that attempt to modify, read-only objects."
> >   	"SmalltalkImage current supportsReadOnlyObjects"
> >   
> > + 	^(self vmParameterAt: 65 default: nil)
> > - 	^(self vmParameterAt: 65)
> >   		ifNil: [false]
> >   		ifNotNil:
> >   			[:param| "In older VMs this is a boolean answering the vm-internal MULTIPLE_BYTECODE_SETS define"
> >   			 param isInteger "In newer VMs it is a set of integer flags, bit 1 of which is the vm-internal IMMUTABILITY define"
> >   				ifTrue: [param anyMask: 2]
> >   				ifFalse: [false]]!
> > 
> > Item was added:
> > + ----- Method: SmalltalkImage>>vmParameterAt:default: (in category 'vm parameters') -----
> > + vmParameterAt: parameterIndex default: defaultValueOrBlock
> > + 	"Answer a VM parameter or defaultValueOrBlock value if out of range."
> > + 	<primitive: 254>
> > + 	^defaultValueOrBlock value!
> > 
> > Item was changed:
> >   ----- Method: SmalltalkImage>>wordSize (in category 'image') -----
> >   wordSize
> >   	"Answer the size in bytes of an object pointer or word in the object memory.
> >   	The value does not change for a given image, but may be modified by a SystemTracer
> >   	when converting the image to another format. The value is cached in WordSize to
> >   	avoid the performance overhead of repeatedly consulting the VM."
> >   
> >   	"Smalltalk wordSize"
> >   
> > + 	^ WordSize ifNil: [WordSize := self vmParameterAt: 40 default: 4]!
> > - 	^ WordSize ifNil: [WordSize := [self vmParameterAt: 40] on: Error do: [4]]!
> > 
> > 
>