0.pre7.58:

[sbcl.git] / src / code / fop.lisp

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index fe07fe7..bf65fdd 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -24,7 +24,6 @@
          `(with-fop-stack ,pushp ,@forms)))
      (%define-fop ',name ,fop-code)))
 
-;;; FIXME: This can be byte coded.
 (defun %define-fop (name code)
   (let ((oname (svref *fop-names* code)))
     (when (and oname (not (eq oname name)))
@@ -126,7 +125,7 @@
   #+sb-xc-host ; since xc host doesn't know how to compile %PRIMITIVE
   (error "FOP-MISC-TRAP can't be defined without %PRIMITIVE.")
   #-sb-xc-host
-  (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-type))
+  (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-widetag))
 
 (define-fop (fop-character 68)
   (code-char (read-arg 3)))
@@ -410,7 +409,7 @@
   (let* ((rank (read-arg 4))
         (vec (pop-stack))
         (length (length vec))
-        (res (make-array-header sb!vm:simple-array-type rank)))
+        (res (make-array-header sb!vm:simple-array-widetag rank)))
     (declare (simple-array vec)
             (type (unsigned-byte 24) rank))
     (set-array-header res vec length length 0
@@ -626,7 +625,7 @@ bug.~:@>")
        (name (pop-stack)))
     (setf (fdefinition name) fn)))
 
-;;; Modify a slot in a Constants object.
+;;; Modify a slot in a CONSTANTS object.
 (define-cloned-fops (fop-alter-code 140 nil) (fop-byte-alter-code 141)
   (let ((value (pop-stack))
        (code (pop-stack)))
@@ -647,12 +646,12 @@ bug.~:@>")
       (error "internal error: unaligned function object, offset = #X~X"
             offset))
     (let ((fun (%primitive sb!c:compute-function code-object offset)))
-      (setf (%function-self fun) fun)
-      (setf (%function-next fun) (%code-entry-points code-object))
+      (setf (%simple-fun-self fun) fun)
+      (setf (%simple-fun-next fun) (%code-entry-points code-object))
       (setf (%code-entry-points code-object) fun)
-      (setf (%function-name fun) name)
-      (setf (%function-arglist fun) arglist)
-      (setf (%function-type fun) type)
+      (setf (%simple-fun-name fun) name)
+      (setf (%simple-fun-arglist fun) arglist)
+      (setf (%simple-fun-type fun) type)
       ;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL.
       #+nil (when *load-print*
              (load-fresh-line)