[slime-cvs] CVS update: slime/swank-openmcl.lisp

[Alan Ruttenberg]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv28939/slime

Modified Files:
	swank-openmcl.lisp 
Log Message:
fix ccl::force-break-in-listener to move to frame immediately following %pascal-functions% which is where the sigint is effectively caught.

Fixed type in create-swank-server

Date: Mon Dec 15 22:29:18 2003
Author: aruttenberg

Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.37 slime/swank-openmcl.lisp:1.38
--- slime/swank-openmcl.lisp:1.37	Mon Dec 15 11:06:52 2003
+++ slime/swank-openmcl.lisp	Mon Dec 15 22:29:18 2003
@@ -13,7 +13,7 @@
 ;;; The LLGPL is also available online at
 ;;; http://opensource.franz.com/preamble.html
 ;;;
-;;;   $Id: swank-openmcl.lisp,v 1.37 2003/12/15 16:06:52 lgorrie Exp $
+;;;   $Id: swank-openmcl.lisp,v 1.38 2003/12/16 03:29:18 aruttenberg Exp $
 ;;;
 
 ;;;
@@ -84,14 +84,14 @@
                             (close *close-swank-socket-after-setup*))
   "Create a Swank TCP server on `port'."
   (let ((server-socket (ccl:make-socket :connect :passive :local-port port
-                                           :reuse-address reuse-address)))
+                                        :reuse-address reuse-address)))
     (funcall announce (ccl:local-port server-socket))
     (cond (background
            (let ((swank (ccl:process-run-function 
                          "Swank" #'accept-loop server-socket close)))
              ;; tell openmcl which process you want to be interrupted when
              ;; sigint is received
-             (setq ccl::*interactive-abort-process* swank))
+             (setq ccl::*interactive-abort-process* swank)
              swank))
           (t
            (accept-loop server-socket close)))))
@@ -101,17 +101,17 @@
     (ccl::process-interrupt
      p
      #'(lambda ()
-         (ccl::ignoring-without-interrupts
+         (ccl::ignoring-without-interrupts 
           (let ((*swank-debugger-stack-frame* nil)
-                (previous-p nil))
+                (previous-f nil))
             (block find-frame
-              (map-backtrace
+              (map-backtrace  
                #'(lambda(frame-number p tcr lfun pc)
                    (declare (ignore frame-number tcr pc))
-                   (when (eq (ccl::lfun-name lfun) 'swank::eval-region)
-                     (setq *swank-debugger-stack-frame* previous-p)
+                   (when (eq  previous-f 'ccl::%pascal-functions%) 
+                     (setq *swank-debugger-stack-frame* p)
                      (return-from find-frame))
-                   (setq previous-p p))))
+                   (setq previous-f (ccl::lfun-name lfun)))))
             (invoke-debugger)
             (clear-input *terminal-io*)))))))