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

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: probe.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: @(#)probe.fth 1.4 98/10/14
purpose: Package methods for Sun keyboard
copyright: Copyright 1990-1997 Sun Microsystems, Inc.  All Rights Reserved

\ About the only thing that currently isn't commented-out in this file
\ is a stub for aborted? which currently just returns false.  The USB
\ keyboard can't be "probed" at reset time the way the Sun keyboard was,
\ so if we have to wait until the first record is returned then we might
\ as well look for the L1-X sequences later during the "regular" key
\ processing sequence!

\ headerless

\ d# 128 8 / constant /downkeys
\ /downkeys instance buffer: downkeys

\
\ WARNING: This routine returns to its callers parent, with rval
\ on the data stack, but only if the key corresponding to scancode was down.
\
\ : keypressed? ( scancode rval -- flag )
\   swap downkeys 			( rval bit addr )
\   bittest if				( rval )
\    r> drop				( rval )  \ XX magic!!
\   else					( rval )
\    drop					( -- )
\   then					( -- )
\ ;

\ We may in fact need a wait-reset word, but that remains to be seen.
\ We definitely don't need one that monitors the Sun kbd reset sequence.
\ : wait-reset ( ?? -- ?? )
\ ;

\ : wait-reset  ( -- bailed? )
   \ Wait for the reset sequence, discarding all prior keys
\    kbd-reset-wait get-msecs + true	( ms more? )
\    begin				( ms more? )
\      over time-reached? 0=		( ms more? flag )
\      over and				( ms more? flag' )
\    while				( ms more? )
\       d# 100 key-timeout? 0= if		( ms more? )
\          kbd-holding c@ resetkey = if	( ms more? )
\             resetkey bput		( ms more? )
\             nextkey  keybid !		( ms more? )
\             ['] normal is keypress	( ms more? )
\             drop false			( ms false )
\          then				( ms more? )
\       then				( ms more? )
\    repeat nip				( timeout? )
\ ;


\  do-probe resets the keyboard to determine if it is present.
\  If the keyboard is not present (i.e. it does not respond to the reset
\  command within a certain time), 0 is returned.
\  Otherwise, the address of a bitmap showing which keys were depressed
\  at the time of the reset is returned.
\
\ Its unclear that USB will send back keys that are down at the time
\ or a reset.  And since the L1-X sequences will come late in the game
\ it's also uncertain if that information will be worth anything, so
\ the do-probe word has been commented out for now.
\ : do-probe ( click -- present? )
\    begin   \ Discard prior received characters
\       nextkey  nokey =
\    until
\ 
\    reset 0= if 0 exit then	\ Nothing there
\ 
   \ See which keys are down.
\    downkeys  /downkeys erase
\    0					( dummy-key# )
\    begin
\       drop				( )
\       nextkey	  	     		( key# )
\       -1 over <> Idle 2 pick <> and	( key# flag )
\    while				( key# )
\       released over and invert  if	( key# )
\         dup downkeys bitset		( key# )
\       then				( key# )
\    repeat				( key# )
\    drop					( )
\    true
\ ;

\ headers			\ XXX for debugging
external

: abort?  ( -- flag )
  false
;
\ Called from the support layer to cope with special keyboard
\ L1 sequences.
\
\ : abort?  ( -- flag )
\    1 downkeys bittest if	( -- )		\ L1 was down
\      d#  80 ascii F keypressed?	( -- F )	\ L1-F
\      d# 105 ascii N keypressed?	( -- N )	\ L1-N
\      d#  79 ascii D keypressed?	( -- D )	\ L1-D
\    then
\    false			( false )
\ ;

\ headerless			\ XXX keep heads for debugging
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: probe.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)probe.fth 1.4 98/10/14
	43	purpose: Package methods for Sun keyboard
	44	copyright: Copyright 1990-1997 Sun Microsystems, Inc. All Rights Reserved
	45
	46	\ About the only thing that currently isn't commented-out in this file
	47	\ is a stub for aborted? which currently just returns false. The USB
	48	\ keyboard can't be "probed" at reset time the way the Sun keyboard was,
	49	\ so if we have to wait until the first record is returned then we might
	50	\ as well look for the L1-X sequences later during the "regular" key
	51	\ processing sequence!
	52
	53	\ headerless
	54
	55	\ d# 128 8 / constant /downkeys
	56	\ /downkeys instance buffer: downkeys
	57
	58	\
	59	\ WARNING: This routine returns to its callers parent, with rval
	60	\ on the data stack, but only if the key corresponding to scancode was down.
	61	\
	62	\ : keypressed? ( scancode rval -- flag )
	63	\ swap downkeys ( rval bit addr )
	64	\ bittest if ( rval )
65	\ r> drop ( rval ) \ XX magic!!
66	\ else ( rval )
67	\ drop ( -- )
68	\ then ( -- )
69	\ ;
70
71	\ We may in fact need a wait-reset word, but that remains to be seen.
72	\ We definitely don't need one that monitors the Sun kbd reset sequence.
73	\ : wait-reset ( ?? -- ?? )
74	\ ;
75
76	\ : wait-reset ( -- bailed? )
77	\ Wait for the reset sequence, discarding all prior keys
78	\ kbd-reset-wait get-msecs + true ( ms more? )
79	\ begin ( ms more? )
80	\ over time-reached? 0= ( ms more? flag )
81	\ over and ( ms more? flag' )
82	\ while ( ms more? )
83	\ d# 100 key-timeout? 0= if ( ms more? )
84	\ kbd-holding c@ resetkey = if ( ms more? )
85	\ resetkey bput ( ms more? )
86	\ nextkey keybid ! ( ms more? )
87	\ ['] normal is keypress ( ms more? )
88	\ drop false ( ms false )
89	\ then ( ms more? )
90	\ then ( ms more? )
91	\ repeat nip ( timeout? )
92	\ ;
93
94
95	\ do-probe resets the keyboard to determine if it is present.
96	\ If the keyboard is not present (i.e. it does not respond to the reset
97	\ command within a certain time), 0 is returned.
98	\ Otherwise, the address of a bitmap showing which keys were depressed
99	\ at the time of the reset is returned.
100	\
101	\ Its unclear that USB will send back keys that are down at the time
102	\ or a reset. And since the L1-X sequences will come late in the game
103	\ it's also uncertain if that information will be worth anything, so
104	\ the do-probe word has been commented out for now.
105	\ : do-probe ( click -- present? )
106	\ begin \ Discard prior received characters
107	\ nextkey nokey =
108	\ until
109	\
110	\ reset 0= if 0 exit then \ Nothing there
111	\
112	\ See which keys are down.
113	\ downkeys /downkeys erase
114	\ 0 ( dummy-key# )
115	\ begin
116	\ drop ( )
117	\ nextkey ( key# )
118	\ -1 over <> Idle 2 pick <> and ( key# flag )
119	\ while ( key# )
120	\ released over and invert if ( key# )
121	\ dup downkeys bitset ( key# )
122	\ then ( key# )
123	\ repeat ( key# )
124	\ drop ( )
125	\ true
126	\ ;
127
128	\ headers \ XXX for debugging
129	external
130
131	: abort? ( -- flag )
132	false
133	;
134	\ Called from the support layer to cope with special keyboard
135	\ L1 sequences.
136	\
137	\ : abort? ( -- flag )
138	\ 1 downkeys bittest if ( -- ) \ L1 was down
139	\ d# 80 ascii F keypressed? ( -- F ) \ L1-F
140	\ d# 105 ascii N keypressed? ( -- N ) \ L1-N
141	\ d# 79 ascii D keypressed? ( -- D ) \ L1-D
142	\ then
143	\ false ( false )
144	\ ;
145
146	\ headerless \ XXX keep heads for debugging