From d3bd278b0c1d92481b527cb51a29fdd6740eed07 Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Wed, 3 Feb 2016 23:57:30 -0500
Subject: [PATCH] Bug workaround for ABCL as the cross-compilation host.

http://abcl.org/trac/ticket/351 was filed >1 year ago but never fixed.
---
 src/code/defsetfs.lisp |  3 +++
 src/code/setf.lisp     | 32 +++++++++++++++++---------------
 2 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/src/code/defsetfs.lisp b/src/code/defsetfs.lisp
index 212996b78..8e3a0947a 100644
--- a/src/code/defsetfs.lisp
+++ b/src/code/defsetfs.lisp
@@ -14,6 +14,9 @@
 
 (sb!int:/show0 "entering defsetfs.lisp")
 
+;;; FIXME: this entire file looks like it should be :not-host
+;;; (The bits that aren't #-sb-xc-host look like innocuous bugs)
+
 ;;; from alieneval.lisp
 (in-package "SB!ALIEN")
 (defsetf slot %set-slot)
diff --git a/src/code/setf.lisp b/src/code/setf.lisp
index e3953e990..239cbc307 100644
--- a/src/code/setf.lisp
+++ b/src/code/setf.lisp
@@ -425,17 +425,6 @@
 
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   ;;; Assign SETF macro information for NAME, making all appropriate checks.
- (macrolet ((assign-it ()
-               `(progn
-                  (when inverse
-                    (clear-info :setf :expander name)
-                    (setf (info :setf :inverse name) inverse))
-                  (when expander
-                    (clear-info :setf :inverse name)
-                    (setf (info :setf :expander name) expander))
-                  (when doc
-                    (setf (fdocumentation name 'setf) doc))
-                  name)))
   (defun %defsetf (name expander inverse &optional doc)
     (with-single-package-locked-error
         (:symbol name "defining a setf-expander for ~A"))
@@ -465,10 +454,23 @@
            ;; The user can declare an FTYPE if both things are intentional.
            (style-warn "defining setf macro for ~S when ~S is also defined"
                        name setf-fn-name)))))
-    (assign-it))
-  ;; For cold-init, because any warning will cause a crash.
-  (defun !quietly-defsetf (name expander inverse &optional doc)
-    (assign-it))))
+    (when inverse
+      (clear-info :setf :expander name)
+      (setf (info :setf :inverse name) inverse))
+    (when expander
+      (clear-info :setf :inverse name)
+      (setf (info :setf :expander name) expander))
+    (when doc
+      (setf (fdocumentation name 'setf) doc))
+    name))
+(defun !quietly-defsetf (&rest args)
+  ;; Because !QUIETLY-DEFSETF calls occur before any condition classoids
+  ;; have been installed, HANDLER-BIND would lead to infinite regress.
+  ;; The only thing we can do to avoid that is: nothing at all.
+  #-sb-xc-host (encapsulate 'style-warn '!bootstrap
+                            (lambda (&rest l) (declare (ignore l))))
+  (apply #'%defsetf args)
+  #-sb-xc-host (unencapsulate 'style-warn '!bootstrap))
 
 (def!macro sb!xc:defsetf (access-fn &rest rest)
   #!+sb-doc
-- 
2.11.4.GIT