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

Diff of /slime/swank-sbcl.lisp

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

revision 1.193 by trittweiler, Thu Feb 28 19:44:14 2008 UTC revision 1.194 by trittweiler, Wed Mar 26 15:57:37 2008 UTC
# Line 56  Line 56 
56  (defun swank-mop:slot-definition-documentation (slot)  (defun swank-mop:slot-definition-documentation (slot)
57    (sb-pcl::documentation slot t))    (sb-pcl::documentation slot t))
58    
59    ;;; Connection info
60    
61    (defimplementation lisp-implementation-type-name ()
62      "sbcl")
63    
64    ;; Declare return type explicitly to shut up STYLE-WARNINGS about
65    ;; %SAP-ALIEN in ENABLE-SIGIO-ON-FD below.
66    (declaim (ftype (function () (values (signed-byte 32) &optional)) getpid))
67    (defimplementation getpid ()
68      (sb-posix:getpid))
69    
70  ;;; TCP Server  ;;; TCP Server
71    
72  (defimplementation preferred-communication-style ()  (defimplementation preferred-communication-style ()
# Line 109  Line 120 
120    
121  (defun enable-sigio-on-fd (fd)  (defun enable-sigio-on-fd (fd)
122    (sb-posix::fcntl fd sb-posix::f-setfl sb-posix::o-async)    (sb-posix::fcntl fd sb-posix::f-setfl sb-posix::o-async)
123    (sb-posix::fcntl fd sb-posix::f-setown (getpid)))    (sb-posix::fcntl fd sb-posix::f-setown (getpid))
124      (values))
125    
126  (defimplementation add-sigio-handler (socket fn)  (defimplementation add-sigio-handler (socket fn)
127    (set-sigio-handler)    (set-sigio-handler)
# Line 173  Line 185 
185    (declare (type function fn))    (declare (type function fn))
186    (sb-sys:without-interrupts (funcall fn)))    (sb-sys:without-interrupts (funcall fn)))
187    
 (defimplementation getpid ()  
   (sb-posix:getpid))  
   
 (defimplementation lisp-implementation-type-name ()  
   "sbcl")  
188    
189    
190  ;;;; Support for SBCL syntax  ;;;; Support for SBCL syntax
# Line 723  Return a list of the form (NAME LOCATION Line 730  Return a list of the form (NAME LOCATION
730    
731  (defvar *sldb-stack-top*)  (defvar *sldb-stack-top*)
732    
733    (defun make-invoke-debugger-hook (hook)
734      #'(lambda (condition old-hook)
735          ;; Notice that *INVOKE-DEBUGGER-HOOK* is tried before
736          ;; *DEBUGGER-HOOK*, so we have to make sure that the latter gets
737          ;; run when it was established locally by a user.
738          (if *debugger-hook*
739              (funcall *debugger-hook* condition old-hook)
740              (funcall hook condition old-hook))))
741    
742  (defimplementation install-debugger-globally (function)  (defimplementation install-debugger-globally (function)
743    (setq sb-ext:*invoke-debugger-hook* function))    (setq *debugger-hook* function)
744      (setq sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook function)))
745    
746  (defimplementation condition-extras (condition)  (defimplementation condition-extras (condition)
747    (cond #+#.(swank-backend::sbcl-with-new-stepper-p)    (cond #+#.(swank-backend::sbcl-with-new-stepper-p)
# Line 772  Return a list of the form (NAME LOCATION Line 789  Return a list of the form (NAME LOCATION
789      (invoke-restart 'sb-ext:step-out)))      (invoke-restart 'sb-ext:step-out)))
790    
791  (defimplementation call-with-debugger-hook (hook fun)  (defimplementation call-with-debugger-hook (hook fun)
792    (let ((sb-ext:*invoke-debugger-hook* hook)    (let ((*debugger-hook* hook)
793            (sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook))
794          #+#.(swank-backend::sbcl-with-new-stepper-p)          #+#.(swank-backend::sbcl-with-new-stepper-p)
795          (sb-ext:*stepper-hook*          (sb-ext:*stepper-hook*
796           (lambda (condition)           (lambda (condition)

Legend:
Removed from v.1.193  
changed lines
  Added in v.1.194

  ViewVC Help
Powered by ViewVC 1.1.5