--- slime/swank-backend.lisp	2004-06-09 13:35:22.000000000 +0100
+++ /home/csr21/misc-cvs/slime/swank-backend.lisp	2004-06-09 17:37:23.000000000 +0100
@@ -175,7 +175,10 @@
   (declare (ignore ignore))
   `(call-with-compilation-hooks (lambda () (progn ,@body))))
 
+(defmacro with-sbcl-protection ((&key) &body body)
+  `(call-with-sbcl-protection (lambda () (progn ,@body))))
+
 (definterface swank-compile-string (string &key buffer position)
   "Compile source from STRING.  During compilation, compiler
 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
--- slime/swank.lisp	2004-06-09 00:57:57.000000000 +0100
+++ /home/csr21/misc-cvs/slime/swank.lisp	2004-06-09 17:43:09.000000000 +0100
@@ -788,11 +788,15 @@
   (let ((*package* *buffer-package*))
     (prin1-to-string string)))
 
+(defun find-package/sbcl (arg)
+  (handler-bind
+      ((sb-int:bootstrap-package-not-found #'sb-int:debootstrap-package))
+    (find-package arg)))
+
 (defun guess-package-from-string (name &optional (default-package *package*))
   (or (and name
-           (or (find-package name)
-               (find-package (string-upcase name))
-               (find-package (substitute #\- #\! name))))
+           (or (find-package/sbcl name)
+               (find-package/sbcl (string-upcase name))))
       default-package))
 
 (defun find-symbol-designator (string &optional
@@ -802,10 +806,11 @@
 resolution.  Return nil if no such symbol exists."
   (multiple-value-bind (name package-name internal-p)
       (tokenize-symbol-designator (case-convert-input string))
-    (cond ((and package-name (not (find-package package-name)))
+    (cond ((and package-name (not (find-package/sbcl package-name)))
            (values nil nil))
           (t
-           (let ((package (or (find-package package-name) default-package)))
+           (let ((package (or (find-package/sbcl package-name)
+                              default-package)))
              (multiple-value-bind (symbol access) (find-symbol name package)
                (cond ((and package-name (not internal-p)
                            (not (eq access :external)))
@@ -1130,27 +1135,89 @@
     (force-output)
     (format-values-for-echo-area values)))
 
+(defun feature-in-list-p (feature list)
+  (etypecase feature
+    (symbol (member feature list :test #'eq))
+    (cons (flet ((subfeature-in-list-p (subfeature)
+		   (feature-in-list-p subfeature list)))
+	    (ecase (first feature)
+	      (:or  (some  #'subfeature-in-list-p (rest feature)))
+	      (:and (every #'subfeature-in-list-p (rest feature)))
+	      (:not (let ((rest (cdr feature)))
+		      (if (or (null (car rest)) (cdr rest))
+			(error "wrong number of terms in compound feature ~S"
+			       feature)
+			(not (subfeature-in-list-p (second feature)))))))))))
+(defun shebang-reader (stream sub-character infix-parameter)
+  (declare (ignore sub-character))
+  (when infix-parameter
+    (error "illegal read syntax: #~D!" infix-parameter))
+  (let ((next-char (read-char stream)))
+    (unless (find next-char "+-")
+      (error "illegal read syntax: #!~C" next-char))
+    ;; When test is not satisfied
+    ;; FIXME: clearer if order of NOT-P and (NOT NOT-P) were reversed? then
+    ;; would become "unless test is satisfied"..
+    (when (let* ((*package* (find-package "KEYWORD"))
+		 (*read-suppress* nil)
+		 (not-p (char= next-char #\-))
+		 (feature (read stream)))
+	    (if (feature-in-list-p feature *features*)
+		not-p
+		(not not-p)))
+      ;; Read (and discard) a form from input.
+      (let ((*read-suppress* t))
+	(read stream t nil t))))
+  (values))
+
+(defun swank-backend::call-with-sbcl-protection (fun)
+  (let (new-readtable)
+    (unwind-protect
+         (let ((*readtable* *readtable*)
+               (readtable *readtable*))
+           (unwind-protect
+                (progn
+                  (when (let ((mismatch
+                               (mismatch "SB-" (package-name *buffer-package*))))
+                          (and mismatch (= mismatch 3)))
+                    (setq *readtable* (copy-readtable nil))
+                    (set-dispatch-macro-character #\# #\! #'shebang-reader))
+                  (handler-bind ((sb-int:bootstrap-package-not-found #'sb-int:debootstrap-package))
+                    (funcall fun)))
+             ;; if we were exectuting sbcl code, set the readtable back
+             (when (let ((mismatch
+                          (mismatch "SB-" (package-name *buffer-package*))))
+                     (and mismatch (= mismatch 3)))
+               (setq *readtable* readtable))
+             ;; if we weren't and *readtable* is different from what
+             ;; it was, propagate that.
+             (unless (eq *readtable* readtable)
+                (setq new-readtable *readtable*))))
+      (when new-readtable
+        (setq *readtable* new-readtable)))))
+
 (defun eval-region (string &optional package-update-p)
   "Evaluate STRING and return the result.
 If PACKAGE-UPDATE-P is non-nil, and evaluation causes a package
 change, then send Emacs an update."
-  (let ((*package* *buffer-package*)
-        - values)
-    (unwind-protect
-         (with-input-from-string (stream string)
-           (loop for form = (read stream nil stream)
-                 until (eq form stream)
-                 do (progn
-                      (setq - form)
-                      (setq values (multiple-value-list (eval form)))
-                      (force-output))
-                 finally (progn
-                           (fresh-line)
-                           (force-output)
-                           (return (values values -)))))
-      (when (and package-update-p (not (eq *package* *buffer-package*)))
-        (send-to-emacs 
-         (list :new-package (shortest-package-nickname *package*)))))))
+  (swank-backend::with-sbcl-protection ()
+    (let ((*package* *buffer-package*)
+          - values)
+      (unwind-protect
+           (with-input-from-string (stream string)
+             (loop for form = (read stream nil stream)
+                   until (eq form stream)
+                   do (progn
+                        (setq - form)
+                        (setq values (multiple-value-list (eval form)))
+                        (force-output))
+                   finally (progn
+                             (fresh-line)
+                             (force-output)
+                             (return (values values -)))))
+        (when (and package-update-p (not (eq *package* *buffer-package*)))
+          (send-to-emacs 
+           (list :new-package (shortest-package-nickname *package*))))))))
 
 (defun shortest-package-nickname (package)
   "Return the shortest nickname (or canonical name) of PACKAGE."
@@ -1855,8 +1922,9 @@
     (format nil "~S" (fmakunbound fname))))
 
 (defslimefun load-file (filename)
-  (to-string (load filename)))
+  (swank-backend::with-sbcl-protection ()
+    (to-string (load filename))))
 
 (defun requires-compile-p (pathname)
   (let ((compile-file-truename (probe-file (compile-file-pathname pathname))))
--- slime/swank-sbcl.lisp	2004-06-09 00:57:35.000000000 +0100
+++ /home/csr21/misc-cvs/slime/swank-sbcl.lisp	2004-06-09 17:37:29.000000000 +0100
@@ -266,7 +266,8 @@
                  (sb-ext:compiler-note #'handle-notification-condition)
                  (style-warning        #'handle-notification-condition)
                  (warning              #'handle-notification-condition))
-    (funcall function)))
+    (with-sbcl-protection ()
+      (funcall function))))
 
 (defimplementation swank-compile-file (filename load-p)
   (with-compilation-hooks ()
