obp/obp/pkg/keyboard/debug.fth

\ ========== Copyright Header Begin ==========================================
\
\ Hypervisor Software File: debug.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: @(#)debug.fth 1.3 99/02/25
\ purpose:
\ copyright: Copyright 1997 Sun Microsystems, Inc.  All Rights Reserved
\

: .line-dump ( -- ) ." DUMP: " kbd-char-ptr @ insert-ptr @ do i c@ . loop cr ;
: .rbase ( base -- ) .r base ! space ;
: .pdec ( xx -- ) base @ swap decimal 2 .rbase ;
: .poct ( xx -- ) base @ swap 8 base ! 3 .rbase ;
: .phex ( xx -- ) base @ swap hex 2 .rbase ;

: .decode-key ( code -- )
  case
    h#  8 of ." bs      " endof
    h#  9 of ." tab     " endof
    h#  a of ." linefeed" endof
    h#  d of ." carret  " endof
    h# 1b of ." esc     " endof
    h# 20 of ." bl      " endof

    h# 82 of ." shift   " endof
    h# 83 of ." power   " endof
    h# 84 of ." ctrl    " endof
    h# 85 of ." altg    " endof
    h# 86 of ." nop     " endof
    h# 87 of ." oops    " endof
    h# 88 of ." hole    " endof

    h# 90 of ." error   " endof
    h# 91 of ." idle    " endof
    h# 92 of ." mon-off/on" endof

    h# 7e of ." error   " endof
    h# 7f of ." del     " endof

    dup h# 0 h# 20 between if           ( char )
      ." h# " dup .phex 2 spaces        ( -- )
    else                                ( char )
      dup h# 90 > if                    ( char )
        ." o# " dup .poct space         ( char )
      else                              ( char )
        ." ascii " dup emit space       ( char )
      then                              ( char )
    then                                ( char )
  endcase  space                        ( -- )
;

\ interact

: .empty ( -- )         d# 9 spaces ;
: insert@ ( n -- )      insert-ptr @ + c@ ;
: .entry ( str,len -- ) 1 insert@ ." d# " .pdec type space ;
: 1st@ ( -- )           2 insert@ .decode-key ;
: 2nd@ ( -- )           3 insert@ .decode-key ;
: 3rd@ ( -- )           4 insert@ .decode-key ;

: .delta-debug ( type -- )
  case
    0 of
      cr
      ." >> decimal" cr ." >>" cr
      ." >> d# " kbddata-buffer >kbd-type c@ .d ." keyboard: "
       current-table$ type cr
      ." >> \ Normal Shift    Alt      Key#"
    endof
    2 of
      cr ." >> kend" cr
    endof
  endcase
  insert-ptr @ c@                       ( bits )
  ?dup if                               ( bits )
    cr ." >> "                          ( bits )
    case
      \       Normal    Shifted Alt     Code
      d# 0 of .empty    .empty  .empty  " none???"      .entry  endof
      d# 1 of .empty    .empty  1st@    " ak"           .entry  endof
      d# 2 of .empty    1st@    .empty  " sk"           .entry  endof
      d# 3 of .empty    2nd@    1st@    " sak"          .entry  endof
      d# 4 of .empty    .empty  .empty  " normal?"      .entry  endof
      d# 5 of 2nd@      .empty  1st@    " nak"          .entry  endof
      d# 6 of 2nd@      1st@    .empty  " nsk"          .entry  endof
      d# 7 of 3rd@      2nd@    1st@    " allk"         .entry  endof
    endcase                             ( -- )
  then                                  ( -- )
;

: .table-debug ( -- )
  cr ." >> : do8 8keys ;" cr
  ." >> d# " kbddata-buffer >kbd-coding c@ .d
  ." full-keyboard: " current-table$ type cr
  key-table 3 0 do              ( addr )
    i case
      0 of ." >> \ Normal Keys" endof
      1 of ." >> \ Shifted Keys" endof
      2 of ." >> \ Alt Keys" endof
    endcase cr
    keymap-size 0 do            ( addr )
      ." >> "                   ( addr )
      d# 8 0 do                 ( addr )
        dup i + c@ .decode-key  ( addr )
      loop ." do8" cr           ( addr )
      d# 8 +                    ( addr' )
    8 +loop                     ( addr' )
  loop drop                     ( -- )
;

: show3 ( addr -- )
  dup >k-altgmap   c@ .decode-key
  dup >k-shiftmap  c@ .decode-key
      >k-normalmap c@ .decode-key
;

: show-index ( index -- )
  dup
  ."             Alt      Shift    Normal" cr
  ." Keytable  : " key-table + show3 cr
  ." Basetable : " base-table + show3 cr
;
: si show-index ;

[ifndef] complete-tables?
' .delta-debug is delta-debug
[else]
' .table-debug is table-debug
[then]