[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-184-ga
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-184-ga531e76 |
|
Date: |
Sun, 10 Oct 2010 11:12:49 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a531e76a74d4517aec0888d38d3c5e412ce67d1a
The branch, master has been updated
via a531e76a74d4517aec0888d38d3c5e412ce67d1a (commit)
via d30542c2b7e52be9e5293b4d4ef065c64316872c (commit)
via b2456dd434fd9b65cd9ac68bb487ee81863adf8d (commit)
via 1924145df58c3fbaae56610e06b430508d5d169f (commit)
via 41e826492a44d66b6056818c5718164f1d7d065b (commit)
from a627100bf39c64f986536e9faff564e5602e0efa (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a531e76a74d4517aec0888d38d3c5e412ce67d1a
Author: Andy Wingo <address@hidden>
Date: Sun Oct 10 12:56:53 2010 +0200
add --listen command line argument.
* libguile/script.c (scm_shell_usage, scm_compile_shell_switches): Add a
--listen argument to spawn a REPL server, possibly specifying the port
or path to listen on. The goal is for this to be the default way to
allow debugging via Emacs or simply using netcat.
commit d30542c2b7e52be9e5293b4d4ef065c64316872c
Author: Andy Wingo <address@hidden>
Date: Sun Oct 10 12:15:34 2010 +0200
add (system repl server)
* module/system/repl/server.scm: New module, listens on a socket for
connections, then serves repls to those sockets.
* module/Makefile.am: Add repl server.
commit b2456dd434fd9b65cd9ac68bb487ee81863adf8d
Author: Andy Wingo <address@hidden>
Date: Sun Oct 10 12:13:04 2010 +0200
fix segfaults when closing the current input port
* libguile/ports.c (scm_char_ready_p, scm_peek_char, scm_unread_char)
(scm_unread_string): Always validate the port, even in the case that
we get it the default current-input-port. Otherwise the following
causes a segfault:
(begin (close-port (current-input-port)) (peek-char))
commit 1924145df58c3fbaae56610e06b430508d5d169f
Author: Andy Wingo <address@hidden>
Date: Sun Oct 10 11:49:50 2010 +0200
readline repl-reader falls back to boot-9 definition for other ports
* guile-readline/ice-9/readline.scm (readline-repl-reader): Pull
definition out of activate-readline. If the current input port is not
the readline port, fall back to the boot-9 repl reader.
(activate-readline): Adapt.
commit 41e826492a44d66b6056818c5718164f1d7d065b
Author: Andy Wingo <address@hidden>
Date: Sun Oct 10 11:24:29 2010 +0200
interrupted syscalls run asyncs before throwing syserror
* libguile/error.c (scm_syserror, scm_syserror_msg): Run pending pending
asyncs before throwing the error, as one of the asyncs might be a
signal handler. But there is unfortunately a race here, as noted in a
comment.
-----------------------------------------------------------------------
Summary of changes:
guile-readline/ice-9/readline.scm | 43 +++++++-----
libguile/error.c | 32 +++++++++
libguile/ports.c | 14 ++--
libguile/script.c | 56 ++++++++++++++++
module/Makefile.am | 3 +-
module/system/repl/server.scm | 131 +++++++++++++++++++++++++++++++++++++
6 files changed, 252 insertions(+), 27 deletions(-)
create mode 100644 module/system/repl/server.scm
diff --git a/guile-readline/ice-9/readline.scm
b/guile-readline/ice-9/readline.scm
index 38fb23f..4879bab 100644
--- a/guile-readline/ice-9/readline.scm
+++ b/guile-readline/ice-9/readline.scm
@@ -200,26 +200,33 @@
(lambda ()
(set! *readline-completion-function* old-completer)))))
+(define readline-repl-reader
+ (let ((boot-9-repl-reader repl-reader))
+ (lambda* (repl-prompt #:optional (reader (fluid-ref current-reader)))
+ (let ((port (current-input-port)))
+ (if (eq? port (readline-port))
+ (let ((outer-new-input-prompt new-input-prompt)
+ (outer-continuation-prompt continuation-prompt)
+ (outer-read-hook read-hook))
+ (dynamic-wind
+ (lambda ()
+ (set-buffered-input-continuation?! port #f)
+ (set-readline-prompt! repl-prompt "... ")
+ (set-readline-read-hook! (lambda ()
+ (run-hook before-read-hook))))
+ (lambda () ((or reader read) port))
+ (lambda ()
+ (set-readline-prompt! outer-new-input-prompt
+ outer-continuation-prompt)
+ (set-readline-read-hook! outer-read-hook))))
+ (boot-9-repl-reader repl-prompt reader))))))
+
(define-public (activate-readline)
(if (isatty? (current-input-port))
- (let ((repl-read-hook (lambda () (run-hook before-read-hook))))
- (set-current-input-port (readline-port))
- (set! repl-reader
- (lambda* (repl-prompt
- #:optional (reader (fluid-ref current-reader)))
- (let ((outer-new-input-prompt new-input-prompt)
- (outer-continuation-prompt continuation-prompt)
- (outer-read-hook read-hook))
- (dynamic-wind
- (lambda ()
- (set-buffered-input-continuation?! (readline-port) #f)
- (set-readline-prompt! repl-prompt "... ")
- (set-readline-read-hook! repl-read-hook))
- (lambda () ((or reader read) (current-input-port)))
- (lambda ()
- (set-readline-prompt! outer-new-input-prompt
outer-continuation-prompt)
- (set-readline-read-hook! outer-read-hook))))))
- (set! (using-readline?) #t))))
+ (begin
+ (set-current-input-port (readline-port))
+ (set! repl-reader readline-repl-reader)
+ (set! (using-readline?) #t))))
(define-public (make-completion-function strings)
"Construct and return a completion function for a list of strings.
diff --git a/libguile/error.c b/libguile/error.c
index 4b6bab8..b4ed7d0 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -147,6 +147,33 @@ void
scm_syserror (const char *subr)
{
SCM err = scm_from_int (SCM_I_ERRNO ());
+
+ /* It could be that we're getting here because the syscall was
+ interrupted by a signal. In that case a signal handler might have
+ been queued to run. The signal handler probably throws an
+ exception.
+
+ If we don't try to run the signal handler now, it will run later,
+ which would result in two exceptions being thrown: this syserror,
+ and then at some later time the exception thrown by the async
+ signal handler.
+
+ The problem is that we don't know if handling the signal caused an
+ async to be queued. By this time scmsigs.c:take_signal will have
+ written a byte on the fd, but we don't know if the signal-handling
+ thread has read it off and queued an async.
+
+ Ideally we need some API like scm_i_ensure_signals_delivered() to
+ catch up signal delivery. Barring that, we just cross our digits
+ and pray; it could be that we handle the signal in time, and just
+ throw once, or it could be that we miss the deadline and throw
+ twice.
+ */
+#ifdef EINTR
+ if (scm_to_int (err) == EINTR)
+ SCM_ASYNC_TICK;
+#endif
+
scm_error (scm_system_error_key,
subr,
"~A",
@@ -157,6 +184,11 @@ scm_syserror (const char *subr)
void
scm_syserror_msg (const char *subr, const char *message, SCM args, int eno)
{
+ /* See above note about the EINTR signal handling race. */
+#ifdef EINTR
+ if (eno == EINTR)
+ SCM_ASYNC_TICK;
+#endif
scm_error (scm_system_error_key,
subr,
message,
diff --git a/libguile/ports.c b/libguile/ports.c
index 6cf0de2..7fabc81 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -261,8 +261,9 @@ SCM_DEFINE (scm_char_ready_p, "char-ready?", 0, 1, 0,
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
- else
- SCM_VALIDATE_OPINPORT (1, port);
+ /* It's possible to close the current input port, so validate even in
+ this case. */
+ SCM_VALIDATE_OPINPORT (1, port);
pt = SCM_PTAB_ENTRY (port);
@@ -1656,8 +1657,7 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0,
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
- else
- SCM_VALIDATE_OPINPORT (1, port);
+ SCM_VALIDATE_OPINPORT (1, port);
column = SCM_COL (port);
line = SCM_LINUM (port);
@@ -1695,8 +1695,7 @@ SCM_DEFINE (scm_unread_char, "unread-char", 1, 1, 0,
SCM_VALIDATE_CHAR (1, cobj);
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
- else
- SCM_VALIDATE_OPINPORT (2, port);
+ SCM_VALIDATE_OPINPORT (2, port);
c = SCM_CHAR (cobj);
@@ -1717,8 +1716,7 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
SCM_VALIDATE_STRING (1, str);
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
- else
- SCM_VALIDATE_OPINPORT (2, port);
+ SCM_VALIDATE_OPINPORT (2, port);
n = scm_i_string_length (str);
diff --git a/libguile/script.c b/libguile/script.c
index 318e5aa..caf3ac6 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -386,6 +386,8 @@ scm_shell_usage (int fatal, char *message)
" --no-autocompile disable automatic source file compilation\n"
" Default is to enable autocompilation of source\n"
" files.\n"
+ " --listen[=P] Listen on a local port or a path for REPL
clients.\n"
+ " If P is not given, the default is local port
37146.\n"
" -q inhibit loading of user init file\n"
" --use-srfi=LS load SRFI modules for the SRFIs in LS,\n"
" which is a list of numbers like \"2,13,14\"\n"
@@ -640,6 +642,60 @@ scm_compile_shell_switches (int argc, char **argv)
tail);
}
+ else if (! strncmp (argv[i], "--listen", 8) /* start a repl server */
+ && (argv[i][8] == '\0' || argv[i][8] == '='))
+ {
+ const char default_template[] =
+ "(@@ (system repl server) (spawn-server))";
+ const char port_template[] =
+ "(@@ (system repl server)"
+ " (spawn-server (make-tcp-server-socket #:port ~a)))";
+ const char path_template[] =
+ "(@@ (system repl server)"
+ " (spawn-server (make-unix-domain-server-socket #:path ~s)))";
+
+ SCM form_str = SCM_BOOL_F;
+ char * p = argv[i] + 8;
+
+ if (*p == '=')
+ {
+ p++;
+ if (*p > '0' && *p <= '9')
+ {
+ /* --listen=PORT */
+ SCM port = scm_string_to_number (scm_from_locale_string (p),
+ SCM_UNDEFINED);
+
+ if (scm_is_false (port))
+ scm_shell_usage (1, "invalid port for --listen");
+
+ form_str =
+ scm_simple_format (SCM_BOOL_F,
+ scm_from_locale_string (port_template),
+ scm_list_1 (port));
+ }
+ else if (*p == '/')
+ {
+ /* --listen=/PATH/TO/SOCKET */
+ SCM path = scm_from_locale_string (p);
+
+ form_str =
+ scm_simple_format (SCM_BOOL_F,
+ scm_from_locale_string (path_template),
+ scm_list_1 (path));
+ }
+ else
+ {
+ /* unknown --listen arg */
+ scm_shell_usage (1, "unknown argument to --listen");
+ }
+ }
+ else
+ form_str = scm_from_locale_string (default_template);
+
+ tail = scm_cons (scm_read (scm_open_input_string (form_str)), tail);
+ }
+
else if (! strcmp (argv[i], "-h")
|| ! strcmp (argv[i], "--help"))
{
diff --git a/module/Makefile.am b/module/Makefile.am
index 9aa4c7a..a11a1d5 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -324,7 +324,8 @@ SYSTEM_SOURCES = \
system/repl/error-handling.scm \
system/repl/common.scm \
system/repl/command.scm \
- system/repl/repl.scm
+ system/repl/repl.scm \
+ system/repl/server.scm
LIB_SOURCES = \
statprof.scm \
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
new file mode 100644
index 0000000..132ea81
--- /dev/null
+++ b/module/system/repl/server.scm
@@ -0,0 +1,131 @@
+;;; Repl server
+
+;; Copyright (C) 2003, 2010 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;; 02110-1301 USA
+
+;;; Code:
+
+(define-module (system repl server)
+ #:use-module (system repl repl)
+ #:use-module (ice-9 threads)
+ #:export (make-tcp-server-socket
+ make-unix-domain-server-socket
+ run-server
+ spawn-server
+ stop-server-and-clients!))
+
+(define *open-sockets* '())
+
+(define sockets-lock (make-mutex))
+
+(define (close-socket! s)
+ (with-mutex sockets-lock
+ (set! *open-sockets* (delq! s *open-sockets*)))
+ ;; Close-port could block or raise an exception flushing buffered
+ ;; output. Hmm.
+ (close-port s))
+
+(define (add-open-socket! s)
+ (with-mutex sockets-lock
+ (set! *open-sockets* (cons s *open-sockets*))))
+
+(define (stop-server-and-clients!)
+ (cond
+ ((with-mutex sockets-lock
+ (and (pair? *open-sockets*)
+ (car *open-sockets*)))
+ => (lambda (s)
+ (close-socket! s)
+ (stop-server-and-clients!)))))
+
+(define* (make-tcp-server-socket #:key
+ (host #f)
+ (addr (if host (inet-aton host) INADDR_LOOPBACK))
+ (port 37146))
+ (let ((sock (socket PF_INET SOCK_STREAM 0)))
+ (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+ (bind sock AF_INET addr port)
+ sock))
+
+(define* (make-unix-domain-server-socket #:key (path "/tmp/guile-socket"))
+ (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+ (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+ (bind sock AF_UNIX path)
+ sock))
+
+(define call-with-sigint
+ (if (not (provided? 'posix))
+ (lambda (thunk) (thunk))
+ (lambda (thunk)
+ (let ((handler #f))
+ (dynamic-wind
+ (lambda ()
+ (set! handler
+ (sigaction SIGINT (lambda (sig) (throw 'interrupt)))))
+ thunk
+ (lambda ()
+ (if handler
+ ;; restore Scheme handler, SIG_IGN or SIG_DFL.
+ (sigaction SIGINT (car handler) (cdr handler))
+ ;; restore original C handler.
+ (sigaction SIGINT #f))))))))
+
+(define* (run-server #:optional (server-socket (make-tcp-server-socket)))
+ (define (accept-new-client)
+ (catch #t
+ (lambda () (call-with-sigint (lambda () (accept server-socket))))
+ (lambda (k . args)
+ (cond
+ ((port-closed? server-socket)
+ ;; Shutting down.
+ #f)
+ ((eq? k 'interrupt)
+ ;; Interrupt.
+ (close-socket! server-socket)
+ #f)
+ (else
+ (warn "Error accepting client" k args)
+ ;; Retry after a timeout.
+ (sleep 1)
+ (accept-new-client))))))
+
+ (add-open-socket! server-socket)
+ (listen server-socket 5)
+ (let lp ((client (accept-new-client)))
+ ;; If client is false, we are shutting down.
+ (if client
+ (let ((client-socket (car client))
+ (client-addr (cdr client)))
+ (add-open-socket! client-socket)
+ (make-thread serve-client client-socket client-addr)
+ (lp (accept-new-client))))))
+
+(define* (spawn-server #:optional (server-socket (make-tcp-server-socket)))
+ (make-thread run-server server-socket))
+
+(define (serve-client client addr)
+ (with-continuation-barrier
+ (lambda ()
+ (with-input-from-port client
+ (lambda ()
+ (with-output-to-port client
+ (lambda ()
+ (with-error-to-port client
+ (lambda ()
+ (with-fluids ((*repl-stack* '()))
+ (start-repl))))))))))
+ (close-socket! client))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-12-184-ga531e76,
Andy Wingo <=