X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftarget-defstruct.lisp;h=4e9b59658522260470f672dae56615517abb2265;hb=f251802ba07257a9b3a23eca02cfd89ad9d6e6b9;hp=7db702987c2e7d55c50f91f95a933764b0380f0a;hpb=96bb2dc76dddb1a21b3886fa7522796879e9ed9d;p=sbcl.git

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 7db7029..4e9b596 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -31,6 +31,29 @@
 (defun %instance-set (instance index new-value)
   (setf (%instance-ref instance index) new-value))
 
+;;; Normally IR2 converted, definition needed for interpreted structure
+;;; constructors only.
+#!+sb-eval
+(defun %make-structure-instance (dd slot-specs &rest slot-values)
+  (let ((instance (%make-instance (dd-instance-length dd))))
+    (setf (%instance-layout instance) (dd-layout-or-lose dd))
+    (mapc (lambda (spec value)
+            (destructuring-bind (raw-type . index) (cdr spec)
+              (macrolet ((make-case ()
+                           `(ecase raw-type
+                              ((t)
+                               (setf (%instance-ref instance index) value))
+                              ,@(mapcar
+                                 (lambda (rsd)
+                                   `(,(raw-slot-data-raw-type rsd)
+                                      (setf (,(raw-slot-data-accessor-name rsd)
+                                              instance index)
+                                            value)))
+                                 *raw-slot-data-list*))))
+                (make-case))))
+          slot-specs slot-values)
+    instance))
+
 #!-hppa
 (progn
   (defun %raw-instance-ref/word (instance index)
@@ -391,7 +414,7 @@
     (when (layout-invalid layout)
       (error "attempt to copy an obsolete structure:~%  ~S" structure))
 
-    ;; Copy ordinary slots.
+    ;; Copy ordinary slots and layout.
     (dotimes (i (- len nuntagged))
       (declare (type index i))
       (setf (%instance-ref res i)