X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbyte-interp.lisp;h=563b66c503009fc735b84f3b7f8136597c47184b;hb=416152f084604094445a758ff399871132dff2bd;hp=214144724c73977113719b2a02479fe7a0fbc23b;hpb=fbe6e22af842835f7c70309f4d48064ca3984ad0;p=sbcl.git

diff --git a/src/code/byte-interp.lisp b/src/code/byte-interp.lisp
index 2141447..563b66c 100644
--- a/src/code/byte-interp.lisp
+++ b/src/code/byte-interp.lisp
@@ -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
@@ -50,16 +51,13 @@
 	  ((nil)))
 	`(function ,(res) *))))))
 
-;;;; the evaluation stack
+;;;; the 'evaluation stack'
+;;;;
+;;;; (The name dates back to CMU CL, when it was used for the IR1
+;;;; interpreted implementation of EVAL. In SBCL >=0.7.0, it's just
+;;;; the byte interpreter stack.)
 
-;;; the interpreter's evaluation stack
 (defvar *eval-stack* (make-array 100)) ; will grow as needed
-;;; FIXME: This seems to be used by the ordinary (non-byte) interpreter
-;;; too, judging from a crash I had when I removed byte-interp.lisp from
-;;; the cold build sequence. It would probably be clearer to pull the
-;;; shared interpreter machinery out of the byte interpreter and ordinary
-;;; interpreter files and put them into their own file shared-interp.lisp
-;;; or something.
 
 ;;; the index of the next free element of the interpreter's evaluation stack
 (defvar *eval-stack-top* 0)
@@ -67,37 +65,37 @@
 #!-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*))
-      (do ((i sp (1+ i))) ; FIXME: DOTIMES? or just :INITIAL-ELEMENT in MAKE-ARRAY?
+    (let ((stack sb!bytecode::*eval-stack*))
+      (do ((i sp (1+ i))) ; FIXME: Use CL:FILL.
 	  ((= i new-sp))
-	(setf (svref stack i) '#:uninitialized))))
+	(setf (svref stack i) '#:uninitialized-eval-stack-element))))
   (values))
 
 (defun pop-eval-stack ()
@@ -113,7 +111,9 @@
 	(new-sp-var (gensym "NEW-SP-"))
 	(decls nil))
     (loop
-      (unless (and (consp body) (consp (car body)) (eq (caar body) 'declare))
+      (unless (and (consp body)
+		   (consp (car body))
+		   (eq (caar body) 'declare))
 	(return))
       (push (pop body) decls))
     `(let ((,new-sp-var (- *eval-stack-top* ,num-vars)))
@@ -396,20 +396,6 @@
 (defun two-arg-string< (x y) (string= x y))
 (defun two-arg-string> (x y) (string= x y))
 
-;;;; miscellaneous primitive stubs
-
-(macrolet ((frob (name &optional (args '(x)))
-	     `(defun ,name ,args (,name ,@args))))
-  (frob %CODE-CODE-SIZE)
-  (frob %CODE-DEBUG-INFO)
-  (frob %CODE-ENTRY-POINTS)
-  (frob %FUNCALLABLE-INSTANCE-FUNCTION)
-  (frob %FUNCALLABLE-INSTANCE-LAYOUT)
-  (frob %FUNCALLABLE-INSTANCE-LEXENV)
-  (frob %FUNCTION-NEXT)
-  (frob %FUNCTION-SELF)
-  (frob %SET-FUNCALLABLE-INSTANCE-FUNCTION (fin new-val)))
-
 ;;;; funny functions
 
 ;;; (used both by the byte interpreter and by the IR1 interpreter)
@@ -616,9 +602,9 @@
 	   (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)
@@ -748,9 +734,9 @@
 	(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))))
@@ -837,7 +823,7 @@
 	(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.