/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osio.h,v 1.6 1991/03/01 00:54:54 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osio.h,v 1.7 1991/03/11 23:42:31 cph Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
extern void EXFUN (OS_channel_nonblocking, (Tchannel channel));
extern void EXFUN (OS_channel_blocking, (Tchannel channel));
+extern unsigned int OS_channels_registered;
+extern int EXFUN (OS_channels_registered_p, (void));
+extern void EXFUN (OS_channel_register, (Tchannel channel));
+extern void EXFUN (OS_channel_unregister, (Tchannel channel));
+extern long EXFUN
+ (OS_channel_select_then_read, (Tchannel channel, PTR buffer, size_t nbytes));
+
#endif /* SCM_OSIO_H */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osproc.h,v 1.3 1991/03/09 21:10:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/osproc.h,v 1.4 1991/03/11 23:42:38 cph Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
extern pid_t EXFUN (OS_process_id, (Tprocess process));
extern enum process_jc_status EXFUN (OS_process_jc_status, (Tprocess process));
extern int EXFUN (OS_process_status_sync, (Tprocess process));
+extern int EXFUN (OS_process_status_sync_all, (void));
extern enum process_status EXFUN (OS_process_status, (Tprocess process));
extern unsigned short EXFUN (OS_process_reason, (Tprocess process));
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosio.c,v 1.4 1991/03/01 00:55:30 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosio.c,v 1.5 1991/03/11 23:42:45 cph Exp $
Copyright (c) 1987-91 Massachusetts Institute of Technology
OS_channel_blocking (arg_channel (1));
PRIMITIVE_RETURN (UNSPECIFIC);
}
-
+\f
DEFINE_PRIMITIVE ("MAKE-PIPE", Prim_make_pipe, 0, 0,
"Return a cons of two channels, the reader and writer of a pipe.")
{
PRIMITIVE_RETURN (result);
}
}
+
+DEFINE_PRIMITIVE ("CHANNEL-REGISTERED?", Prim_channel_registered_p, 1, 1,
+ "Return #F iff CHANNEL is registered for selection.")
+{
+ PRIMITIVE_HEADER (1);
+ PRIMITIVE_RETURN
+ (BOOLEAN_TO_OBJECT (OS_channel_registered_p (arg_channel (1))));
+}
+
+DEFINE_PRIMITIVE ("CHANNEL-REGISTER", Prim_channel_register, 1, 1,
+ "Register CHANNEL for selection.")
+{
+ PRIMITIVE_HEADER (1);
+ OS_channel_register (arg_channel (1));
+ PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("CHANNEL-UNREGISTER", Prim_channel_unregister, 1, 1,
+ "Unregister CHANNEL for selection.")
+{
+ PRIMITIVE_HEADER (1);
+ OS_channel_unregister (arg_channel (1));
+ PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("CHANNEL-SELECT-THEN-READ", Prim_channel_select_then_read, 4, 4,
+ "Like CHANNEL-READ, but also watches registered input channels.\n\
+If there is no input on CHANNEL, but there is input on some other registered\n\
+channel, this procedure returns #T.")
+{
+ PRIMITIVE_HEADER (4);
+ CHECK_ARG (2, STRING_P);
+ {
+ SCHEME_OBJECT buffer = (ARG_REF (2));
+ long length = (STRING_LENGTH (buffer));
+ long end = (arg_index_integer (4, (length + 1)));
+ long start = (arg_index_integer (3, (end + 1)));
+ long nread =
+ (OS_channel_select_then_read ((arg_channel (1)),
+ (STRING_LOC (buffer, start)),
+ (end - start)));
+ PRIMITIVE_RETURN
+ ((nread == -2)
+ ? SHARP_T
+ : (nread < 0)
+ ? SHARP_F
+ : (long_to_integer (nread)));
+ }
+}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.6 1991/03/09 21:10:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prosproc.c,v 1.7 1991/03/11 23:42:52 cph Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
if ((ARG_REF (4)) == SHARP_F)
ctty_type = process_ctty_type_none;
else if ((ARG_REF (4)) == (LONG_TO_FIXNUM (-1)))
- {
- if (scheme_jc_status == process_jc_status_no_ctty)
- error_bad_range_arg (4);
- ctty_type = process_ctty_type_inherit_bg;
- }
+ ctty_type = process_ctty_type_inherit_bg;
else if ((ARG_REF (4)) == (LONG_TO_FIXNUM (-2)))
- {
- if (scheme_jc_status == process_jc_status_no_ctty)
- error_bad_range_arg (4);
- ctty_type = process_ctty_type_inherit_fg;
- }
+ ctty_type = process_ctty_type_inherit_fg;
else
{
ctty_type = process_ctty_type_explicit;
}
}
}
-\f
+
DEFINE_PRIMITIVE ("PROCESS-ID", Prim_process_id, 1, 1,
"Return the process ID of process PROCESS-NUMBER.")
{
PRIMITIVE_RETURN (UNSPECIFIC);
}
}
-
+\f
DEFINE_PRIMITIVE ("PROCESS-STATUS-SYNC", Prim_process_status_sync, 1, 1,
"Synchronize the status of process PROCESS-NUMBER.\n\
Return #F if it was previously synchronized, #T if not.")
(BOOLEAN_TO_OBJECT (OS_process_status_sync (arg_process (1))));
}
+DEFINE_PRIMITIVE ("PROCESS-STATUS-SYNC-ALL", Prim_process_status_sync_all, 0, 0, 0)
+{
+ PRIMITIVE_HEADER (0);
+ PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (OS_process_status_sync_all ()));
+}
+
DEFINE_PRIMITIVE ("PROCESS-STATUS", Prim_process_status, 1, 1,
"Return the status of process PROCESS-NUMBER, a nonnegative integer:\n\
0 = running; 1 = stopped; 2 = exited; 3 = signalled.\n\
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.c,v 1.9 1991/03/01 00:56:07 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.c,v 1.10 1991/03/11 23:43:02 cph Exp $
-Copyright (c) 1990-1 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
size_t OS_channel_table_size;
struct channel * channel_table;
+#ifdef FD_SET
+#define SELECT_TYPE fd_set
+#else
+#define SELECT_TYPE int
+#define FD_SETSIZE ((sizeof (int)) * CHAR_BIT)
+#define FD_SET(n, p) ((*(p)) |= (1 << (n)))
+#define FD_CLR(n, p) ((*(p)) &= ~(1 << (n)))
+#define FD_ISSET(n, p) (((*(p)) & (1 << (n))) != 0)
+#define FD_ZERO(p) ((*(p)) = 0)
+#endif
+
+unsigned int OS_channels_registered;
+static SELECT_TYPE input_descriptors;
+#ifdef HAVE_SELECT
+static struct timeval zero_timeout;
+#endif
+
static void
DEFUN_VOID (UX_channel_close_all)
{
MARK_CHANNEL_CLOSED (channel);
}
add_reload_cleanup (UX_channel_close_all);
+ FD_ZERO (&input_descriptors);
+ OS_channels_registered = 0;
+#ifdef HAVE_SELECT
+ (zero_timeout . tv_sec) = 0;
+ (zero_timeout . tv_usec) = 0;
+#endif
}
void
{
if (! (CHANNEL_INTERNAL (channel)))
{
+ OS_channel_unregister (channel);
STD_VOID_SYSTEM_CALL
(syscall_close, (UX_close (CHANNEL_DESCRIPTOR (channel))));
MARK_CHANNEL_CLOSED (channel);
{
if (! (CHANNEL_INTERNAL (channel)))
{
+ OS_channel_unregister (channel);
UX_close (CHANNEL_DESCRIPTOR (channel));
MARK_CHANNEL_CLOSED (channel);
}
}
#endif /* FCNTL_NONBLOCK */
+\f
+int
+DEFUN (OS_channel_registered_p, (channel), Tchannel channel)
+{
+ return (CHANNEL_REGISTERED (channel));
+}
+
+void
+DEFUN (OS_channel_register, (channel), Tchannel channel)
+{
+#ifdef HAVE_SELECT
+ if (! (CHANNEL_REGISTERED (channel)))
+ {
+ FD_SET ((CHANNEL_DESCRIPTOR (channel)), (&input_descriptors));
+ OS_channels_registered += 1;
+ (CHANNEL_REGISTERED (channel)) = 1;
+ }
+#else
+ error_unimplemented_primitive ();
+#endif
+}
+
+void
+DEFUN (OS_channel_unregister, (channel), Tchannel channel)
+{
+ if (CHANNEL_REGISTERED (channel))
+ {
+ FD_CLR ((CHANNEL_DESCRIPTOR (channel)), (&input_descriptors));
+ OS_channels_registered -= 1;
+ (CHANNEL_REGISTERED (channel)) = 0;
+ }
+}
+
+int
+DEFUN (UX_select_input, (fd, blockp), int fd AND int blockp)
+{
+#ifdef HAVE_SELECT
+ int nfds;
+ SELECT_TYPE readable = input_descriptors;
+ FD_SET (fd, (&readable));
+ STD_UINT_SYSTEM_CALL
+ (syscall_select,
+ nfds,
+ (select (FD_SETSIZE, (&readable), 0, 0, (blockp ? 0 : (&zero_timeout)))));
+ return ((nfds > 0) && (! (FD_ISSET (fd, (&readable)))));
+#else
+ return (0);
+#endif
+}
+
+long
+DEFUN (OS_channel_select_then_read, (channel, buffer, nbytes),
+ Tchannel channel AND
+ PTR buffer AND
+ size_t nbytes)
+{
+#ifdef HAVE_SELECT
+ if ((OS_channels_registered > ((CHANNEL_REGISTERED (channel)) ? 1 : 0))
+ && (UX_select_input ((CHANNEL_DESCRIPTOR (channel)),
+ (CHANNEL_NONBLOCKING (channel)))))
+ return (-2);
+#endif
+ return (OS_channel_read (channel, buffer, nbytes));
+}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.h,v 1.1 1990/06/20 19:37:20 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.h,v 1.2 1991/03/11 23:43:07 cph Exp $
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
enum channel_type type;
unsigned int internal : 1;
unsigned int nonblocking : 1;
+ unsigned int registered : 1;
};
#define MARK_CHANNEL_CLOSED(channel) ((CHANNEL_DESCRIPTOR (channel)) = (-1))
#define CHANNEL_INTERNAL(channel) ((channel_table [(channel)]) . internal)
#define CHANNEL_NONBLOCKING(channel) \
((channel_table [(channel)]) . nonblocking)
+#define CHANNEL_REGISTERED(channel) ((channel_table [(channel)]) . registered)
#define MAKE_CHANNEL(descriptor, type, receiver) \
{ \
(CHANNEL_TYPE (MAKE_CHANNEL_temp)) = (type); \
(CHANNEL_INTERNAL (MAKE_CHANNEL_temp)) = 0; \
(CHANNEL_NONBLOCKING (MAKE_CHANNEL_temp)) = 0; \
+ (CHANNEL_REGISTERED (MAKE_CHANNEL_temp)) = 0; \
receiver (MAKE_CHANNEL_temp); \
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.8 1991/03/09 21:10:57 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.9 1991/03/11 23:43:12 cph Exp $
Copyright (c) 1990-91 Massachusetts Institute of Technology
static Tprocess foreground_child_process;
static long process_tick;
+static long sync_tick;
#define NEW_RAW_STATUS(process, status, reason) \
{ \
transaction_record_action (tat_always, release_sigchld, 0);
}
-#endif /* HAVE_SYSV3_SIGNALS */
+#else /* not HAVE_SYSV3_SIGNALS */
+
+#define block_sigchld()
+
+#endif /* not HAVE_SYSV3_SIGNALS */
#define block_jc_signals block_sigchld
#define grab_signal_mask()
subprocess_death_hook = subprocess_death;
stop_signal_hook = stop_signal_handler;
process_tick = 0;
+ sync_tick = 0;
}
void
transaction_begin ();
child = (process_allocate ());
- /* Flush streams so that i/o won't be duplicated after the fork */
- fflush (stdin);
+ /* Flush streams so that output won't be duplicated after the fork. */
fflush (stdout);
fflush (stderr);
transaction_commit ();
return (child);
}
+\f
/* In the child process -- if any errors occur, just exit. */
/* Don't do `transaction_commit ()' here. Because we used `vfork'
to spawn the child, the side-effects that are performed by
err_fd = fd;
}
}
-
+\f
/* Install the new standard I/O channels. */
if ((in_fd >= 0) && (in_fd != STDIN_FILENO))
{
block_sigchld ();
{
int result = ((PROCESS_TICK (process)) != (PROCESS_SYNC_TICK (process)));
- if (result)
- PROCESS_STATUS_SYNC (process);
+ if (result) PROCESS_STATUS_SYNC (process);
+ transaction_commit ();
+ return (result);
+ }
+}
+
+int
+DEFUN_VOID (OS_process_status_sync_all)
+{
+ transaction_begin ();
+ block_sigchld ();
+ {
+ int result = (process_tick != sync_tick);
+ if (result) sync_tick = process_tick;
transaction_commit ();
return (result);
}
#endif /* not HAVE_POSIX_SIGNALS */
}
\f
-static Tprocess EXFUN (find_process, (pid_t pid));
+static Tprocess
+DEFUN (find_process, (pid), pid_t pid)
+{
+ Tprocess process;
+ for (process = 0; (process < OS_process_table_size); process += 1)
+ if ((PROCESS_ID (process)) == pid)
+ return (process);
+ return (NO_PROCESS);
+}
static void
DEFUN (subprocess_death, (pid, status), pid_t pid AND wait_status_t * status)
}
}
-static Tprocess
-DEFUN (find_process, (pid), pid_t pid)
-{
- Tprocess process;
- for (process = 0; (process < OS_process_table_size); process += 1)
- if ((PROCESS_ID (process)) == pid)
- return (process);
- return (NO_PROCESS);
-}
-
static void
DEFUN (stop_signal_handler, (signo), int signo)
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.66 1991/03/09 21:11:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.67 1991/03/11 23:43:21 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 66
+#define SUBVERSION 67
#endif
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.15 1990/10/02 22:52:26 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.16 1991/03/11 23:43:28 cph Exp $
-Copyright (c) 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1989-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
entry that reads events -- or else that all other event readers
cooperate with this strategy. */
+extern unsigned int OS_channels_registered;
+extern int EXFUN (UX_select_input, (int fd, int blockp));
+
static SCHEME_OBJECT
DEFUN (xd_process_events, (xd, time_limit_p, time_limit),
struct xdisplay * xd AND
{
extern unsigned long EXFUN (OS_real_time_clock, (void));
XEvent event;
- if (time_limit_p)
+ if (time_limit_p || (OS_channels_registered > 0))
{
- if (events_queued == 0)
+ if (events_queued > 0)
+ events_queued -= 1;
+ else
while (1)
{
events_queued = (XEventsQueued (display, QueuedAfterReading));
if (events_queued > 0)
- break;
- if ((OS_real_time_clock ()) >= time_limit)
+ {
+ events_queued -= 1;
+ break;
+ }
+ if (time_limit_p && ((OS_real_time_clock ()) >= time_limit))
return (SHARP_F);
+ if (UX_select_input ((ConnectionNumber (display)),
+ (!time_limit_p)))
+ /* No input is available from the display, but some
+ other registered input channel has input. Return a
+ special value immediately so that input can be
+ processed. */
+ return (SHARP_T);
}
- events_queued -= 1;
}
XNextEvent (display, (&event));
if ((event . type) == KeymapNotify)
}
}
}
-
+\f
static void
DEFUN_VOID (initialize_once)
{
add_reload_cleanup (x_close_all_displays);
initialization_done = 1;
}
-\f
+
DEFINE_PRIMITIVE ("X-DEBUG", Prim_x_debug, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.66 1991/03/09 21:11:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.67 1991/03/11 23:43:21 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 66
+#define SUBVERSION 67
#endif
projects / mit-scheme.git / commitdiff