Integrate cooperative REPL server.

* 2d/repl.scm: New file.
* 2d/repl/repl.scm: Delete it.
* 2d/repl/server.scm: Delete it.
* Makfile.am (REPL_SOURCES): Delete it.
  (SOURCES): Add '2d/repl.scm'.
* examples/common.scm: Use cooperative REPL module.

1 files changed, 0 insertions, 132 deletions

diff --git a/2d/repl/server.scm b/2d/repl/server.scm
deleted file mode 100644
index 9498b1d..0000000
--- a/2d/repl/server.scm
+++ /dev/null
@@ -1,132 +0,0 @@
-;;; Repl server
-
-;; Copyright (C)  2003, 2010, 2011 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 (2d repl server)
-  #:use-module (2d 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))))))
-
-  (sigaction SIGPIPE SIG_IGN)
-  (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))