Solution: Extension for non-polling and non-blocking input
In message <199410061543.AA09144_at_taloa.unice.fr> I wrote:
>
>My problem: The program I need to write (quickly) must react to and
>send messages from/to other process(es), to which it is connected
>through pipes.
>
>I have tried the process extension in STk-2.1.3/Contrib/Process/ and
>it seems to work[...]
>
>However, my future program must not stay blocked while waiting for
>input from a pipe - it must react to X events in the meantime (at
>least; the Scheme read-eval-print loop should also remain active, if
>possible).
>
>So I need something like XtAppAddInput which is part of the Xt
>toolkit.
>
>I would imagine something like
>
> (add-input an-input-port a-callback)
>
> (remove-input an-input-port)
>
Following this request, Berry Kercheval <kerch_at_parc.xerox.com> sent me
an STk extension of his, register-file-handler. It does what I needed
and more (write-bin, which I haven't used).
Unfortunately, buffered input makes things a little more complicated,
so I added 2 lines, to the (non-implemented) char_readyp dummy (from
primitives.c) and made it to a new kludgy primitive. I called it
char-buffered?, because it does not do half of what one imagines under
char-ready?. Char_bufferedp uses a macro copied from the TK patch
addinput-3.6b.
Lastly, when the process dies, the input handler must be unregistered
or unpleasant things will happen, so I wrote unregister_file_handler
(another 2-liner).
The file rw.c below contains it all. The file DIFFERENCES tells how to
make it known to the STk interpreter, and the file testrw.stk shows
how to use it. (Sorry for the way these 3 files are appended - this
site seems to have lost shar.)
It all works well enough for my current purposes, though I certainly
would be interested in a clean solution, to become part of future STk
releases.
Thanks to Erick Gallesio for STk, J. Ousterhout for TK, Berry
Kercheval for register-file-handler, to the authors of run-process
etc, Gregory Nickonov, David Tolpin, A.Taranov, and to those of the
addinput-3.6b patch to TK.
Miroslav Vodslon
Gesellschaft fuer Mathematik und Datenverarbeitung, Forschungsinstitut
fuer offene Kommunikationssysteme.
Mail: GMD-FOKUS, Hardenbergplatz 2,D-10623 Berlin
Voice: 49-30-25499185. Fax: 49-30-25499202. E-mail: vodslon_at_fokus.gmd.de
----BEGIN DIFFERENCES----------------------------------
magellan% ls Makefile.in userinit.c | xargs -i_at_ diff -c @~ @
*** Makefile.in~ Tue Oct 11 14:36:14 1994
--- Makefile.in Tue Oct 11 10:56:49 1994
***************
*** 31,37 ****
gc.o port.o number.o list.o symbol.o\
read.o print.o globals.o eval.o env.o macros.o syntax.o \
cont.o io.o sport.o promise.o error.o proc.o keyword.o \
! dump.o address.o dynload.o unix.o toplevel.o argv.o
#
# Tk objects needed when -DUSE_TK is used
--- 31,38 ----
gc.o port.o number.o list.o symbol.o\
read.o print.o globals.o eval.o env.o macros.o syntax.o \
cont.o io.o sport.o promise.o error.o proc.o keyword.o \
! dump.o address.o dynload.o unix.o toplevel.o argv.o \
! process.o rw.o
#
# Tk objects needed when -DUSE_TK is used
*** userinit.c~ Tue Oct 11 14:36:39 1994
--- userinit.c Tue Oct 11 11:01:41 1994
***************
*** 40,46 ****
--- 40,51 ----
#include <signal.h>
+ void init_process(void);
+ void init_rw(void);
+
void STk_user_init(void)
{
/* Put here the code you want to be run at init time */
+ init_process(); /* Process extension */
+ init_rw(); /* Filehandling extension */
}
----END DIFFERENCES----------------------------------
----BEGIN rw.c----------------------------------
/* rw.c -- STk extension for non-polling and non-blocking input
To: "M.Vodslon" <vodslon_at_fokus.gmd.de>
cc: kerch_at_parc.xerox.com
Subject: Re: Extension for non-polling and non-blocking input?
In-reply-to: Your message of "Thu, 06 Oct 94 08:33:57 PDT." <199410061543.AA09144_at_taloa.unice.fr>
From: Berry Kercheval <kerch_at_parc.xerox.com>
Message-Id: <94Oct6.112510pdt.25545_at_reynaldo.parc.xerox.com>
[...]
Here's something like it. I used it to write and read binary data to a device.
Using to talk to a pipe should work.
Create the pipe, and call (register_file_handler proc port) to have procedure
'proc' called when input is ready on 'port'.
It's a loadable extension, so compile like any other STk extension and (load
"rw.so").
*/
#include <stk.h>
/* BEGIN kludge: code copied form port.c */
/* Copied from <stk-top>/Src/port.c because it's THERE instead of in a .h
* where it belongs....
*/
#define OUTP(p) (OPORTP(p) || OSPORTP(p))
#define INP(p) (IPORTP(p) || ISPORTP(p))
#define F_READ 01
#define F_WRITE 02
/* copied from port.c because it's STATIC...*/
static SCM my_verify_port(char *who, SCM port, int mode)
{
char buff[100];
if (port == UNBOUND)
port = (mode&F_WRITE) ? curr_oport: curr_iport; /* test write cause of
flush */
if (port->storage_as.port.f == NULL) {
sprintf(buff, "%s: port is closed", who);
err(buff, port);
}
if ((mode & F_READ) && INP(port)) return port; /* not else. It can be both
*/
if ((mode & F_WRITE) && OUTP(port)) return port;
Error:
sprintf(buff, "%s: bad port", who);
err(buff, port);
}
/* END kludge */
/*
* write a byte to a port. Use the low 8 bits of the integer i
*/
static PRIMITIVE write_bin(SCM i, SCM port)
{
if (NINTEGERP(i)) err("write-bin: not an integer", i);
port = my_verify_port("write-bin", port, F_WRITE);
Putc((0xff & INTEGER(i)), port->storage_as.port.f);
return UNDEFINED;
}
/*
* TK FIle Handler callback proc.
*/
static void ReadPortProc(ClientData data, int mask)
{
SCM proc;
SCM port;
proc = CAR((SCM)data);
port = CDR((SCM)data);
if(!(mask & TK_READABLE))
return; /* oops, not interested */
if(procedurep(proc) == ntruth)
err("ReadPortProc: bad procedure", proc);
(void)apply(proc, cons(port, NIL));
}
/*
* register a file handler to call a function when input is ready on a port.
*/
static PRIMITIVE register_file_handler(SCM proc, SCM port)
{
SCM z;
if(procedurep(proc) == ntruth)
err("register_file_handler: bad procedure", proc);
port = my_verify_port("register-file-handler", port, F_READ);
NEWCELL(z, tc_cons);
CAR(z) = proc;
CDR(z) = port;
Tk_CreateFileHandler(fileno(port->storage_as.port.f), TK_READABLE,
ReadPortProc, (ClientData) z);
}
/*************************************************************************/
static void init_rw_bk(void)
{
add_new_primitive("write-bin", tc_subr_1_or_2, write_bin);
add_new_primitive("register-file-handler", tc_subr_1_or_2,
register_file_handler);
}
/*************************************************************************
The following is entirely my fault (Miroslav Vodslon, vodslon_at_fokus.gmd.de)
I haven't looked into the arcana of terminal io, which are not of
interest to me. And I do not know how portable this is.
Sorry, I do not know whom to credit for tk patch addinput-3.6b
*/
/*
* Unregister the input file handler on a file.
*/
static PRIMITIVE unregister_file_handler(SCM port)
{
port = my_verify_port("unregister-file-handler", port, F_READ);
Tk_DeleteFileHandler(fileno(port->storage_as.port.f));
}
/* BEGIN Snarfed from tk patch addinput-3.6b */
/* A quote from addinput-3.6b patch text: */
#if 0
+ This patch is only compatible with Tk 3.6. When Tk 4.0 is available, this
+ functionallity will be a standard part of Tk via the "fileevent" command.
+ The latest version of this patch should be available from:
+
+ ftp.neosoft.com:~ftp/pub/tcl/distrib
+ or
+ harbor.ecn.purdue.edu:~ftp/pub/tcl/extensions
+
+ The implementation of addinput has been changed so only Tk is patched,
+ Tcl (and TclX if you are using it) are no longer modified. No code C beyond
+ Tk needs to be modified to use these commands.
#endif
/*
* Macro to probe the stdio buffer to see if any data is pending in the
* buffer. Different versions are provided for System V and BSD stdio.
*/
#ifdef _STDIO_USES_IOSTREAM /* GNU libc */
# ifdef _IO_STDIO_H
# define READ_DATA_PENDING(fp) (fp->_IO_read_ptr != fp->_IO_read_end)
#else
# define READ_DATA_PENDING(fp) ((fp)->_gptr < (fp)->_egptr)
# endif
#endif
#if (!defined (READ_DATA_PENDING)) && defined __SLBF
# define READ_DATA_PENDING(fp) (fp->_r > 0)
#endif
#if !defined (READ_DATA_PENDING)
# define READ_DATA_PENDING(fp) (fp->_cnt != 0)
#endif
/* END Snarfed from tk patch addinput-3.6b */
/* Modified char-ready stub from port.c: */
PRIMITIVE char_bufferedp(SCM port)
{
port = my_verify_port("char-ready?", port, F_READ);
if (Eof(port->storage_as.port.f)) return truth;
if (ISPORTP(port)) /* !eof -> */ return truth;
else if (READ_DATA_PENDING(port->storage_as.port.f)) return truth; /*mv*/
else return ntruth; /*mv*/
#if 0 /*mv*/
else
if (isatty(fileno(port->storage_as.port.f)))
return truth;
else
return truth;
#endif /*mv*/
}
void init_rw(void)
{
init_rw_bk();
add_new_primitive("unregister-file-handler", tc_subr_0_or_1,
unregister_file_handler);
add_new_primitive("char-buffered?", tc_subr_0_or_1, char_bufferedp);
}
----END rw.c----------------------------------
----BEGIN testrw.stk----------------------------------
;;;; Test for following extensions of STk2.1.3 from kaolin.unice.fr by
;;;; eg_at_kaolin.unice.fr (Erick Gallesio) :
;;;; process.c by Gregory Nickonov, [gn_at_jet.msk.su], David Tolpin
;;;; Dvd_at_CIM.Msk.SU and A.Taranov tay_at_jet.msk.su;
;;;; rw.c by Berry Kercheval <kerch_at_parc.xerox.com>;
;;;; my version of char-read? (named char-buffered?).
;;; load this, then do (test) and click on the "Flush" button or type
;;; (snd "whatever string" myprocess) several times.
(define myprocess #f)
(define (_read-while-ready port)
(let ((result '()))
(while (char-buffered? port) (set! result (cons (read-char port) result)))
result))
;;; This does not work: before the first read-char, fd's buffer contains "".
(define (read-while-ready port)
(list->string (reverse (_read-while-ready port))))
;;; This one assumes that at least one char is in buffer. It works.
(define (read-as-long-as-ready port)
(let ((firstchar (read-char port)))
(list->string (cons firstchar (reverse (_read-while-ready port))))))
(define (handler port)
(display (format #t "got : ~A\n" (read-as-long-as-ready port))))
;;; This does not work. The handler must read the port or it will be
;;; called again!:
'(define (handler port) (display "Input ready!\n"))
(define (snd msg proces)
(display msg (process-input proces))
(flush (process-input proces)))
(define (test)
(set! myprocess (run-process "cat" '() '(#t #t #t)))
(register-file-handler handler (process-output myprocess))
(snd "Initial test message" myprocess))
(begin
(button '.b
:text "Flush"
:command '(begin (display "Button pressed\n")
(snd "aaa\nbbbb\ncccccc\nx" myprocess)))
(pack '.b))
----END testrw.stk----------------------------------
Received on Tue Oct 11 1994 - 15:15:55 CET
This archive was generated by hypermail 2.3.0
: Mon Jul 21 2014 - 19:38:59 CEST