(rcl-spec-16 dst src input-rflags) → (mv * * *)
Function:
(defun rcl-spec-16 (dst src input-rflags) (declare (type (unsigned-byte 16) dst) (type (unsigned-byte 6) src) (type (unsigned-byte 32) input-rflags)) (let ((__function__ 'rcl-spec-16)) (declare (ignorable __function__)) (b* ((dst (mbe :logic (n-size 16 dst) :exec dst)) (src (mbe :logic (n-size 6 src) :exec src)) (input-rflags (mbe :logic (n32 input-rflags) :exec input-rflags)) (old-cf (the (unsigned-byte 1) (rflagsbits->cf input-rflags))) (new-dst (mbe :logic (part-install old-cf dst :low 16 :width 1) :exec (the (unsigned-byte 17) (logior (the (unsigned-byte 17) (ash old-cf 16)) dst)))) (raw-result (the (unsigned-byte 17) (fast-rotate-left new-dst 17 src))) (result (the (unsigned-byte 16) (n-size 16 raw-result))) ((mv (the (unsigned-byte 32) output-rflags) (the (unsigned-byte 32) undefined-flags)) (case src (0 (mv input-rflags 0)) (1 (b* ((cf (mbe :logic (logbit 16 raw-result) :exec (logand 1 (the (unsigned-byte 1) (ash (the (unsigned-byte 17) raw-result) -16))))) (of (b-xor cf (mbe :logic (logbit 15 result) :exec (logand 1 (the (unsigned-byte 1) (ash (the (unsigned-byte 16) result) -15)))))) (output-rflags (mbe :logic (change-rflagsbits input-rflags :cf cf :of of) :exec (the (unsigned-byte 32) (!rflagsbits->cf cf (!rflagsbits->of of input-rflags)))))) (mv output-rflags 0))) (otherwise (b* ((cf (mbe :logic (logbit 16 raw-result) :exec (logand 1 (the (unsigned-byte 1) (ash (the (unsigned-byte 17) raw-result) -16))))) (output-rflags (the (unsigned-byte 32) (!rflagsbits->cf cf input-rflags))) (undefined-flags (the (unsigned-byte 32) (!rflagsbits->of 1 0)))) (mv output-rflags undefined-flags))))) (output-rflags (mbe :logic (n32 output-rflags) :exec output-rflags))) (mv result output-rflags undefined-flags))))
Theorem:
(defthm n16-mv-nth-0-rcl-spec-16 (unsigned-byte-p 16 (mv-nth 0 (rcl-spec-16 dst src input-rflags))) :rule-classes (:rewrite (:type-prescription :corollary (natp (mv-nth 0 (rcl-spec-16 dst src input-rflags))) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p natp)))) (:linear :corollary (and (<= 0 (mv-nth 0 (rcl-spec-16 dst src input-rflags))) (< (mv-nth 0 (rcl-spec-16 dst src input-rflags)) 65536)) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p (:e expt)))))))
Theorem:
(defthm mv-nth-1-rcl-spec-16 (unsigned-byte-p 32 (mv-nth 1 (rcl-spec-16 dst src input-rflags))) :rule-classes (:rewrite (:type-prescription :corollary (natp (mv-nth 1 (rcl-spec-16 dst src input-rflags))) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p natp)))) (:linear :corollary (and (<= 0 (mv-nth 1 (rcl-spec-16 dst src input-rflags))) (< (mv-nth 1 (rcl-spec-16 dst src input-rflags)) 4294967296)) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p (:e expt)))))))
Theorem:
(defthm mv-nth-2-rcl-spec-16 (unsigned-byte-p 32 (mv-nth 2 (rcl-spec-16 dst src input-rflags))) :rule-classes (:rewrite (:type-prescription :corollary (natp (mv-nth 2 (rcl-spec-16 dst src input-rflags))) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p natp)))) (:linear :corollary (and (<= 0 (mv-nth 2 (rcl-spec-16 dst src input-rflags))) (< (mv-nth 2 (rcl-spec-16 dst src input-rflags)) 4294967296)) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p (:e expt)))))))