\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: kbd.fth
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ - Do no alter or remove copyright notices
\ - Redistribution and use of this software in source and binary forms, with
\ or without modification, are permitted provided that the following
\ - Redistribution of source code must retain the above copyright notice,
\ this list of conditions and the following disclaimer.
\ - Redistribution in binary form must reproduce the above copyright notice,
\ this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\ Neither the name of Sun Microsystems, Inc. or the names of contributors
\ may be used to endorse or promote products derived from this software
\ without specific prior written permission.
\ This software is provided "AS IS," without a warranty of any kind.
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ ========== Copyright Header End ============================================
id: @(#)kbd.fth 1.1 07/01/24
purpose: USB boot keyboard driver
copyright: Copyright 2007 Sun Microsystems, Inc. All Rights Reserved
\ See license at end of file
\ Code copied from Sun's old keyboard driver
0 instance value kbd-package
\ We didn't use interpose so we use call-methods instead.
\ This sucks.. but until the pathname part of interpose works
\ properly we need to live with this ick.
: .call-kbd ( str,len -- XXX? ) kbd-package $call-method ;
: kbd-convert ( key# alt shft -- entry )
: init-kbd-package ( -- okay? )
my-args " kbd-translator" $open-package to kbd-package
." Can't open USB keyboard package" cr false
\ Interfaces into keyboard translator package for setting keyboard layouts
: set-keyboard-layout ( $layout-name -- failure?)
" set-keyboard-layout" .call-kbd
: get-layout-names ( buffer size -- size )
" get-layout-names" .call-kbd
: kbd-dropin&id ( -- magic$ dropin$ layoutid )
" UKBD" " usbkbds" get-kbd-cntry-id
\ End code copied from Sun's old keyboard driver
variable kbd-refcount 0 kbd-refcount !
: +refcnt ( n -- ) kbd-refcount +! ;
: /string ( adr len n -- adr' len' ) tuck - -rot + swap ;
false value check-abort? \ True to abort on CTRL-BREAK
false value locked? \ Interrupt lockout for get-scan
: lock ( -- ) true to locked? ;
: unlock ( -- ) false to locked? ;
\ Scan code queue: raw data from USB keyboard (see later comment on entry detail)
\ head is index to the start of queue to deque
\ tail is index to the last entry enqued
\ Each entry is a tuple of (mm xx kc kc kc kc kc kc)
\ where mm is modifier (bit mask of the gui, alt, shift, ctrl keys)
\ kc are the raw scan codes, 0 meaning null
\ A new-entry is enqued iff the last-entry is not the same as the new-entry
\ to avoid duplicate entries. This is an effort not to duplicate raw data
\ Except where BREAK is concerned, the get-scan code does not really interpret
\ the content of the raw data.
h# 11 constant mm-mask-ctrl
h# 22 constant mm-mask-shift
h# 44 constant mm-mask-alt
h# 88 constant mm-mask-gui
\ Constants and variables for typematic
0 value last-ts \ Last timestamp
d# 500 constant repeat-delay \ Typematic begins after x ms, repeat key
d# 30 constant repeat-rate \ Repeat key after y ms in typematic mode
d# 4 constant idle-rate \ Parameter for set-idle
variable head 0 head ! \ Index into q
variable tail 0 tail ! \ Index into q
/q buffer: q \ #qe entries of length /qe each
#qe 1- value q-end \ Index into q
/qe buffer: last-entry \ Buffer to hold the last entry (from kbd)
/qe buffer: new-entry \ Buffer to hold the new entry (from kbd)
/qe buffer: cur-entry \ Buffer to hold the current entry being
\ examined by getkey (to application)
/qe buffer: null-entry \ Buffer to hold a null entry
: init-q ( -- ) 0 head ! 0 tail ! #qe 1- to q-end ;
: inc-q-ptr ( pointer-addr -- )
dup @ q-end >= if 0 swap ! else 1 swap +! then
: q-adr ( pointer-addr -- adr ) @ /qe * q + ;
tail @ head @ 2dup > if - q-end else 1- then ( new-entry$ tail head )
<> if tail q-adr swap move tail inc-q-ptr else 2drop then
: deque? ( -- false | entry$ true )
cur-entry /qe 2dup head q-adr -rot move head inc-q-ptr true
\ We enque the new-entry if one of the following is true:
\ 1. It is different from the last-entry. Update last-ts and
\ set typematic? to false.
\ 2. It is the same as the last-entry and it is non-zero and
\ typematic? is false and repeat-delay has expired.
\ In this case, set typematic? true and update last-ts.
\ 3. It is the same as the last-entry and typematic? is true
\ and repeat-rate has expired.
\ In this case, update last-ts.
: key-pressed? ( entry$ -- flag ) dup 4 + l@ swap l@ or 0<> ;
: ok-to-enque? ( entry$ -- flag )
last-entry swap comp if \ new-entry <> last-entry
get-msecs to last-ts \ Update last-ts
false to typematic? \ End any auto-repeat
true \ Enque the new-entry
else \ new-entry = last-entry
get-msecs dup last-ts - repeat-rate u>= if
to last-ts \ Update last-ts
true \ In auto-repeat, enque the new-entry
drop false \ Don't auto-repeat yet
last-entry key-pressed? if
get-msecs dup last-ts - repeat-delay u>= if
to last-ts \ Update last-ts
true dup to typematic? \ Start auto-repeat
drop false \ Don't auto-repeat yet
\ Check for L1-a sequence (sun-specific)
: l1-a? ( entry$ -- flag )
2 /string 2dup ( entry$' entry$' )
false -rot bounds ?do ( entry$' flag )
i c@ h# 78 = if drop true leave then ( entry$' flag )
\ If we found an l1, see if we have an "a" as well
if false -rot bounds ?do ( flag )
i c@ h# 4 = if drop true leave then ( flag )
\ Check for shift-pause/break (sun-specific, firmworks uses control-break)
: shift-pause/break? ( entry$ -- flag )
over c@ mm-mask-shift and if
false -rot bounds ?do ( flag )
i c@ h# 48 = if drop true leave then \ Pause/Break key
: check-abort ( entry$ -- flag ) \ L1-A or shift-break pressed?
2drop true ( flag ) \ L1-a was pressed
shift-pause/break? ( flag )
new-entry /qe get-data? ( actual )
new-entry /qe ok-to-enque? if ( )
new-entry /qe 2dup last-entry swap move \ Update last-entry
2dup ( new-entry$ new-entry$ )
\ In the following code, we must be careful to unlock the
\ queue before calling user-abort, because a timer interrupt
\ can occur at any time after user-abort is executed.
\ Wait here for long enough to ensure that an alarm timer tick
\ will happen if it is going to happen. This is the safest
\ solution I have found to the following problem: If the abort
\ sequence is detected while polling the keyboard from the
\ application level (i.e. not from the alarm handler), then
\ the alarm handler is likely to sense it a little later,
\ perhaps in the middle of deque? . Aborting in the middle of
\ of deque? is bad, because it leaves the lock set and potentially
\ leaves the queue pointers and/or stateful hardware in an
\ inconsistent state. One solution would be to avoid calling
\ deque after calling user-abort, but that would hang the driver
\ if the alarm tick is turned off.
enque \ If no abort, then enqueue the character
\ Process entries in the scan code queue.
\ For simplicity, the following process usesa key-state buffer which
\ is indexed by kc. Each kc has a byte stating its state. The states
\ For each raw data entry from q,
\ for each kc, if key-state[kc]==01, set to -1 \ make current previous
\ else if key-state[kc]==-1, set to 0 \ make old previous null
\ for each kc found, if key-state[kc]==0, process kc \ queue if ascii
\ key-state[kc]=1 \ mark it currently pressed
\ There's plenty of room of performance/space fine tuning.
false value shift? \ True if the shift key is down
false value ctrl? \ True if the ctrl key is down
false value alt-gr? \ True if the AltGr key is down
: #queued++ ( -- ) #queued 1+ to #queued ;
: enque-ascii ( char -- )
#queued /aq = if drop exit then
( char ) ascii-queue #queued + c!
: ?ctrl ( char -- char' )
dup h# 40 h# 7f between if h# 1f and then
: modifier? ( scan-code -- true | scan-code false )
39 of scroll-lock? if \ If ScrollLock is on ...
true to ctrl? \ ... treat the CapsLock key like Ctrl
else \ Otherwise give it ...
led-mask-caps-lock toggle-leds \ ... the normal CapsLock function
then true endof \ Caps Lock
53 of led-mask-num-lock toggle-leds true endof \ Num Lock
47 of led-mask-scroll-lock toggle-leds true endof \ Scroll Lock
( otherwise ) dup false rot
endcase ( true | scan-code false )
: process-scancode ( modifer scan-code -- )
\ Handle modifiers: alt, shift, ctrl
swap ( scan-code modifier )
dup mm-mask-ctrl and 0<> to ctrl?
dup mm-mask-shift and 0<> to shift?
mm-mask-alt and 0<> to alt-gr?
\ Handle modifier: NumLock, CapsLock, ShiftLock
modifier? if exit then ( scan-code )
\ Call Sun's translator code instead of using firmwork's
\ get-ascii if enque-ascii then ( )
alt-gr? shift? kbd-convert ?ctrl ( ascii-value )
h# 100 constant /key-state \ Can probably be optimized to A5
/key-state buffer: key-state
00 constant ks-none \ Not pressed
01 constant ks-curr \ Currently pressed
ff constant ks-prev \ Previously pressed
: update-key-state ( -- )
key-state /key-state bounds 1+ do
ks-curr of ks-prev i c! endof
ks-prev of ks-none i c! endof
: entry->char ( entry$ -- false | ASCII-code true )
update-key-state ( entry$ )
over c@ -rot 2 /string ( mm entry$' )
dup key-state + dup c@ ( mm mm kc 'ks ks )
ks-curr rot c! ( mm mm kc ks ) \ Update key-state[kc]
ks-none = if process-scancode else 2drop then ( mm )
#queued if #queued 1- dup to #queued ascii-queue + c@ true else false then
: getkey ( -- ASCII-char true | false )
#queued if #queued 1- dup to #queued ascii-queue + c@ true exit then
get-scan deque? 0= if false exit then ( entry$ )
entry->char until ( ASCII-char )
: install-abort ( -- ) true to check-abort? ; \ Check for break
: remove-abort ( -- ) false to check-abort? ;
\ Read at most "len" characters into the buffer at adr, stopping when
\ no more characters are immediately available.
: read ( adr len -- #read ) \ -2 for none available right now
\ Poll the keyboard even if len is 0, as extra insurance against overrun
dup 0<> if getkey else false then ( len adr' len' [ char ] flag )
while ( len adr' len' char )
2 pick c! ( len adr' len' )
1 /string ( len adr'' len'' )
dup 0= if drop -2 then ( #read | -2 )
kbd-refcount @ if 1 +refcnt true exit then
noop \ Add noop so I can patch it before open
get-msecs to last-ts \ Initialize auto-repeat timestamp
false to typematic? \ Not in auto-repeat mode yet
init-kbd-package \ Bring in keyboard translator
-1 +refcnt kbd-refcount @ if exit then
: selftest ( -- 0 ) kbd-refcount @ 0<> if 0 else -1 then ;
key-state /key-state erase
configuration set-config if ." Failed to set keyboard configuration" cr then
set-boot-protocol if ." Failed to set boot protocol" cr then
idle-rate set-idle if ." Failed to set idle" cr then
\ Copyright (c) 2006 FirmWorks
\ Permission is hereby granted, free of charge, to any person obtaining
\ a copy of this software and associated documentation files (the
\ "Software"), to deal in the Software without restriction, including
\ without limitation the rights to use, copy, modify, merge, publish,
\ distribute, sublicense, and/or sell copies of the Software, and to
\ permit persons to whom the Software is furnished to do so, subject to
\ the following conditions:
\ The above copyright notice and this permission notice shall be
\ included in all copies or substantial portions of the Software.
\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
projects / OpenSPARC-T2-SAM / blob