Virtualization
/
SLOF
mirror of https://gitlab.com/qemu-project/SLOF.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

resolve ihandle and xt handle in the input command (like for the output) 

Signed-off-by: Laurent Vivier <lvivier@redhat.com>
Reviewed-by: Thomas Huth <thuth@redhat.com>
Signed-off-by: Alexey Kardashevskiy <aik@ozlabs.ru>
This commit is contained in:
Laurent Vivier 2018-05-17 15:16:04 +02:00 committed by Alexey Kardashevskiy
parent f05c38f762
commit 85d5b4d62d
1 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
slof/fs/term-io.fs
View File

@ -10,10 +10,20 @@
\ * IBM Corporation - initial implementation \ * IBM Corporation - initial implementation
\ ****************************************************************************/ \ ****************************************************************************/
0 VALUE read-xt
0 VALUE write-xt 0 VALUE write-xt
VARIABLE stdin
VARIABLE stdout VARIABLE stdout
: set-stdin ( ihandle -- )
\ Close old stdin:
stdin @ ?dup IF close-dev THEN
\ Now set the new stdin:
dup stdin !
encode-int s" stdin" set-chosen
;
: set-stdout ( ihandle -- ) : set-stdout ( ihandle -- )
\ Close old stdout: \ Close old stdout:
stdout @ ?dup IF close-dev THEN stdout @ ?dup IF close-dev THEN
@ -24,12 +34,15 @@ VARIABLE stdout
: input ( dev-str dev-len -- ) : input ( dev-str dev-len -- )
open-dev ?dup IF open-dev ?dup IF
\ Close old stdin: \ find new ihandle and xt handle
s" stdin" get-chosen IF dup s" read" rot ihandle>phandle find-method
decode-int nip nip ?dup IF close-dev THEN 0= IF
drop
cr ." Cannot find the read method for the given input console " cr
EXIT
THEN THEN
\ Now set the new stdin: to read-xt
encode-int s" stdin" set-chosen set-stdin
THEN THEN
; ;
@ -51,7 +64,6 @@ VARIABLE stdout
2dup input output 2dup input output
; ;
1 BUFFER: (term-io-char-buf) 1 BUFFER: (term-io-char-buf)
: term-io-emit ( char -- ) : term-io-emit ( char -- )
@ -67,16 +79,14 @@ VARIABLE stdout
' term-io-emit to emit ' term-io-emit to emit
: term-io-key ( -- char ) : term-io-key ( -- char )
s" stdin" get-chosen IF read-xt IF
decode-int nip nip dup 0= IF 0 EXIT THEN BEGIN
>r BEGIN (term-io-char-buf) 1 read-xt stdin @ call-package
(term-io-char-buf) 1 s" read" r@ $call-method
0 > 0 >
UNTIL UNTIL
(term-io-char-buf) c@ (term-io-char-buf) c@
r> drop
ELSE ELSE
[ ' key behavior compile, ] serial-key
THEN THEN
; ;
@ -88,8 +98,7 @@ VARIABLE stdout
\ - if it's an hv console, use hvterm-key? \ - if it's an hv console, use hvterm-key?
\ otherwise it will always return false \ otherwise it will always return false
: term-io-key? ( -- true|false ) : term-io-key? ( -- true|false )
s" stdin" get-chosen IF stdin @ ?dup IF
decode-int nip nip dup 0= IF drop 0 EXIT THEN \ return false and exit if no stdin set
>r \ store ihandle on return stack >r \ store ihandle on return stack
s" device_type" r@ ihandle>phandle ( propstr len phandle ) s" device_type" r@ ihandle>phandle ( propstr len phandle )
get-property ( true | data dlen false ) get-property ( true | data dlen false )
@ -115,8 +124,7 @@ VARIABLE stdout
2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false 2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false
THEN THEN
ELSE ELSE
\ stdin not set, return false serial-key?
false
THEN THEN
; ;