/[slime]/slime/swank-clisp.lisp
ViewVC logotype

Diff of /slime/swank-clisp.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by wjenkner, Thu Jan 22 05:22:50 2004 UTC revision 1.14.2.1 by heller, Sat Jan 31 11:26:02 2004 UTC
# Line 42  Line 42 
42              (progn ,@body)              (progn ,@body)
43           (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))           (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))
44    
45  #+linux  ;; #+linux
46  (defmethod call-without-interrupts (fn)  ;; (defmethod call-without-interrupts (fn)
47    (with-blocked-signals (#.linux:SIGINT) (funcall fn)))  ;;   (with-blocked-signals (#.linux:SIGINT) (funcall fn)))
48    ;;
49  #-linux  ;; #-linux
50  (defmethod call-without-interrupts (fn)  (defmethod call-without-interrupts (fn)
51    (funcall fn))    (funcall fn))
52    
# Line 57  Line 57 
57    
58  ;;; TCP Server  ;;; TCP Server
59    
60    (setq *swank-in-background* nil)
61    
62  (defimplementation create-socket (port)  (defimplementation create-socket (port)
63    (socket:socket-server port))    (socket:socket-server port))
64    
# Line 74  Line 76 
76                                            :charset 'charset:iso-8859-1                                            :charset 'charset:iso-8859-1
77                                            :line-terminator :unix)))                                            :line-terminator :unix)))
78    
79    (defvar *sigio-handlers* '()
80      "List of (key . fn) pairs to be called on SIGIO.")
81    
82    (defun sigio-handler (signal)
83      (mapc (lambda (handler) (funcall (cdr handler))) *sigio-handlers*))
84    
85    ;(trace sigio-handler)
86    
87    (defvar *saved-sigio-handler*)
88    
89    (defun set-sigio-handler ()
90      (setf *saved-sigio-handler*
91            (linux:set-signal-handler linux:SIGIO
92                                      (lambda (signal) (sigio-handler signal))))
93      (let* ((action (linux:signal-action-retrieve linux:SIGIO))
94             (flags (linux:sa-flags action)))
95        (setf (linux:sa-flags action) (logior flags linux:SA_NODEFER))
96        (linux:signal-action-install linux:SIGIO action)))
97    
98    (defimplementation add-input-handler (socket fn)
99      (set-sigio-handler)
100      (let ((fd (socket:socket-stream-handle socket)))
101        (format *debug-io* "Adding input handler: ~S ~%" fd)
102        ;; XXX error checking
103        (linux:fcntl3l fd linux:F_SETOWN (getpid))
104        (linux:fcntl3l fd linux:F_SETFL linux:O_ASYNC)
105        (push (cons fd fn) *sigio-handlers*)))
106    
107    (defimplementation remove-input-handlers (socket)
108      (let ((fd (socket:socket-stream-handle socket)))
109        (remove-sigio-handler fd)
110        (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car)))
111      (close socket))
112    
113  ;;; Swank functions  ;;; Swank functions
114    
115  (defimplementation arglist-string (fname)  (defimplementation arglist-string (fname)
# Line 165  Return NIL if the symbol is unbound." Line 201  Return NIL if the symbol is unbound."
201  (defvar *sldb-restarts*)  (defvar *sldb-restarts*)
202  (defvar *sldb-debugmode* 4)  (defvar *sldb-debugmode* 4)
203    
   
204  (defimplementation call-with-debugging-environment (debugger-loop-fn)  (defimplementation call-with-debugging-environment (debugger-loop-fn)
205    (let* ((sys::*break-count* (1+ sys::*break-count*))    (let* ((sys::*break-count* (1+ sys::*break-count*))
206           (sys::*driver* debugger-loop-fn)           (sys::*driver* debugger-loop-fn)
# Line 199  Return NIL if the symbol is unbound." Line 234  Return NIL if the symbol is unbound."
234                                                            sys::*debug-mode*)                                                            sys::*debug-mode*)
235          repeat index          repeat index
236          never (eq frame *sldb-botframe*)          never (eq frame *sldb-botframe*)
237          finally (return frame)));(setq sys::*debug-frame* frame))))          finally (return frame)))
238    
239  (defun compute-backtrace (start end)  (defun compute-backtrace (start end)
240    (let ((end (or end most-positive-fixnum)))    (let ((end (or end most-positive-fixnum)))

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.14.2.1

  ViewVC Help
Powered by ViewVC 1.1.5