0.pre7.38:
[sbcl.git] / src / code / byte-interp.lisp
index a309344..563b66c 100644 (file)
@@ -1,5 +1,6 @@
 ;;;; the byte code interpreter
 
+;;; FIXME: should really be in SB!BYTECODE
 (in-package "SB!C")
 
 ;;;; This software is part of the SBCL system. See the README file for
 #!-sb-fluid (declaim (inline eval-stack-ref))
 (defun eval-stack-ref (offset)
   (declare (type stack-pointer offset))
-  (svref sb!eval::*eval-stack* offset))
+  (svref sb!bytecode::*eval-stack* offset))
 
 #!-sb-fluid (declaim (inline (setf eval-stack-ref)))
 (defun (setf eval-stack-ref) (new-value offset)
   (declare (type stack-pointer offset))
-  (setf (svref sb!eval::*eval-stack* offset) new-value))
+  (setf (svref sb!bytecode::*eval-stack* offset) new-value))
 
 (defun push-eval-stack (value)
-  (let ((len (length (the simple-vector sb!eval::*eval-stack*)))
+  (let ((len (length (the simple-vector sb!bytecode::*eval-stack*)))
        (sp *eval-stack-top*))
     (when (= len sp)
       (let ((new-stack (make-array (ash len 1))))
-       (replace new-stack sb!eval::*eval-stack* :end1 len :end2 len)
-       (setf sb!eval::*eval-stack* new-stack)))
+       (replace new-stack sb!bytecode::*eval-stack* :end1 len :end2 len)
+       (setf sb!bytecode::*eval-stack* new-stack)))
     (setf *eval-stack-top* (1+ sp))
     (setf (eval-stack-ref sp) value)))
 
 (defun allocate-eval-stack (amount)
-  (let* ((len (length (the simple-vector sb!eval::*eval-stack*)))
+  (let* ((len (length (the simple-vector sb!bytecode::*eval-stack*)))
         (sp *eval-stack-top*)
         (new-sp (+ sp amount)))
     (declare (type index sp new-sp))
     (when (>= new-sp len)
       (let ((new-stack (make-array (ash new-sp 1))))
-       (replace new-stack sb!eval::*eval-stack* :end1 len :end2 len)
-       (setf sb!eval::*eval-stack* new-stack)))
+       (replace new-stack sb!bytecode::*eval-stack* :end1 len :end2 len)
+       (setf sb!bytecode::*eval-stack* new-stack)))
     (setf *eval-stack-top* new-sp)
-    (let ((stack sb!eval::*eval-stack*))
+    (let ((stack sb!bytecode::*eval-stack*))
       (do ((i sp (1+ i))) ; FIXME: Use CL:FILL.
          ((= i new-sp))
        (setf (svref stack i) '#:uninitialized-eval-stack-element))))
 (defun two-arg-string< (x y) (string= x y))
 (defun two-arg-string> (x y) (string= x y))
 \f
-;;;; miscellaneous primitive stubs
-
-(macrolet ((def-frob (name &optional (args '(x)))
-            `(defun ,name ,args (,name ,@args))))
-  (def-frob %code-code-size)
-  (def-frob %code-debug-info)
-  (def-frob %code-entry-points)
-  (def-frob %funcallable-instance-function)
-  (def-frob %funcallable-instance-layout)
-  (def-frob %funcallable-instance-lexenv)
-  (def-frob %function-next)
-  (def-frob %function-self)
-  (def-frob %set-funcallable-instance-function (fin new-val)))
-\f
 ;;;; funny functions
 
 ;;; (used both by the byte interpreter and by the IR1 interpreter)
           (type pc pc))
   pc)
 
-;;; This is exactly like THROW, except that the tag is the last thing on
-;;; the stack instead of the first. This is used for RETURN-FROM (hence the
-;;; name).
+;;; This is exactly like THROW, except that the tag is the last thing
+;;; on the stack instead of the first. This is used for RETURN-FROM
+;;; (hence the name).
 (define-xop return-from (component old-pc pc fp)
   (declare (type code-component component)
           (type pc old-pc)
        (if (typep type 'structure-class)
            (let ((info (layout-info (class-layout type))))
              (if (and info (eq (dd-type info) 'structure))
-                 (let ((pred (dd-predicate info)))
-                   (if (and pred (fboundp pred))
-                       (fdefinition pred)
+                 (let ((predicate-name (dd-predicate-name info)))
+                   (if (and predicate-name (fboundp predicate-name))
+                       (fdefinition predicate-name)
                        type))
                  type))
            type))))
        (format *trace-output*
                "pc=~D, fp=~D, sp=~D, byte=#b~,'0X, frame:~%    ~S~%"
                pc fp *eval-stack-top* byte
-               (subseq sb!eval::*eval-stack* fp *eval-stack-top*)))))
+               (subseq sb!bytecode::*eval-stack* fp *eval-stack-top*)))))
   (if (zerop (logand byte #x80))
       ;; Some stack operation. No matter what, we need the operand,
       ;; so compute it.