Commit 15d7839f authored by ram's avatar ram
Browse files

Added missing type declarations

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