Skip to content
Snippets Groups Projects
Commit 15d7839f authored by ram's avatar ram
Browse files

Added missing type declarations

parent 39b95647
No related branches found
No related tags found
No related merge requests found
...@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment