1 \ tag: stdin/stdout handling
3 \ Copyright (C) 2003 Samuel Rydh
5 \ See the file "COPYING" for further information about
6 \ the copyright and warranty status of this work.
14 : input ( dev-str dev-len -- )
16 ." Input device " type ." not found." cr exit
19 " read" rot find-method 0= if
20 type ." has no read method." cr exit
25 2dup open-dev ?dup 0= if
26 ." Opening " type ." failed." cr exit
30 \ call install-abort if present
31 dup " install-abort" rot ['] $call-method catch if 3drop then
35 dup " remove-abort" rot ['] $call-method catch if 3drop then
41 " /chosen" find-package if
42 >r stdin @ encode-int " stdin" r> (property)
45 [IFDEF] CONFIG_SPARC32
46 \ update stdin-path properties
47 \ (this isn't part of the IEEE1275 spec but needed by older Solaris)
49 >r stdin @ get-instance-path encode-string " stdin-path" r> (property)
54 : output ( dev-str dev-len -- )
56 ." Output device " type ." not found." cr exit
59 " write" rot find-method 0= if
60 type ." has no write method." cr exit
65 2dup open-dev ?dup 0= if
66 ." Opening " type ." failed." cr exit
71 stdout @ ?dup if close-dev then
75 " /chosen" find-package if
76 >r stdout @ encode-int " stdout" r> (property)
79 [IFDEF] CONFIG_SPARC32
80 \ update stdout-path properties
81 \ (this isn't part of the IEEE1275 spec but needed by older Solaris)
83 >r stdout @ get-instance-path encode-string " stdout-path" r> (property)
88 : io ( dev-str dev-len -- )
92 \ key?, key and emit implementation
96 : io-key? ( -- available? )
97 io-char @ -1 <> if true exit then
98 io-char 1 " read" stdin @ $call-method
105 io-char c@ -1 to io-char
108 : io-emit ( char -- )
111 io-out-char 1 " write" stdout @ $call-method
116 variable CONSOLE-IN-list
117 variable CONSOLE-OUT-list
119 : CONSOLE-IN-initializer ( xt -- )
120 CONSOLE-IN-list list-add ,
122 : CONSOLE-OUT-initializer ( xt -- )
123 CONSOLE-OUT-list list-add ,
126 : install-console ( -- )
128 \ create screen alias
129 " /aliases" find-package if
131 " screen" find-package if drop else
132 \ bad (or missing) screen alias
133 0 " display" iterate-device-type ?dup if
134 ( display-ph R: alias-ph )
135 get-package-path encode-string " screen" r@ (property)
144 \ let arch determine a useful output device
145 CONSOLE-OUT-list begin list-get while
146 stdout @ if drop else @ execute then
149 \ let arch determine a useful input device
150 CONSOLE-IN-list begin list-get while
151 stdin @ if drop else @ execute then
168 ; CONSOLE-OUT-initializer