From patchwork Fri Mar 23 10:15:30 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Laurent Vivier X-Patchwork-Id: 889867 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from lists.ozlabs.org (lists.ozlabs.org [IPv6:2401:3900:2:1::3]) (using TLSv1.2 with cipher ADH-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 406zw41XhZz9s4c for ; Fri, 23 Mar 2018 21:16:20 +1100 (AEDT) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=redhat.com Received: from bilbo.ozlabs.org (lists.ozlabs.org [IPv6:2401:3900:2:1::3]) by lists.ozlabs.org (Postfix) with ESMTP id 406zw34GLpzF1yD for ; Fri, 23 Mar 2018 21:16:19 +1100 (AEDT) Authentication-Results: lists.ozlabs.org; dmarc=pass (p=none dis=none) header.from=redhat.com X-Original-To: slof@lists.ozlabs.org Delivered-To: slof@lists.ozlabs.org Authentication-Results: lists.ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=redhat.com (client-ip=66.187.233.73; helo=mx1.redhat.com; envelope-from=lvivier@redhat.com; receiver=) Authentication-Results: lists.ozlabs.org; dmarc=pass (p=none dis=none) header.from=redhat.com Received: from mx1.redhat.com (mx3-rdu2.redhat.com [66.187.233.73]) (using TLSv1.2 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by lists.ozlabs.org (Postfix) with ESMTPS id 406zvG6wpSzF1k3 for ; Fri, 23 Mar 2018 21:15:38 +1100 (AEDT) Received: from smtp.corp.redhat.com (int-mx03.intmail.prod.int.rdu2.redhat.com [10.11.54.3]) (using TLSv1.2 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by mx1.redhat.com (Postfix) with ESMTPS id F010E722DB; Fri, 23 Mar 2018 10:15:35 +0000 (UTC) Received: from thinkpad.redhat.com (ovpn-204-35.brq.redhat.com [10.40.204.35]) by smtp.corp.redhat.com (Postfix) with ESMTP id 0A3C8111DD10; Fri, 23 Mar 2018 10:15:34 +0000 (UTC) From: Laurent Vivier To: slof@lists.ozlabs.org Date: Fri, 23 Mar 2018 11:15:30 +0100 Message-Id: <20180323101530.17490-3-lvivier@redhat.com> In-Reply-To: <20180323101530.17490-1-lvivier@redhat.com> References: <20180323101530.17490-1-lvivier@redhat.com> X-Scanned-By: MIMEDefang 2.78 on 10.11.54.3 X-Greylist: Sender IP whitelisted, not delayed by milter-greylist-4.5.16 (mx1.redhat.com [10.11.55.2]); Fri, 23 Mar 2018 10:15:36 +0000 (UTC) X-Greylist: inspected by milter-greylist-4.5.16 (mx1.redhat.com [10.11.55.2]); Fri, 23 Mar 2018 10:15:36 +0000 (UTC) for IP:'10.11.54.3' DOMAIN:'int-mx03.intmail.prod.int.rdu2.redhat.com' HELO:'smtp.corp.redhat.com' FROM:'lvivier@redhat.com' RCPT:'' Subject: [SLOF] [PATCH v4 2/2] resolve ihandle and xt handle in the input command (like for the output) X-BeenThere: slof@lists.ozlabs.org X-Mailman-Version: 2.1.26 Precedence: list List-Id: "Patches for https://github.com/aik/SLOF" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Thomas Huth MIME-Version: 1.0 Errors-To: slof-bounces+incoming=patchwork.ozlabs.org@lists.ozlabs.org Sender: "SLOF" Signed-off-by: Laurent Vivier --- slof/fs/term-io.fs | 87 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 45 insertions(+), 42 deletions(-) diff --git a/slof/fs/term-io.fs b/slof/fs/term-io.fs index d1a27aa..022ef2f 100644 --- a/slof/fs/term-io.fs +++ b/slof/fs/term-io.fs @@ -10,10 +10,17 @@ \ * IBM Corporation - initial implementation \ ****************************************************************************/ +0 VALUE read-xt 0 VALUE write-xt +VARIABLE stdin VARIABLE stdout +: set-stdin ( ihandle -- ) + dup stdin ! + encode-int s" stdin" set-chosen +; + : set-stdout ( ihandle -- ) dup stdout ! encode-int s" stdout" set-chosen @@ -21,12 +28,18 @@ VARIABLE stdout : input ( dev-str dev-len -- ) open-dev ?dup IF - \ Close old stdin: - s" stdin" get-chosen IF - decode-int nip nip ?dup IF close-dev THEN + \ find new ihandle and xt handle + dup s" read" rot ihandle>phandle find-method + 0= IF + drop + cr ." Cannot find the read method for the given input console " cr + EXIT THEN + \ Close old stdin: + stdin @ ?dup IF close-dev THEN \ Now set the new stdin: - encode-int s" stdin" set-chosen + to read-xt + set-stdin THEN ; @@ -64,17 +77,12 @@ VARIABLE stdout ' term-io-emit to emit : term-io-key ( -- char ) - s" stdin" get-chosen IF - decode-int nip nip dup 0= IF 0 EXIT THEN - >r BEGIN - (term-io-char-buf) 1 s" read" r@ $call-method - 0 > - UNTIL - (term-io-char-buf) c@ - r> drop - ELSE - [ ' key behavior compile, ] - THEN + read-xt 0= IF 0 EXIT THEN + BEGIN + (term-io-char-buf) 1 read-xt stdin @ call-package + 0 > + UNTIL + (term-io-char-buf) c@ ; ' term-io-key to key @@ -85,35 +93,30 @@ VARIABLE stdout \ - if it's an hv console, use hvterm-key? \ otherwise it will always return false : term-io-key? ( -- true|false ) - s" stdin" get-chosen 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 - s" device_type" r@ ihandle>phandle ( propstr len phandle ) - get-property ( true | data dlen false ) - IF - \ device_type not found, return false and exit - false - ELSE - 1 - \ remove 1 from length to ignore null-termination char - \ device_type found, check wether it is serial or keyboard - 2dup s" serial" str= IF - 2drop serial-key? r> drop EXIT - THEN \ call serial-key, cleanup return-stack, exit - 2dup s" keyboard" str= IF - 2drop ( ) - \ keyboard found, check for key-available? method, execute it or return false - s" key-available?" r@ ihandle>phandle find-method IF - drop s" key-available?" r@ $call-method - ELSE - false - THEN - r> drop EXIT \ cleanup return-stack, exit + stdin @ ?dup 0= IF false EXIT THEN \ stdin not set, return false + >r \ store ihandle on return stack + s" device_type" r@ ihandle>phandle ( propstr len phandle ) + get-property ( true | data dlen false ) + IF + \ device_type not found, return false and exit + false + ELSE + 1 - \ remove 1 from length to ignore null-termination char + \ device_type found, check wether it is serial or keyboard + 2dup s" serial" str= IF + 2drop serial-key? r> drop EXIT + THEN \ call serial-key, cleanup return-stack, exit + 2dup s" keyboard" str= IF + 2drop ( ) + \ keyboard found, check for key-available? method, execute it or return false + s" key-available?" r@ ihandle>phandle find-method IF + drop s" key-available?" r@ $call-method + ELSE + false THEN - 2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false + r> drop EXIT \ cleanup return-stack, exit THEN - ELSE - \ stdin not set, return false - false + 2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false THEN ;