From 15d7839f4c28d3df90cc7a4967f26e76df9df55e Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 7 Sep 1992 16:10:36 +0000
Subject: [PATCH] Added missing type declarations

---
 code/byte-interp.lisp | 51 +++++++++++++++++++++++++++++--------------
 1 file changed, 35 insertions(+), 16 deletions(-)

diff --git a/code/byte-interp.lisp b/code/byte-interp.lisp
index 872fc92ac..a53ce11b9 100644
--- a/code/byte-interp.lisp
+++ b/code/byte-interp.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.2 1992/08/02 19:38:47 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.3 1992/09/07 16:10:36 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -75,6 +75,7 @@
     value))
 
 (defmacro multiple-value-pop-eval-stack ((&rest vars) &body body)
+  (declare (optimize (inhibit-warnings 3)))
   (let ((num-vars (length vars))
 	(index -1)
 	(new-sp-var (gensym "NEW-SP-"))
@@ -130,13 +131,6 @@
 	  (ash (component-ref component (1+ pc)) 8)
 	  (component-ref component (+ pc 2))))
 
-(declaim (inline component-ref-32))
-(defun component-ref-32 (component pc)
-  (logior (ash (component-ref component pc) 24)
-	  (ash (component-ref component (1+ pc)) 16)
-	  (ash (component-ref component (+ pc 2)) 8)
-	  (component-ref component (+ pc 3))))
-
 
 ;;;; Debugging support.
 
@@ -249,6 +243,7 @@
 ;;;; Inlines.
 
 (defmacro expand-into-inlines ()
+  (declare (optimize (inhibit-warnings 3)))
   (labels ((build-dispatch (bit base)
 	     (if (minusp bit)
 		 (let ((info (nth base *inline-functions*)))
@@ -345,6 +340,7 @@
 
 ;;; *BYTE-XOPS* -- Simple vector of the XOP functions.
 ;;; 
+(declaim (type (simple-vector 256) *byte-xops*))
 (defvar *byte-xops*
   (make-array 256 :initial-element #'undefined-xop))
 
@@ -417,15 +413,16 @@
   (labels ((grovel (remaining-blocks block-count-ptr)
 	     (declare (type index remaining-blocks)
 		      (type stack-pointer block-count-ptr))
+	     (declare (values index stack-pointer))
 	     (let ((block-count (eval-stack-ref block-count-ptr)))
+	       (declare (type index block-count))
 	       (if (= remaining-blocks 1)
 		   (values block-count block-count-ptr)
 		   (let ((src (- block-count-ptr block-count)))
+		     (declare (type index src))
 		     (multiple-value-bind
 			 (values-above dst)
 			 (grovel (1- remaining-blocks) (1- src))
-		       (declare (type index values-above)
-				(type stack-pointer dst))
 		       (stack-copy dst src block-count)
 		       (values (+ values-above block-count)
 			       (+ dst block-count))))))))
@@ -469,6 +466,7 @@
 	   (ignore pc)
 	   (type stack-pointer fp))
   (let ((num-results (pop-eval-stack)))
+    (declare (type index num-results))
     (case num-results
       (0
        (let ((tag (pop-eval-stack)))
@@ -513,6 +511,7 @@
 			  (catch (pop-eval-stack)
 			    (return (byte-interpret component (+ pc 3) fp))))))
 		    (let ((num-results 0))
+		      (declare (type index num-results))
 		      (dolist (result results)
 			(push-eval-stack result)
 			(incf num-results))
@@ -544,6 +543,7 @@
 	   (type stack-pointer fp))
   (let ((tag (pop-eval-stack))
 	(num-results (pop-eval-stack)))
+    (declare (type index num-results))
     (case num-results
       (0
        (with-debugger-info (component old-pc fp)
@@ -774,10 +774,11 @@
 	   (type pc pc)
 	   (type stack-pointer fp)
 	   (type (unsigned-byte 8) byte))
-  (when *byte-trace*
-    (format *trace-output* "pc=~D, fp=~D, sp=~D, byte=#b~8,'0B, frame=~S~%"
-	    pc fp (current-stack-pointer) byte
-	    (subseq eval::*eval-stack* fp (current-stack-pointer))))
+  (locally (declare (optimize (inhibit-warnings 3)))
+    (when *byte-trace*
+      (format *trace-output* "pc=~D, fp=~D, sp=~D, byte=#b~8,'0B, frame=~S~%"
+	      pc fp (current-stack-pointer) byte
+	      (subseq eval::*eval-stack* fp (current-stack-pointer)))))
   (if (zerop (logand byte #x80))
       ;; Some stack operation.  No matter what, we need the operand,
       ;; so compute it.
@@ -809,6 +810,7 @@
 		    (setf (eval-stack-ref (+ fp operand)) (pop-eval-stack))
 		    (if (zerop operand)
 			(let ((operand (pop-eval-stack)))
+			  (declare (type index operand))
 			  (decf (current-stack-pointer) operand))
 			(decf (current-stack-pointer) operand)))))
 	(byte-interpret component new-pc fp))
@@ -886,7 +888,7 @@
 				(values (component-ref component (+ pc 1))
 					(+ pc 2))
 				(values operand (1+ pc))))
-			(funcall (svref *byte-xops* sub-code)
+			(funcall (the function (svref *byte-xops* sub-code))
 				 component pc new-pc fp))))
 	      ;; Random inline function.
 	      (progn
@@ -904,6 +906,9 @@
 			    old-fp))
 
 (defun do-tail-local-call (component pc fp num-args)
+  (declare (type code-component component) (type pc pc)
+	   (type stack-pointer fp)
+	   (type index num-args))
   (let ((old-fp (eval-stack-ref (- fp 1)))
 	(old-sp (eval-stack-ref (- fp 2)))
 	(old-pc (eval-stack-ref (- fp 3)))
@@ -947,6 +952,7 @@
 ;;; and restore the SP to the specifier value.
 ;;;
 (defun byte-apply (function num-args restore-sp)
+  (declare (function function) (type index num-args))
   (let ((start (- (current-stack-pointer) num-args)))
     (declare (type stack-pointer start))
     (macrolet ((frob ()
@@ -1084,6 +1090,7 @@
 (defun invoke-xep (old-component ret-pc old-sp old-fp num-args xep
 				 &optional closure-vars)
   (declare (type (or null code-component) old-component)
+	   (type index num-args)
 	   (type return-pc ret-pc)
 	   (type stack-pointer old-sp old-fp)
 	   (type byte-xep xep)
@@ -1110,7 +1117,10 @@
 				    (result nil
 					    (cons (eval-stack-ref index)
 						  result)))
-				   ((< index more-args-start) result)))))
+				   ((< index more-args-start) result)
+				 (declare (type index index))))))
+	       (declare (type index more-args-supplied)
+			(type stack-pointer more-args-start))
 	       (cond
 		((not (byte-xep-keywords-p xep))
 		 (assert restp)
@@ -1125,6 +1135,8 @@
 			(temp (max sp new-sp))
 			(temp-sp (+ temp more-args-supplied))
 			(keywords (byte-xep-keywords xep)))
+		   (declare (type index temp)
+			    (type stack-pointer new-sp temp-sp))
 		   (setf (current-stack-pointer) temp-sp)
 		   (stack-copy temp more-args-start more-args-supplied)
 		   (when restp
@@ -1141,6 +1153,7 @@
 			 (allow (eq (byte-xep-keywords-p xep) :allow-others))
 			 (bogus-key nil)
 			 (bogus-key-p nil))
+		     (declare (type stack-pointer index))
 		     (loop
 		       (decf index 2)
 		       (when (< index more-args-start)
@@ -1150,6 +1163,7 @@
 			 (if (eq key :allow-other-keys)
 			     (setf allow value)
 			     (let ((target more-args-start))
+			       (declare (type stack-pointer target))
 			       (dolist (keyword keywords
 						(setf bogus-key key
 						      bogus-key-p t))
@@ -1174,6 +1188,7 @@
 			      closure-vars)))
 
 (defun do-return (fp num-results)
+  (declare (type stack-pointer fp) (type index num-results))
   (let ((old-component (eval-stack-ref (- fp 4))))
     (typecase old-component
       (code-component
@@ -1201,9 +1216,11 @@
        (error "function-end breakpoints not supported.")))))
 
 (defun do-local-return (old-component fp num-results)
+  (declare (type stack-pointer fp) (type index num-results))
   (let ((old-fp (eval-stack-ref (- fp 1)))
 	(old-sp (eval-stack-ref (- fp 2)))
 	(old-pc (eval-stack-ref (- fp 3))))
+    (declare (type (signed-byte 25) old-pc))
     (if (plusp old-pc)
 	;; Wants single value.
 	(let ((result (if (zerop num-results)
@@ -1227,6 +1244,7 @@
 ;;;; Random testing noise.
 
 (defun dump-byte-fun (fun)
+  (declare (optimize (inhibit-warnings 3)))
   (let* ((xep (system:find-if-in-closure #'byte-xep-p fun))
 	 (component (byte-xep-component xep))
 	 (bytes (* (code-header-ref component vm:code-code-size-slot)
@@ -1236,6 +1254,7 @@
 
 
 (defun disassem-byte-fun (fun)
+  (declare (optimize (inhibit-warnings 3)))
   (let* ((xep (system:find-if-in-closure #'byte-xep-p fun))
 	 (component (byte-xep-component xep))
 	 (bytes (* (code-header-ref component vm:code-code-size-slot)
-- 
GitLab