The Inbox: Kernel-eem.1294.mcz

A new version of Kernel was added to project The Inbox:
http://source.squeak.org/inbox/Kernel-eem.1294.mcz

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

Name: Kernel-eem.1294
Author: eem
Time: 24 January 2020, 12:04:41.143093 pm
UUID: 3c3915d5-7426-4d3b-91b7-479deaf5468d
Ancestors: Kernel-eem.1285, Kernel-nice.1293

A much better Behavior>>instSpec using the newe integer array classes as examples.

A resumable AssertionFailure (essential for my usage; I want to be able to log AssertFails and continue in one crucial VM debuggingissue that has been in the background for years).

Nicolas's primitive highBit faaaaaast.

Nicolas' fixes for event dispatch which make my system usable.

But this one is really about Behavior>instSpec and resumable AssertFailure.

=============== Diff against Kernel-eem.1285 ===============

Item was changed:
+ Error subclass: #AssertionFailure
- Halt subclass: #AssertionFailure
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Kernel-Exceptions'!
 
  !AssertionFailure commentStamp: 'gh 5/2/2002 20:29' prior: 0!
  AsssertionFailure is the exception signaled from Object>>assert: when the assertion block evaluates to false.!

Item was added:
+ ----- Method: AssertionFailure>>isResumable (in category 'priv handling') -----
+ isResumable
+ ^ true!

Item was changed:
  ----- Method: Behavior>>instSpec (in category 'testing') -----
  instSpec
  "Answer the instance specification part of the format that defines what kind of object
  an instance of the receiver is.  The formats are
  0 = 0 sized objects (UndefinedObject True False et al)
  1 = non-indexable objects with inst vars (Point et al)
  2 = indexable objects with no inst vars (Array et al)
  3 = indexable objects with inst vars (Context BlockClosure AdditionalMethodState et al)
  4 = weak indexable objects with inst vars (WeakArray et al)
  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  6 = unused
  7 = immediates (SmallInteger, Character)
  8 = unused
+ 9 = 64-bit indexable (DoubleWordArray et al)
+ 10-11 = 32-bit indexable (WordArray et al) (includes one odd bit, unused in 32-bit instances)
+ 12-15 = 16-bit indexable (DoubleByteArray et al) (includes two odd bits, one unused in 32-bit instances)
+ 16-23 = 8-bit indexable (ByteArray et al) (includes three odd bits, one unused in 32-bit instances)
+ 24-31 = compiled code (CompiledCode et al) (includes three odd bits, one unused in 32-bit instances)
+
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap) (plus one odd bit, unused in 32-bits)
- 12-15 = 16-bit indexable (plus two odd bits, one unused in 32-bits)
- 16-23 = 8-bit indexable (plus three odd bits, one unused in 32-bits)
- 24-31 = compiled methods (CompiledMethod) (plus three odd bits, one unused in 32-bits)
  Note that in the VM instances also have a 5 bit format field that relates to their class's format.
  Formats 11, 13-15, 17-23 & 25-31 are unused in classes but used in instances to define the
  number of elements missing up to the slot size.  For example, a 2-byte ByteString instance
+ has format 18 in 32 bits, since its size is one 32-bit slot - 2 bytes ((18 bitAnd: 3) = 2), and
+ 22 in 64 bits, since its size is one 64-bit slot - 6 bytes ((22 bitAnd: 7) = 6).
+ Formats 24-31 are for compiled code which is a combination of pointers and bytes.  The number of pointers is
+ determined by literal count field of the method header, which is the first field of the object and must be a SmallInteger.
+ The literal count field occupies the least significant 15 bits of the mehtod header, allowing up to 32,767 pointer fields,
+ not including the header."
- has format 18 in 32-bits, since its size is one 32-bit slot - 2 bytes ((18 bitAnd: 3) = 2), and
- 22 in 64 bits, since its size is one 64-bit slot - 6 bytes ((22 bitAnd: 7) = 6)."
  ^(format bitShift: -16) bitAnd: 16r1F!

Item was changed:
  Object subclass: #EventSensor
  instanceVariableNames: 'mouseButtons mousePosition mouseWheelDelta keyboardBuffer interruptKey interruptSemaphore eventQueue inputSemaphore lastEventPoll hasInputSemaphore'
  classVariableNames: 'ButtonDecodeTable EventPollPeriod EventTicklerProcess InterruptSemaphore InterruptWatcherProcess KeyDecodeTable'
  poolDictionaries: 'EventSensorConstants'
  category: 'Kernel-Processes'!
 
+ !EventSensor commentStamp: 'mt 12/13/2019 14:38' prior: 0!
- !EventSensor commentStamp: 'dtl 1/30/2016 14:44' prior: 0!
  An EventSensor is an interface to the user input devices.
  There is at least one instance of EventSensor named Sensor in the system.
 
  EventSensor is a replacement for the earlier InputSensor implementation based on a set of (optional) event primitives. An EventSensor updates its state when events are received so that all state based users of Sensor (e.g., Sensor keyboard, Sensor leftShiftDown, Sensor mouseButtons) will work exactly as before, by moving the current VM mechanisms into EventSensor itself. An optional input semaphore is part of the new design.
 
  For platforms that support true asynchronous event notification, the semaphore will be signaled to indicate pending events.
  On platforms that do not support asynchronous notifications about events, the UI will have to poll EventSensor periodically to read events from the VM.
 
  Instance variables:
  mouseButtons <Integer> - mouse button state as replacement for primMouseButtons
  mousePosition <Point> - mouse position as replacement for primMousePt
  keyboardBuffer <SharedQueue> - keyboard input buffer
  interruptKey <Integer> - currently defined interrupt key
  interruptSemaphore <Semaphore> - the semaphore signaled when the interruptKey is detected
  eventQueue <SharedQueue> - an optional event queue for event driven applications
  inputSemaphore <Semaphore>- the semaphore signaled by the VM if asynchronous event notification is supported
  lastEventPoll <Integer> - the last millisecondClockValue at which we called fetchMoreEvents
  hasInputSemaphore <Boolean> - true if my inputSemaphore has actually been signaled at least once.
 
  Class variables:
  ButtonDecodeTable <ByteArray> - maps mouse buttons as reported by the VM to ones reported in the events.
  KeyDecodeTable <Dictionary<SmallInteger->SmallInteger>> - maps some keys and their modifiers to other keys (used for instance to map Ctrl-X to Alt-X)
  InterruptSemaphore <Semaphore> - signalled by the the VM and/or the event loop upon receiving an interrupt keystroke.
  InterruptWatcherProcess <Process> - waits on the InterruptSemaphore and then responds as appropriate.
  EventPollPeriod <Integer> - the number of milliseconds to wait between polling for more events in the userInterruptHandler.
  EventTicklerProcess <Process> - the process that makes sure that events are polled for often enough (at least every EventPollPeriod milliseconds).
 
  Event format:
  The current event format is very simple. Each event is recorded into an 8 element array. All events must provide some SmallInteger ID (the first field in the event buffer) and a time stamp (the second field in the event buffer), so that the difference between the time stamp of an event and the current time can be reported.
 
  Currently, the following events are defined:
 
  Null event
  =============
  The Null event is returned when the ST side asks for more events but no more events are available.
  Structure:
  [1] - event type 0
  [2-8] - unused
 
  Mouse event structure
  ==========================
  Mouse events are generated when mouse input is detected.
- Structure:
  [1] - event type 1
  [2] - time stamp
  [3] - mouse x position
  [4] - mouse y position
  [5] - button state; bitfield with the following entries:
+ 1 - 2r001 yellow (e.g., right) button
+ 2 - 2r010 blue (e.g., middle) button
+ 4 - 2r100 red (e.g., left) button
- 1 - yellow (e.g., right) button
- 2 - blue (e.g., middle) button
- 4 - red (e.g., left) button
  [all other bits are currently undefined]
  [6] - modifier keys; bitfield with the following entries:
  1 - shift key
  2 - ctrl key
  4 - (Mac specific) option key
  8 - Cmd/Alt key
  [all other bits are currently undefined]
  [7] - reserved.
+ [8] - host window id.
- [8] - reserved.
 
  Keyboard events
  ====================
  Keyboard events are generated when keyboard input is detected.
  [1] - event type 2
  [2] - time stamp
+ [3] - character code (Ascii)
+ For now the character code is in Mac Roman encoding. See #macToSqueak.
+ For key press/release (see [4]), character codes are normalized.
- [3] - character code
- For now the character code is in Mac Roman encoding.
  [4] - press state; integer with the following meaning
+ 0 - character (aka. key stroke or key still pressed)
+ 1 - key press (aka. key down)
+ 2 - key release (aka. key up)
- 0 - character
- 1 - key press (down)
- 2 - key release (up)
  [5] - modifier keys (same as in mouse events)
+ For key press/release (see [4]), modifier keys are still accessible.
+ [6] - character code (Unicode UTF32)
+ Manual decoding via KeyboardInputInterpreter possible.
+ For key press/release (see [4]), character codes are normalized.
- [6] - reserved.
  [7] - reserved.
+ [8] - host window id.
+
+ Mouse-wheel event structure
+ ==========================
+ Mouse-wheel events are generated when mouse-wheel input is detected.
+ [1] - event type 7
+ [2] - time stamp
+ [3] - horizontal scroll delta
+ [4] - vertical scroll delta
+ [5] - button state (same as in mouse events)
+ [6] - modifier keys (same as in mouse events)
+ [7] - reserved.
+ [8] - host window id.
- [8] - reserved.
  !

Item was changed:
  ----- Method: EventSensor class>>installDuplicateKeyEntryFor: (in category 'key decode table') -----
+ installDuplicateKeyEntryFor: aPrintableCharacter
+ "Updates the key-decode table, which maps between pairs of {character code . modifier code}.
+ See the class comment for more information.
+ The purpose of this change is to let ctrl+key act like cmd+key (Mac) or alt+key (linux/windows).
+ It is especially usefull on windows VM where default feel is to use ctrl as shortcut (ctrl+C = copy, etc...).
+ Note that the bitmask 16r9F removes the high bits, which subtracts 64 from the key code for (upper) $A to $Z and 96 for (lower) $a to $z. The VM sends non-printable control characters for [ctrl]+[A-Za-Z] in ASCII < 32, but the given character is expected to be ASCII >= 32 and thus printable. So we have to convert control characters to printable characters in this mapping table."
+
+ | upper lower |
+ upper := aPrintableCharacter asUppercase asInteger.
+ lower := aPrintableCharacter asLowercase asInteger.
+
+ KeyDecodeTable at: { lower bitAnd: 16r9F . 2 "ctrl" } put: { lower . 8 "cmd/alt" }.
+ KeyDecodeTable at: { upper bitAnd: 16r9F . 2 bitOr: 1 "ctrl + shift" } put: { upper . 8 bitOr: 1 "cmd/alt + shift" }.!
- installDuplicateKeyEntryFor: c
- | key |
- key := c asInteger.
- "first do control->alt key"
- KeyDecodeTable at: { key bitAnd: 16r9F . 2 } put: { key . 8 }.
- "then alt->alt key"
- KeyDecodeTable at: { key . 8 } put: { key . 8 }
- !

Item was changed:
  ----- Method: EventSensor class>>installKeyDecodeTable (in category 'class initialization') -----
  installKeyDecodeTable
+ "Create a decode table that swaps or duplicates some keys if the respective preference is set."
+
- "Create a decode table that swaps some keys if
- Preferences swapControlAndAltKeys is set"
  KeyDecodeTable := Dictionary new.
+
- Preferences duplicateControlAndAltKeys
- ifTrue: [ self defaultCrossPlatformKeys do:
- [ :c | self installDuplicateKeyEntryFor: c ] ].
  Preferences swapControlAndAltKeys
+ ifTrue: [ (Character allByteCharacters select: [:ea | ea isAlphaNumeric]) do:
- ifTrue: [ self defaultCrossPlatformKeys do:
  [ :c | self installSwappedKeyEntryFor: c ] ].
  Preferences duplicateAllControlAndAltKeys
  ifTrue: [ (Character allByteCharacters select: [:ea | ea isAlphaNumeric]) do:
  [ :c | self installDuplicateKeyEntryFor: c ] ].
+
+ self flag: #toDeprecate. "mt: This mapping should be deprecated in the future."
+ Preferences duplicateControlAndAltKeys
+ ifTrue: [ self defaultCrossPlatformKeys do:
+ [ :c | self installDuplicateKeyEntryFor: c ] ].
  !

Item was changed:
  ----- Method: EventSensor class>>installSwappedKeyEntryFor: (in category 'key decode table') -----
+ installSwappedKeyEntryFor: aPrintableCharacter
+ "Updates the key-decode table, which maps between pairs of {character code . modifier code}. See the class comment for more information.
+ Note that the bitmask 16r9F removes the high bits, which subtracts 64 from the key code for (upper) $A to $Z and 96 for (lower) $a to $z. The VM sends non-printable control characters for [ctrl]+[A-Za-Z] in ASCII < 32, but the given character is expected to be ASCII >= 32 and thus printable. So we have to convert printable characters to control characters in this mapping table."
+
+ | upper lower |
+ upper := aPrintableCharacter asUppercase asInteger.
+ lower := aPrintableCharacter asLowercase asInteger.
+
+ KeyDecodeTable at: { lower bitAnd: 16r9F . 2 "ctrl" } put: { lower . 8 "cmd/alt" }.
+ KeyDecodeTable at: { lower . 8 "cmd/alt" } put: { lower bitAnd: 16r9F . 2 "ctrl" }.
+ KeyDecodeTable at: { upper bitAnd: 16r9F . 2 bitOr: 1 "ctrl+shift" } put: { upper . 8 bitOr: 1 "cmd/alt+shift" }.
+ KeyDecodeTable at: { upper . 8 bitOr: 1 "cmd/alt+shift" } put: { upper bitAnd: 16r9F . 2 bitOr: 1 "ctrl+shift" }.!
- installSwappedKeyEntryFor: c
- | key |
- key := c asInteger.
- "first do control->alt key"
- KeyDecodeTable at: { key bitAnd: 16r9F . 2 } put: { key . 8 }.
- "then alt->control key"
- KeyDecodeTable at: { key . 8 } put: { key bitAnd: 16r9F . 2 }!

Item was changed:
  ----- Method: EventSensor>>processEvent: (in category 'private-I/O') -----
  processEvent: evt
  "Process a single event. This method is run at high priority."
  | type buttons window |
  type := evt at: 1.
 
  "Only process main window events, forward others to host window proxies"
  window := evt at: 8.
  (window isNil or: [window isZero]) ifTrue:
  [window := 1.
  evt at: 8 put: window].
  window = 1 ifFalse: [
  ^Smalltalk at: #HostWindowProxy ifPresent: [:w | w processEvent: evt]].
 
  "Tackle mouse events and mouse wheel events first"
  (type = EventTypeMouse or: [type = EventTypeMouseWheel])
  ifTrue: [buttons := (ButtonDecodeTable at: (evt at: 5) + 1).
  evt at: 5 put: (Smalltalk platformName = 'Mac OS'
  ifTrue: [ buttons ]
  ifFalse: [ self mapButtons: buttons modifiers: (evt at: 6) ]).
  self queueEvent: evt.
  type = EventTypeMouse ifTrue: [self processMouseEvent: evt].
  type = EventTypeMouseWheel ifTrue: [self processMouseWheelEvent: evt].
  ^self].
 
  "Store the event in the queue if there's any"
  type = EventTypeKeyboard
  ifTrue: [ "Check if the event is a user interrupt"
+ ((evt at: 4) = EventKeyChar
- ((evt at: 4) = 0
  and: [((evt at: 3)
  bitOr: (((evt at: 5)
  bitAnd: 8)
  bitShift: 8))
  = interruptKey])
  ifTrue: ["interrupt key is meta - not reported as event"
  ^ interruptSemaphore signal].
+ "Decode keys for characters (i.e., duplicate or swap, ctrl <-> alt/cmd)."
+ (evt at: 4) = EventKeyChar
+ ifTrue: [ | unicode ascii |
+ "Copy lookup key first in case of key swap."
+ unicode := {evt at: 6. evt at: 5}.
+ ascii := {evt at: 3. evt at: 5}.
+ KeyDecodeTable "Unicode character first"
+ at: unicode
+ ifPresent: [:a | evt at: 6 put: a first;
+ at: 5 put: a second].
+ KeyDecodeTable "ASCII character second"
+ at: ascii
+ ifPresent: [:a | evt at: 3 put: a first;
+ at: 5 put: a second]].
- "Else swap ctrl/alt keys if neeeded.
- Look at the Unicode char first, then ascii."
- KeyDecodeTable
- at: {evt at: 6. evt at: 5}
- ifPresent: [:a | evt at: 6 put: a first;
- at: 5 put: a second].
- KeyDecodeTable
- at: {evt at: 3. evt at: 5}
- ifPresent: [:a | evt at: 3 put: a first;
- at: 5 put: a second].
  self queueEvent: evt.
  self processKeyboardEvent: evt .
  ^self ].
 
+ "Handle all events other than Keyboard or Mouse."
- "Handle all events other than Keyborad or Mouse."
  self queueEvent: evt.
  !

Item was changed:
  ----- Method: SmallInteger>>highBit (in category 'bit manipulation') -----
  highBit
  "Answer the index of the high order bit of the receiver, or zero if the  
  receiver is zero. Raise an error if the receiver is negative, since  
  negative integers are defined to have an infinite number of leading 1's
  in 2's-complement arithmetic. Use >>highBitOfMagnitude if you want to
  get the highest bit of the magnitude."
+ <primitive: 575>
  self < 0 ifTrue: [^ self error: 'highBit is not defined for negative integers'].
  ^ self highBitOfPositiveReceiver!

Item was changed:
  ----- Method: SmallInteger>>highBitOfMagnitude (in category 'bit manipulation') -----
  highBitOfMagnitude
  "Answer the index of the high order bit of the receiver, or zero if the  
  receiver is zero. This method is used for negative SmallIntegers as well,  
  since Squeak's LargeIntegers are sign/magnitude."
 
+ <primitive: 575>
+ self < 0 ifTrue: [^self negated highBit].
- self < 0 ifTrue: [
- "Beware: do not use highBitOfPositiveReceiver
- because self negated is not necessarily a SmallInteger
- (see SmallInteger minVal)"
- ^self negated highBitOfMagnitude].
-
- "Implementation note: this method could be as well inlined here."
  ^self highBitOfPositiveReceiver!