qemu/roms/SLOF/slof/fs/term-io.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 IBM Corporation
   3 \ * All rights reserved.
   4 \ * This program and the accompanying materials
   5 \ * are made available under the terms of the BSD License
   6 \ * which accompanies this distribution, and is available at
   7 \ * http://www.opensource.org/licenses/bsd-license.php
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13
  14 : input  ( dev-str dev-len -- )
  15    open-dev ?dup IF
  16       \ Close old stdin:
  17       s" stdin" get-chosen IF
  18          decode-int nip nip ?dup IF close-dev THEN
  19       THEN
  20       \ Now set the new stdin:
  21       encode-int s" stdin"  set-chosen
  22    THEN
  23 ;
  24
  25 : output  ( dev-str dev-len -- )
  26    open-dev ?dup IF
  27       \ Close old stdout:
  28       s" stdout" get-chosen IF
  29          decode-int nip nip ?dup IF close-dev THEN
  30       THEN
  31       \ Now set the new stdout:
  32       encode-int s" stdout" set-chosen
  33    THEN
  34 ;
  35
  36 : io  ( dev-str dev-len -- )
  37    2dup input output
  38 ;
  39
  40
  41 1 BUFFER: (term-io-char-buf)
  42
  43 : term-io-key  ( -- char )
  44    s" stdin" get-chosen IF
  45       decode-int nip nip dup 0= IF 0 EXIT THEN
  46       >r BEGIN
  47          (term-io-char-buf) 1 s" read" r@ $call-method
  48          0 >
  49       UNTIL
  50       (term-io-char-buf) c@
  51       r> drop
  52    ELSE
  53       [ ' key behavior compile, ]
  54    THEN
  55 ;
  56
  57 ' term-io-key to key
  58
  59 \ this word will check what the current chosen input device is:
  60 \ - if it is a serial device, it will use serial-key? to check for available input
  61 \ - if it is a keyboard, it will check if the "key-available?" method is implemented (i.e. for usb-keyboard) and use that
  62 \ - if it's an hv console, use hvterm-key?
  63 \ otherwise it will always return false
  64 : term-io-key?  ( -- true|false )
  65    s" stdin" get-chosen IF
  66       decode-int nip nip dup 0= IF drop 0 EXIT THEN \ return false and exit if no stdin set
  67       >r \ store ihandle on return stack
  68       s" device_type" r@ ihandle>phandle ( propstr len phandle )
  69       get-property ( true | data dlen false )
  70       IF
  71          \ device_type not found, return false and exit
  72          false
  73       ELSE
  74          1 - \ remove 1 from length to ignore null-termination char
  75          \ device_type found, check wether it is serial or keyboard
  76          2dup s" serial" str= IF
  77             2drop serial-key? r> drop EXIT
  78          THEN \ call serial-key, cleanup return-stack, exit
  79          2dup s" keyboard" str= IF
  80             2drop ( )
  81             \ keyboard found, check for key-available? method, execute it or return false
  82             s" key-available?" r@ ihandle>phandle find-method IF
  83                drop s" key-available?" r@ $call-method
  84             ELSE
  85                false
  86             THEN
  87             r> drop EXIT \ cleanup return-stack, exit
  88          THEN
  89          2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false
  90       THEN
  91    ELSE
  92       \ stdin not set, return false
  93       false
  94    THEN
  95 ;
  96
  97 ' term-io-key? to key?