Initial commit of OpenSPARC T2 architecture model.

[OpenSPARC-T2-SAM] / obp / obp / dev / usb-devices / kbd / usbkeyin.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: usbkeyin.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 
\    conditions are met: 
\ 
\  - 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
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
\ id: @(#)usbkeyin.fth 1.19 06/12/15
\ purpose: 
\ copyright: Copyright 2006 Sun Microsystems, Inc.  All Rights Reserved


\ headers			\ XXX for debugging
external

1 instance value ha-toggle
: our-toggle  ( -- new-toggle )
  ha-toggle if
    0 dup to ha-toggle	( 0-toggle )
  else
    1 dup to ha-toggle	( 1-toggle )
  then
;


: get-keynumber  ( index -- key# )
  curr-byte1-bfaddr + c@
;


\ Once the current down keys have been evaluated and dealt with, they
\ become the previous report's keys, so copy all relevant data.
\
: copy-curr-to-prev  ( -- )

  /key-info-buff 0 do
     keybuff-curr^v i + c@   keybuff-prev i + c!
  loop

  shiftflag to pr-shiftflag   stopflag to pr-stopflag
  ctrlflag  to pr-ctrlflag    altgflag to pr-altgflag
  powerflag to pr-powerflag   monflag  to pr-monflag
;



\ Increment the variable (that's kept in the key input buffer) which
\ keeps track of how many nonspecial keys are down in the current report.
\
: count-curr-as-nonspcl  ( -- )
  keybuff-curr^v >#regl-keys-dn	( regkey-cnt-adr )
  dup c@ 1+ swap c!
;


\ If the keynumber matches for a special key ( Control, Shift - including
\ capslock, Altg, Power, Mon or Stop ) then set the index from the 1st
\ keybyte buff location into its "flag".
\ At the same time keep a count of the non-special keys.
\
\ Note that in a way this is cheating because we haven't used the
\ keymap to get the "intent" of the key# - we've explicitly associated
\ some of the key#s with their known actions.  This will be OK for two
\ reasons; 1) We won't take action on the special keys (except Stop)
\ until later when we're applying the "rules", and 2) regardless of
\ country layout, the key#/action for each of these keys will always
\ remain constant.  So, for example, if we get a key# of 102 (power
\ key), it will only matter to us later if a shift key is also present.
\
: chk-n-set-spcl|regl  ( -- )
  0 keybuff-curr^v >#regl-keys-dn c!		\ init count to 0
  curr-#ksdn-bfaddr c@				( #downkeys )
  0 do
     true   i get-keynumber			( yes-spcl-flag key# )
 
     case
     \ Note that the case doesn't contain values for rt shift or rt
     \ control since we explicitly convert the modifier byte's bits
     \ to be left shift and left control (in "add-key-to-array").
        d# 225 of   i to shiftflag   endof	\ left shift
        d# 224 of   i to ctrlflag    endof	\ left control
        d# 230 of   i to altgflag    endof	\ right alt == Altgraph
        d# 57  of   i to shiftflag   endof	\ capslock
        d# 102 of   i to powerflag   endof	\ power key
        d# 127 of   i to monflag     endof	\ mute(nonshift)
                                          	\ mon-off-on(shift)
        d# 120 of   i to stopflag    endof	\ stop (L1) key down
 
        nip false swap				( no-spcl-flag key# )
     endcase					( spcl-flag? )
 
     \ Now use the index and flag to mark the key as special or regular.
     false = if					( )
        count-curr-as-nonspcl			( )
     then
  loop
;


\ If the control key is down and it is in effect (it is the highest
\ priority control key down) then apply the control offset to the
\ keyvalue.
\
: chk&adjust4ctrl ( keyvalue' -- keyvalue )

  ctrl-in-effect if
     ctrlflag -1 > if
        h# 1f and	( keyvalue )
     then
  then
;


\ Take the key# (prior to conversion to the ascii char) and see if it was
\ in the previous report.
\
: in-last-rep?  ( key# -- flag )
  false swap					( flag' key# )
  keybuff-prev >#keys-down c@ dup if		( flag' key# #prev-kys-dn )
     0 do					( flag' key# )
        dup prev-byte1-bfaddr i + c@ = if	( flag' key# )
           nip true swap			( true-flag key# )
        then					( flag' key# )
     loop   1					( flag' key# dropjunk )
  then						( flag' key# something )
  2drop						( flag )
;


: set-repeating-flag  \ ( prpt|-1 rpting? newk|-1 key# keyval --
                      \   -- prpt|-1 rpting?' newk|-1 )
\ drop rot true or -rot
  2drop >r  true or  r> 
;


: chknset-potential-rpt  \ ( prpt|-1 rpting? newk|-1 k# keyval --
                         \   -- prpt rpting? newk|-1 )
  >r drop		( prpt|-1 rpting? newk|-1 ) ( R: keyval )
  rot dup -1 = if	( rpting? newk|-1 prpt|-1 ) ( R: keyval )
     drop r>		( rpting? newk|-1 prpt )    
  else
     r> drop		( rpting? newk|-1 prpt )    
  then
  -rot 			( prpt rpting? newk|-1 )
;


\ Set the keval as the newkey, but only if another keyval from the current
\ report hasn't already been set.  (The first "new" key found is used.)
\
: chknset-new-keyval-rcvd  \ ( prpt|-1 rpting? newk|-1 keyval --
                           \   -- prpt|-1 rpting? newkey' )
  swap dup -1 = if	( prpt|-1 rpting? keyval newk|-1 )
     drop 		( prpt|-1 rpting? newkey )
  else
     nip 		( prpt|-1 rpting? prev-newkey )
  then
;


: queue?-adjust-flags \ ( prpt|-1 rpting? newkey|-1 key# keyval -- 
                      \   -- prpt|-1' rpting?' newkey|-1' )
  dup curr-repeat-key = if	( prpt|-1 rpting? nwkey|-1 k# keyval )
     set-repeating-flag		( prpt|-1 rpting! newkey|-1 )
     exit
  then				( prpt|-1 rpting? nwkey|-1 k# keyval )

  over in-last-rep? if		( prpt|-1 rpting? nwkey|-1 k# keyval )
     chknset-potential-rpt	( prpt' rpting? newkey|-1 )
     exit
  then	nip			( prpt|-1 rpting? newkey|-1 keyval )

  dup bput			( prpt|-1 rpting? newkey|-1 keyval )
  chknset-new-keyval-rcvd	( prpt|-1 rpting? newkey' )
;


\ Go through the list of keys which are down, queuing any new keys after
\ they've been converted to ascii chars.  Three items are returned;
\ 1)  The first key in the current report which was also seen in the
\     last report - but which is not the repeat key, or -1 if those
\     criteria are not met.
\ 2)  A true/false flag which indicates if the repeat key was found in
\     in this latest report.
\ 3)  The first "new" key in the report, or a -1 if there were no new
\     keys seen.
\
defer convert      ' noop is convert

0 instance value shift-map?
0 instance value altg-map?

: setup-flags ( -- altg? shift? )
   altg-map? shift-map?
;

: queue-new-keys  ( -- potrptkey|-1 repeating? newkey|-1 )
  -1 false -1 	(		 prpt|-1 rpting? newk|-1 )

  curr-#ksdn-bfaddr c@		( prpt|-1 rpting? newk|-1 #dnkeys )
  0 do				( prpt|-1 rpting? newk|-1 )
     i get-keynumber dup	( prpt|-1 rpting? newk|-1 k# k# )
     setup-flags 		( prpt|-1 rpting? newk|-1 k# k# altg? shift? )
     convert			( prpt|-1 rpting? newk|-1 k# keyval )
     chk&adjust4ctrl		( prpt|-1 rpting? newk|-1  k# keyval' )
     queue?-adjust-flags	( prpt|-1' rpting?' newk|-1' )
  loop
;


\ There's a new key, so mark it and add in the initial delay time
\ for the repeat timer mechanism.
\
: new-repeat-key  ( keyvalue -- )
  to curr-repeat-key				( )
  get-msecs d# 700 + to key-repeat-time
;


\ Using the specified keymap, have the regular keys queued and then
\ set the repeat key.  The algorithm for determining the repeat key is
\ as follows;
\ 1)  If a new keyvalue is found that was not in the last report then
\     set it as the new repeat key.
\ 2)  If no new keyvalue was found, see if the currently repeating
\     keyvalue was seen - if so take no action so that the timers will
\     be continuous.
\ 3)  If there's no new key, and the currently repeating key was not
\     seen, it's still possible that a keyvalue that was found in the
\     last report is still in the current report, and if so then that
\     keyvalue becomes the repeat key.  (This would occur if the user
\     pressed two or more keys simultaneously, but then released one
\     or more keys - including the repeat key, but still kept one or
\     more keys pressed.)
\
: process-dn-keys  ( -- )
  queue-new-keys	( potrptkey|-1 repeating? newkey|-1 )

  dup -1 > if		( potrptkey|-1 repeating? newkey|-1 )
     new-repeat-key	( potrptkey|-1 repeating? )
     2drop exit
  then  drop		( potrptkey|-1 repeating? )

  if			( potrptkey|-1 )
     drop exit		\ The "old" repeat key continues...
  then			( potrptkey|-1 )

  dup -1 = if		( potrptkey|-1 )
     drop		( )
     nokey to curr-repeat-key
  else
     new-repeat-key	( )
  then
;


\ The only special key down is Stop, and at least 1 regular key is down.
\ Stop-a was taken care of elsewhere.  Not yet certain if we're going
\ to attempt to put in Stop-d, Stop-n or Stop-f, so ignore for now.
\
: eval-stop+keys ( table-offset -- )
  process-dn-keys	( )
;

: stop-&-regl-dn  ( -- )
  false to shift-map? false to altg-map? eval-stop+keys	
;


: shift-&-regl-dn  ( -- )
  true to shift-map? false to altg-map? process-dn-keys
;


: altg-&-regl-dn  ( -- )
  false to shift-map? true to altg-map? process-dn-keys
;


\ Find out if each of the xspecial keys (don't bother with the monitor or
\ power keys) that are currently down were also down in the last report
\ - if so return a true flag.
\
: all-spcl-prev-dn?		( -- flag )
  true				( flag' )
  stopflag -1 <> if
     pr-stopflag -1 <> and	( flag' )
  then
  shiftflag -1 <> if
     pr-shiftflag -1 <> and	( flag' )
  then
  ctrlflag -1 <> if
     pr-ctrlflag -1 <> and	( flag' )
  then
  altgflag -1 <> if
     pr-altgflag -1 <> and	( flag )
  then
;


: check-shift-power&mon  ( -- )

  powerflag -1 > if   turn-me-off   then
  monflag -1 > if     toggle-mon    then
;


: do-shift-&-regl-dn  ( -- )
  check-shift-power&mon shift-&-regl-dn
;


\ Determine the highest priority spcecial key that is down so that only
\ it will be considered when we evaluate the "normal" keys that will go
\ into the queue.
\
: use-hipri-spcl  ( -- )
  stopflag -1 > if
     stop-&-regl-dn		( )
     exit
  then

  shiftflag -1 > if
     do-shift-&-regl-dn		( )
     exit
  then

  ctrlflag -1 > if
     -1 to ctrl-in-effect	( )
     shift-&-regl-dn		( )
     0 to ctrl-in-effect	( )
     exit
  then

  altgflag -1 > if
     altg-&-regl-dn		( )
     exit
  then
;



\ Return true if the current flag is set and the previous flag is not set.
\
: only-curr-set?  ( curr-flag-val|-1 prev-flag-val|-1 -- flag )
  -1 =			( curr-flag-val flag' )
  swap -1 > and
;


\ One or more special keys down.  If only one is new then ignore the
\ rest and use the new.  If more than one special key is new then use
\ the one with the highest priority.  Note that checking of Stop-a was
\ done prior to arriving here.
\
: spcl-keys-dn ( -- )

  all-spcl-prev-dn? if		( )
     \ Since there are no new special keys, we're going to select the
     \ highest priority key as the one to use.
     use-hipri-spcl		( )
  else
     \ Find out which of the special keys are "new" and select the
     \ highest priority key from that one.

     stopflag pr-stopflag only-curr-set? if
        stop-&-regl-dn		( )
        exit
     then

     shiftflag pr-shiftflag only-curr-set? if
        do-shift-&-regl-dn	( )
        exit
     then

     ctrlflag pr-ctrlflag only-curr-set? if
        -1 to ctrl-in-effect	( )
        shift-&-regl-dn		( )
        0 to ctrl-in-effect	( )
        exit
     then

     \ If none of the above-three are the new down special then it must
     \ be the AltGraph key.
     altg-&-regl-dn		( )
  then
;


\ Determine if special keys are present and will be used, or if there
\ are only std keys.
\ Note that checking of Stop-a was done prior to arriving here.
\
: due-process  ( #spclkeys-dn -- )
  dup curr-#ksdn-bfaddr c@ swap	( #spclkeys-dn #keys-dn #spclkeys-dn )
  - 0= if			( #spclkeys-dn )
     \ Only spcl keys down.
     shiftflag -1 = if		( #spclkeys-dn )
        \ If one of the spcl keys wasn't the shift key (indicating that a
        \ shift-power or shift-mon could be possible) then no keys from
        \ the current report will go into the queue.
        nokey to curr-repeat-key	( )
        drop   exit		( )
     then
  then				( #spclkeys-dn )
 
  if
     spcl-keys-dn		( )
  else
     false to shift-map? false to altg-map? process-dn-keys
  then
;


\ The Stop key is known to be down, so cycle through all down keys to
\ see if the 'a' key is down.
\
: stopA-active?  ( -- StopA? )
  false curr-#ksdn-bfaddr c@	( StopA?' #down-keys )
  0 do
     i get-keynumber		( StopA?' key# )
     4 = if			( StopA?' )
        true or leave		( yes-StopA )
     then
  loop				( StopA? )
;
 
\ Check to see if alternate break chord is pressed - shift-pause

: shift-pause? ( -- SPause? )
  false curr-#ksdn-bfaddr c@	( false #down-keys )
  0 do
     i get-keynumber		( false key# )
     d# 72 = if			( false )
        true or leave		( true-SPause? )
     then
  loop				( SPause? )
;



\ If more than 1 key is down then we'll need to apply a set of "rules"
\ that will let us know the precedence of the pressed keys.  For example,
\ there might just be several normal keys down, or there may be special
\ keys down as well.  In the case where multiple keys are reported, we'll
\ look at the down keys in the previous report (if any) to see if it can
\ be determined which of the current down keys are "new".
\
: start-key-processing  ( -- Abort-of-some-kind-requested? )
  chk-n-set-spcl|regl			( )

  shiftflag -1 > if
    shift-pause? dup if			( SPause? )
      exit
    then
  else
    stopflag -1 > if
       stopA-active? dup if		( StopA? )
          exit				( yes-StopA )
       then
    else
       false				( no-stopA )
    then
  then

  curr-#ksdn-bfaddr c@			( no-StopA #down-keys )
  keybuff-curr^v >#regl-keys-dn c@ -	( no-StopA #spclkeys-dn )
  due-process				( no-StopA )
;


\ Sets the global offset into the current and previous report's key-down
\ buffer to point to the 1st (of 9) key-down bytes.  A pointer to the
\ # of keys down in the current buffer is also set since it's used
\ frequently.
\
: set-oftused-buf-offsets  ( -- )
  keybuff-curr^v >kbd-in-byte1 to curr-byte1-bfaddr
  keybuff-curr^v >#keys-down   to curr-#ksdn-bfaddr

  keybuff-prev >kbd-in-byte1 to prev-byte1-bfaddr
;


\ Receive a keyvalue which represents a special key, and place it
\ into the 1st available array position in the input key array.
\
: add-key-to-array  ( #dn-keys modbyte byte-to-add -- #dn-keys' modbyte )
  swap >r				( #down-keys' byte-2-add )
  over keybuff-curr^v >kbd-in-byte1 +	( #dn-keys' byte-2-add byteN-addr)
  c!   1+   r>				( #dn-keys' modbyte )
;


\ 1 indicates a keyboard rollover - indicating too many keys pressed or
\ kbd is confused; 2 indicates kbd diag failure; 3 is undefined error;
\ The rollover error seems to be cleared on next understandable keypress,
\ but don't know about the other two.
\
: kbd-err?  ( key-value -- flag )
  4 < if true else false then
;


\ The "down" keys from the latest key report are placed into one of the
\ buffers by the HA by specifying its address in the enable-interrupts
\ call to the HA; We then use pointers to the buffers to get at the
\ key information.
\ USB keyboards automatically sets individual key bytes to 0 if no key
\ is down.
\ Note that we'll "copy" any shift, cntrl or AltGraph keys into the
\ 1st open slot in the array (based on the info in the modifier byte). This
\ is being done since the code was originally written to expect those
\ three special keys to be returned in the array rather than the modifier
\ byte.  The buffer definition was extended 3 bytes just for this purpose.
\
: set-#down-keys  ( -- #down-keys )
  0						( #down-keys' )
  6 0 do
     i get-keynumber ?dup if			( #down-keys' key-value )
        kbd-err? if				( #down-keys' )
           drop 0 leave				( 0-down-keys )
        else
           1+					( #down-keys' )
        then
     then
  loop						( #down-keys' )

  dup 0= if
    exit					( #down-keys )
  then						( #down-keys' )

  keybuff-curr^v >kbd-in-modkeys c@		( #down-keys' modbyte )

  dup h# 11 and if				\ either left or rt cntrl
     d# 224 add-key-to-array			( #down-keys' modbyte )
     \ put the byte representing a Cntrl into
     \ the 1st available key array locn
  then
  dup h# 22 and if				\ either left or rt shift
     d# 225 add-key-to-array
     \ put the byte representing a Shift into
     \ the 1st available key array locn
  then
  dup h# 40 and if				\ rt alt = AltGraph
     d# 230 add-key-to-array			( #down-keys' modbyte )
     \ put the byte representing an AltGraph 
     \ into the 1st available key array locn
  then
  drop						( #down-keys )
  dup curr-#ksdn-bfaddr c!			( #down-keys )
;
 

\ In the buffer that holds the key information for the previous key
\ report, zero the bytes that hold the # of down keys and # of "regular"
\ down keys, and clear the special key flags.
\
: clear-all-prev-keys  ( -- )
  0 keybuff-prev >#keys-down c!
  0 keybuff-prev >#regl-keys-dn c!
  -1 to pr-shiftflag   -1 to pr-ctrlflag   -1 to pr-altgflag
  -1 to pr-powerflag   -1 to pr-monflag    -1 to pr-stopflag
;


\ In the buffer that holds the key information for the current key
\ report, zero the bytes that hold the # of down keys and # of "regular"
\ down keys, and clear the special key flags.  Don't need to zero the
\ individual key data bytes because they are set for each report by the
\ hid kbd device.
\
: clear-all-curr-keys  ( -- )
  0 curr-#ksdn-bfaddr c!
  0 keybuff-curr^v >#regl-keys-dn c!
  -1 to shiftflag   -1 to ctrlflag   -1 to altgflag
  -1 to powerflag   -1 to monflag    -1 to stopflag
;


\ An "ack" was received from the keyboard, so we can now go and evaluate
\ the keycodes that were received in the current report.
\
: eval-key-data   ( -- Stop-a? )

   0 to unstall-cnt
  set-#down-keys if			( )
  \ If *any* key was pressed - std or "special", i.e. cntrl.
     start-key-processing		( Stop-a? )
     copy-curr-to-prev			( Stop-a? )
     clear-all-curr-keys		( Stop-a? )
  else
     clear-all-prev-keys   false	( no-Stop-a )
     nokey to curr-repeat-key		( no-Stop-a )
  then
;

\ Clear the software state associated with the keyboard. This is called
\ when the PROM is entered from an unknown state.
\
: clear-keyboard ( -- )
  initkeybuf		\ clear the keyboard circular queue
  clear-all-curr-keys
  clear-all-prev-keys
  nokey to curr-repeat-key
;