(rml64 lin-addr r-x x86) → (mv * * x86)
Theorem:
(defthm rb-and-rvm64 (implies (and (app-view x86) (x86p x86) (canonical-address-p lin-addr) (canonical-address-p (+ 7 lin-addr))) (equal (rvm64 lin-addr x86) (rb 8 lin-addr r-x x86))))
Function:
(defun rml64 (lin-addr r-x x86) (declare (xargs :stobjs (x86))) (declare (type (signed-byte 48) lin-addr) (type (member :r :x) r-x)) (declare (xargs :guard (canonical-address-p lin-addr))) (let ((__function__ 'rml64)) (declare (ignorable __function__)) (if (mbt (canonical-address-p lin-addr)) (let* ((7+lin-addr (the (signed-byte 49) (+ 7 (the (signed-byte 48) lin-addr))))) (if (mbe :logic (canonical-address-p 7+lin-addr) :exec (< (the (signed-byte 49) 7+lin-addr) 140737488355328)) (mbe :logic (rb 8 lin-addr r-x x86) :exec (if (app-view x86) (rvm64 lin-addr x86) (b* (((mv flag (the (unsigned-byte 52) p-addr0) x86) (la-to-pa lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) ((the (signed-byte 49) 1+lin-addr) (+ 1 lin-addr)) ((mv flag (the (unsigned-byte 52) p-addr1) x86) (la-to-pa 1+lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) ((the (signed-byte 50) 2+lin-addr) (+ 2 lin-addr)) ((mv flag (the (unsigned-byte 52) p-addr2) x86) (la-to-pa 2+lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) ((the (signed-byte 51) 3+lin-addr) (+ 3 lin-addr)) ((mv flag (the (unsigned-byte 52) p-addr3) x86) (la-to-pa 3+lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) ((the (signed-byte 52) 4+lin-addr) (+ 4 lin-addr)) ((mv flag (the (unsigned-byte 52) p-addr4) x86) (la-to-pa 4+lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) ((the (signed-byte 53) 5+lin-addr) (+ 5 lin-addr)) ((mv flag (the (unsigned-byte 52) p-addr5) x86) (la-to-pa 5+lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) ((the (signed-byte 54) 6+lin-addr) (+ 6 lin-addr)) ((mv flag (the (unsigned-byte 52) p-addr6) x86) (la-to-pa 6+lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) ((the (signed-byte 55) 7+lin-addr) (+ 7 lin-addr)) ((mv flag (the (unsigned-byte 52) p-addr7) x86) (la-to-pa 7+lin-addr r-x x86)) ((when flag) (mv flag 0 x86)) (byte0 (memi p-addr0 x86)) (byte1 (memi p-addr1 x86)) (byte2 (memi p-addr2 x86)) (byte3 (memi p-addr3 x86)) (byte4 (memi p-addr4 x86)) (byte5 (memi p-addr5 x86)) (byte6 (memi p-addr6 x86)) (byte7 (memi p-addr7 x86)) (word0 (the (unsigned-byte 16) (logior (the (unsigned-byte 16) (ash byte1 8)) byte0))) (word1 (the (unsigned-byte 16) (logior (the (unsigned-byte 16) (ash byte3 8)) byte2))) (dword0 (the (unsigned-byte 32) (logior (the (unsigned-byte 32) (ash word1 16)) word0))) (word2 (the (unsigned-byte 16) (logior (the (unsigned-byte 16) (ash byte5 8)) byte4))) (word3 (the (unsigned-byte 16) (logior (the (unsigned-byte 16) (ash byte7 8)) byte6))) (dword1 (the (unsigned-byte 32) (logior (the (unsigned-byte 32) (ash word3 16)) word2))) (qword (the (unsigned-byte 64) (logior (the (unsigned-byte 64) (ash dword1 32)) dword0)))) (mv nil qword x86)))) (mv 'rml64 0 x86))) (mv 'rml64 0 x86))))
Theorem:
(defthm n64p-mv-nth-1-rml64 (unsigned-byte-p 64 (mv-nth 1 (rml64 lin-addr r-x x86))) :rule-classes (:rewrite (:type-prescription :corollary (natp (mv-nth 1 (rml64 lin-addr r-x x86))) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p natp)))) (:linear :corollary (and (<= 0 (mv-nth 1 (rml64 lin-addr r-x x86))) (< (mv-nth 1 (rml64 lin-addr r-x x86)) 18446744073709551616)) :hints (("Goal" :in-theory '(unsigned-byte-p integer-range-p (:e expt)))))))
Theorem:
(defthm x86p-rml64 (implies (force (x86p x86)) (x86p (mv-nth 2 (rml64 lin-addr r-x x86)))) :rule-classes (:rewrite :type-prescription))
Theorem:
(defthm rml64-value-when-error (implies (mv-nth 0 (rml64 lin-addr r-x x86)) (equal (mv-nth 1 (rml64 lin-addr r-x x86)) 0)))
Theorem:
(defthm rml64-x86-unmodified-in-app-view (implies (app-view x86) (equal (mv-nth 2 (rml64 lin-addr r-x x86)) x86)))
Theorem:
(defthm xr-rml64-state-sys-view (implies (and (not (app-view x86)) (not (equal fld :mem)) (not (equal fld :fault)) (not (equal fld :tlb)) (member-equal fld *x86-field-names-as-keywords*)) (equal (xr fld index (mv-nth 2 (rml64 lin-addr r-x x86))) (xr fld index x86))))
Theorem:
(defthm rml64-xw-app-view (implies (and (app-view x86) (not (equal fld :mem)) (not (equal fld :app-view))) (and (equal (mv-nth 0 (rml64 lin-addr r-x (xw fld index value x86))) (mv-nth 0 (rml64 lin-addr r-x x86))) (equal (mv-nth 1 (rml64 lin-addr r-x (xw fld index value x86))) (mv-nth 1 (rml64 lin-addr r-x x86))))))
Theorem:
(defthm rml64-xw-sys-view (implies (and (not (app-view x86)) (not (equal fld :fault)) (not (equal fld :seg-visible)) (not (equal fld :seg-hidden-base)) (not (equal fld :seg-hidden-limit)) (not (equal fld :seg-hidden-attr)) (not (equal fld :mem)) (not (equal fld :ctr)) (not (equal fld :msr)) (not (equal fld :rflags)) (not (equal fld :app-view)) (not (equal fld :marking-view)) (not (equal fld :tlb)) (not (equal fld :implicit-supervisor-access)) (member-equal fld *x86-field-names-as-keywords*)) (and (equal (mv-nth 0 (rml64 lin-addr r-x (xw fld index value x86))) (mv-nth 0 (rml64 lin-addr r-x x86))) (equal (mv-nth 1 (rml64 lin-addr r-x (xw fld index value x86))) (mv-nth 1 (rml64 lin-addr r-x x86))) (equal (mv-nth 2 (rml64 lin-addr r-x (xw fld index value x86))) (xw fld index value (mv-nth 2 (rml64 lin-addr r-x x86)))))))
Theorem:
(defthm rml64-xw-sys-view-rflags-not-ac (implies (and (not (app-view x86)) (equal (rflagsbits->ac value) (rflagsbits->ac (rflags x86)))) (and (equal (mv-nth 0 (rml64 lin-addr r-x (xw :rflags nil value x86))) (mv-nth 0 (rml64 lin-addr r-x x86))) (equal (mv-nth 1 (rml64 lin-addr r-x (xw :rflags nil value x86))) (mv-nth 1 (rml64 lin-addr r-x x86))) (equal (mv-nth 2 (rml64 lin-addr r-x (xw :rflags nil value x86))) (xw :rflags nil value (mv-nth 2 (rml64 lin-addr r-x x86)))))))