#|
Copyright (C) 1994 by Computational Logic, Inc.  All Rights Reserved.
You may copy and distribute verbatim copies of this Nqthm-1992 event script as
you receive it, in any medium, including embedding it verbatim in derivative
works, provided that you conspicuously and appropriately publish on each copy
a valid copyright notice "Copyright (C) 1994 by Computational Logic, Inc.  All
Rights Reserved."
NO WARRANTY
Computational Logic, Inc. PROVIDES ABSOLUTELY NO WARRANTY.  THE EVENT SCRIPT
IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED,
INCLUDING, BUT NOT LIMITED TO, ANY IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND
PERFORMANCE OF THE SCRIPT IS WITH YOU.  SHOULD THE SCRIPT PROVE DEFECTIVE, YOU
ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
IN NO EVENT WILL Computational Logic, Inc. BE LIABLE TO YOU FOR ANY DAMAGES,
ANY LOST PROFITS, LOST MONIES, OR OTHER SPECIAL, INCIDENTAL OR CONSEQUENTIAL
DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THIS SCRIPT (INCLUDING BUT
NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES
SUSTAINED BY THIRD PARTIES), EVEN IF YOU HAVE ADVISED US OF THE POSSIBILITY OF
SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY.
|#
; FM9001 Piton
; J Strother Moore
; October, 1991
; History
; This file contains the complete script of the events establishing
; that Piton is correctly implemented on top of the FM9001.  The
; original correctness proof for Piton was done for the FM8502 and is
; reported accurately and completely in CLI Tech Report 22.  That
; report is still basically accurate.  FM9001 differs from FM8502
; primarily in that instructions are in a slightly different format
; and the instruction set is slightly different.  However, when Hunt
; and Brock developed FM9001 from FM8502 they explicitly considered
; Piton's use of the FM8502 instruction set.  For each FM8502
; instruction-instance used by the Piton compiler, they included an
; FM9001 instruction that could provide the same functionality.  Thus,

; to port the Piton implementation from FM8502 to FM9001 it was only
; necessary to change the code linkers, essentially from
; LINK-INSTR-WORD on down.
; However, porting the proof from FM8502 to FM9001 was harder than
; suggested by the instruction set changes alone.  FM9001 uses a
; different formal representation of memory -- a binary tree instead
; of a linear list -- and uses a different formalization of bit
; vectors -- lists of Booleans instead of the BITV shell.  But most
; dramatically, the FM8502 proof used an experimental version of NQTHM
; that was supposed to become the released version.  That experimental
; NQTHM, called XNQTHM, provided "books".  Indeed, it was the FM8502
; Piton effort that caused books to be invented in the first place.
; With books, the XNQTHM user could develop a large body of lemmas in
; one session and then, in the course of later sessions, extract
; selected results to build upon.  Thus, books were incremental as
; opposed to the monolithic "core dump" view of state saving provided
; by NQTHM's lib files.  The FM8502 Piton proofs used four different
; (major) books: one to handle the p->r diagram, one for r->i, one for
; i->m (where we also handled m=FM8502), and then one in which the
; main correctness result was derived by extracting the key theorems
; from the three preceding books.  In addition, the original
; development devoted a book each to the definitions of the various
; machines (p, r, i, and m) and to the implementation of the compiler
; and link-assembler so they could be loaded and run in isolation from
; the correctness proof.  (This was in fact necessary since, for
; example, both the p->r book and the r->i book both needed access to
; the definition of the r machine and the implementation.)  Finally, I
; redid the FM8502 correctness proof in book form so that Piton could
; build on the definition of FM8502 without the clutter of its
; correctness proof or gate-level implementation.
; In the summer of 1989, Boyer and I began the process of "blessing"
; XNQTHM in preparation for its release as the new NQTHM.  However,
; after several months of trying to combine macros and books, we
; decided to start afresh.  We thereby embarked on the NTHM Project,
; where books are central to the whole design.  That is another story.
; However, one impact of the decision not to release XNQTHM was the
; need to reproduce the Piton proofs in a publicly available NQTHM.  I
; decided to wait until FM9001 was done and then to do the new Piton
; in NQTHM (rather than XNQTHM).
; This has had a major detrimental effect on the readability of the
; proof script.  Books allowed a clean hierarchical decomposition of

; the various layers of the problem.  This was lost when I
; (essentially) just concatenated the event lists from all of the
; Piton books into one massive script.  Of course, I had to start this
; proof effort in the library file created for the FM9001 correctness
; proof, the only NQTHM file containing "the" correct definition of
; FM9001.  To achieve the effect of isolation provided by books, each
; major section is separated from the others by thousands of DISABLE
; events which effectively erase the rule base developed thus far.  In
; addition, some names had to be changed because of clashes which were
; allowed under the book mechanism.  In short, the "new" proof of
; Piton is, in many ways, a step backward from the original one.  This
; was particularly frustrating for me since NTHM's books (which are
; implemented and seem to work) provide even greater functionality
; than XNQTHM's books.  The ideal thing to have done would have been
; for everybody else to take ten years' vacation while Boyer and I
; perfected and released NTHM, and then to develop the new FM9001 stack
; in NTHM.
; I ported the first of Piton's 3 commutative diagrams to the FM9001
; in May, 1991.  At that time, the FM9001 correctness proof was not
; completed.  I "borrowed" a lib file from Bishop that contained the
; majority of the proof and did the bottom-most diagram in that lib.
; Actually, I introduced a fourth layer to Piton: the link from M to
; FM9001 (the corresponding level in the FM8502 proof was an equality)
; has become a full-fledged commutative diagram that handles the
; memory.  See M->FM9001, which is now the fourth application in LOAD,
; and ONE-WAY-CORRESPONDENCE-M-FM9001.  In one week in May, I
; successfully proved that the M machine was implemented on FM9001.  I
; then waited until my decks were clear (October, 1991) to port the
; rest of the proof.  It has taken roughly 2 weeks to do the rest.
; A major new proof burden was introduced by the new memory representation.
; See the events surrounding PLAUSIBLE-DATA-LINK-TABLEP.  The basic problem
; was that in order to display the FM9001 memory to recover the M memory (i.e.,
; to get the "up" arrow in the bottom-most diagram), it was necessary to know
; that no address exceeded the size the of FM9001 memory.  This in turn
; required showing that the size of the final memory was the same as that
; for the initial memory.  This in turn forced us to prove the analogous
; fact all the way up, i.e., for M, I, R, and P.  At the higher levels, of
; course, what we proved was that the machines preserved the "signatures"
; of the program and data segments.  While this work could have been
; rather naturally done at the time we were dealing with the respective
; machines in their component diagrams, we did not recognize the need for the
; theorems until we had redone all of the old diagrams and were trying to

; combine everything at the very end.  Thus, you will see at the end of this
; script some hideous lemmas about the r and p machines where we tediously
; enable things that were "naturally" enabled earlier in the script.
; The book structure of the original proof can be seen by searching
; for comments of the form "; Book:".
; November, 1991: After the first successful port to FM9001 a new
; patch was installed: The loader was changed to allow us to specify
; the location at which the Piton data segment was laid down in
; memory.  This was done so that part of the data segment could be
; memory mapped to allow us to do some output from Piton.  This was
; achieved by swapping the positions of the prog segment and the data
; segment (in the original Piton work, the prog segment was laid out
; first, followed by the data segment and then the system data).  Now
; the data segment is laid out first, then the program segment, and
; then the system data segment.  Furthermore, all of this is laid out
; starting at a given location, generally named the LOAD-ADDR, and the
; contents of memory below that point is specified by an oracle,
; generally named BOOT-LST.
; This change has had drastic effects rippling through the Piton
; proof.
; This takes roughly 8 hours on a Sparc 2 in AKCL and generates 30Mb
; of .proof output and a .lib file of about 20Mb.

Event: Start with the library "fm9001-replay" using the compiled version.

Event: Set the status of all events. The status of each event is to be set as follows. Each ‘boot-strap’ satellite is to be returned to the initial condition. Each ‘add-shell’ satellite is to be enabled. enabled. Anything not otherwise mentioned is to be disabled. Name this event ‘close-data-base-1’.

; Book:  Implementation.events
; We first define the implementation of Piton.  It is odd that we
; start there rather than with the semantics of the P machine.
; Logically and historically we started with the semantics.  But we
; are building the proof from the bottom up and in the beginning all
; we have is FM9001 and the implementation and we will build the m
; machine to explain the link part of the implementation, the i

; machine to build the code generator part, etc.

Definition: incr (c, x) = if x ≃ nil then nil

else cons (xor (c, car (x)), incr (c ∧ car (x), cdr (x))) endif

Definition: bitn (x, n) = if n ≃ 0 then f

elseif n = 1 then car (x) else bitn (cdr (x), n − 1) endif

Event: Add the shell p-state, with recognizer function symbol p-statep and 9 accessors: p-pc, with type restriction (none-of) and default value zero; p-ctrl-stk, with type restriction (none-of) and default value zero; p-temp-stk, with type restriction (none-of) and default value zero; p-prog-segment, with type restriction (none-of) and default value zero; p-data-segment, with type restriction (noneof) and default value zero; p-max-ctrl-stk-size, with type restriction (none-of) and default value zero; p-max-temp-stk-size, with type restriction (none-of) and default value zero; p-word-size, with type restriction (none-of) and default value zero; p-psw, with type restriction (none-of) and default value zero.

Definition: errorp (psw) = ((psw ≠ 'run) ∧ (psw ≠ 'halt))

Definition: definition (name, alist) = assoc (name, alist)

Definition: strip-cdrs (alist) = if alist ≃ nil then nil

else cons (cdar (alist), strip-cdrs (cdr (alist))) endif

Definition: name (d) = car (d)

Definition: formal-vars (d) = cadr (d)

Definition: temp-var-dcls (d) = caddr (d)

Definition: program-body (d) = cdddr (d)

Definition: local-vars (d) = append (formal-vars (d), strip-cars (temp-var-dcls (d)))

Definition: adp-name (adp) = car (adp)

Definition: adp-offset (adp) = cdr (adp) Definition: sub-adp (adp, n) = cons (adp-name (adp), adp-offset (adp) − n) Definition: get (n, lst) = if n ≃ 0 then car (lst)

else get (n − 1, cdr (lst)) endif Definition: tag (type, obj ) = list (type, obj ) Definition: type (const) = car (const) Definition: untag (const) = cadr (const) Definition: area-name (x) = adp-name (untag (x)) Definition: sub-addr (addr, n) = tag (type (addr), sub-adp (untag (addr), n)) Definition: top (stk) = car (stk) Definition: pop (stk) = cdr (stk) Definition: dl (lab, comment, ins) = list ('dl, lab, comment, ins) Definition: labelledp (x) = (car (x) = 'dl) Definition: unlabel (x) = if labelledp (x) then cadddr (x)

else x endif Definition: find-label (x, lst) = if lst ≃ nil then 0

elseif labelledp (car (lst)) ∧ (x = cadar (lst)) then 0 else 1 + find-label (x, cdr (lst)) endif

Definition: pc (lab, program) = tag ('pc, cons (name (program), find-label (lab, program-body (program)))) Definition: bindings (frame) = car (frame) Definition: ret-pc (frame) = cadr (frame)

Definition: p-frame-size (frame) = (2 + length (bindings (frame)))

Definition: p-ctrl-stk-size (ctrl-stk) = if ctrl-stk ≃ nil then 0

else p-frame-size (top (ctrl-stk))

+ p-ctrl-stk-size (cdr (ctrl-stk)) endif

Definition: icode-call (ins, pcn, program)

= list ('(cpush *),

tag ('pc, cons (name (program), 1 + pcn)),

       '(jump *),

tag ('pc, cons (cadr (ins), '(prelude))))

Definition: generate-prelude1 (temp-var-dcls) = if temp-var-dcls ≃ nil then nil

else cons ('(cpush *),

cons (cadar (temp-var-dcls), generate-prelude1 (cdr (temp-var-dcls)))) endif

Definition: generate-prelude2 (formal-vars) = if formal-vars ≃ nil then nil

    else cons ('(cpush <tsp>+),

generate-prelude2 (cdr (formal-vars))) endif

Definition: generate-prelude (program) = append (cons (dl (cons (name (program), '(prelude)),

                  '(prelude),
                  '(cpush cfp)),
               '((move cfp csp))),

append (generate-prelude1 (reverse (temp-var-dcls (program))), generate-prelude2 (formal-vars (program))))

Definition: find-position-of-var (var, lst) = if lst ≃ nil then 0

elseif var = car (lst) then 0

else 1 + find-position-of-var (var, cdr (lst)) endif

Definition: offset-from-csp (var, program) = find-position-of-var (var, local-vars (program))

Definition: generate-postlude (program) = cons (dl (cons (name (program), length (program-body (program))),

           '(postlude),
           '(move csp cfp)),
        '((cpop cfp) (cpop pc)))

Definition: icode-ret (ins, pcn, program)

= list ('(jump *),

tag ('pc, cons (name (program), length (program-body (program)))))

Definition: icode-locn (ins, pcn, program)

= cons ('(move x *),

cons (tag ('nat, offset-from-csp (cadr (ins), program)),

             '((add x{n} csp)
               (move x <x{s}>)
               (add x{n} csp)
               (tpush <x{s}>))))

Definition: icode-push-constant (ins, pcn, program)

= list ('(tpush *),

if cadr (ins) = 'pc then tag ('pc, cons (name (program), 1 + pcn)) elseif cadr (ins) ≃ nil then pc (cadr (ins), program) else cadr (ins) endif)

Definition: icode-push-local (ins, pcn, program)

= cons ('(move x *),

cons (tag ('nat, offset-from-csp (cadr (ins), program)),

             '((add x{n} csp) (tpush <x{s}>))))

Definition: icode-push-global (ins, pcn, program)

= cons ('(move x *),

cons (tag ('addr, cons (cadr (ins), 0)), '((tpush <x{a}>))))

Definition: icode-push-ctrl-stk-free-size (ins, pcn, program)

= '((move x *)
      (sys-addr (full-ctrl-stk-addr . 0))
      (move x <x{s}>)
      (tpush csp)
      (sub <tsp>{s} x{s}))

Definition: icode-push-temp-stk-free-size (ins, pcn, program)

= '((move x *)
      (sys-addr (full-temp-stk-addr . 0))
      (move x <x{s}>)
      (tpush tsp)
      (sub <tsp>{s} x{s}))

Definition: icode-push-temp-stk-index (ins, pcn, program)

= cons ('(move y tsp),
        cons ('(move x *),
             cons ('(sys-addr (empty-temp-stk-addr . 0)),
                  cons ('(move x <x{s}>),

cons ('(sub <z> x{s} y{s}),

                           cons ('(tpush x),
                                cons ('(move x *),

cons (tag ('nat, 1 + cadr (ins)),

                                         '((sub <tsp>{n} x{n}))))))))))

Definition: icode-jump-if-temp-stk-full (ins, pcn, program)

= cons ('(move x tsp),
        cons ('(move y *),
             cons ('(sys-addr (full-temp-stk-addr . 0)),
                  cons ('(move y <y{s}>),

cons ('(sub <z> x{s} y{s}),

                           cons ('(move x *),

cons (pc (cadr (ins), program),

                                    '((jump-z x)))))))))

Definition: icode-jump-if-temp-stk-empty (ins, pcn, program)

= cons ('(move y tsp),
        cons ('(move x *),
             cons ('(sys-addr (empty-temp-stk-addr . 0)),
                  cons ('(move x <x{s}>),

cons ('(sub <z> x{s} y{s}),

                           cons ('(move x *),

cons (pc (cadr (ins), program),

                                    '((jump-z x)))))))))

Definition: icode-pop (ins, pcn, program) = '((tpop x))

Definition: icode-pop* (ins, pcn, program) = list ('(add tsp *{n}), tag ('nat, cadr (ins)))

Definition: icode-popn (ins, pcn, program) = '((tpop x) (add tsp x{n}))

Definition: icode-pop-local (ins, pcn, program)

= cons ('(move x *),

cons (tag ('nat, offset-from-csp (cadr (ins), program)),

             '((add x{n} csp) (tpop <x{s}>))))

Definition: icode-pop-global (ins, pcn, program)

= cons ('(move x *),

cons (tag ('addr, cons (cadr (ins), 0)), '((tpop <x{a}>))))

Definition: icode-pop-locn (ins, pcn, program)

= cons ('(move x *),

cons (tag ('nat, offset-from-csp (cadr (ins), program)),

             '((add x{n} csp)
               (move x <x{s}>)
               (add x{n} csp)
               (tpop <x{s}>))))

Definition: icode-pop-call (ins, pcn, program)

= cons ('(tpop x),
        cons ('(cpush *),

cons (tag ('pc, cons (name (program), 1 + pcn)),

                  '((jump x{subr})))))

Definition: icode-fetch-temp-stk (ins, pcn, program)

= '((tpop y)
      (incr y y{n})
      (move x *)
      (sys-addr (empty-temp-stk-addr . 0))
      (move x <x{s}>)
      (sub x{s} y{n})
      (tpush <x{s}>))

Definition: icode-deposit-temp-stk (ins, pcn, program)

= '((tpop y)
      (incr y y{n})
      (move x *)
      (sys-addr (empty-temp-stk-addr . 0))
      (move x <x{s}>)
      (sub x{s} y{n})
      (tpop <x{s}>))

Definition: icode-jump (ins, pcn, program) = list ('(jump *), pc (cadr (ins), program))

Definition: jump *-lst (lst, program) = if lst ≃ nil then nil

else cons ('(jump *),

cons (pc (car (lst), program), jump *-lst (cdr (lst), program))) endif

Definition: icode-jump-case (ins, pcn, program)

= append ('((tpop x) (add x x{n}) (add pc x{n})),

jump *-lst (cdr (ins), program))

Definition: icode-pushj (ins, pcn, program)

= list ('(tpush *),

tag ('pc, cons (name (program), 1 + pcn)),

       '(jump *),

pc (cadr (ins), program))

Definition: icode-popj (ins, pcn, program) = '((tpop pc))

Definition: icode-set-local (ins, pcn, program)

= cons ('(move x *),

cons (tag ('nat, offset-from-csp (cadr (ins), program)),

             '((add x{n} csp) (move <x{s}> <tsp>))))

Definition: icode-set-global (ins, pcn, program)

= cons ('(move x *),

cons (tag ('addr, cons (cadr (ins), 0)),

             '((move <x{a}> <tsp>))))

Definition: icode-test-nat-and-jump (ins, pcn, program) = if cadr (ins) = 'zero

then cons ('(tpop{n} <z> y),

          cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-z x)))))

else cons ('(tpop{n} <z> y),

         cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-nz x))))) endif

Definition: icode-test-int-and-jump (ins, pcn, program) = case on car (cdr (ins)):

case = zero then cons ('(tpop{i} <zn> y),

          cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-z x)))))

case = not-zero then cons ('(tpop{i} <zn> y),

           cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-nz x)))))

case = neg then cons ('(tpop{i} <zn> y),

           cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-n x)))))

case = not-neg then cons ('(tpop{i} <zn> y),

           cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-nn x)))))

case = pos then list ('(tpop{i} <zn> y),

          '(move x *),

tag ('pc, cons (name (program), 1 + pcn)),

          '(jump-n x),
          '(jump-z x),
          '(jump *),

pc (caddr (ins), program))

otherwise cons ('(tpop{i} <zn> y),

               cons ('(move x *),

cons (pc (caddr (ins), program),

                        '((jump-n x) (jump-z x))))) endcase

Definition: icode-test-bool-and-jump (ins, pcn, program) = if cadr (ins) = 't then cons ('(tpop{b} <z> y),

             cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-nz x)))))

else cons ('(tpop{b} <z> y),

            cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-z x))))) endif

Definition: icode-test-bitv-and-jump (ins, pcn, program) = if cadr (ins) = 'all-zero

then cons ('(tpop{v} <z> y),

             cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-z x)))))

else cons ('(tpop{v} <z> y),

            cons ('(move x *),

cons (pc (caddr (ins), program), '((jump-nz x))))) endif

Definition: icode-no-op (ins, pcn, program) = '((move x x))

Definition: icode-add-addr (ins, pcn, program)

= '((tpop x) (add <tsp>{a} x{n}))

Definition: icode-sub-addr (ins, pcn, program)

= '((tpop x) (sub <tsp>{a} x{n}))

Definition: icode-eq (ins, pcn, program)

= '((tpop x)
      (xor <z> <tsp> x)
      (xor <tsp> <tsp>)
      (move-z <tsp> *)
      (bool t))

Definition: icode-lt-addr (ins, pcn, program)

= '((tpop x)
      (sub <c> <tsp>{a} x{a})
      (xor <tsp> <tsp>)
      (move-c <tsp> *)
      (bool t))

Definition: icode-fetch (ins, pcn, program) = '((tpop x) (tpush <x{a}>))

Definition: icode-deposit (ins, pcn, program) = '((tpop x) (tpop <x{a}>))

Definition: icode-add-int (ins, pcn, program)

= '((tpop x) (add <tsp>{i} x{i}))

Definition: icode-add-int-with-carry (ins, pcn, program)

= '((tpop x)
      (tpop y)
      (asr <c> <tsp> <tsp>{b})
      (addc <v> x{i} y{i})
      (move-v <tsp> *)
      (bool t)
      (tpush x))

Definition: icode-add1-int (ins, pcn, program) = '((incr <tsp> <tsp>{i}))

Definition: icode-sub-int (ins, pcn, program)

= '((tpop x) (sub <tsp>{i} x{i}))

Definition: icode-sub-int-with-carry (ins, pcn, program)

= '((tpop y)
      (tpop x)
      (asr <c> <tsp> <tsp>{b})
      (subb <v> x{i} y{i})
      (move-v <tsp> *)
      (bool t)
      (tpush x))

Definition: icode-sub1-int (ins, pcn, program) = '((decr <tsp> <tsp>{i}))

Definition: icode-neg-int (ins, pcn, program) = '((neg <tsp> <tsp>{i}))

Definition: icode-lt-int (ins, pcn, program)

= '((tpop x)
      (sub <nv> <tsp>{i} x{i})

      (move <tsp> *)

(bool f)
(move-v <tsp> *)
(bool t)
(move x *)
(bool f)
(move-n x *)
(bool t)
(xor <tsp>{b} x{b}))

Definition: icode-int-to-nat (ins, pcn, program) = '((int-to-nat))

Definition: icode-add-nat (ins, pcn, program)

= '((tpop x) (add <tsp>{n} x{n}))

Definition: icode-add-nat-with-carry (ins, pcn, program)

= '((tpop x)
(tpop y)
(asr <c> <tsp> <tsp>{b})
(addc <c> x{n} y{n})
(move-c <tsp> *)
(bool t)
(tpush x))

Definition: icode-add1-nat (ins, pcn, program) = '((incr <tsp> <tsp>{n}))

Definition: icode-sub-nat (ins, pcn, program)

= '((tpop x) (sub <tsp>{n} x{n}))

Definition: icode-sub-nat-with-carry (ins, pcn, program)

= '((tpop y)
(tpop x)
(asr <c> <tsp> <tsp>{b})
(subb <c> x{n} y{n})
(move-c <tsp> *)
(bool t)
(tpush x))

Definition: icode-sub1-nat (ins, pcn, program) = '((decr <tsp> <tsp>{n}))

Definition: icode-lt-nat (ins, pcn, program)

= '((tpop x)
      (sub <c> <tsp>{n} x{n})
      (xor <tsp> <tsp>)
      (move-c <tsp> *)
      (bool t))

Definition: icode-mult2-nat (ins, pcn, program) = '((add <tsp> <tsp>{n}))

Definition: icode-mult2-nat-with-carry-out (ins, pcn, program)

= '((tpop x)
      (add <c> x x{n})
      (tpush *)
      (bool f)
      (move-c <tsp> *)
      (bool t)
      (tpush x))

Definition: icode-div2-nat (ins, pcn, program)

= '((tpop <c> x)
      (lsr <c> x x{n})
      (tpush x)
      (tpush *)
      (nat 0)
      (move-c <tsp> *)
      (nat 1))

Definition: icode-or-bitv (ins, pcn, program) = '((tpop x) (or <tsp>{v} x{v}))

Definition: icode-and-bitv (ins, pcn, program)

= '((tpop x) (and <tsp>{v} x{v}))

Definition: icode-not-bitv (ins, pcn, program) = '((not <tsp> <tsp>{v}))

Definition: icode-xor-bitv (ins, pcn, program)

= '((tpop x) (xor <tsp>{v} x{v}))

Definition: icode-rsh-bitv (ins, pcn, program) = '((lsr <tsp> <tsp>{v}))

Definition: icode-lsh-bitv (ins, pcn, program) = '((add <tsp> <tsp>{v}))

Definition: icode-or-bool (ins, pcn, program) = '((tpop x) (or <tsp>{b} x{b}))

Definition: icode-and-bool (ins, pcn, program)

= '((tpop x) (and <tsp>{b} x{b}))

Definition: icode-not-bool (ins, pcn, program)

= '((xor <tsp>{b} *{b}) (bool t))

Definition: icode1 (ins, pcn, prog) = case on car (ins):

case = call

then icode-call (ins, pcn, prog)

case = ret

then icode-ret (ins, pcn, prog)

case = locn

then icode-locn (ins, pcn, prog)

case = push-constant

then icode-push-constant (ins, pcn, prog)

case = push-local

then icode-push-local (ins, pcn, prog)

case = push-global

then icode-push-global (ins, pcn, prog)

case = push-ctrl-stk-free-size then icode-push-ctrl-stk-free-size (ins, pcn, prog) case = push-temp-stk-free-size then icode-push-temp-stk-free-size (ins, pcn, prog) case = push-temp-stk-index then icode-push-temp-stk-index (ins, pcn, prog) case = jump-if-temp-stk-full then icode-jump-if-temp-stk-full (ins, pcn, prog) case = jump-if-temp-stk-empty then icode-jump-if-temp-stk-empty (ins, pcn, prog) case = pop then icode-pop (ins, pcn, prog) case = pop* then icode-pop* (ins, pcn, prog) case = popn then icode-popn (ins, pcn, prog) case = pop-local then icode-pop-local (ins, pcn, prog) case = pop-global then icode-pop-global (ins, pcn, prog) case = pop-locn then icode-pop-locn (ins, pcn, prog) case = pop-call then icode-pop-call (ins, pcn, prog) case = fetch-temp-stk then icode-fetch-temp-stk (ins, pcn, prog) case = deposit-temp-stk then icode-deposit-temp-stk (ins, pcn, prog) case = jump then icode-jump (ins, pcn, prog) case = jump-case then icode-jump-case (ins, pcn, prog) case = pushj then icode-pushj (ins, pcn, prog) case = popj then icode-popj (ins, pcn, prog) case = set-local then icode-set-local (ins, pcn, prog) case = set-global then icode-set-global (ins, pcn, prog) case = test-nat-and-jump then icode-test-nat-and-jump (ins, pcn, prog) case = test-int-and-jump then icode-test-int-and-jump (ins, pcn, prog) case = test-bool-and-jump then icode-test-bool-and-jump (ins, pcn, prog) case = test-bitv-and-jump then icode-test-bitv-and-jump (ins, pcn, prog) case = no-op then icode-no-op (ins, pcn, prog) case = add-addr then icode-add-addr (ins, pcn, prog) case = sub-addr then icode-sub-addr (ins, pcn, prog) case = eq then icode-eq (ins, pcn, prog) case = lt-addr then icode-lt-addr (ins, pcn, prog) case = fetch then icode-fetch (ins, pcn, prog) case = deposit then icode-deposit (ins, pcn, prog) case = add-int then icode-add-int (ins, pcn, prog) case = add-int-with-carry then icode-add-int-with-carry (ins, pcn, prog) case = add1-int then icode-add1-int (ins, pcn, prog) case = sub-int then icode-sub-int (ins, pcn, prog) case = sub-int-with-carry then icode-sub-int-with-carry (ins, pcn, prog) case = sub1-int then icode-sub1-int (ins, pcn, prog) case = neg-int then icode-neg-int (ins, pcn, prog) case = lt-int then icode-lt-int (ins, pcn, prog) case = int-to-nat then icode-int-to-nat (ins, pcn, prog) case = add-nat then icode-add-nat (ins, pcn, prog) case = add-nat-with-carry then icode-add-nat-with-carry (ins, pcn, prog) case = add1-nat then icode-add1-nat (ins, pcn, prog) case = sub-nat then icode-sub-nat (ins, pcn, prog) case = sub-nat-with-carry then icode-sub-nat-with-carry (ins, pcn, prog) case = sub1-nat then icode-sub1-nat (ins, pcn, prog) case = lt-nat then icode-lt-nat (ins, pcn, prog) case = mult2-nat then icode-mult2-nat (ins, pcn, prog) case = mult2-nat-with-carry-out then icode-mult2-nat-with-carry-out (ins, pcn, prog) case = div2-nat then icode-div2-nat (ins, pcn, prog) case = or-bitv then icode-or-bitv (ins, pcn, prog) case = and-bitv then icode-and-bitv (ins, pcn, prog) case = not-bitv then icode-not-bitv (ins, pcn, prog) case = xor-bitv then icode-xor-bitv (ins, pcn, prog) case = rsh-bitv then icode-rsh-bitv (ins, pcn, prog) case = lsh-bitv then icode-lsh-bitv (ins, pcn, prog) case = or-bool then icode-or-bool (ins, pcn, prog) case = and-bool then icode-and-bool (ins, pcn, prog) case = not-bool then icode-not-bool (ins, pcn, prog) otherwise '((error)) endcase

Definition: dl-block (lab, comment, block) = cons (dl (lab, comment, car (block)), cdr (block))

Definition: icode (ins, pcn, program) = dl-block (cons (name (program), pcn), ins, icode1 (unlabel (ins), pcn, program))

Definition: icompile-program-body (lst, pcn, program) = if lst ≃ nil then nil

else append (icode (car (lst), pcn, program), icompile-program-body (cdr (lst), 1 + pcn, program)) endif

Definition: icompile-program (program) = cons (name (program),

append (generate-prelude (program),

append (icompile-program-body (program-body (program),

                                           0,

program),

generate-postlude (program))))

Definition: icompile (programs) = if programs ≃ nil then nil

else cons (icompile-program (car (programs)), icompile (cdr (programs))) endif Definition: segment-length (segment) = if segment ≃ nil then 0

else length (cdar (segment)) + segment-length (cdr (segment)) endif

Definition: total-p-system-size (p, load-addr) = (load-addr

+ segment-length (p-data-segment (p))

+ segment-length (icompile (p-prog-segment (p)))

+ (1 + p-max-ctrl-stk-size (p)) + (1 + p-max-temp-stk-size (p)) + 3)

Definition: p-loadablep (p, load-addr) = (total-p-system-size (p, load-addr) < exp (2, p-word-size (p)))

Event: Add the shell r-state, with recognizer function symbol r-statep and 15 accessors: r-pc, with type restriction (none-of) and default value zero; rcfp, with type restriction (none-of) and default value zero; r-csp, with type restriction (none-of) and default value zero; r-tsp, with type restriction (noneof) and default value zero; r-x, with type restriction (none-of) and default value zero; r-y, with type restriction (none-of) and default value zero; r-c-flg, with type restriction (none-of) and default value zero; r-v-flg, with type restriction (none-of) and default value zero; r-n-flg, with type restriction (none-of) and default value zero; r-z-flg, with type restriction (none-of) and default value zero; r-prog-segment, with type restriction (none-of) and default value zero; rusr-data-segment, with type restriction (none-of) and default value zero; r-sys-data-segment, with type restriction (none-of) and default value zero; r-word-size, with type restriction (none-of) and default value zero; r-psw, with type restriction (none-of) and default value zero.

Definition: nat-0s (n) = if n ≃ 0 then nil

else cons (tag ('nat, 0), nat-0s (n − 1)) endif

Definition: p->r temp-stk (temp-stk, max-temp-stk-size) = cons ('tstk,

append (nat-0s (max-temp-stk-size − length (temp-stk)), append (temp-stk, list (tag ('nat, 0)))))

Definition: p->r csp (stk, max) = tag ('sys-addr, cons ('cstk, max − p-ctrl-stk-size (stk)))

Definition: p->r cfp (stk, max) = sub-addr (p->r csp (pop (stk), max), 2)

Definition: p->r p-frame (pframe, stk, max) = append (strip-cdrs (bindings (pframe)),

list (p->r cfp (stk, max), ret-pc (pframe)))

Definition: p->r ctrl-stk1 (stk, max) = if stk ≃ nil then nil

else append (p->r p-frame (top (stk), pop (stk), max), p->r ctrl-stk1 (pop (stk), max)) endif

Definition: p->r ctrl-stk (stk, max) = cons ('cstk,

append (nat-0s (max − p-ctrl-stk-size (stk)), append (p->r ctrl-stk1 (stk, max), list (tag ('nat, 0)))))

Definition: p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size) = list (p->r ctrl-stk (ctrl-stk, max-ctrl-stk-size),

p->r temp-stk (temp-stk, max-temp-stk-size),

       list ('full-ctrl-stk-addr, tag ('sys-addr, '(cstk . 0))),
       list ('full-temp-stk-addr, tag ('sys-addr, '(tstk . 0))),
       list ('empty-temp-stk-addr,

tag ('sys-addr, cons ('tstk, max-temp-stk-size))))

Definition: p->r tsp (stk, max) = tag ('sys-addr, cons ('tstk, max − length (stk)))

Definition: p->r (p) = r-state (p-pc (p),

p->r cfp (p-ctrl-stk (p), p-max-ctrl-stk-size (p)), p->r csp (p-ctrl-stk (p), p-max-ctrl-stk-size (p)), p->r tsp (p-temp-stk (p), p-max-temp-stk-size (p)),

          '(nat 0),
          '(nat 0),
          '(bool f),

          '(bool f),
          '(bool f),
          '(bool f),

p-prog-segment (p), p-data-segment (p), p->r sys-data-segment (p-ctrl-stk (p),

p-max-ctrl-stk-size (p), p-temp-stk (p), p-max-temp-stk-size (p)),

p-word-size (p), p-psw (p))

Event: Add the shell i-state, with recognizer function symbol i-statep and 15 accessors: i-pc, with type restriction (none-of) and default value zero; icfp, with type restriction (none-of) and default value zero; i-csp, with type restriction (none-of) and default value zero; i-tsp, with type restriction (noneof) and default value zero; i-x, with type restriction (none-of) and default value zero; i-y, with type restriction (none-of) and default value zero; i-c-flg, with type restriction (none-of) and default value zero; i-v-flg, with type restriction (none-of) and default value zero; i-n-flg, with type restriction (none-of) and default value zero; i-z-flg, with type restriction (none-of) and default value zero; i-prog-segment, with type restriction (none-of) and default value zero; iusr-data-segment, with type restriction (none-of) and default value zero; i-sys-data-segment, with type restriction (none-of) and default value zero; i-word-size, with type restriction (none-of) and default value zero; i-psw, with type restriction (none-of) and default value zero.

Definition: r->i pc (pc, programs) = tag ('ipc,

cons (area-name (pc),

find-label (untag (pc),

cdr (icompile-program (definition (area-name (pc), programs))))))

Definition: r->i psw (psw) = if psw = 'halt then 'run

else psw endif

Definition: r->i (r) = i-state (r->i pc (r-pc (r), r-prog-segment (r)),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), icompile (r-prog-segment (r)), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r), r->i psw (r-psw (r)))

Event: Add the shell m-state, with recognizer function symbol m-statep and 6 accessors: m-regs, with type restriction (none-of) and default value zero; mc-flg, with type restriction (none-of) and default value zero; m-v-flg, with type restriction (none-of) and default value zero; m-n-flg, with type restriction (noneof) and default value zero; m-z-flg, with type restriction (none-of) and default value zero; m-mem, with type restriction (none-of) and default value zero.

Definition: link-table-for-segment (segment, addr0 ) = if segment ≃ nil then nil

else cons (cons (caar (segment), addr0 ),

link-table-for-segment (cdr (segment), addr0 + length (cdar (segment)))) endif

Definition: link-table-for-labels (lst, addr0 ) = if lst ≃ nil then nil

elseif labelledp (car (lst))

then cons (cons (cadar (lst), addr0 ),

link-table-for-labels (cdr (lst), 1 + addr0 ))

else link-table-for-labels (cdr (lst), 1 + addr0 ) endif

Definition: link-table-for-prog-labels (segment, addr0 ) = if segment ≃ nil then nil

else cons (cons (caar (segment),

link-table-for-labels (cdar (segment), addr0 )), link-table-for-prog-labels (cdr (segment),

addr0 + length (cdar (segment)))) endif Definition: i-link-tables (i, load-addr) = list (link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

link-table-for-prog-labels (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

link-table-for-segment (i-usr-data-segment (i), load-addr), link-table-for-segment (i-sys-data-segment (i),

load-addr

+ segment-length (i-prog-segment (i))

+ segment-length (i-usr-data-segment (i))))

Definition: prog-links (link-tables) = car (link-tables)

Definition: prog-label-tables (link-tables) = cadr (link-tables)

Definition: usr-data-links (link-tables) = caddr (link-tables)

Definition: sys-data-links (link-tables) = cadddr (link-tables)

Definition: label-links (label, prog-label-tables) = cdr (assoc (adp-name (label), prog-label-tables))

Definition: base-address (name, link-table) = cdr (assoc (name, link-table))

Definition: find-containing-area-name (n, link-table) = if link-table ≃ nil then 0

elseif cdr (link-table) ≃ nil then caar (link-table) elseif (n ≮ cdar (link-table)) ∧ (n < cdadr (link-table)) then caar (link-table) else find-containing-area-name (n, cdr (link-table)) endif

Definition: invert-base-address (n, link-table) = find-containing-area-name (n, link-table)

Definition: label-address (label, prog-label-tables) = base-address (label, label-links (label, prog-label-tables))

Definition: assoc-cdrp (n, alist) = if alist ≃ nil then f

elseif n = cdar (alist) then t

else assoc-cdrp (n, cdr (alist)) endif Definition: find-containing-label-table (n, label-tables) = if label-tables ≃ nil then f

elseif assoc-cdrp (n, cdar (label-tables)) then cdar (label-tables) else find-containing-label-table (n, cdr (label-tables)) endif

Definition: invert-label-address (n, prog-label-tables) = invert-base-address (n,

find-containing-label-table (n, prog-label-tables))

Definition: absolute-address (adp, link-table) = (base-address (adp-name (adp), link-table) + adp-offset (adp))

Definition: invert-absolute-address (n, link-table) = cons (find-containing-area-name (n, link-table),

n − base-address (find-containing-area-name (n, link-table), link-table))

Definition: bitv-to-v (lst, word-size) = if word-size ≃ 0 then nil

else append (bitv-to-v (cdr (lst), word-size − 1),

list (if car (lst) = 0 then f else t endif)) endif

Definition: v-to-bitv (v) = if v ≃ nil then nil

else append (v-to-bitv (cdr (v)),

list (if car (v) then 1 else 0 endif)) endif

Definition: bool-to-v (b, word-size) = if b = 'f then nat-to-v (0, word-size)

else nat-to-v (1, word-size) endif

Definition: v-to-bool (v) = if car (v) then 't

else 'f endif Definition: addr-to-v (adp, usr-data-links, word-size) = nat-to-v (absolute-address (adp, usr-data-links), word-size)

Definition: v-to-addr (v, usr-data-links) = invert-absolute-address (v-to-nat (v), usr-data-links)

Definition: subr-to-v (subr, prog-links, word-size) = nat-to-v (base-address (subr, prog-links), word-size)

Definition: v-to-subr (v, prog-links) = invert-base-address (v-to-nat (v), prog-links)

Definition: sys-addr-to-v (adp, sys-data-links, word-size) = nat-to-v (absolute-address (adp, sys-data-links), word-size)

Definition: v-to-sys-addr (v, sys-data-links) = invert-absolute-address (v-to-nat (v), sys-data-links)

Definition: label-to-v (ilab, prog-label-tables, word-size) = nat-to-v (label-address (ilab, prog-label-tables), word-size)

Definition: v-to-label (v, prog-label-tables) = invert-label-address (v-to-nat (v), prog-label-tables)

Definition: ipc-to-v (pcpp, prog-links, word-size) = nat-to-v (absolute-address (pcpp, prog-links), word-size)

Definition: link-data-word (x, link-tables, word-size) = case on type (x):

case = nat

then nat-to-v (untag (x), word-size)

case = int

then int-to-v (untag (x), word-size) case = bitv then bitv-to-v (untag (x), word-size) case = bool then bool-to-v (untag (x), word-size) case = addr then addr-to-v (untag (x), usr-data-links (link-tables), word-size) case = subr then subr-to-v (untag (x), prog-links (link-tables), word-size) case = sys-addr then sys-addr-to-v (untag (x), sys-data-links (link-tables), word-size) case = pc then label-to-v (untag (x), prog-label-tables (link-tables), word-size) case = ipc then ipc-to-v (untag (x), prog-links (link-tables), word-size) otherwise nat-to-v (0, word-size) endcase

Definition: unlink-data-word (type, v, link-tables) = case on type:

case = nat then tag ('nat, v-to-nat (v)) case = int then tag ('int, v-to-int (v)) case = bitv then tag ('bitv, v-to-bitv (v)) case = bool then tag ('bool, v-to-bool (v)) case = addr then tag ('addr, v-to-addr (v, usr-data-links (link-tables))) case = subr then tag ('subr, v-to-subr (v, prog-links (link-tables))) case = sys-addr then tag ('sys-addr, v-to-sys-addr (v, sys-data-links (link-tables))) case = pc then tag ('pc, v-to-label (v, prog-label-tables (link-tables)))

otherwise '(unrecognized i-level type) endcase

Definition: link-instruction-alist

= '((add <c> x x{n} (add (c) x x))
  (add <tsp> <tsp>{v} (add nil (tsp) (tsp)))
  (add <tsp> <tsp>{n} (add nil (tsp) (tsp)))
  (add <tsp>{a} x{n} (add nil (tsp) x))
  (add tsp *{n} (add nil tsp (pc 1)))
  (add tsp x{n} (add nil tsp x))
  (add <tsp>{i} x{i} (add nil (tsp) x))
  (add <tsp>{n} x{n} (add nil (tsp) x))
  (add pc x{n} (add nil pc x))

(add x x{n} (add nil x x))
(add x{n} csp (add nil x csp))
(addc <c> x{n} y{n} (addc (c) x y))
(addc <v> x{i} y{i} (addc (v) x y))
(and <tsp>{v} x{v} (and nil (tsp) x))
(and <tsp>{b} x{b} (and nil (tsp) x))
(asr <c> <tsp> <tsp>{b} (asr (c) (tsp) (tsp)))
(cpop cfp (move nil cfp (csp 1)))
(cpop pc (move nil pc (csp 1)))
(cpush * (move nil (-1 csp) (pc 1)))
(cpush <tsp>+ (move nil (-1 csp) (tsp 1)))
(cpush cfp (move nil (-1 csp) cfp))
(decr <tsp> <tsp>{i} (decr nil (tsp) (tsp)))
(decr <tsp> <tsp>{n} (decr nil (tsp) (tsp)))
(incr <tsp> <tsp>{i} (incr nil (tsp) (tsp)))
(incr <tsp> <tsp>{n} (incr nil (tsp) (tsp)))
(incr y y{n} (incr nil y y))
(int-to-nat (move nil x x))
(jump-n x (move-n nil pc x))
(jump-nn x (move-nn nil pc x))
(jump-nz x (move-nz nil pc x))
(jump-z x (move-z nil pc x))
(jump * (move nil pc (pc)))
(jump x{subr} (move nil pc x))
(lsr <c> x x{n} (lsr (c) x x))
(lsr <tsp> <tsp>{v} (lsr nil (tsp) (tsp)))
(move-c <tsp> * (move-c nil (tsp) (pc 1)))
(move-v <tsp> * (move-v nil (tsp) (pc 1)))
(move-z <tsp> * (move-z nil (tsp) (pc 1)))
(move-n x * (move-n nil x (pc 1)))
(move <tsp> * (move nil (tsp) (pc 1)))
(move <x{a}> <tsp> (move nil (x) (tsp)))
(move <x{s}> <tsp> (move nil (x) (tsp)))
(move cfp csp (move nil cfp csp))
(move csp cfp (move nil csp cfp))
(move x * (move nil x (pc 1)))
(move x <x{s}> (move nil x (x)))
(move x tsp (move nil x tsp))
(move x x (move nil x x))
(move y * (move nil y (pc 1)))
(move y <y{s}> (move nil y (y)))
(move y tsp (move nil y tsp))
(neg <tsp> <tsp>{i} (neg nil (tsp) (tsp)))
(not <tsp> <tsp>{v} (not nil (tsp) (tsp)))

(or <tsp>{v} x{v} (or nil (tsp) x))
(or <tsp>{b} x{b} (or nil (tsp) x))
(sub <c> <tsp>{a} x{a} (sub (c) (tsp) x))
(sub <c> <tsp>{n} x{n} (sub (c) (tsp) x))
(sub <nv> <tsp>{i} x{i} (sub (n v) (tsp) x))
(sub <tsp>{a} x{n} (sub nil (tsp) x))
(sub x{s} y{n} (sub nil x y))
(sub <tsp>{i} x{i} (sub nil (tsp) x))
(sub <tsp>{n} x{n} (sub nil (tsp) x))
(sub <tsp>{s} x{s} (sub nil (tsp) x))
(sub <z> x{s} y{s} (sub (z) x y))
(subb <c> x{n} y{n} (subb (c) x y))
(subb <v> x{i} y{i} (subb (v) x y))
(tpop <c> x (move (c) x (tsp 1)))
(tpop <x{a}> (move nil (x) (tsp 1)))
(tpop <x{s}> (move nil (x) (tsp 1)))
(tpop pc (move nil pc (tsp 1)))
(tpop x (move nil x (tsp 1)))
(tpop y (move nil y (tsp 1)))
(tpop{v} <z> y (move (z) y (tsp 1)))
(tpop{b} <z> y (move (z) y (tsp 1)))
(tpop{i} <zn> y (move (z n) y (tsp 1)))
(tpop{n} <z> y (move (z) y (tsp 1)))
(tpush * (move nil (-1 tsp) (pc 1)))
(tpush <x{a}> (move nil (-1 tsp) (x)))
(tpush <x{s}> (move nil (-1 tsp) (x)))
(tpush csp (move nil (-1 tsp) csp))
(tpush tsp (move nil (-1 tsp) tsp))
(tpush x (move nil (-1 tsp) x))
(xor <tsp> <tsp> (xor nil (tsp) (tsp)))
(xor <tsp>{v} x{v} (xor nil (tsp) x))
(xor <tsp>{b} *{b} (xor nil (tsp) (pc 1)))
(xor <tsp>{b} x{b} (xor nil (tsp) x))
(xor <z> <tsp> x (xor (z) (tsp) x)))

Definition: pack-instruction (op, move-bits, cvnz, mode-b, reg-b, mode-a, reg-a, word-size) = nat-to-v ((op ∗ exp (2, 24))

+ (move-bits ∗ exp (2, 20)) + (cvnz ∗ exp (2, 16)) + (mode-b ∗ exp (2, 14)) + (reg-b ∗ exp (2, 10)) + (mode-a ∗ exp (2, 4)) + reg-a,

word-size)

Definition: extract-op (opcode) = cadr (assoc (opcode,

'((incr 1)
(addc 2)
(add 3)
(neg 4)
(decr 5)
(subb 6)
(sub 7)
(ror 8)
(asr 9)
(lsr 10)
(xor 11)
(or 12)
(and 13)
(not 14)
(move 15)
(move-nc 15)
(move-c 15)
(move-nv 15)
(move-v 15)
(move-nz 15)
(move-z 15)
(move-nn 15)
(move-n 15))))

Definition: extract-move-bits (opcode) = case on opcode:

case = move then 14 case = move-nc then 0 case = move-c then 1 case = move-nv then 2 case = move-v then 3 case = move-nz then 6 case = move-z then 7 case = move-nn then 4 case = move-n then 5 otherwise 14 endcase

Definition: extract-mode (reg-spec) = if litatom (reg-spec) then 0

elseif cdr (reg-spec) = nil then 1 elseif car (reg-spec) = -1 then 2 else 3 endif

Definition: extract-cvnz (flg-names) = ((if 'c ∈ flg-names then 1

else 0 endif

∗ exp (2, 3))

+ (if 'v ∈ flg-names then 1 else 0 endif

∗ exp (2, 2)) + (if 'n ∈ flg-names then 1

else 0 endif

∗ exp (2, 1)) + (if 'z ∈ flg-names then 1

else 0 endif

∗ exp (2, 0)))

Definition: extract-reg1 (reg-spec) = if litatom (reg-spec) then reg-spec

elseif cdr (reg-spec) = nil then car (reg-spec) elseif car (reg-spec) = -1 then cadr (reg-spec) else car (reg-spec) endif

Definition: extract-reg (reg-spec) = cadr (assoc (extract-reg1 (reg-spec),

              '((pc 15)
                (cfp 1)
                (csp 2)
                (tsp 3)
                (x 4)
                (y 5))))

Definition: mci (ins, word-size) = pack-instruction (extract-op (car (ins)),

extract-move-bits (car (ins)), extract-cvnz (cadr (ins)), extract-mode (caddr (ins)), extract-reg (caddr (ins)), extract-mode (cadddr (ins)), extract-reg (cadddr (ins)), word-size)

Definition: icode-instructionp (ins) = (cdr (ins) = nil)

Definition: link-instr-word (ins, word-size) = mci (cadr (assoc (car (ins), link-instruction-alist)), word-size)

Definition: link-word (x, link-tables, word-size) = if icode-instructionp (x) then link-instr-word (x, word-size)

else link-data-word (x, link-tables, word-size) endif

Definition: link-area (lst, link-tables, word-size) = if lst ≃ nil then nil

else cons (link-word (unlabel (car (lst)), link-tables, word-size), link-area (cdr (lst), link-tables, word-size)) endif

Definition: link-segment (segment, link-tables, word-size) = if segment ≃ nil then nil

else append (link-area (cdar (segment), link-tables, word-size), link-segment (cdr (segment), link-tables, word-size)) endif

Definition: boot-code (lst, n, word-size) = if n ≃ 0 then nil

else cons (nat-to-v (car (lst), word-size), boot-code (cdr (lst), n − 1, word-size)) endif

Definition: link-mem (boot-lst,

load-addr,

usr-data-segment, prog-segment, sys-data-segment, link-tables, word-size)

= append (boot-code (boot-lst, load-addr, word-size),

append (link-segment (usr-data-segment, link-tables, word-size),

append (link-segment (prog-segment, link-tables, word-size),

link-segment (sys-data-segment, link-tables, word-size))))

Definition: bool-to-logical (b) = if b = 'f then f

else t endif

Definition: i->m (i, boot-lst, load-addr) = let tables be i-link-tables (i, load-addr),

w be i-word-size (i) in m-state (list (link-word ('(nat 0), tables, w),

link-word (i-cfp (i), tables, w), link-word (i-csp (i), tables, w), link-word (i-tsp (i), tables, w), link-word (i-x (i), tables, w), link-word (i-y (i), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word ('(nat 0), tables, w), link-word (i-pc (i), tables, w)),

bool-to-logical (untag (i-c-flg (i))), bool-to-logical (untag (i-v-flg (i))), bool-to-logical (untag (i-n-flg (i))), bool-to-logical (untag (i-z-flg (i))), link-mem (boot-lst,

load-addr,

i-usr-data-segment (i), i-prog-segment (i), i-sys-data-segment (i), tables, w)) endlet

Theorem: my-lessp-quotient ((size ∈ N) ∧ (size ≠ 0)) → ((size ÷ 2) < size)

Definition: ram-tree (lst, size) = if size ≃ 0 then stub (nat-to-v (0, 32))

elseif lst ≃ nil then stub (nat-to-v (0, 32))

elseif size = 1 then ram (car (lst))

else cons (ram-tree (firstn (size ÷ 2, lst), size ÷ 2), ram-tree (restn (size ÷ 2, lst), size ÷ 2)) endif

Definition: fm-state (regs, c, v, n, z, mem) = list (list (ram-tree (regs, 16), list (z, n, v, c)), ram-tree (mem, exp (2, 32)))

Definition: m->fm9001 (m) = list (list (ram-tree (m-regs (m), 16),

list (m-z-flg (m), m-n-flg (m), m-v-flg (m), m-c-flg (m))), ram-tree (m-mem (m), exp (2, 32)))

Definition: load (p, boot-lst, load-addr) = m->fm9001 (i->m (r->i (p->r (p)), boot-lst, load-addr))

Definition: link-tables (p, load-addr) = i-link-tables (r->i (p->r (p)), load-addr)

Definition: type-lst (lst) = if lst ≃ nil then nil

else cons (type (car (lst)), type-lst (cdr (lst))) endif

Definition: area-type-specification (area) = cons (car (area), type-lst (cdr (area)))

Definition: type-specification (segment) = if segment ≃ nil then nil

else cons (area-type-specification (car (segment)), type-specification (cdr (segment))) endif Definition: display-fm9001-array (type-lst, n, fm-mem, link-tables) = if type-lst ≃ nil then nil

else cons (unlink-data-word (car (type-lst), read-mem (nat-to-v (n, 32), fm-mem), link-tables),

display-fm9001-array (cdr (type-lst), 1 + n, fm-mem, link-tables)) endif

Definition: display-fm9001-data-area (area-type-spec, fm-mem, link-tables) = cons (car (area-type-spec),

display-fm9001-array (cdr (area-type-spec),

base-address (car (area-type-spec),

usr-data-links (link-tables)),

fm-mem, link-tables))

Definition: display-fm9001-data-segment1 (type-spec, fm-mem, link-tables) = if type-spec ≃ nil then nil

else cons (display-fm9001-data-area (car (type-spec), fm-mem, link-tables),

display-fm9001-data-segment1 (cdr (type-spec), fm-mem, link-tables)) endif

Definition: display-fm9001-data-segment (fm-state, type-spec, link-tables) = display-fm9001-data-segment1 (type-spec, cadr (fm-state), link-tables)

; Book:  m.events.  Now we define the m machine.

Definition: v-nth1 (v-n, lst) = if v-to-nat (v-n) < length (lst) then nth (v-to-nat (v-n), lst)

else nat-to-v (0, 32) endif

Definition: current-instruction (regs, mem) = v-nth1 (v-nth1 (nat-to-v (15, 4), regs), mem)

Definition: m-store-resultp (store-cc, c, v, n, z) = case on store-cc:

case = *1*false (*1*false, *1*false, *1*false) then ¬ c case = *1*true (*1*false, *1*false, *1*false) then c case = *1*false (*1*true, *1*false, *1*false) then ¬ v case = *1*true (*1*true, *1*false, *1*false) then v case = *1*false (*1*false, *1*true, *1*false) then ¬ n case = *1*true (*1*false, *1*true, *1*false) then n case = *1*false (*1*true, *1*true, *1*false) then ¬ z case = *1*true (*1*true, *1*true, *1*false) then z case = *1*false (*1*false, *1*false, *1*true) then (¬ c) ∧ (¬ z) case = *1*true (*1*false, *1*false, *1*true) then c ∨ z case = *1*false (*1*true, *1*false, *1*true) then (n ∧ v) ∨ ((¬ n) ∧ (¬ v)) case = *1*true (*1*true, *1*false, *1*true) then (n ∧ (¬ v)) ∨ ((¬ n) ∧ v) case = *1*false (*1*false, *1*true, *1*true) then (n ∧ v ∧ (¬ z)) ∨ ((¬ n) ∧ (¬ v) ∧ (¬ z)) case = *1*true (*1*false, *1*true, *1*true) then z ∨ (n ∧ (¬ v)) ∨ ((¬ n) ∧ v) case = *1*false (*1*true, *1*true, *1*true) then t otherwise f endcase

Theorem: m-store-resultp-is-store-resultp m-store-resultp (store-cc, c, v, n, z) = store-resultp (store-cc, list (z, n, v, c))

Event: Disable m-store-resultp.

Event: Disable store-resultp.

Definition: m-alu-operation (regs, c, v, n, z, mem, ins, operand-a, operand-b, b-address) = m-state (if m-store-resultp (store-cc (ins), c, v, n, z)

∧ reg-direct-p (mode-b (ins)) then update-v-nth (rn-b (ins),

regs,

bv (v-alu (c, operand-a, operand-b, op-code (ins))))

else regs endif,

b-if (c-set (set-flags (ins)), c (v-alu (c, operand-a, operand-b, op-code (ins))), c),

b-if (v-set (set-flags (ins)), v (v-alu (c, operand-a, operand-b, op-code (ins))), v),

b-if (n-set (set-flags (ins)), n (v-alu (c, operand-a, operand-b, op-code (ins))), n),

b-if (z-set (set-flags (ins)), zb (v-alu (c, operand-a, operand-b, op-code (ins))), z),

if m-store-resultp (store-cc (ins), c, v, n, z) ∧ (¬ reg-direct-p (mode-b (ins)))

then update-v-nth (b-address, mem, bv (v-alu (c, operand-a, operand-b, op-code (ins))))

else mem endif)

Definition: read-mem1-ram-tree-hint (raddr, lst) = if raddr ≃ nil then t

elseif car (raddr)

then read-mem1-ram-tree-hint (cdr (raddr),

restn (exp (2, length (cdr (raddr))), lst))

else read-mem1-ram-tree-hint (cdr (raddr),

firstn (exp (2, length (cdr (raddr))), lst)) endif

Definition: rev (x) = if x ≃ nil then nil

else append (rev (cdr (x)), list (car (x))) endif

Event: Enable append.

Theorem: rev1-is-rev rev1 (x, a) = append (rev (x), a)

Theorem: append-nil properp (x) → (append (x, nil) = x) Theorem: properp-rev properp (rev (x)) Theorem: read-mem1-rev-ram-tree-lemma1 stubp (ram-tree (lst, n)) → (stub-guts (ram-tree (lst, n)) = nat-to-v (0, 32)) Event: Enable plus-0. Event: Enable plus-add1-sub1. Event: Enable plus-add1. Event: Enable associativity-of-plus. Event: Enable commutativity-of-plus. Event: Enable times-commutes. Event: Enable times-add1-again. Event: Enable times-1. Event: Enable times-distributes-over-plus. Event: Enable associativity-of-times. Theorem: my-v-to-nat-append v-to-nat (append (a, b)) = (v-to-nat (a) + (exp (2, length (a)) ∗ v-to-nat (b))) Event: Enable plus. Event: Enable difference. Theorem: difference-add1-add1-x-2 ((1 + (1 + x)) − 2) = fix (x)

Event: Enable quotient-plus-x-x-2.

Event: Enable length-firstn.

Event: Enable length-restn.

Theorem: my-lessp-v-to-nat-exp (n = length (v)) → (v-to-nat (v) < exp (2, n))

Theorem: length-rev length (rev (x)) = length (x)

Theorem: nth-firstn (i < n) → (nth (i, firstn (n, lst)) = nth (i, lst))

Theorem: lessp-difference (v < (l − e)) = if e < l then (e + v) < l

else f endif

Theorem: nth-restn-plus (i < length (lst)) → (nth (n, restn (i, lst)) = nth (i + n, lst))

Theorem: read-mem1-rev-ram-tree (exp (2, length (raddr)) ≮ length (lst)) → (v-nth1 (rev (raddr), lst)

= read-mem1 (raddr, ram-tree (lst, exp (2, length (raddr)))))

Theorem: rev-append rev (append (a, b)) = append (rev (b), rev (a))

Theorem: v-to-nat-rev-rev v-to-nat (rev (rev (addr))) = v-to-nat (addr)

Theorem: read-mem-ram-tree ((e = exp (2, length (addr))) ∧ (e ≮ length (lst))) → (v-nth1 (addr, lst) = read-mem (addr, ram-tree (lst, e)))

Event: Disable v-nth1.

Event: Disable read-mem.

Theorem: restn-update-nth-plus restn (e, update-nth (v + e, l, val)) = update-nth (v, restn (e, l), val)

Theorem: firstn-update-nth-plus firstn (e, update-nth (v + e, l, val)) = firstn (e, l)

Theorem: restn-update-nth (v < e) → (restn (e, update-nth (v, l, val)) = restn (e, l))

Theorem: firstn-update-nth (v < e) → (firstn (e, update-nth (v, l, val)) = update-nth (v, firstn (e, l), val))

Theorem: write-mem1-rev-ram-tree (exp (2, length (raddr)) ≮ length (lst)) → (ram-tree (update-v-nth (rev (raddr), lst, val), exp (2, length (raddr)))

= write-mem1 (raddr, ram-tree (lst, exp (2, length (raddr))), val))

Theorem: write-mem-ram-tree ((e = exp (2, length (addr))) ∧ (e ≮ length (lst))) → (ram-tree (update-v-nth (addr, lst, val), e)

= write-mem (addr, ram-tree (lst, e), val))

Event: Disable update-v-nth.

Event: Disable write-mem.

Theorem: length-rn-b length (rn-b (ins)) = 4

Theorem: m-alu-operation-is-fm9001-alu-operation ((length (b-address) = 32) ∧ (length (regs) = 16) ∧ (exp (2, 32) ≮ length (mem))) → (m->fm9001 (m-alu-operation (regs,

c, v, n, z, mem, ins, operand-a, operand-b, b-address))

= fm9001-alu-operation (ram-tree (regs, 16), list (z, n, v, c), ram-tree (mem, exp (2, 32)), ins, operand-a, operand-b, b-address))

Definition: bvp-listp (lst) = if lst ≃ nil then lst = nil

else bvp (car (lst)) ∧ (length (car (lst)) = 32) ∧ bvp-listp (cdr (lst)) endif

Definition: proper-m-statep (m) = (m-statep (m)

∧ bvp-listp (m-regs (m)) ∧ bvp-listp (m-mem (m)) ∧ (length (m-regs (m)) = 16) ∧ (exp (2, 32) ≮ length (m-mem (m))))

Theorem: length-nth (bvp-listp (lst) ∧ (n < length (lst))) → (bvp (nth (n, lst)) ∧ (length (nth (n, lst)) = 32))

Theorem: length-v-nth1 bvp-listp (lst) → (bvp (v-nth1 (addr, lst)) ∧ (length (v-nth1 (addr, lst)) = 32))

Theorem: length-read-mem (bvp-listp (lst) ∧ (k = exp (2, length (addr))) ∧ (k ≮ length (lst))) → (bvp (read-mem (addr, ram-tree (lst, k)))

∧ (length (read-mem (addr, ram-tree (lst, k))) = 32))

Theorem: bvp-listp-update-nth (bvp (val) ∧ (length (val) = 32) ∧ bvp-listp (lst)) → bvp-listp (update-nth (n, lst, val))

Theorem: bvp-listp-update-v-nth (bvp (val) ∧ (length (val) = 32) ∧ bvp-listp (lst)) → bvp-listp (update-v-nth (addr, lst, val))

Event: Enable bvp-bv-v-alu.

Theorem: length-bv-v-alu ((length (a) = length (b)) ∧ listp (a)) → (length (bv (v-alu (c, a, b, op))) = length (a))

Theorem: length-update-nth length (update-nth (i, lst, val)) = length (lst)

Theorem: length-update-v-nth length (update-v-nth (v, lst, val)) = length (lst)

Theorem: m-alu-operation-preserves-hyps (bvp-listp (mem) ∧ bvp-listp (regs) ∧ bvp (operand-a) ∧ (length (operand-a) = 32) ∧ (length (operand-b) = 32) ∧ listp (operand-a) ∧ (length (b-address) = 32) ∧ (length (regs) = 16) ∧ (exp (2, 32) ≮ length (mem))) → proper-m-statep (m-alu-operation (regs,

c, v, n, z, mem, ins, operand-a, operand-b, b-address))

Event: Disable m-alu-operation.

Event: Disable fm9001-alu-operation.

Definition: m-operand-b (regs, c, v, n, z, mem, ins, operand-a) = m-alu-operation (if pre-dec-p (mode-b (ins))

then update-v-nth (rn-b (ins), regs, v-dec (v-nth1 (rn-b (ins), regs)))

elseif post-inc-p (mode-b (ins)) then update-v-nth (rn-b (ins),

regs, v-inc (v-nth1 (rn-b (ins), regs)))

else regs endif, c, v, n, z, mem, ins, operand-a, if reg-direct-p (mode-b (ins)) then v-nth1 (rn-b (ins), regs) else v-nth1 (if pre-dec-p (mode-b (ins))

then v-dec (v-nth1 (rn-b (ins), regs)) else v-nth1 (rn-b (ins), regs) endif, mem) endif,

if pre-dec-p (mode-b (ins)) then v-dec (v-nth1 (rn-b (ins), regs)) else v-nth1 (rn-b (ins), regs) endif)

Event: Enable length-v-not.

Theorem: length-v-adder length (v-adder (c, a, b)) = (1 + length (a))

Event: Enable length-nat-to-v.

Theorem: length-v-dec length (v-dec (v)) = length (v)

Theorem: m-operand-b-is-fm9001-operand-b (bvp-listp (regs) ∧ (length (regs) = 16) ∧ (exp (2, 32) ≮ length (mem))) → (m->fm9001 (m-operand-b (regs, c, v, n, z, mem, ins, operand-a))

= fm9001-operand-b (ram-tree (regs, 16), list (z, n, v, c), ram-tree (mem, exp (2, 32)), ins, operand-a))

Theorem: length-v-inc length (v-inc (v)) = length (v)

Theorem: bvp-firstn-v-adder (n = length (a)) → bvp (firstn (n, v-adder (c, a, b)))

Theorem: bvp-v-dec bvp (v-dec (v))

Theorem: bvp-v-inc bvp (v-inc (v))

Theorem: bvp-listp-if (bvp-listp (b) ∧ bvp-listp (c)) → bvp-listp (if a then b

else c endif)

Event: Enable length-if.

Theorem: listp-operand-a (length (operand-a) = 32) → listp (operand-a)

Theorem: m-operand-b-preserves-hyps (bvp-listp (regs) ∧ bvp-listp (mem) ∧ bvp (operand-a) ∧ (length (operand-a) = 32) ∧ (length (regs) = 16) ∧ (exp (2, 32) ≮ length (mem))) → proper-m-statep (m-operand-b (regs, c, v, n, z, mem, ins, operand-a))

Event: Disable m-operand-b.

Event: Disable fm9001-operand-b.

Definition: m-operand-a (regs, c, v, n, z, mem, ins) = m-operand-b (if a-immediate-p (ins) then regs

elseif pre-dec-p (mode-a (ins)) then update-v-nth (rn-a (ins),

regs,

v-dec (v-nth1 (rn-a (ins), regs)))

elseif post-inc-p (mode-a (ins)) then update-v-nth (rn-a (ins),

regs,

v-inc (v-nth1 (rn-a (ins), regs)))

else regs endif, c, v, n, z, mem, ins, if a-immediate-p (ins) then sign-extend (a-immediate (ins), 32) elseif reg-direct-p (mode-a (ins)) then v-nth1 (rn-a (ins), regs) elseif pre-dec-p (mode-a (ins)) then v-nth1 (v-dec (v-nth1 (rn-a (ins), regs)), mem) else v-nth1 (v-nth1 (rn-a (ins), regs), mem) endif)

Theorem: length-rn-a length (rn-a (ins)) = 4

Theorem: m-operand-a-is-fm9001-operand-a (bvp-listp (regs) ∧ (length (regs) = 16) ∧ (exp (2, 32) ≮ length (mem))) → (m->fm9001 (m-operand-a (regs, c, v, n, z, mem, ins))

= fm9001-operand-a (ram-tree (regs, 16), list (z, n, v, c), ram-tree (mem, exp (2, 32)), ins))

Theorem: m-operand-a-preserves-hyps (bvp-listp (regs) ∧ bvp-listp (mem) ∧ (length (regs) = 16) ∧ (exp (2, 32) ≮ length (mem))) → proper-m-statep (m-operand-a (regs, c, v, n, z, mem, ins))

Event: Disable m-operand-a.

Event: Disable fm9001-operand-a.

Definition: m-step1 (current-instruction, m) = m-operand-a (update-v-nth (nat-to-v (15, 4),

m-regs (m),

v-inc (v-nth1 (nat-to-v (15, 4), m-regs (m)))),

m-c-flg (m), m-v-flg (m), m-n-flg (m), m-z-flg (m), m-mem (m), current-instruction)

Definition: m-step (m) = m-step1 (current-instruction (m-regs (m), m-mem (m)), m)

Theorem: m-step-is-fm9001-step (bvp-listp (m-regs (m)) ∧ (length (m-regs (m)) = 16) ∧ (exp (2, 32) ≮ length (m-mem (m)))) → (m->fm9001 (m-step (m)) = fm9001-step (m->fm9001 (m), nat-to-v (15, 4)))

Theorem: m-step-preserves-hyps (bvp-listp (m-regs (m)) ∧ bvp-listp (m-mem (m)) ∧ (length (m-regs (m)) = 16) ∧ (exp (2, 32) ≮ length (m-mem (m)))) → proper-m-statep (m-step (m))

Event: Disable m-step.

Event: Disable m->fm9001.

Event: Disable fm9001-step.

Definition: m (m, n) = if n ≃ 0 then m

else m (m-step (m), n − 1) endif

Theorem: one-way-correspondence-m-fm9001 proper-m-statep (m) → (m->fm9001 (m (m, n)) = fm9001 (m->fm9001 (m), n))

; Book:  i.events.  Now we move up to the i machine.

Event: Set the status of all events. The status of each event is to be set as follows. Each ‘boot-strap’ satellite is to be returned to the initial condition. Each ‘add-shell’ satellite is to be enabled. enabled. Anything not otherwise mentioned is to be disabled. Name this event ‘close-data-base-2’.

Definition: put-assoc (val, name, alist) = if alist ≃ nil then alist

elseif name = caar (alist) then cons (cons (name, val), cdr (alist))

else cons (car (alist), put-assoc (val, name, cdr (alist))) endif

Definition: definedp (name, alist) = if alist ≃ nil then f

elseif name = caar (alist) then t else definedp (name, cdr (alist)) endif

; DEFINIENS, below, used to be named VALUE but that name is now used
; in FM9001.

Definition: definiens (name, alist) = cdr (definition (name, alist))

Definition: put-value (val, name, alist) = put-assoc (val, name, alist)

Definition: adpp (x, segment) = (listp (x)

∧ (adp-offset (x) ∈ N)

∧ definedp (adp-name (x), segment)

∧ (adp-offset (x) < length (definiens (adp-name (x), segment))))

Definition: add-adp (adp, n) = cons (adp-name (adp), adp-offset (adp) + n)

Definition: add1-adp (adp) = add-adp (adp, 1)

Definition: sub1-adp (adp) = sub-adp (adp, 1)

Definition: put (val, n, lst) = if n ≃ 0

then if listp (lst) then cons (val, cdr (lst))

else list (val) endif else cons (car (lst), put (val, n − 1, cdr (lst))) endif

Definition: fetch-adp (adp, segment) = get (adp-offset (adp), definiens (adp-name (adp), segment))

Definition: deposit-adp (val, adp, segment) = put-value (put (val, adp-offset (adp), definiens (adp-name (adp), segment)),

adp-name (adp), segment)

Definition: addressp (x, segment) = adpp (untag (x), segment)

Definition: offset (x) = adp-offset (untag (x))

Definition: add-addr (addr, n) = tag (type (addr), add-adp (untag (addr), n))

Definition: add1-addr (addr) = add-addr (addr, 1)

Definition: sub1-addr (addr) = sub-addr (addr, 1)

Definition: fetch (addr, segment) = fetch-adp (untag (addr), segment)

Definition: deposit (val, addr, segment) = deposit-adp (val, untag (addr), segment)

Definition: booleanp (x) = ((x = 't) ∨ (x = 'f))

Definition: bool (x) = tag ('bool,

if x then 't else 'f endif)

Definition: or-bool (x, y) = if x = 'f then y

else 't endif

Definition: and-bool (x, y) = if x = 'f then 'f

else y endif

Definition: xor-bool (x, y) = if x = 'f then y

elseif y = 'f then 't else 'f endif

Definition: small-naturalp (i, word-size) = ((i ∈ N) ∧ (i < exp (2, word-size)))

Definition: bool-to-nat (flg) = if flg = 'f then 0

else 1 endif

Definition: fix-small-natural (n, word-size) = (n mod exp (2, word-size))

Definition: small-integerp (i, word-size) = (integerp (i)

∧ (¬ ilessp (i, − exp (2, word-size − 1)))

∧ ilessp (i, exp (2, word-size − 1)))

Definition: inegate (i) = if negativep (i) then negative-guts (i)

elseif i ≃ 0 then 0

else − i endif

Definition: fix-small-integer (i, word-size) = if small-integerp (i, word-size) then i

elseif negativep (i) then iplus (i, exp (2, word-size))

else iplus (i, − exp (2, word-size)) endif

Definition: bitp (x) = ((x = 0) ∨ (x = 1))

Definition: bit-vectorp (x, n) = if x ≃ nil then (x = nil) ∧ (n ≃ 0)

else (n ≄ 0) ∧ bitp (car (x)) ∧ bit-vectorp (cdr (x), n − 1) endif

Definition: or-bit (bit1 , bit2 ) = if bit1 = 0

then if bit2 = 0 then 0 else 1 endif

else 1 endif

Definition: not-bit (bit) = if bit = 0 then 1

else 0 endif

Definition: and-bit (bit1 , bit2 ) = if bit1 = 0 then 0

elseif bit2 = 0 then 0

else 1 endif

Definition: xor-bit (bit1 , bit2 )

= if bit1 = 0

then if bit2 = 0 then 0 else 1 endif elseif bit2 = 0 then 1 else 0 endif

Definition: or-bitv (a, b) = if a ≃ nil then nil

else cons (or-bit (car (a), car (b)), or-bitv (cdr (a), cdr (b))) endif

Definition: not-bitv (a) = if a ≃ nil then nil

else cons (not-bit (car (a)), not-bitv (cdr (a))) endif

Definition: and-bitv (a, b) = if a ≃ nil then nil

else cons (and-bit (car (a), car (b)), and-bitv (cdr (a), cdr (b))) endif

Definition: xor-bitv (a, b) = if a ≃ nil then nil

else cons (xor-bit (car (a), car (b)), xor-bitv (cdr (a), cdr (b))) endif

Definition: all-but-last (a) = if a ≃ nil then nil

elseif cdr (a) ≃ nil then nil

else cons (car (a), all-but-last (cdr (a))) endif

Definition: rsh-bitv (a) = cons (0, all-but-last (a))

Definition: lsh-bitv (a) = append (cdr (a), '(0))

Definition: all-zero-bitvp (a) = if listp (a) then (car (a) = 0) ∧ all-zero-bitvp (cdr (a))

else t endif

Definition: find-labelp (x, lst) = if lst ≃ nil then f

elseif labelledp (car (lst)) ∧ (x = cadar (lst)) then t

else find-labelp (x, cdr (lst)) endif Definition: x-y-error-msg (x, y) = pack (append (unpack ('illegal-),

append (unpack (y), cdr (unpack ('g-instruction)))))

Definition: cstkp (x, segment) = ((type (x) = 'sys-addr)

∧ addressp (x, segment) ∧ (area-name (x) = 'cstk) ∧ (cddr (x) = nil))

Definition: tstkp (x, segment) = ((type (x) = 'sys-addr)

∧ addressp (x, segment) ∧ (area-name (x) = 'tstk) ∧ (cddr (x) = nil))

Definition: push-stk (sys-addr) = sub1-addr (sys-addr)

Definition: pop-stk (sys-addr) = add1-addr (sys-addr)

Definition: stk-length (addr, segment) = ((length (definiens (area-name (addr), segment)) − offset (addr)) − 1)

Definition: empty-stkp (addr, segment) = (stk-length (addr, segment) ≃ 0)

Definition: free-stk-size (addr) = offset (addr)

Definition: icode-labelp (lab, segment) = (definedp (adp-name (lab), segment)

∧ find-labelp (lab, definiens (adp-name (lab), segment)))

Definition: i-objectp (x, i) = (listp (x)

∧ (cddr (x) = nil) ∧ case on type (x): case = nat then small-naturalp (untag (x), i-word-size (i)) case = int then small-integerp (untag (x), i-word-size (i)) case = bitv then bit-vectorp (untag (x), i-word-size (i)) case = bool then booleanp (untag (x)) case = addr then adpp (untag (x), i-usr-data-segment (i)) case = pc then icode-labelp (untag (x), i-prog-segment (i)) case = subr then adpp (cons (untag (x), 0), i-prog-segment (i)) case = sys-addr then adpp (untag (x), i-sys-data-segment (i)) case = ipc then adpp (untag (x), i-prog-segment (i)) otherwise f endcase)

Definition: i-objectp-type (type, x, i) = ((type = type (x)) ∧ i-objectp (x, i))

Definition: i-usr-data-typep (type)

= (type ∈ '(nat int bitv bool addr subr pc))

Definition: i-usr-data-objectp (x, i) = (i-objectp (x, i) ∧ i-usr-data-typep (type (x)))

Definition: total-i-system-size (i, load-addr) = (load-addr

+ segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i)) + segment-length (i-sys-data-segment (i)))

Definition: i-loadablep (i, load-addr) = (total-i-system-size (i, load-addr) < exp (2, i-word-size (i)))

Definition: i-state-okp (i, load-addr) = (i-statep (i)

∧ i-objectp-type ('ipc, i-pc (i), i)

∧ cstkp (i-cfp (i), i-sys-data-segment (i)) ∧ cstkp (i-csp (i), i-sys-data-segment (i)) ∧ tstkp (i-tsp (i), i-sys-data-segment (i)) ∧ i-objectp-type ('bool, i-c-flg (i), i)

∧ i-objectp-type ('bool, i-v-flg (i), i) ∧ i-objectp-type ('bool, i-n-flg (i), i) ∧ i-objectp-type ('bool, i-z-flg (i), i) ∧ i-loadablep (i, load-addr))

Definition: all-i-usr-data-objectps (lst, i) = if lst ≃ nil then lst = nil

else i-usr-data-objectp (car (lst), i)

∧ all-i-usr-data-objectps (cdr (lst), i) endif

Definition: proper-i-usr-data-area (area, i) = (litatom (car (area))

∧ listp (cdr (area))

∧ all-i-usr-data-objectps (cdr (area), i))

Definition: proper-i-usr-data-segmentp (data-segment, i) = if data-segment ≃ nil then data-segment = nil

else proper-i-usr-data-area (car (data-segment), i) ∧ (¬ definedp (caar (data-segment), cdr (data-segment))) ∧ proper-i-usr-data-segmentp (cdr (data-segment), i) endif

Definition: add1-i-pc (i) = add1-addr (i-pc (i))

Definition: add1-i-pcp (i) = addressp (add1-i-pc (i), i-prog-segment (i))

Definition: add2-i-pc (i) = add1-addr (add1-addr (i-pc (i)))

Definition: add2-i-pcp (i) = addressp (add2-i-pc (i), i-prog-segment (i))

Definition: i-current-instruction (i) = unlabel (fetch (i-pc (i), i-prog-segment (i)))

Definition: i-nextword (i) = unlabel (fetch (add1-i-pc (i), i-prog-segment (i)))

Definition: ipc (lab, program) = tag ('ipc, cons (name (program), find-label (lab, cdr (program))))

Definition: i-halt (i, psw) = i-state (i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i), psw)

Definition: xor-xxx (obj1 , obj2 , i, load-addr) = xor-bitv (v-to-bitv (link-data-word (obj1 ,

i-link-tables (i, load-addr), i-word-size (i))),

v-to-bitv (link-data-word (obj2 , i-link-tables (i, load-addr), i-word-size (i))))

Definition: i-add <c> x x{n}-okp (i) = (add1-i-pcp (i) ∧ i-objectp-type ('nat, i-x (i), i))

Definition: i-add <c> x x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), tag ('nat,

fix-small-natural (2 ∗ untag (i-x (i)), i-word-size (i))), i-y (i), bool (¬ small-naturalp (2 ∗ untag (i-x (i)), i-word-size (i))), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-add <tsp> <tsp>{v}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bitv,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-add <tsp> <tsp>{v}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bitv,

lsh-bitv (untag (fetch (i-tsp (i),

i-sys-data-segment (i))))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-add <tsp> <tsp>{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ small-naturalp (2 ∗ untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

i-word-size (i)))

Definition: i-add <tsp> <tsp>{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

2 ∗ untag (fetch (i-tsp (i), i-sys-data-segment (i)))), i-tsp (i), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-add <tsp>{a} x{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, i-x (i), i) ∧ i-objectp-type ('addr,

fetch (i-tsp (i), i-sys-data-segment (i)),

i)

∧ i-objectp-type ('addr,

add-addr (fetch (i-tsp (i), i-sys-data-segment (i)),

untag (i-x (i))),

i))

Definition: i-add <tsp>{a} x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (add-addr (fetch (i-tsp (i), i-sys-data-segment (i)),

untag (i-x (i))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-add tsp *{n}-okp (i) = (add2-i-pcp (i)

∧ i-objectp-type ('nat, i-nextword (i), i) ∧ addressp (add-addr (i-tsp (i), untag (i-nextword (i))),

i-sys-data-segment (i)))

Definition: i-add tsp *{n}-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), add-addr (i-tsp (i), untag (i-nextword (i))), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-add tsp x{n}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('nat, i-x (i), i) ∧ addressp (add-addr (i-tsp (i), untag (i-x (i))),

i-sys-data-segment (i)))

Definition: i-add tsp x{n}-step (i) = i-state (add1-i-pc (i), i-cfp (i), i-csp (i), add-addr (i-tsp (i), untag (i-x (i))), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-add <tsp>{i} x{i}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('int, i-x (i), i) ∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ small-integerp (iplus (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i))), i-word-size (i)))

Definition: i-add <tsp>{i} x{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('int,

iplus (untag (fetch (i-tsp (i), i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-add <tsp>{n} x{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, i-x (i), i) ∧ i-objectp-type ('nat, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ small-naturalp (untag (fetch (i-tsp (i), i-sys-data-segment (i)))

+ untag (i-x (i)), i-word-size (i)))

Definition: i-add <tsp>{n} x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

untag (fetch (i-tsp (i), i-sys-data-segment (i))) + untag (i-x (i))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-add pc x{n}-okp (i) = (i-objectp-type ('nat, i-x (i), i)

∧ addressp (add-addr (i-pc (i), 1 + untag (i-x (i))), i-prog-segment (i)))

Definition: i-add pc x{n}-step (i) = i-state (add-addr (i-pc (i), 1 + untag (i-x (i))), i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-add x x{n}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('nat, i-x (i), i) ∧ small-naturalp (2 ∗ untag (i-x (i)), i-word-size (i)))

Definition: i-add x x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), tag ('nat, 2 ∗ untag (i-x (i))), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-add x{n} csp-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('nat, i-x (i), i) ∧ addressp (add-addr (i-csp (i), untag (i-x (i))),

i-sys-data-segment (i)))

Definition: i-add x{n} csp-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), add-addr (i-csp (i), untag (i-x (i))), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-addc <c> x{n} y{n}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('nat, i-x (i), i) ∧ i-objectp-type ('nat, i-y (i), i))

Definition: i-addc <c> x{n} y{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), tag ('nat,

fix-small-natural (bool-to-nat (untag (i-c-flg (i))) + untag (i-y (i)) + untag (i-x (i)), i-word-size (i))),

i-y (i), bool (¬ small-naturalp (bool-to-nat (untag (i-c-flg (i)))

+ untag (i-y (i)) + untag (i-x (i)), i-word-size (i))),

i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-addc <v> x{i} y{i}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('int, i-x (i), i) ∧ i-objectp-type ('int, i-y (i), i))

Definition: i-addc <v> x{i} y{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), tag ('int,

fix-small-integer (iplus (bool-to-nat (untag (i-c-flg (i))),

iplus (untag (i-y (i)), untag (i-x (i)))), i-word-size (i))),

i-y (i), i-c-flg (i), bool (¬ small-integerp (iplus (bool-to-nat (untag (i-c-flg (i))),

iplus (untag (i-y (i)),

untag (i-x (i)))),

i-word-size (i))),

i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-and <tsp>{v} x{v}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bitv, i-x (i), i) ∧ i-objectp-type ('bitv,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-and <tsp>{v} x{v}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bitv,

and-bitv (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-and <tsp>{b} x{b}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bool, i-x (i), i) ∧ i-objectp-type ('bool,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-and <tsp>{b} x{b}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bool,

and-bool (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-asr <c> <tsp> <tsp>{b}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bool,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-asr <c> <tsp> <tsp>{b}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), fetch (i-tsp (i), i-sys-data-segment (i)), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bool, 'f), i-tsp (i), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-cpop cfp-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-csp (i), i-sys-data-segment (i))) ∧ cstkp (fetch (i-csp (i), i-sys-data-segment (i)),

i-sys-data-segment (i)))

Definition: i-cpop cfp-step (i)

= i-state (add1-i-pc (i), fetch (i-csp (i), i-sys-data-segment (i)), pop-stk (i-csp (i)), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-cpop pc-okp (i) = ((¬ empty-stkp (i-csp (i), i-sys-data-segment (i)))

∧ i-objectp-type ('pc, fetch (i-csp (i), i-sys-data-segment (i)), i))

Definition: i-cpop pc-step (i) = i-state (ipc (untag (fetch (i-csp (i), i-sys-data-segment (i))),

definition (area-name (fetch (i-csp (i), i-sys-data-segment (i))),

i-prog-segment (i))),

i-cfp (i), pop-stk (i-csp (i)), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-cpush *-okp (i) = (add2-i-pcp (i)

∧ i-objectp (i-nextword (i), i)

∧ (free-stk-size (i-csp (i)) ≄ 0))

Definition: i-cpush *-step (i) = i-state (add2-i-pc (i),

i-cfp (i), push-stk (i-csp (i)), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (i-nextword (i),

push-stk (i-csp (i)), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-cpush <tsp>+-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ (free-stk-size (i-csp (i)) ≄ 0))

Definition: i-cpush <tsp>+-step (i) = i-state (add1-i-pc (i),

i-cfp (i), push-stk (i-csp (i)), pop-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (fetch (i-tsp (i), i-sys-data-segment (i)),

push-stk (i-csp (i)), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-cpush cfp-okp (i) = (add1-i-pcp (i) ∧ (free-stk-size (i-csp (i)) ≄ 0))

Definition: i-cpush cfp-step (i) = i-state (add1-i-pc (i),

i-cfp (i), push-stk (i-csp (i)), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (i-cfp (i), push-stk (i-csp (i)), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-decr <tsp> <tsp>{i}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ small-integerp (idifference (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

1),

i-word-size (i)))

Definition: i-decr <tsp> <tsp>{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('int,

idifference (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

1)),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-decr <tsp> <tsp>{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ (untag (fetch (i-tsp (i), i-sys-data-segment (i))) ≄ 0))

Definition: i-decr <tsp> <tsp>{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

untag (fetch (i-tsp (i), i-sys-data-segment (i))) − 1), i-tsp (i), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-incr <tsp> <tsp>{i}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i)

∧ small-integerp (iplus (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

1), i-word-size (i)))

Definition: i-incr <tsp> <tsp>{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('int,

iplus (untag (fetch (i-tsp (i), i-sys-data-segment (i))),

1)),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-incr <tsp> <tsp>{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ small-naturalp (1 + untag (fetch (i-tsp (i), i-sys-data-segment (i))),

i-word-size (i)))

Definition: i-incr <tsp> <tsp>{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

1 + untag (fetch (i-tsp (i), i-sys-data-segment (i)))), i-tsp (i), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-incr y y{n}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('nat, i-y (i), i) ∧ small-naturalp (1 + untag (i-y (i)), i-word-size (i)))

Definition: i-incr y y{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), tag ('nat, 1 + untag (i-y (i))), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-int-to-nat-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ (¬ negativep (untag (fetch (i-tsp (i), i-sys-data-segment (i))))))

Definition: i-int-to-nat-step (i) = i-state (add1-i-pc (i), i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

untag (fetch (i-tsp (i), i-sys-data-segment (i)))), i-tsp (i), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-jump-n x-okp (i) = if untag (i-n-flg (i)) = 'f then add1-i-pcp (i)

else i-objectp-type ('pc, i-x (i), i) endif

Definition: i-jump-n x-step (i) = i-state (if untag (i-n-flg (i)) = 'f then add1-i-pc (i)

else ipc (untag (i-x (i)),

definition (area-name (i-x (i)), i-prog-segment (i))) endif,

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-jump-nn x-okp (i)

= if untag (i-n-flg (i)) = 'f then i-objectp-type ('pc, i-x (i), i) else add1-i-pcp (i) endif

Definition: i-jump-nn x-step (i) = i-state (if untag (i-n-flg (i)) = 'f

then ipc (untag (i-x (i)),

definition (area-name (i-x (i)), i-prog-segment (i)))

else add1-i-pc (i) endif, i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-jump-nz x-okp (i) = if untag (i-z-flg (i)) = 'f then i-objectp-type ('pc, i-x (i), i)

else add1-i-pcp (i) endif

Definition: i-jump-nz x-step (i) = i-state (if untag (i-z-flg (i)) = 'f

then ipc (untag (i-x (i)),

definition (area-name (i-x (i)), i-prog-segment (i)))

else add1-i-pc (i) endif, i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-jump-z x-okp (i) = if untag (i-z-flg (i)) = 'f then add1-i-pcp (i)

else i-objectp-type ('pc, i-x (i), i) endif

Definition: i-jump-z x-step (i) = i-state (if untag (i-z-flg (i)) = 'f then add1-i-pc (i)

else ipc (untag (i-x (i)),

definition (area-name (i-x (i)), i-prog-segment (i))) endif,

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-jump *-okp (i) = (add1-i-pcp (i) ∧ i-objectp-type ('pc, i-nextword (i), i))

Definition: i-jump *-step (i) = i-state (ipc (untag (i-nextword (i)),

definition (area-name (i-nextword (i)), i-prog-segment (i))), i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-jump x{subr}-okp (i) = i-objectp-type ('subr, i-x (i), i)

Definition: i-jump x{subr}-step (i) = i-state (tag ('ipc, cons (untag (i-x (i)), 0)),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-lsr <c> x x{n}-okp (i) = (add1-i-pcp (i) ∧ i-objectp-type ('nat, i-x (i), i))

Definition: i-lsr <c> x x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), tag ('nat, untag (i-x (i)) ÷ 2), i-y (i), bool ((untag (i-x (i)) mod 2) = 1), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-lsr <tsp> <tsp>{v}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bitv,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-lsr <tsp> <tsp>{v}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bitv,

rsh-bitv (untag (fetch (i-tsp (i),

i-sys-data-segment (i))))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-move-c <tsp> *-okp (i) = (add2-i-pcp (i)

∧ i-objectp (i-nextword (i), i) ∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))))

Definition: i-move-c <tsp> *-step (i) = i-state (add2-i-pc (i), i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), if untag (i-c-flg (i)) = 'f then i-sys-data-segment (i) else deposit (i-nextword (i),

i-tsp (i),

i-sys-data-segment (i)) endif,

i-word-size (i),

'run)

Definition: i-move-v <tsp> *-okp (i) = (add2-i-pcp (i)

∧ i-objectp (i-nextword (i), i) ∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))))

Definition: i-move-v <tsp> *-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), if untag (i-v-flg (i)) = 'f then i-sys-data-segment (i) else deposit (i-nextword (i),

i-tsp (i),

i-sys-data-segment (i)) endif,

i-word-size (i),

'run)

Definition: i-move-z <tsp> *-okp (i) = (add2-i-pcp (i)

∧ i-objectp (i-nextword (i), i) ∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))))

Definition: i-move-z <tsp> *-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), if untag (i-z-flg (i)) = 'f then i-sys-data-segment (i) else deposit (i-nextword (i),

i-tsp (i),

i-sys-data-segment (i)) endif,

i-word-size (i),

'run)

Definition: i-move-n x *-okp (i) = (add2-i-pcp (i) ∧ i-objectp (i-nextword (i), i))

Definition: i-move-n x *-step (i) = i-state (add2-i-pc (i),

i-sys-data-segment (i), i-word-size (i),

'run)

i-cfp (i), i-csp (i), i-tsp (i), if untag (i-n-flg (i)) = 'f then i-x (i) else i-nextword (i) endif, i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), Definition: i-move <tsp> *-okp (i) = (add2-i-pcp (i)

∧ i-objectp (i-nextword (i), i) ∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))))

Definition: i-move <tsp> *-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (i-nextword (i), i-tsp (i), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-move <x{a}> <tsp>-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('addr, i-x (i), i))

Definition: i-move <x{a}> <tsp>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), deposit (fetch (i-tsp (i), i-sys-data-segment (i)),

i-x (i),

i-usr-data-segment (i)), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move <x{s}> <tsp>-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('sys-addr, i-x (i), i))

Definition: i-move <x{s}> <tsp>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (fetch (i-tsp (i), i-sys-data-segment (i)),

i-x (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-move cfp csp-okp (i) = add1-i-pcp (i)

Definition: i-move cfp csp-step (i) = i-state (add1-i-pc (i),

i-csp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move csp cfp-okp (i) = add1-i-pcp (i)

Definition: i-move csp cfp-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-cfp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move x *-okp (i) = add2-i-pcp (i)

Definition: i-move x *-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-nextword (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move x <x{s}>-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('sys-addr, i-x (i), i) ∧ i-objectp (fetch (i-x (i), i-sys-data-segment (i)), i))

Definition: i-move x <x{s}>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), fetch (i-x (i), i-sys-data-segment (i)), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move x tsp-okp (i) = add1-i-pcp (i)

Definition: i-move x tsp-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-tsp (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), Definition: i-move x x-okp (i) = add1-i-pcp (i)

Definition: i-move x x-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move y *-okp (i) = add2-i-pcp (i)

Definition: i-move y *-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-nextword (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move y <y{s}>-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('sys-addr, i-y (i), i) ∧ i-objectp (fetch (i-y (i), i-sys-data-segment (i)), i))

Definition: i-move y <y{s}>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), fetch (i-y (i), i-sys-data-segment (i)), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-move y tsp-okp (i) = add1-i-pcp (i)

Definition: i-move y tsp-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-tsp (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-neg <tsp> <tsp>{i}-okp (i)

= (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ small-integerp (inegate (untag (fetch (i-tsp (i),

i-sys-data-segment (i)))),

i-word-size (i)))

Definition: i-neg <tsp> <tsp>{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('int,

inegate (untag (fetch (i-tsp (i),

i-sys-data-segment (i))))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-not <tsp> <tsp>{v}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bitv,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-not <tsp> <tsp>{v}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bitv,

not-bitv (untag (fetch (i-tsp (i),

i-sys-data-segment (i))))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-or <tsp>{v} x{v}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bitv, i-x (i), i) ∧ i-objectp-type ('bitv,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-or <tsp>{v} x{v}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bitv,

or-bitv (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-or <tsp>{b} x{b}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bool, i-x (i), i) ∧ i-objectp-type ('bool,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-or <tsp>{b} x{b}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bool,

or-bool (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub <c> <tsp>{a} x{a}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('addr, i-x (i), i) ∧ i-objectp-type ('addr,

fetch (i-tsp (i), i-sys-data-segment (i)), i)

∧ (area-name (fetch (i-tsp (i), i-sys-data-segment (i))) = area-name (i-x (i))))

Definition: i-sub <c> <tsp>{a} x{a}-step (i)

= i-state (add1-i-pc (i), i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), bool (offset (fetch (i-tsp (i), i-sys-data-segment (i)))

< offset (i-x (i))), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

if offset (fetch (i-tsp (i), i-sys-data-segment (i)))

< offset (i-x (i)) then exp (2, i-word-size (i)) − (offset (i-x (i))

− offset (fetch (i-tsp (i),

i-sys-data-segment (i))))

else offset (fetch (i-tsp (i),

i-sys-data-segment (i)))

− offset (i-x (i)) endif),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub <c> <tsp>{n} x{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, i-x (i), i) ∧ i-objectp-type ('nat, fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-sub <c> <tsp>{n} x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), bool (untag (fetch (i-tsp (i), i-sys-data-segment (i)))

< untag (i-x (i))), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

if untag (fetch (i-tsp (i), i-sys-data-segment (i)))

< untag (i-x (i)) then exp (2, i-word-size (i)) − (untag (i-x (i))

− untag (fetch (i-tsp (i),

i-sys-data-segment (i))))

else untag (fetch (i-tsp (i),

i-sys-data-segment (i)))

− untag (i-x (i)) endif),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub <nv> <tsp>{i} x{i}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ i-objectp-type ('int, i-x (i), i))

Definition: i-sub <nv> <tsp>{i} x{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), bool (¬ small-integerp (idifference (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i))),

i-word-size (i))),

bool (negativep (fix-small-integer (idifference (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i))),

i-word-size (i)))), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('int,

fix-small-integer (idifference (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i))),

i-word-size (i))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub <tsp>{a} x{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, i-x (i), i) ∧ i-objectp-type ('addr,

fetch (i-tsp (i), i-sys-data-segment (i)), i)

∧ (offset (fetch (i-tsp (i), i-sys-data-segment (i))) ≮ untag (i-x (i))))

Definition: i-sub <tsp>{a} x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (sub-addr (fetch (i-tsp (i), i-sys-data-segment (i)),

untag (i-x (i))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub x{s} y{n}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('sys-addr, i-x (i), i) ∧ i-objectp-type ('nat, i-y (i), i) ∧ (offset (i-x (i)) ≮ untag (i-y (i))))

Definition: i-sub x{s} y{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), sub-addr (i-x (i), untag (i-y (i))), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-sub <tsp>{i} x{i}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('int, i-x (i), i) ∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ small-integerp (idifference (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i))),

i-word-size (i)))

Definition: i-sub <tsp>{i} x{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('int,

idifference (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub <tsp>{n} x{n}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, i-x (i), i) ∧ i-objectp-type ('nat, fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ (untag (fetch (i-tsp (i), i-sys-data-segment (i)))

≮ untag (i-x (i))))

Definition: i-sub <tsp>{n} x{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

untag (fetch (i-tsp (i), i-sys-data-segment (i))) − untag (i-x (i))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub <tsp>{s} x{s}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('sys-addr, i-x (i), i) ∧ i-objectp-type ('sys-addr,

fetch (i-tsp (i), i-sys-data-segment (i)), i)

∧ (area-name (fetch (i-tsp (i), i-sys-data-segment (i)))

= area-name (i-x (i))) ∧ (offset (fetch (i-tsp (i), i-sys-data-segment (i)))

≮ offset (i-x (i))))

Definition: i-sub <tsp>{s} x{s}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('nat,

offset (fetch (i-tsp (i), i-sys-data-segment (i))) − offset (i-x (i))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-sub <z> x{s} y{s}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('sys-addr, i-x (i), i) ∧ i-objectp-type ('sys-addr, i-y (i), i) ∧ (area-name (i-y (i)) = area-name (i-x (i))) ∧ (offset (i-x (i)) ≮ offset (i-y (i))))

Definition: i-sub <z> x{s} y{s}-step (i)

= i-state (add1-i-pc (i), i-cfp (i), i-csp (i), i-tsp (i), tag ('nat, offset (i-x (i)) − offset (i-y (i))), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), bool (offset (i-x (i)) = offset (i-y (i))), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-subb <c> x{n} y{n}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('nat, i-x (i), i) ∧ i-objectp-type ('nat, i-y (i), i))

Definition: i-subb <c> x{n} y{n}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), tag ('nat,

if untag (i-x (i))

< (untag (i-y (i))

+ bool-to-nat (untag (i-c-flg (i)))) then exp (2, i-word-size (i)) − ((untag (i-y (i))

+ bool-to-nat (untag (i-c-flg (i))))

− untag (i-x (i)))

else untag (i-x (i))

− (untag (i-y (i))

+ bool-to-nat (untag (i-c-flg (i)))) endif),

i-y (i), bool (untag (i-x (i))

< (untag (i-y (i)) + bool-to-nat (untag (i-c-flg (i))))), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-subb <v> x{i} y{i}-okp (i) = (add1-i-pcp (i)

∧ i-objectp-type ('int, i-x (i), i) ∧ i-objectp-type ('int, i-y (i), i))

Definition: i-subb <v> x{i} y{i}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), tag ('int,

fix-small-integer (idifference (untag (i-x (i)),

iplus (untag (i-y (i)),

bool-to-nat (untag (i-c-flg (i))))),

i-word-size (i))),

i-y (i), i-c-flg (i), bool (¬ small-integerp (idifference (untag (i-x (i)),

iplus (untag (i-y (i)),

bool-to-nat (untag (i-c-flg (i))))),

i-word-size (i))),

i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop <c> x-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp (fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop <c> x-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), fetch (i-tsp (i), i-sys-data-segment (i)), i-y (i),

tag ('bool, 'f),

i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop <x{a}>-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('addr, i-x (i), i))

Definition: i-tpop <x{a}>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), deposit (fetch (i-tsp (i), i-sys-data-segment (i)),

i-x (i),

i-usr-data-segment (i)), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop <x{s}>-okp (i)

= (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('sys-addr, i-x (i), i))

Definition: i-tpop <x{s}>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (fetch (i-tsp (i), i-sys-data-segment (i)),

i-x (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-tpop pc-okp (i) = ((¬ empty-stkp (i-tsp (i), i-sys-data-segment (i)))

∧ i-objectp-type ('pc, fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop pc-step (i) = i-state (ipc (untag (fetch (i-tsp (i), i-sys-data-segment (i))),

definition (area-name (fetch (i-tsp (i), i-sys-data-segment (i))),

i-prog-segment (i))),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), Definition: i-tpop x-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp (fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop x-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), fetch (i-tsp (i), i-sys-data-segment (i)), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop y-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp (fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop y-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), fetch (i-tsp (i), i-sys-data-segment (i)), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop{v} <z> y-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bitv,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop{v} <z> y-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), fetch (i-tsp (i), i-sys-data-segment (i)), i-c-flg (i), i-v-flg (i), i-n-flg (i), bool (all-zero-bitvp (untag (fetch (i-tsp (i),

i-sys-data-segment (i))))),

i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop{b} <z> y-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bool,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop{b} <z> y-step (i) = i-state (add1-i-pc (i), i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), fetch (i-tsp (i), i-sys-data-segment (i)), i-c-flg (i), i-v-flg (i), i-n-flg (i), bool (untag (fetch (i-tsp (i), i-sys-data-segment (i))) = 'f), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop{i} <zn> y-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('int, fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop{i} <zn> y-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), fetch (i-tsp (i), i-sys-data-segment (i)), i-c-flg (i), i-v-flg (i), bool (negativep (untag (fetch (i-tsp (i), i-sys-data-segment (i))))), bool (untag (fetch (i-tsp (i), i-sys-data-segment (i))) = 0), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpop{n} <z> y-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('nat, fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-tpop{n} <z> y-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), pop-stk (i-tsp (i)), i-x (i), fetch (i-tsp (i), i-sys-data-segment (i)), i-c-flg (i), i-v-flg (i), i-n-flg (i), bool (untag (fetch (i-tsp (i), i-sys-data-segment (i))) = 0), i-prog-segment (i), i-usr-data-segment (i), i-sys-data-segment (i), i-word-size (i),

'run)

Definition: i-tpush *-okp (i) = (add2-i-pcp (i)

∧ i-objectp (i-nextword (i), i) ∧ (free-stk-size (i-tsp (i)) ≄ 0))

Definition: i-tpush *-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), push-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (i-nextword (i),

push-stk (i-tsp (i)), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-tpush <x{a}>-okp (i) = (add1-i-pcp (i)

∧ (free-stk-size (i-tsp (i)) ≄ 0) ∧ i-objectp-type ('addr, i-x (i), i) ∧ i-objectp (fetch (i-x (i), i-usr-data-segment (i)), i))

Definition: i-tpush <x{a}>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), push-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (fetch (i-x (i), i-usr-data-segment (i)),

push-stk (i-tsp (i)), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-tpush <x{s}>-okp (i) = (add1-i-pcp (i)

∧ (free-stk-size (i-tsp (i)) ≄ 0) ∧ i-objectp-type ('sys-addr, i-x (i), i))

Definition: i-tpush <x{s}>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), push-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (fetch (i-x (i), i-sys-data-segment (i)),

push-stk (i-tsp (i)), i-sys-data-segment (i)),

i-word-size (i),

'run)

Definition: i-tpush csp-okp (i) = (add1-i-pcp (i) ∧ (free-stk-size (i-tsp (i)) ≄ 0))

Definition: i-tpush csp-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), push-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (i-csp (i), push-stk (i-tsp (i)), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-tpush tsp-okp (i) = (add1-i-pcp (i) ∧ (free-stk-size (i-tsp (i)) ≄ 0))

Definition: i-tpush tsp-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), push-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (i-tsp (i), push-stk (i-tsp (i)), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-tpush x-okp (i) = (add1-i-pcp (i)

∧ (free-stk-size (i-tsp (i)) ≄ 0) ∧ i-objectp (i-x (i), i))

Definition: i-tpush x-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), push-stk (i-tsp (i)), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (i-x (i), push-stk (i-tsp (i)), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-xor <tsp> <tsp>-okp (i) = (add1-i-pcp (i) ∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))))

Definition: i-xor <tsp> <tsp>-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bool, 'f), i-tsp (i), i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-xor <tsp>{v} x{v}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bitv, i-x (i), i) ∧ i-objectp-type ('bitv,

fetch (i-tsp (i), i-sys-data-segment (i)), i))

Definition: i-xor <tsp>{v} x{v}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bitv,

xor-bitv (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-xor <tsp>{b} *{b}-okp (i) = (add2-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bool,

fetch (i-tsp (i), i-sys-data-segment (i)), i)

∧ i-objectp-type ('bool, i-nextword (i), i))

Definition: i-xor <tsp>{b} *{b}-step (i) = i-state (add2-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bool,

xor-bool (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-nextword (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

'run)

Definition: i-xor <tsp>{b} x{b}-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i))) ∧ i-objectp-type ('bool,

fetch (i-tsp (i), i-sys-data-segment (i)), i)

∧ i-objectp-type ('bool, i-x (i), i))

Definition: i-xor <tsp>{b} x{b}-step (i) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), i-z-flg (i), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bool,

xor-bool (untag (fetch (i-tsp (i),

i-sys-data-segment (i))),

untag (i-x (i)))),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

          'run)

Definition: i-xor <z> <tsp> x-okp (i) = (add1-i-pcp (i)

∧ (¬ empty-stkp (i-tsp (i), i-sys-data-segment (i)))

∧ i-usr-data-objectp (i-x (i), i)

∧ i-usr-data-objectp (fetch (i-tsp (i), i-sys-data-segment (i)), i) ∧ (type (i-x (i)) = type (fetch (i-tsp (i), i-sys-data-segment (i)))))

; Note: This step function is different from all the others in that it
; takes a second argument!  The problem is that to xor any two
; addresses we must know where they are loaded to compute the
; resultant bit vector.  In the days before we added load-addr, the
; address 0 was built into this definition and this stepper was like
; all the others.  But now we have to supply it.  We could have made
; it part of the I state, but that would have required changing all
; the steppers to construct the new sized state and might have
; required other changes (e.g., in proving that it is unchanged?).  So
; we have just added it to this one stepper, which will be handled
; specially in by i-ins-step.  Of course, we have to add load-addr as
; an argument to the I machine itself.  Sigh.

Definition: i-xor <z> <tsp> x-step (i, load-addr) = i-state (add1-i-pc (i),

i-cfp (i), i-csp (i), i-tsp (i), i-x (i), i-y (i), i-c-flg (i), i-v-flg (i), i-n-flg (i), bool (fetch (i-tsp (i), i-sys-data-segment (i)) = i-x (i)), i-prog-segment (i), i-usr-data-segment (i), deposit (tag ('bitv,

xor-xxx (fetch (i-tsp (i), i-sys-data-segment (i)), i-x (i), i, load-addr)),

i-tsp (i),

i-sys-data-segment (i)), i-word-size (i),

  'run)

Definition: i-ins-okp (ins, i) = ((cdr (ins) = nil)

∧ case on car (ins): case = add <c> x x{n} then i-add <c> x x{n}-okp (i) case = add <tsp> <tsp>{v} then i-add <tsp> <tsp>{v}-okp (i) case = add <tsp> <tsp>{n} then i-add <tsp> <tsp>{n}-okp (i) case = add <tsp>{a} x{n} then i-add <tsp>{a} x{n}-okp (i) case = add tsp *{n} then i-add tsp *{n}-okp (i) case = add tsp x{n} then i-add tsp x{n}-okp (i) case = add <tsp>{i} x{i} then i-add <tsp>{i} x{i}-okp (i) case = add <tsp>{n} x{n} then i-add <tsp>{n} x{n}-okp (i) case = add pc x{n} then i-add pc x{n}-okp (i) case = add x x{n} then i-add x x{n}-okp (i) case = add x{n} csp then i-add x{n} csp-okp (i) case = addc <c> x{n} y{n} then i-addc <c> x{n} y{n}-okp (i) case = addc <v> x{i} y{i} then i-addc <v> x{i} y{i}-okp (i) case = and <tsp>{v} x{v} then i-and <tsp>{v} x{v}-okp (i) case = and <tsp>{b} x{b} then i-and <tsp>{b} x{b}-okp (i) case = asr <c> <tsp> <tsp>{b} then i-asr <c> <tsp> <tsp>{b}-okp (i) case = cpop cfp then i-cpop cfp-okp (i) case = cpop pc then i-cpop pc-okp (i) case = cpush * then i-cpush *-okp (i) case = cpush <tsp>+ then i-cpush <tsp>+-okp (i) case = cpush cfp then i-cpush cfp-okp (i) case = decr <tsp> <tsp>{i} then i-decr <tsp> <tsp>{i}-okp (i) case = decr <tsp> <tsp>{n} then i-decr <tsp> <tsp>{n}-okp (i) case = incr <tsp> <tsp>{i} then i-incr <tsp> <tsp>{i}-okp (i) case = incr <tsp> <tsp>{n} then i-incr <tsp> <tsp>{n}-okp (i) case = incr y y{n} then i-incr y y{n}-okp (i) case = int-to-nat then i-int-to-nat-okp (i) case = jump-n x then i-jump-n x-okp (i) case = jump-nn x then i-jump-nn x-okp (i) case = jump-nz x then i-jump-nz x-okp (i) case = jump-z x then i-jump-z x-okp (i) case = jump * then i-jump *-okp (i) case = jump x{subr} then i-jump x{subr}-okp (i) case = lsr <c> x x{n} then i-lsr <c> x x{n}-okp (i) case = lsr <tsp> <tsp>{v} then i-lsr <tsp> <tsp>{v}-okp (i) case = move-c <tsp> * then i-move-c <tsp> *-okp (i) case = move-v <tsp> * then i-move-v <tsp> *-okp (i) case = move-z <tsp> * then i-move-z <tsp> *-okp (i) case = move-n x * then i-move-n x *-okp (i) case = move <tsp> * then i-move <tsp> *-okp (i) case = move <x{a}> <tsp> then i-move <x{a}> <tsp>-okp (i) case = move <x{s}> <tsp> then i-move <x{s}> <tsp>-okp (i) case = move cfp csp then i-move cfp csp-okp (i) case = move csp cfp then i-move csp cfp-okp (i) case = move x * then i-move x *-okp (i) case = move x <x{s}> then i-move x <x{s}>-okp (i) case = move x tsp then i-move x tsp-okp (i) case = move x x then i-move x x-okp (i) case = move y * then i-move y *-okp (i) case = move y <y{s}> then i-move y <y{s}>-okp (i) case = move y tsp then i-move y tsp-okp (i) case = neg <tsp> <tsp>{i} then i-neg <tsp> <tsp>{i}-okp (i) case = not <tsp> <tsp>{v} then i-not <tsp> <tsp>{v}-okp (i) case = or <tsp>{v} x{v} then i-or <tsp>{v} x{v}-okp (i) case = or <tsp>{b} x{b} then i-or <tsp>{b} x{b}-okp (i) case = sub <c> <tsp>{a} x{a} then i-sub <c> <tsp>{a} x{a}-okp (i) case = sub <c> <tsp>{n} x{n} then i-sub <c> <tsp>{n} x{n}-okp (i) case = sub <nv> <tsp>{i} x{i} then i-sub <nv> <tsp>{i} x{i}-okp (i) case = sub <tsp>{a} x{n} then i-sub <tsp>{a} x{n}-okp (i) case = sub x{s} y{n} then i-sub x{s} y{n}-okp (i) case = sub <tsp>{i} x{i} then i-sub <tsp>{i} x{i}-okp (i) case = sub <tsp>{n} x{n} then i-sub <tsp>{n} x{n}-okp (i) case = sub <tsp>{s} x{s} then i-sub <tsp>{s} x{s}-okp (i) case = sub <z> x{s} y{s} then i-sub <z> x{s} y{s}-okp (i) case = subb <c> x{n} y{n} then i-subb <c> x{n} y{n}-okp (i) case = subb <v> x{i} y{i} then i-subb <v> x{i} y{i}-okp (i) case = tpop <c> x then i-tpop <c> x-okp (i) case = tpop <x{a}> then i-tpop <x{a}>-okp (i) case = tpop <x{s}> then i-tpop <x{s}>-okp (i) case = tpop pc then i-tpop pc-okp (i) case = tpop x then i-tpop x-okp (i) case = tpop y then i-tpop y-okp (i) case = tpop{v} <z> y then i-tpop{v} <z> y-okp (i) case = tpop{b} <z> y then i-tpop{b} <z> y-okp (i) case = tpop{i} <zn> y then i-tpop{i} <zn> y-okp (i) case = tpop{n} <z> y then i-tpop{n} <z> y-okp (i) case = tpush * then i-tpush *-okp (i) case = tpush <x{a}> then i-tpush <x{a}>-okp (i) case = tpush <x{s}> then i-tpush <x{s}>-okp (i) case = tpush csp then i-tpush csp-okp (i) case = tpush tsp then i-tpush tsp-okp (i) case = tpush x then i-tpush x-okp (i) case = xor <tsp> <tsp> then i-xor <tsp> <tsp>-okp (i) case = xor <tsp>{v} x{v} then i-xor <tsp>{v} x{v}-okp (i) case = xor <tsp>{b} *{b} then i-xor <tsp>{b} *{b}-okp (i) case = xor <tsp>{b} x{b} then i-xor <tsp>{b} x{b}-okp (i) case = xor <z> <tsp> x then i-xor <z> <tsp> x-okp (i) otherwise f endcase)

Definition: i-ins-step (ins, i, load-addr) = case on car (ins):

case = add <c> x x{n} then i-add <c> x x{n}-step (i) case = add <tsp> <tsp>{v} then i-add <tsp> <tsp>{v}-step (i) case = add <tsp> <tsp>{n} then i-add <tsp> <tsp>{n}-step (i) case = add <tsp>{a} x{n} then i-add <tsp>{a} x{n}-step (i) case = add tsp *{n} then i-add tsp *{n}-step (i) case = add tsp x{n} then i-add tsp x{n}-step (i) case = add <tsp>{i} x{i} then i-add <tsp>{i} x{i}-step (i) case = add <tsp>{n} x{n} then i-add <tsp>{n} x{n}-step (i) case = add pc x{n} then i-add pc x{n}-step (i) case = add x x{n} then i-add x x{n}-step (i) case = add x{n} csp then i-add x{n} csp-step (i) case = addc <c> x{n} y{n} then i-addc <c> x{n} y{n}-step (i) case = addc <v> x{i} y{i} then i-addc <v> x{i} y{i}-step (i) case = and <tsp>{v} x{v} then i-and <tsp>{v} x{v}-step (i) case = and <tsp>{b} x{b} then i-and <tsp>{b} x{b}-step (i) case = asr <c> <tsp> <tsp>{b} then i-asr <c> <tsp> <tsp>{b}-step (i) case = cpop cfp then i-cpop cfp-step (i) case = cpop pc then i-cpop pc-step (i) case = cpush * then i-cpush *-step (i) case = cpush <tsp>+ then i-cpush <tsp>+-step (i) case = cpush cfp then i-cpush cfp-step (i) case = decr <tsp> <tsp>{i} then i-decr <tsp> <tsp>{i}-step (i) case = decr <tsp> <tsp>{n} then i-decr <tsp> <tsp>{n}-step (i) case = incr <tsp> <tsp>{i} then i-incr <tsp> <tsp>{i}-step (i) case = incr <tsp> <tsp>{n} then i-incr <tsp> <tsp>{n}-step (i) case = incr y y{n} then i-incr y y{n}-step (i) case = int-to-nat then i-int-to-nat-step (i) case = jump-n x then i-jump-n x-step (i) case = jump-nn x then i-jump-nn x-step (i) case = jump-nz x then i-jump-nz x-step (i) case = jump-z x then i-jump-z x-step (i) case = jump * then i-jump *-step (i) case = jump x{subr} then i-jump x{subr}-step (i) case = lsr <c> x x{n} then i-lsr <c> x x{n}-step (i) case = lsr <tsp> <tsp>{v} then i-lsr <tsp> <tsp>{v}-step (i) case = move-c <tsp> * then i-move-c <tsp> *-step (i) case = move-v <tsp> * then i-move-v <tsp> *-step (i) case = move-z <tsp> * then i-move-z <tsp> *-step (i) case = move-n x * then i-move-n x *-step (i) case = move <tsp> * then i-move <tsp> *-step (i) case = move <x{a}> <tsp> then i-move <x{a}> <tsp>-step (i) case = move <x{s}> <tsp> then i-move <x{s}> <tsp>-step (i) case = move cfp csp then i-move cfp csp-step (i) case = move csp cfp then i-move csp cfp-step (i) case = move x * then i-move x *-step (i) case = move x <x{s}> then i-move x <x{s}>-step (i) case = move x tsp then i-move x tsp-step (i) case = move x x then i-move x x-step (i) case = move y * then i-move y *-step (i) case = move y <y{s}> then i-move y <y{s}>-step (i) case = move y tsp then i-move y tsp-step (i) case = neg <tsp> <tsp>{i} then i-neg <tsp> <tsp>{i}-step (i) case = not <tsp> <tsp>{v} then i-not <tsp> <tsp>{v}-step (i) case = or <tsp>{v} x{v} then i-or <tsp>{v} x{v}-step (i) case = or <tsp>{b} x{b} then i-or <tsp>{b} x{b}-step (i) case = sub <c> <tsp>{a} x{a} then i-sub <c> <tsp>{a} x{a}-step (i) case = sub <c> <tsp>{n} x{n} then i-sub <c> <tsp>{n} x{n}-step (i) case = sub <nv> <tsp>{i} x{i} then i-sub <nv> <tsp>{i} x{i}-step (i) case = sub <tsp>{a} x{n} then i-sub <tsp>{a} x{n}-step (i) case = sub x{s} y{n} then i-sub x{s} y{n}-step (i) case = sub <tsp>{i} x{i} then i-sub <tsp>{i} x{i}-step (i) case = sub <tsp>{n} x{n} then i-sub <tsp>{n} x{n}-step (i) case = sub <tsp>{s} x{s} then i-sub <tsp>{s} x{s}-step (i) case = sub <z> x{s} y{s} then i-sub <z> x{s} y{s}-step (i) case = subb <c> x{n} y{n} then i-subb <c> x{n} y{n}-step (i) case = subb <v> x{i} y{i} then i-subb <v> x{i} y{i}-step (i) case = tpop <c> x then i-tpop <c> x-step (i) case = tpop <x{a}> then i-tpop <x{a}>-step (i) case = tpop <x{s}> then i-tpop <x{s}>-step (i) case = tpop pc then i-tpop pc-step (i) case = tpop x then i-tpop x-step (i) case = tpop y then i-tpop y-step (i) case = tpop{v} <z> y then i-tpop{v} <z> y-step (i) case = tpop{b} <z> y then i-tpop{b} <z> y-step (i) case = tpop{i} <zn> y then i-tpop{i} <zn> y-step (i) case = tpop{n} <z> y then i-tpop{n} <z> y-step (i) case = tpush * then i-tpush *-step (i) case = tpush <x{a}> then i-tpush <x{a}>-step (i) case = tpush <x{s}> then i-tpush <x{s}>-step (i) case = tpush csp then i-tpush csp-step (i) case = tpush tsp then i-tpush tsp-step (i) case = tpush x then i-tpush x-step (i) case = xor <tsp> <tsp> then i-xor <tsp> <tsp>-step (i) case = xor <tsp>{v} x{v} then i-xor <tsp>{v} x{v}-step (i) case = xor <tsp>{b} *{b} then i-xor <tsp>{b} *{b}-step (i) case = xor <tsp>{b} x{b} then i-xor <tsp>{b} x{b}-step (i) case = xor <z> <tsp> x then i-xor <z> <tsp> x-step (i, load-addr) otherwise i-halt (i, 'run) endcase

Definition: i-step1 (ins, i, load-addr) = if i-state-okp (i, load-addr)

then if i-ins-okp (ins, i) then i-ins-step (ins, i, load-addr)

else i-halt (i, x-y-error-msg ('i, car (ins))) endif else i-halt (i, 'state-not-okp) endif

Definition: i-step (i, load-addr) = if i-psw (i) = 'run

then i-step1 (i-current-instruction (i), i, load-addr) else i endif

Definition: i (i, n, load-addr) = if n ≃ 0 then i

else i (i-step (i, load-addr), n − 1, load-addr) endif

Definition: list-of-nats (lst) = if lst ≃ nil then nil

else cons (v-to-nat (car (lst)), list-of-nats (cdr (lst))) endif

; Book: i-m.events.  We now develop the proof that the i machine is
; implemented on the m machine.

; I first develop the necessary rules about the FM9001 alu.
; Each of the alu theorems is about the bv-alu-cv function.
; That function returns a triple.  We are most interested in
; the bv and c components of the triple.  We are occasionally
; interested in the v component, but only for those instructions
; that we use that set the v flag.
; For each opcode op, each component, cmp, in {bv c v}
; and type, t, in {bitv nat tc} we have a theorem called
; alu-thm_t-cmp-op.  For example, we have alu-thm_BITV-BV-MOVE,
; which gives the BITV interpretation of the BV component of
; the alu on a MOVE opcode.  We omit some combinations because
; they do not make much sense.  Occasionally we have to prove
; conflicting rules -- rules that rewrite the same lhs.  This
; happens when the opcode has a natural interpretation for more
; than one type.  When it happens we note it.

Event: Enable v-buf-works.

Theorem: alu-thm bitv-bv-move-15 (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, t, t, t))) = a)

Theorem: alu-thm bitv-c-move-15 (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, t, t, t))) = f)

Theorem: alu-thm bitv-bv-not (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, t, t, t))) = v-not (a))

Theorem: alu-thm bitv-c-not (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (f, t, t, t))) = f)

Theorem: alu-thm bitv-bv-and (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, f, t, t))) = v-and (a, b))

Theorem: alu-thm bitv-c-and (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, f, t, t))) = f)

Theorem: alu-thm bitv-bv-or (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, f, t, t))) = v-or (a, b))

Theorem: alu-thm bitv-c-or (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (f, f, t, t))) = f)

Theorem: alu-thm bitv-bv-xor (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, t, f, t))) = v-xor (a, b))

Theorem: alu-thm bitv-c-xor (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, t, f, t))) = f)

; Conflict:  We will have both a BITV and a NAT interpretation of the
; BV and C produced by the LSR instruction.  Here is the BITV case:

Theorem: alu-thm bitv-bv-lsr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, t, f, t))) = v-lsr (a))

; Note that we have an additional hypothesis below, (listp a).

Theorem: alu-thm bitv-c-lsr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ listp (a) ∧ boolp (c)) → (c (v-alu (c, a, b, list (f, t, f, t))) = bitn (a, 1))

; Conflict:  We will have both a BITV and a TC interpretation of the BV
; produced by the ASR instruction.

Theorem: alu-thm bitv-bv-asr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, f, f, t))) = v-asr (a))

; Note that we have an additional hypothesis below, (listp a).

Theorem: alu-thm bitv-c-asr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ listp (a) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, f, f, t))) = bitn (a, 1))

Theorem: alu-thm bitv-bv-ror (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, f, f, t))) = v-ror (a, c))

; To prove the next one we need another piece of help.

Theorem: boolp-truep boolp (c) → (truep (c) = c)

Theorem: alu-thm bitv-c-ror (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (f, f, f, t)))

= if length (a) ≃ 0 then c else bitn (a, 1) endif)

; Here are the natural number interpretations of the bv and c flag of the
; alu.
; Our first step is to get the natural interpretation lemma as a rewrite
; rule and shut down v-alu:

Event: Disable v-alu.

Theorem: v-alu-correct-nat-rewriter bv2p (a, b) → (v-alu (c, a, b, op) = v-alu-nat (c, a, b, op))

; The original (FM8502) Piton proofs were based on alu interpretation
; lemmas proved for FM8502.  When FM9001 was done, Matt Kaufmann was given
; a free hand to formulate the alu interpretation lemmas for it.  His
; algebraic expressions were different than those used for FM8502, even
; though they were equivalent.  Rather than redesign the Piton proof to
; use Matt's formulation, we take the approach of proving the old-style
; algebraic formulations from Matt's.  That is what we do now.
; This gets exceptionally tedious for the twos-complement stuff.  I essentially
; just use brute force to wade through this stuff.  The general scheme was
; was to attack the top-level theorems with a fixed set of rules enabled,
; generating certain goals (all phrased in integer terms) and then attack
; each of those goals as a separate lemma with the integer stuff enabled.
; Those integer lemmas are killers, taking hundreds or thousands of seconds
; each.  But it was better than thinking...

Theorem: alu-thm nat-bv-lsr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, t, f, t)))

= nat-to-v (v-to-nat (a) ÷ 2, length (a)))

Theorem: alu-thm nat-c-lsr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (f, t, f, t))) = ((v-to-nat (a) mod 2) ≄ 0))

Event: Enable plus-0.

Theorem: pathological-difference (a ≮ b) → ((b − a) = 0)

Theorem: difference-difference-plus (((b + e) − a) − e) = (b − a)

Event: Enable lessp-v-to-nat-exp.

Theorem: remainder-difference-hack (b < e) → (((b − a) mod e) = (b − a))

Theorem: difference-difference-hack (a ≮ b) → ((e − (a − b)) = ((b + e) − a))

; Conflict:  We will have both a NAT and a TC interpretation of the BV
; produced by the SUB instruction.

Theorem: alu-thm nat-bv-sub (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, t, t, f)))

= if v-to-nat (b) ≮ v-to-nat (a)

then nat-to-v (v-to-nat (b) − v-to-nat (a), length (a)) else nat-to-v (exp (2, length (a))

− (v-to-nat (a) − v-to-nat (b)), length (a)) endif)

Theorem: alu-thm nat-c-sub (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, t, t, f))) = (v-to-nat (b) < v-to-nat (a)))

Definition: carry (c) = if c then 1

else 0 endif

; Conflict:  We will have both a NAT and a TC interpretation of the the
; BV produced by the SUBB instruction.

Theorem: alu-thm nat-bv-subb (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, t, t, f)))

= if v-to-nat (b) < (v-to-nat (a) + carry (c)) then nat-to-v (exp (2, length (a))

− ((v-to-nat (a) + carry (c)) − v-to-nat (b)),

length (a))

else nat-to-v (v-to-nat (b)

− (v-to-nat (a) + carry (c)), length (a)) endif)

Theorem: alu-thm nat-c-subb (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (f, t, t, f)))

= (v-to-nat (b) < (v-to-nat (a) + carry (c))))

Event: Disable pathological-difference.

Event: Disable difference-difference-plus.

Event: Disable lessp-v-to-nat-exp.

Event: Disable remainder-difference-hack.

Event: Disable difference-difference-hack.

Event: Enable length-nat-to-v.

Event: Enable commutativity-of-plus.

Event: Enable associativity-of-plus.

Event: Enable plus-add1.

Event: Enable plus-0.

Event: Enable times-commutes.

Event: Enable associativity-of-times.

Event: Enable times-distributes-over-plus.

Event: Enable times-add1-again.

Event: Enable times-1.

Theorem: plus-commutes2 (x + (y + z)) = (y + (x + z))

Theorem: times-commutes2 (x ∗ (y ∗ z)) = (y ∗ (x ∗ z))

Theorem: remainder-lessp ((x mod y) < y) = (y ≄ 0)

Event: Enable remainder-quotient-elim.

Theorem: remainder-quotient-rewrite ((x ∈ N) ∧ (y ≄ 0)) → (((x mod y) + (y ∗ (x ÷ y))) = x)

Theorem: v-to-nat-nat-to-v (n < exp (2, len)) → (v-to-nat (nat-to-v (n, len)) = fix (n))

Theorem: lessp-0-exp (i ≄ 0) → (0 < exp (i, j ))

Theorem: difference-plus ((a + b) − b) = fix (a)

; The following lemma is a way to get linear arithmetic to address the
; question "is a less than b" when opening up (remainder a b).

Theorem: remainder-opener (a < b) → ((a mod b) = fix (a))

Event: Enable lessp-v-to-nat-exp.

Theorem: lessp-v-to-nat-exp-gen v-to-nat (a) < exp (2, length (a))

Theorem: remainder-hack2 ((v-to-nat (v) − 1) mod exp (2, length (v))) = (v-to-nat (v) − 1)

Event: Enable difference-x-1.

; Conflict:  We will have both a NAT and a TC interpretation of the the
; BV produced by the DECR instruction.

Theorem: alu-thm nat-bv-decr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, f, t, f)))

= if v-to-nat (a) ≃ 0 then nat-to-v (exp (2, length (a)) − 1, length (a)) else nat-to-v (v-to-nat (a) − 1, length (a)) endif)

Theorem: alu-thm nat-c-decr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, f, t, f))) = (v-to-nat (a) ≃ 0))

; Conflict:  We will have both a NAT and a TC interpretation of the the
; BV produced by the ADD instruction.

Theorem: alu-thm nat-bv-add (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, t, f, f)))

= if (v-to-nat (a) + v-to-nat (b)) < exp (2, length (a)) then nat-to-v (v-to-nat (a) + v-to-nat (b), length (a)) else nat-to-v ((v-to-nat (a) + v-to-nat (b))

mod exp (2, length (a)), length (a)) endif)

Theorem: alu-thm nat-c-add (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, t, f, f)))

= ((v-to-nat (a) + v-to-nat (b)) ≮ exp (2, length (a))))

; Conflict:  We will have both a NAT and a TC interpretation of the the
; BV produced by the ADDC instruction.

Theorem: alu-thm nat-bv-addc (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, t, f, f)))

= if (v-to-nat (a) + v-to-nat (b) + carry (c))

< exp (2, length (a)) then nat-to-v (v-to-nat (a) + v-to-nat (b) + carry (c),

length (a))

else nat-to-v ((v-to-nat (a) + v-to-nat (b) + carry (c)) mod exp (2, length (a)), length (a)) endif)

Theorem: alu-thm nat-c-addc (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (f, t, f, f)))

= ((v-to-nat (a) + v-to-nat (b) + carry (c)) ≮ exp (2, length (a))))

; Conflict:  We will have both a NAT and a TC interpretation of the the
; BV produced by the INCR instruction.

Theorem: alu-thm nat-bv-incr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, f, f, f)))

= if (1 + v-to-nat (a)) < exp (2, length (a)) then nat-to-v (1 + v-to-nat (a), length (a)) else nat-to-v (0, length (a)) endif)

Theorem: alu-thm nat-c-incr (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (c (v-alu (c, a, b, list (t, f, f, f)))

= ((1 + v-to-nat (a)) ≮ exp (2, length (a))))

; Conflict:  Each of the TC interpretations conflicts with some other rule.
; Warning: all of these tc guys had (hands-off if) hints!

Event: Disable v-alu-correct-nat-rewriter.

Theorem: v-alu-correct-int-rewriter (bv2p (a, b) ∧ listp (a)) → (v-alu (c, a, b, op) = v-alu-int (c, a, b, op))

Definition: mod2 (x) = if negativep (x) then − ((1 + negative-guts (x)) ÷ 2)

else x ÷ 2 endif Event: Enable quotient-plus-x-x-2.

; A lemma quotient-add1-plus-x-x-2 exists in fm9001.events, but it did
; not originally.  We accommodate this change by introducing the "my-"
; prefix below.

Theorem: my-quotient-add1-plus-x-x-2 ((1 + (x + x)) ÷ 2) = fix (x)

Theorem: idiv-is-mod2 idiv (x, 2) = if integerp (x) then mod2 (x)

else 0 endif

Event: Disable idiv.

; A lemma integerp-v-to-int exists in fm9001.events, but it did not
; originally.  We accommodate this change by introducing the "my-"
; prefix below.

Theorem: my-integerp-v-to-int integerp (v-to-int (v))

Theorem: alu-thm tc-bv-asr (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, f, f, t)))

= int-to-v (mod2 (v-to-int (a)), length (a)))

Definition: tc-in-rangep (x, n) = if n ≃ 0 then f

elseif negativep (x) then exp (2, n − 1) ≮ negative-guts (x)

else x < exp (2, n − 1) endif

Definition: tc-add (x, y) = iplus (x, y)

Definition: tc-minus (x) = ineg (x)

Theorem: iplus-0 iplus (x, 0) = fix-int (x)

Theorem: equal-length-0 (length (x) = 0) = (x ≃ nil)

Theorem: negativep-ineg ((x ∈ N) ∧ (x ≠ 0)) → negativep (ineg (x))

Theorem: not-equal-exp-0 (x ≄ 0) → (exp (x, y) ≠ 0)

Theorem: ineg-exp-2-x ineg (exp (2, x)) = (− exp (2, x))

Theorem: diff-diff ((a ∈ N) ∧ (b ∈ N)) → ((a − (a − b))

= if a < b then a else b endif)

Theorem: alu-thm tc-bv-sub-lemma (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (b), ineg (v-to-int (a))))) ∧ (iplus (v-to-int (b), ineg (v-to-int (a))) ≮ exp (2, length (a) − 1))) → (int-to-v (iplus (v-to-int (b),

iplus (− exp (2, length (a)), ineg (v-to-int (a)))), length (a))

= int-to-v (iplus (v-to-int (b), ineg (v-to-int (a))), length (a)))

; Note: This was proved with the lower case a's replaced by b's, but I
; have now assumed it as shown below (except that the concluding
; equality was reversed).  Under that assumption, I can prove the
; tc-bv-sub lemma I need.  However, I now want to reverse the
; direction of the concluding equality so as not to take the chance
; that it loops.

Theorem: alu-thm tc-bv-sub-lemma2 (bvp (a) ∧ listp (a)

∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (b), ineg (v-to-int (a)))) ∧ (exp (2, length (a) − 1)

< negative-guts (iplus (v-to-int (b), ineg (v-to-int (a)))))) → (int-to-v (iplus (v-to-int (b),

iplus (exp (2, length (a)), ineg (v-to-int (a)))), length (a))

= int-to-v (iplus (v-to-int (b), ineg (v-to-int (a))), length (a)))

Theorem: alu-thm tc-bv-sub (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, t, t, f)))

= int-to-v (if tc-in-rangep (tc-add (v-to-int (b),

tc-minus (v-to-int (a))), length (a))

then tc-add (v-to-int (b), tc-minus (v-to-int (a))) elseif negativep (tc-add (v-to-int (b),

tc-minus (v-to-int (a))))

then tc-add (v-to-int (b),

tc-add (exp (2, length (a)),

tc-minus (v-to-int (a))))

else tc-add (v-to-int (b),

tc-add (− exp (2, length (a)),

tc-minus (v-to-int (a)))) endif,

length (a)))

Theorem: alu-thm tc-v-sub (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (v (v-alu (c, a, b, list (t, t, t, f)))

= (¬ tc-in-rangep (tc-add (v-to-int (b), tc-minus (v-to-int (a))), length (a))))

Theorem: diff-plus-cancellation-hack2 ((a + b + c + d) − (b + c)) = (a + d)

Theorem: diff-plus-sub1-hack1 (a < e) → (((b + (e − 1)) − a) = (b + ((e − a) − 1)))

Theorem: alu-thm tc-bv-subb-lemma1 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (b), ineg (iplus (v-to-int (a), 1))))) ∧ (iplus (v-to-int (b), ineg (iplus (v-to-int (a), 1)))

≮ exp (2, length (a) − 1))) → (int-to-v (iplus (v-to-int (b),

iplus (− exp (2, length (a)),

ineg (iplus (v-to-int (a), 1)))),

length (a)) = int-to-v (iplus (v-to-int (b), ineg (iplus (v-to-int (a), 1))),

length (a)))

Theorem: diff-plus-sub1-hack2 ((e ≄ 0) ∧ (a < e)) → (((b + ((e − a) − 1)) − e) = ((b + (e − 1)) − (a + e)))

Theorem: alu-thm tc-bv-subb-lemma2-lemma1 (bvp (a) ∧ (length (a) ≠ 0)) → (nat-to-v ((v-to-nat (b)

+ (((exp (2, length (a) − 1) + exp (2, length (a) − 1))

− v-to-nat (a))− 1)) − (exp (2, length (a) − 1) + exp (2, length (a) − 1)), length (a)) = nat-to-v ((v-to-nat (b)

+ ((exp (2, length (a) − 1)

+ exp (2, length (a) − 1))− 1)) − (v-to-nat (a)

+ exp (2, length (a) − 1) + exp (2, length (a) − 1)),

length (a)))

Event: Disable diff-plus-sub1-hack2.

Theorem: alu-thm tc-bv-subb-lemma2 (bvp (a)

∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (b), ineg (iplus (v-to-int (a), 1)))) ∧ (exp (2, length (a) − 1)

< negative-guts (iplus (v-to-int (b), ineg (iplus (v-to-int (a), 1)))))) → (int-to-v (iplus (v-to-int (b),

iplus (exp (2, length (a)), ineg (iplus (v-to-int (a), 1)))), length (a))

= int-to-v (iplus (v-to-int (b), ineg (iplus (v-to-int (a), 1))), length (a)))

Theorem: alu-thm tc-bv-subb (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, t, t, f)))

= int-to-v (if tc-in-rangep (tc-add (v-to-int (b),

tc-minus (tc-add (v-to-int (a),

carry (c)))),

length (a))

then tc-add (v-to-int (b),

tc-minus (tc-add (v-to-int (a), carry (c))))

elseif negativep (tc-add (v-to-int (b),

tc-minus (tc-add (v-to-int (a),

carry (c)))))

then tc-add (v-to-int (b),

tc-add (exp (2, length (a)),

tc-minus (tc-add (v-to-int (a),

carry (c)))))

else tc-add (v-to-int (b),

tc-add (− exp (2, length (a)),

tc-minus (tc-add (v-to-int (a),

carry (c))))) endif,

length (a)))

Theorem: alu-thm tc-v-subb (bvp (a) ∧ listp (a) ∧ bvp (b)

∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (v (v-alu (c, a, b, list (f, t, t, f)))

= (¬ tc-in-rangep (tc-add (v-to-int (b),

tc-minus (tc-add (v-to-int (a), carry (c)))), length (a))))

Theorem: v-to-int-int-to-v-0 v-to-int (int-to-v (0, n)) = 0

; A lemma length-int-to-v exists in fm9001.events, but it did not
; originally.  We accommodate this change by introducing the "my-"
; prefix below.

Theorem: my-length-int-to-v length (int-to-v (x, n)) = fix (n)

Theorem: alu-thm tc-bv-decr-lemma1 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), -1))) ∧ (iplus (v-to-int (a), -1) ≮ exp (2, length (a) − 1))) → (int-to-v (iplus (v-to-int (a), -1), length (a))

= int-to-v (iplus (v-to-int (a), iplus (-1, − exp (2, length (a)))), length (a)))

Theorem: alu-thm tc-bv-decr-lemma2 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), -1)) ∧ (exp (2, length (a) − 1) < negative-guts (iplus (v-to-int (a), -1)))) → (int-to-v (iplus (v-to-int (a), -1), length (a))

= int-to-v (iplus (v-to-int (a), iplus (-1, exp (2, length (a)))), length (a)))

Theorem: alu-thm tc-bv-decr (bvp (a)

∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, f, t, f)))

= int-to-v (if tc-in-rangep (tc-add (v-to-int (a), -1), length (a)) then tc-add (v-to-int (a), -1) elseif negativep (tc-add (v-to-int (a), -1)) then tc-add (v-to-int (a), tc-add (-1, exp (2, length (a)))) else tc-add (v-to-int (a),

tc-add (-1, − exp (2, length (a)))) endif,

length (a)))

Theorem: iplus-0-2 iplus (0, x) = fix-int (x)

Theorem: alu-thm tc-bv-neg-lemma1 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (ineg (v-to-int (a)))) ∧ (ineg (v-to-int (a)) ≮ exp (2, length (a) − 1)) ∧ (¬ integerp (ineg (v-to-int (a))))) → (int-to-v (0, length (a))

= int-to-v (iplus (− exp (2, length (a)), ineg (v-to-int (a))), length (a)))

Theorem: alu-thm tc-bv-neg-lemma2 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (ineg (v-to-int (a)))) ∧ (ineg (v-to-int (a)) ≮ exp (2, length (a) − 1)) ∧ integerp (ineg (v-to-int (a)))) → (int-to-v (ineg (v-to-int (a)), length (a))

= int-to-v (iplus (− exp (2, length (a)), ineg (v-to-int (a))), length (a)))

Theorem: alu-thm tc-bv-neg-lemma3 (bvp (a)

∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (ineg (v-to-int (a))) ∧ (exp (2, length (a) − 1) < negative-guts (ineg (v-to-int (a)))) ∧ (¬ integerp (ineg (v-to-int (a))))) → (int-to-v (0, length (a))

= int-to-v (iplus (exp (2, length (a)), ineg (v-to-int (a))), length (a)))

Theorem: alu-thm tc-bv-neg-lemma4 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (ineg (v-to-int (a))) ∧ (exp (2, length (a) − 1) < negative-guts (ineg (v-to-int (a)))) ∧ integerp (ineg (v-to-int (a)))) → (int-to-v (ineg (v-to-int (a)), length (a))

= int-to-v (iplus (exp (2, length (a)), ineg (v-to-int (a))), length (a)))

Theorem: alu-thm tc-bv-neg-lemma5 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (ineg (v-to-int (a)))) ∧ (ineg (v-to-int (a)) < exp (2, length (a) − 1)) ∧ (¬ integerp (ineg (v-to-int (a))))) → (int-to-v (0, length (a)) = int-to-v (ineg (v-to-int (a)), length (a)))

Theorem: alu-thm tc-bv-neg-lemma6 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (ineg (v-to-int (a))) ∧ (exp (2, length (a) − 1) ≮ negative-guts (ineg (v-to-int (a)))) ∧ (¬ integerp (ineg (v-to-int (a))))) → (int-to-v (0, length (a)) = int-to-v (ineg (v-to-int (a)), length (a)))

Theorem: alu-thm tc-bv-neg (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, f, t, f)))

= int-to-v (if tc-in-rangep (tc-minus (v-to-int (a)), length (a)) then tc-minus (v-to-int (a)) elseif negativep (tc-minus (v-to-int (a))) then tc-add (exp (2, length (a)), tc-minus (v-to-int (a))) else tc-add (− exp (2, length (a)),

tc-minus (v-to-int (a))) endif,

length (a)))

Theorem: diff-plus-plus-plus-cancellation ((a + (b + e)) − e) = (a + b)

Theorem: alu-thm tc-bv-add-lemma1 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), v-to-int (b)))) ∧ (iplus (v-to-int (a), v-to-int (b)) ≮ exp (2, length (a) − 1))) → (int-to-v (iplus (v-to-int (a), v-to-int (b)), length (a))

= int-to-v (iplus (v-to-int (a),

iplus (v-to-int (b), − exp (2, length (a)))), length (a)))

Theorem: alu-thm tc-bv-add-lemma2 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), v-to-int (b))) ∧ (exp (2, length (a) − 1)

< negative-guts (iplus (v-to-int (a), v-to-int (b))))) → (int-to-v (iplus (v-to-int (a), v-to-int (b)), length (a))

= int-to-v (iplus (v-to-int (a),

iplus (v-to-int (b), exp (2, length (a)))), length (a)))

Theorem: alu-thm tc-bv-add (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, t, f, f)))

= int-to-v (if tc-in-rangep (tc-add (v-to-int (a), v-to-int (b)),

length (a)) then tc-add (v-to-int (a), v-to-int (b)) elseif negativep (tc-add (v-to-int (a), v-to-int (b))) then tc-add (v-to-int (a),

tc-add (v-to-int (b), exp (2, length (a))))

else tc-add (v-to-int (a),

tc-add (v-to-int (b),

− exp (2, length (a)))) endif,

length (a)))

Theorem: alu-thm tc-bv-addc-lemma1 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (iplus (v-to-int (a), iplus (v-to-int (b), 1)) ≮ exp (2, length (a) − 1))) → (int-to-v (iplus (1, iplus (v-to-int (a), v-to-int (b))), length (a))

= int-to-v (iplus (v-to-int (a),

iplus (v-to-int (b),

iplus (1, − exp (2, length (a))))),

length (a)))

Theorem: alu-thm tc-bv-addc-lemma2 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1))) ∧ (exp (2, length (a) − 1)

< negative-guts (iplus (v-to-int (a), iplus (v-to-int (b), 1))))) → (int-to-v (iplus (1, iplus (v-to-int (a), v-to-int (b))), length (a))

= int-to-v (iplus (v-to-int (a),

iplus (v-to-int (b), iplus (1, exp (2, length (a))))), length (a)))

; The following three lemmas are killers as far as performance goes.
; I prove them, use them to get the lemmas I need, and then
; disable them.

Theorem: alu-thm tc-bv-addc-lemma3-killer1 ((a ∈ N) ∧ (a ≮ ((e + e) − b)) ∧ (1 ≮ ((e + e) − b)) ∧ (b < (e + e))) → ((1 + ((a + b) − (e + e))) = a)

Theorem: alu-thm tc-bv-addc-lemma3-killer2 ((1 ≮ ((e + e) − b)) ∧ (b < (e + e))) → (((e + e) − b) = 1)

Theorem: alu-thm tc-bv-addc-lemma3-killer3 (v-to-nat (a) < 1) → (v-to-nat (a) = 0)

Theorem: alu-thm tc-bv-addc-lemma3-lemma1 ((v-to-nat (b) < (exp (2, length (a) − 1) + exp (2, length (a) − 1))) ∧ (1 ≮ ((exp (2, length (a) − 1) + exp (2, length (a) − 1))

− v-to-nat (b)))

∧ (v-to-nat (a)

≮ ((exp (2, length (a) − 1) + exp (2, length (a) − 1))

− v-to-nat (b))))

→ ((nat-to-v (1 + ((v-to-nat (a) + v-to-nat (b))

− (exp (2, length (a) − 1)

+ exp (2, length (a) − 1))),

length (a))

= nat-to-v (v-to-nat (a), length (a)))

= t)

Theorem: alu-thm tc-bv-addc-lemma3-lemma2 ((1 ≮ ((exp (2, length (a) − 1) + exp (2, length (a) − 1)) − v-to-nat (b))) ∧ (v-to-nat (b) < (exp (2, length (a) − 1) + exp (2, length (a) − 1))) ∧ (v-to-nat (a)

< ((exp (2, length (a) − 1) + exp (2, length (a) − 1))

− v-to-nat (b))))

→ ((nat-to-v (0, length (a)) = nat-to-v (v-to-nat (a), length (a))) = t)

Event: Disable alu-thm tc-bv-addc-lemma3-killer1.

Event: Disable alu-thm tc-bv-addc-lemma3-killer2.

Event: Disable alu-thm tc-bv-addc-lemma3-killer3.

Theorem: alu-thm tc-bv-addc-lemma3 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (iplus (v-to-int (a), iplus (v-to-int (b), 1)) < exp (2, length (a) − 1))) → (int-to-v (iplus (1, iplus (v-to-int (a), v-to-int (b))), length (a))

= int-to-v (iplus (v-to-int (a), iplus (v-to-int (b), 1)), length (a)))

Theorem: alu-thm tc-bv-addc-lemma4-lemma1 ((v-to-nat (b) < (exp (2, length (a) − 1) + exp (2, length (a) − 1))) ∧ (v-to-nat (a) < (exp (2, length (a) − 1) + exp (2, length (a) − 1))) ∧ ((exp (2, length (a) − 1) + exp (2, length (a) − 1))

≮ (((exp (2, length (a) − 1)

+ exp (2, length (a) − 1) + exp (2, length (a) − 1) + exp (2, length (a) − 1)) − v-to-nat (a)) − v-to-nat (b))))

→ (((exp (2, length (a) − 1) + exp (2, length (a) − 1))

− (((exp (2, length (a) − 1) + exp (2, length (a) − 1)) − v-to-nat (a)) + (((exp (2, length (a) − 1) + exp (2, length (a) − 1))

− v-to-nat (b))− 1)))

= (1 + ((v-to-nat (a) + v-to-nat (b))

− (exp (2, length (a) − 1) + exp (2, length (a) − 1)))))

Theorem: alu-thm tc-bv-addc-lemma4 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1))) ∧ (exp (2, length (a) − 1)

≮ negative-guts (iplus (v-to-int (a), iplus (v-to-int (b), 1))))) → (int-to-v (iplus (1, iplus (v-to-int (a), v-to-int (b))), length (a))

= int-to-v (iplus (v-to-int (a), iplus (v-to-int (b), 1)), length (a)))

Theorem: alu-thm tc-bv-addc (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (f, t, f, f)))

= int-to-v (if tc-in-rangep (tc-add (v-to-int (a),

tc-add (v-to-int (b), carry (c))), length (a))

then tc-add (v-to-int (a), tc-add (v-to-int (b), carry (c))) elseif negativep (tc-add (v-to-int (a),

tc-add (v-to-int (b), carry (c))))

then tc-add (v-to-int (a),

tc-add (v-to-int (b),

tc-add (carry (c), exp (2, length (a)))))

else tc-add (v-to-int (a),

tc-add (v-to-int (b),

tc-add (carry (c),

− exp (2, length (a))))) endif,

length (a)))

Theorem: alu-thm tc-v-addc-lemma1 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (iplus (v-to-int (a), iplus (v-to-int (b), 1)) ≮ exp (2, length (a) − 1)) ∧ (¬ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b)))))) → ((iplus (1, iplus (v-to-int (a), v-to-int (b))) < exp (2, length (a) − 1))

= f)

Theorem: alu-thm tc-v-addc-lemma2 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (iplus (v-to-int (a), iplus (v-to-int (b), 1)) ≮ exp (2, length (a) − 1)) ∧ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b)))))

→ ((exp (2, length (a) − 1)

< negative-guts (iplus (1, iplus (v-to-int (a), v-to-int (b))))) = t)

Theorem: alu-thm tc-v-addc-lemma3 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1))) ∧ (exp (2, length (a) − 1)

< negative-guts (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (¬ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b)))))) → ((iplus (1, iplus (v-to-int (a), v-to-int (b))) < exp (2, length (a) − 1))

= f)

Theorem: alu-thm tc-v-addc-lemma4 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1))) ∧ (exp (2, length (a) − 1)

< negative-guts (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b))))) → ((exp (2, length (a) − 1)

< negative-guts (iplus (1, iplus (v-to-int (a), v-to-int (b))))) = t)

Theorem: alu-thm tc-v-addc-lemma5 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (iplus (v-to-int (a), iplus (v-to-int (b), 1)) < exp (2, length (a) − 1)) ∧ (¬ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b)))))) → ((iplus (1, iplus (v-to-int (a), v-to-int (b))) < exp (2, length (a) − 1))

= t)

Theorem: alu-thm tc-v-addc-lemma6 (bvp (a)

∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ (¬ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (iplus (v-to-int (a), iplus (v-to-int (b), 1)) < exp (2, length (a) − 1)) ∧ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b))))) → ((exp (2, length (a) − 1)

< negative-guts (iplus (1, iplus (v-to-int (a), v-to-int (b))))) = f)

Theorem: alu-thm tc-v-addc-lemma7 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1))) ∧ (exp (2, length (a) − 1)

≮ negative-guts (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ (¬ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b)))))) → ((iplus (1, iplus (v-to-int (a), v-to-int (b))) < exp (2, length (a) − 1))

= t)

Theorem: alu-thm tc-v-addc-lemma8 (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ negativep (iplus (v-to-int (a), iplus (v-to-int (b), 1))) ∧ (exp (2, length (a) − 1)

≮ negative-guts (iplus (v-to-int (a), iplus (v-to-int (b), 1)))) ∧ negativep (iplus (1, iplus (v-to-int (a), v-to-int (b))))) → ((exp (2, length (a) − 1)

< negative-guts (iplus (1, iplus (v-to-int (a), v-to-int (b))))) = f)

Theorem: alu-thm tc-v-addc (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c))

→ (v (v-alu (c, a, b, list (f, t, f, f)))

= (¬ tc-in-rangep (tc-add (v-to-int (a),

tc-add (v-to-int (b), carry (c))), length (a))))

Theorem: alu-thm tc-bv-incr-lemma1 (bvp (a) ∧ listp (a) ∧ (¬ negativep (iplus (v-to-int (a), 1))) ∧ (iplus (v-to-int (a), 1) ≮ exp (2, length (a) − 1))) → (int-to-v (iplus (v-to-int (a), iplus (1, − exp (2, length (a)))), length (a))

= int-to-v (iplus (1, v-to-int (a)), length (a)))

Theorem: alu-thm tc-bv-incr-lemma2 (bvp (a) ∧ listp (a) ∧ negativep (iplus (v-to-int (a), 1)) ∧ (exp (2, length (a) − 1) < negative-guts (iplus (v-to-int (a), 1)))) → (int-to-v (iplus (v-to-int (a), iplus (1, exp (2, length (a)))), length (a))

= int-to-v (iplus (1, v-to-int (a)), length (a)))

Theorem: alu-thm tc-bv-incr (bvp (a) ∧ listp (a) ∧ bvp (b) ∧ listp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (bv (v-alu (c, a, b, list (t, f, f, f)))

= int-to-v (if tc-in-rangep (tc-add (v-to-int (a), 1), length (a)) then tc-add (v-to-int (a), 1) elseif negativep (tc-add (v-to-int (a), 1)) then tc-add (v-to-int (a), tc-add (1, exp (2, length (a)))) else tc-add (v-to-int (a),

tc-add (1, − exp (2, length (a)))) endif,

length (a)))

; That completes the alu interpretation lemmas.  Now we disable everything we did
; in this section other than the old-style interpretation lemmas (i.e., we make the
; data base behave as though we had done an add-axiom for each of the interpretation
; lemmas).  The reason for this is that the first time we rebuilt Piton on FM9001 we
; skipped the proofs of these boring facts so we could get on with the interesting
; part and now, having proved them, we have to make sure the lemmas we added don't
; mess up future proofs.

Event: Disable theory equal-length-0, negativep-ineg, not-equal-exp-0, inegexp-2-x, diff-diff, alu-thm tc-bv-sub-lemma, alu-thm tc-bv-sub-lemma2, diff-plus-cancellation-hack2, diff-plus-sub1-hack1, alu-thm tc-bv-subb-lemma1, diff-plus-sub1-hack2, alu-thm tc-bv-subb-lemma2-lemma1, diff-plus-sub1-hack2-off, aluthm tc-bv-subb-lemma2, v-to-int-int-to-v-0, my-length-int-to-v, alu-thm tc-bv-decr-lemma1, alu-thm tc-bv-decr-lemma2, iplus-0-2, alu-thm tc-bv-neg-lemma1, alu-thm tc-bv-neg-lemma2, alu-thm tc-bv-neg-lemma3, alu-thm tc-bv-neg-lemma4, alu-thm tc-bv-neg-lemma5, alu-thm tc-bv-neg-lemma6, diff-plus-plus-plus-cancellation, alu-thm tc-bv-add-lemma1, alu-thm tc-bv-add-lemma2, alu-thm tc-bv-addc-lemma1, alu-thm tc-bv-addc-lemma2, alu-thm tc-bv-addc-lemma3-killer1, alu-thm tc-bv-addc-lemma3-killer2, alu-thm tc-bv-addc-lemma3-killer3, alu-thm tc-bv-addc-lemma3-lemma1, alu-thm tc-bv-addc-lemma3-lemma2, alu-thm tc-bv-addc-lemma3-killer1-off, alu-thm tc-bv-addc-lemma3-killer2-off, alu-thm tc-bv-addc-lemma3-killer3-off, alu-thm tc-bv-addc-lemma3, alu-thm tc-bv-addc-lemma4-lemma1, alu-thm tcbv-addc-lemma4, alu-thm tc-v-addc-lemma1, alu-thm tc-v-addc-lemma2, aluthm tc-v-addc-lemma3, alu-thm tc-v-addc-lemma4, alu-thm tc-v-addc-lemma5, alu-thm tc-v-addc-lemma6, alu-thm tc-v-addc-lemma7, alu-thm tc-v-addc-lemma8, alu-thm tc-bv-incr-lemma1, alu-thm tc-bv-incr-lemma2, bv, v, c, v-alu-correct-int-rewriter, unlabel, i-usr-data-typep.

; This completes our rule base for the alu.  We should now be able
; to reduce any bv-alu-cv expression that arises.
; This completes the preliminary pass from m down to fm9001.

; I now prove a few useful equivalences between
; concepts at the m level and concepts at the i level.

Theorem: nth-is-get nth (n, l) = get (n, l)

Theorem: update-nth-is-put (n < length (l)) → (update-nth (n, l, v) = put (v, n, l))

; Goal:  v-to-nat-inverts-nat-to-v
; Subgoal: remainder-quotient-elim
; First we build up the classic proof of remainder-quotient-elim, doing
; a lot of arithmetic along the way.

Event: Enable difference-elim.

Theorem: difference-elim-rewrite ((x ∈ N) ∧ (x ≮ y)) → (((x − y) + y) = x)

Theorem: v-to-nat-inverts-nat-to-v small-naturalp (n, word-size) → (v-to-nat (nat-to-v (n, word-size)) = n)

; QED:  v-to-nat-inverts-nat-to-v

; Next I will speed up the handling of i-objectp-type for
; the case where the type is a quoted constant.

Theorem: i-objectp-type-simplifier (i-objectp-type ('nat, x, i) = ((type (x) = 'nat)

∧ (cddr (x) = nil)

∧ small-naturalp (untag (x), i-word-size (i)))) ∧ (i-objectp-type ('int, x, i)

= ((type (x) = 'int) ∧ (cddr (x) = nil) ∧ small-integerp (untag (x), i-word-size (i))))

∧ (i-objectp-type ('bitv, x, i)

= ((type (x) = 'bitv)

∧ (cddr (x) = nil) ∧ bit-vectorp (untag (x), i-word-size (i))))

∧ (i-objectp-type ('bool, x, i)

= ((type (x) = 'bool)

∧ (cddr (x) = nil) ∧ booleanp (untag (x))))

∧ (i-objectp-type ('addr, x, i)

= ((type (x) = 'addr)

∧ (cddr (x) = nil) ∧ adpp (untag (x), i-usr-data-segment (i))))

∧ (i-objectp-type ('pc, x, i)

= ((type (x) = 'pc)

∧ (cddr (x) = nil) ∧ icode-labelp (untag (x), i-prog-segment (i))))

∧ (i-objectp-type ('subr, x, i)

= ((type (x) = 'subr)

∧ (cddr (x) = nil) ∧ adpp (cons (untag (x), 0), i-prog-segment (i))))

∧ (i-objectp-type ('sys-addr, x, i)

= ((type (x) = 'sys-addr) ∧ (cddr (x) = nil) ∧ adpp (untag (x), i-sys-data-segment (i))))

∧ (i-objectp-type ('ipc, x, i)

= ((type (x) = 'ipc)

∧ (cddr (x) = nil) ∧ adpp (untag (x), i-prog-segment (i))))

Event: Disable i-objectp-type.

; I will disable type, tag and untag for sanity's sake,
; but prove the obvious relationships first.

Theorem: type-tag type (tag (x, y)) = x

Theorem: untag-tag untag (tag (x, y)) = y

Event: Disable type.

Event: Disable tag.

Event: Disable untag.

; And I will do a similar thing for the adp handlers

Theorem: adp-name-cons adp-name (cons (name, offset)) = name

Theorem: adp-offset-cons adp-offset (cons (name, offset)) = offset

Theorem: adp-name-add-adp adp-name (add-adp (adp, n)) = adp-name (adp)

Theorem: adp-offset-add-adp adp-offset (add-adp (adp, n)) = (adp-offset (adp) + n)

Theorem: adp-name-sub-adp adp-name (sub-adp (adp, n)) = adp-name (adp)

Theorem: adp-offset-sub-adp adp-offset (sub-adp (adp, n)) = (adp-offset (adp) − n)

Event: Disable sub-adp.

Event: Disable add-adp.

Event: Disable adp-name.

Event: Disable adp-offset.

; The function BOOLEANP is a killer because it
; causes everything to split.  I will disable it
; and prove what I need about it as necessary.

Event: Disable booleanp.

Event: Disable bool-to-logical.

; I am now going to partition the conjunctions of i-state-okp
; into two pots.  The first pot will put into the function
; defined below, i-state-types-okp, which will remain disabled.
; I will extract stuff from this hyp by back chaining when
; necessary.

Definition: i-state-types-okp (i) = (i-statep (i)

∧ (type (i-pc (i)) = 'ipc) ∧ (cddr (i-pc (i)) = nil) ∧ listp (untag (i-pc (i))) ∧ definedp (adp-name (untag (i-pc (i))), i-prog-segment (i)) ∧ (type (i-cfp (i)) = 'sys-addr) ∧ listp (untag (i-cfp (i))) ∧ (adp-name (untag (i-cfp (i))) = 'cstk) ∧ (cddr (i-cfp (i)) = nil) ∧ definedp ('cstk, i-sys-data-segment (i)) ∧ (type (i-csp (i)) = 'sys-addr) ∧ listp (untag (i-csp (i))) ∧ (adp-name (untag (i-csp (i))) = 'cstk) ∧ (cddr (i-csp (i)) = nil) ∧ (type (i-tsp (i)) = 'sys-addr) ∧ listp (untag (i-tsp (i))) ∧ (adp-name (untag (i-tsp (i))) = 'tstk) ∧ (cddr (i-tsp (i)) = nil) ∧ definedp ('tstk, i-sys-data-segment (i)) ∧ (type (i-c-flg (i)) = 'bool) ∧ (cddr (i-c-flg (i)) = nil) ∧ booleanp (untag (i-c-flg (i))) ∧ (type (i-v-flg (i)) = 'bool) ∧ (cddr (i-v-flg (i)) = nil) ∧ booleanp (untag (i-v-flg (i))) ∧ (type (i-n-flg (i)) = 'bool) ∧ (cddr (i-n-flg (i)) = nil) ∧ booleanp (untag (i-n-flg (i))) ∧ (type (i-z-flg (i)) = 'bool) ∧ (cddr (i-z-flg (i)) = nil) ∧ booleanp (untag (i-z-flg (i))))

; The second pot will be introduced explicitly into any clause
; containing i-state-okp.  These hyps will all be useful to
; linear and I don't want to hide them.
; Here is the lemma that does the restructuring.

Theorem: i-state-okp-restructuring i-state-okp (i, load-addr) = (i-state-types-okp (i)

∧ (adp-offset (untag (i-pc (i))) ∈ N) ∧ (adp-offset (untag (i-pc (i)))

< length (cdr (assoc (adp-name (untag (i-pc (i))),

i-prog-segment (i)))))

∧ (adp-offset (untag (i-cfp (i))) ∈ N) ∧ (adp-offset (untag (i-cfp (i)))

< length (cdr (assoc ('cstk, i-sys-data-segment (i))))) ∧ (adp-offset (untag (i-csp (i))) ∈ N) ∧ (adp-offset (untag (i-csp (i)))

< length (cdr (assoc ('cstk, i-sys-data-segment (i))))) ∧ (adp-offset (untag (i-tsp (i))) ∈ N) ∧ (adp-offset (untag (i-tsp (i)))

< length (cdr (assoc ('tstk, i-sys-data-segment (i))))) ∧ ((load-addr

+ segment-length (i-prog-segment (i)) + segment-length (i-usr-data-segment (i)) + segment-length (i-sys-data-segment (i))) < exp (2, i-word-size (i))))

Event: Disable i-state-okp.

; And here is the lemma that lets me back chain into i-state-types-okp.

Theorem: i-state-types-okp-properties i-state-types-okp (i) → (i-statep (i)

∧ (type (i-pc (i)) = 'ipc) ∧ (cddr (i-pc (i)) = nil) ∧ (listp (untag (i-pc (i))) = t) ∧ definedp (adp-name (untag (i-pc (i))), i-prog-segment (i)) ∧ (type (i-cfp (i)) = 'sys-addr) ∧ (listp (untag (i-cfp (i))) = t) ∧ (adp-name (untag (i-cfp (i))) = 'cstk) ∧ (cddr (i-cfp (i)) = nil) ∧ definedp ('cstk, i-sys-data-segment (i)) ∧ (type (i-csp (i)) = 'sys-addr) ∧ (listp (untag (i-csp (i))) = t) ∧ (adp-name (untag (i-csp (i))) = 'cstk) ∧ (cddr (i-csp (i)) = nil) ∧ (type (i-tsp (i)) = 'sys-addr) ∧ (listp (untag (i-tsp (i))) = t) ∧ (adp-name (untag (i-tsp (i))) = 'tstk) ∧ (cddr (i-tsp (i)) = nil)

∧ definedp ('tstk, i-sys-data-segment (i)) ∧ (type (i-c-flg (i)) = 'bool) ∧ (cddr (i-c-flg (i)) = nil) ∧ booleanp (untag (i-c-flg (i))) ∧ (type (i-v-flg (i)) = 'bool) ∧ (cddr (i-v-flg (i)) = nil) ∧ booleanp (untag (i-v-flg (i))) ∧ (type (i-n-flg (i)) = 'bool) ∧ (cddr (i-n-flg (i)) = nil) ∧ booleanp (untag (i-n-flg (i))) ∧ (type (i-z-flg (i)) = 'bool) ∧ (cddr (i-z-flg (i)) = nil) ∧ booleanp (untag (i-z-flg (i))))

Event: Disable i-state-types-okp.

; Some accellerators for psw handling...

Theorem: not-equal-x-y-error-msg-run x-y-error-msg (x, y) ≠ 'run

Event: Disable x-y-error-msg.

Theorem: i-psw-i-halt i-psw (i-halt (i, psw)) = psw

Event: Disable i-halt.

; Disabling some messy functions.
; I will disable a bunch of functions that cause large case
; splits.  These functions will have to be explicitly enabled
; to do proofs about their values.

Theorem: link-instr-word-expander link-instr-word (cons (opcode, nil), word-size) = mci (cadr (assoc (opcode, link-instruction-alist)), word-size)

Event: Disable link-instr-word.

Theorem: link-data-word-expander litatom (type (x)) → (link-data-word (x, link-tables, word-size)

= case on type (x): case = nat then nat-to-v (untag (x), word-size) case = int then int-to-v (untag (x), word-size) case = bitv then bitv-to-v (untag (x), word-size) case = bool then bool-to-v (untag (x), word-size) case = addr then addr-to-v (untag (x),

usr-data-links (link-tables), word-size)

case = subr then subr-to-v (untag (x), prog-links (link-tables), word-size) case = sys-addr then sys-addr-to-v (untag (x),

sys-data-links (link-tables), word-size)

case = pc then label-to-v (untag (x),

prog-label-tables (link-tables), word-size)

case = ipc then ipc-to-v (untag (x), prog-links (link-tables), word-size) otherwise nat-to-v (0, word-size) endcase)

Theorem: size-incr length (incr (c, a)) = length (a)

Theorem: size-compl length (v-not (a)) = length (a)

Theorem: size-bitv-to-v length (bitv-to-v (a, word-size)) = fix (word-size)

Theorem: size-link-data-word length (link-data-word (x, link-tables, word-size)) = fix (word-size)

Event: Disable link-data-word.

Event: Disable *1*exp.

Theorem: size-link-instr-word length (link-instr-word (ins, word-size)) = fix (word-size)

Theorem: size-link-word length (link-word (x, link-tables, word-size)) = fix (word-size)

Theorem: link-word-expander (icode-instructionp (x) → (link-word (x, link-tables, word-size) = link-instr-word (x, word-size))) ∧ ((¬ icode-instructionp (x))

→ (link-word (x, link-tables, word-size) = link-data-word (x, link-tables, word-size)))

Event: Disable link-word.

; I am going to keep the i-link-tables function turned off and
; enable it as needed.  It expands into something I don't like
; reading.  Instead I'll prove the rewrite rules that let the
; four accessors work on it.

Theorem: prog-links-i-link-tables prog-links (i-link-tables (i, load-addr)) = link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i)))

Theorem: prog-label-tables-i-link-tables prog-label-tables (i-link-tables (i, load-addr)) = link-table-for-prog-labels (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i)))

Theorem: usr-data-links-i-link-tables usr-data-links (i-link-tables (i, load-addr)) = link-table-for-segment (i-usr-data-segment (i), load-addr)

Theorem: sys-data-links-i-link-tables sys-data-links (i-link-tables (i, load-addr)) = link-table-for-segment (i-sys-data-segment (i),

load-addr

+ segment-length (i-prog-segment (i)) + segment-length (i-usr-data-segment (i)))

Event: Disable i-link-tables.

Event: Disable prog-links.

Event: Disable prog-label-tables.

Event: Disable usr-data-links.

Event: Disable sys-data-links.

; Goal:  The fundamental theorems about Link Tables

Theorem: assoc-append assoc (x, append (alist1 , alist2 )) = if definedp (x, alist1 ) then assoc (x, alist1 )

else assoc (x, alist2 ) endif

Theorem: get-append-1 (n < length (a)) → (get (n, append (a, b)) = get (n, a))

Theorem: get-append-2 (n = length (a)) → (get (n + k, append (a, b)) = get (k, b))

; Because we have swapped the positions of the data and prog
; segments we have to add the following version of get-append-2.
; Unknownst to me, the original proof exploited the fact that
; "i-prog-segment" comes lexicographically before "i-usr-data-segment"
; so that when the segment-lengths of those two are commuted into
; order the order agreed with that used by link-mem, namely,
; the prog-segment comes first.

Theorem: get-append-3 ((n1 = length (a1 )) ∧ (n2 = length (a2 ))) → (get (n2 + n1 + k, append (a1 , append (a2 , b))) = get (k, b))

Theorem: length-link-area-is-length length (link-area (lst, table, word-size)) = length (lst)

Event: Enable associativity-of-append.

Theorem: get-link-area (n < length (area)) → (get (n, link-area (area, table, word-size))

= link-word (unlabel (get (n, area)), table, word-size))

Definition: link-table-entry (name, segment) = if segment ≃ nil then 0

elseif name = caar (segment) then 0 else length (cdar (segment))

+ link-table-entry (name, cdr (segment)) endif

Definition: label-table-entry (lab, segment) = find-label (lab, cdr (assoc (car (lab), segment)))

Theorem: assoc-link-table-for-segment (definedp (name, segment) ∧ (addr0 ∈ N)) → (cdr (assoc (name, link-table-for-segment (segment, addr0 )))

= (addr0 + link-table-entry (name, segment)))

Theorem: lessp-absolute-address-segment-length-generalized (definedp (name, segment) ∧ (offset < length (cdr (assoc (name, segment))))) → ((link-table-entry (name, segment) + offset)

< segment-length (segment))

;  In anticipation of the various uses of this fact, we prove four
;  instances...

Theorem: lessp-absolute-address-segment-length-adp-name (definedp (adp-name (adp), segment) ∧ (adp-offset (adp) < length (cdr (assoc (adp-name (adp), segment))))) → ((link-table-entry (adp-name (adp), segment) + adp-offset (adp))

< segment-length (segment))

Theorem: lessp-absolute-address-segment-length-cfp (definedp ('cstk, i-sys-data-segment (i)) ∧ (adp-offset (untag (i-cfp (i)))

< length (cdr (assoc ('cstk, i-sys-data-segment (i)))))) → ((link-table-entry ('cstk, i-sys-data-segment (i))

+ adp-offset (untag (i-cfp (i))))

< segment-length (i-sys-data-segment (i)))

Theorem: lessp-absolute-address-segment-length-csp (definedp ('cstk, i-sys-data-segment (i)) ∧ (adp-offset (untag (i-csp (i)))

< length (cdr (assoc ('cstk, i-sys-data-segment (i)))))) → ((link-table-entry ('cstk, i-sys-data-segment (i))

+ adp-offset (untag (i-csp (i))))

< segment-length (i-sys-data-segment (i)))

Theorem: lessp-absolute-address-segment-length-tsp (definedp ('tstk, i-sys-data-segment (i)) ∧ (adp-offset (untag (i-tsp (i)))

< length (cdr (assoc ('tstk, i-sys-data-segment (i)))))) → ((link-table-entry ('tstk, i-sys-data-segment (i))

+ adp-offset (untag (i-tsp (i))))

< segment-length (i-sys-data-segment (i)))

Event: Enable length-append.

Theorem: length-link-segment-is-segment-length length (link-segment (segment, table, word-size)) = segment-length (segment)

Event: Disable commutativity-of-plus.

Theorem: get-link-table-entry-link-segment (definedp (adp-name (adp), segment) ∧ (adp-offset (adp) < length (cdr (assoc (adp-name (adp), segment))))) → (get (link-table-entry (adp-name (adp), segment) + adp-offset (adp),

link-segment (segment, table, word-size)) = link-word (unlabel (get (adp-offset (adp),

cdr (assoc (adp-name (adp), segment)))),

table,

word-size))

; The above lemma states the fundamental relationship between
; linking and fetching.
; At this point we have enough machinery to reduce any legal
; current-instruction fetch at the m level to a link-word of the
; i level.
; We can speed things up in the subsequent proofs if we package
; this knowledge up.  We do it by proving a fact about
; current-instruction.  We still need the foregoing machinery for
; those occasions when the m machine fetches data from program memory.
; But after this we will disable current-instruction and at least
; short circuit all this for the top level fetch for each instruction.

; We first make it possible to get and put past the boot-code in
; linked memory.  By doing it this way (proving length-boot-code to introduce
; fix and this disabling it when we are done) we prevent all future
; splits on whether load-addr is numeric.

Theorem: length-boot-code length (boot-code (lst, n, word-size)) = fix (n)

Theorem: get-past-boot-code get (load-addr + n, append (boot-code (boot-lst, load-addr, word-size), a)) = get (n, a)

; When the address in question has been incremented or decremented,
; as happens when it is a stack pointer, we need:

Theorem: get-past-boot-code-add1 get (1 + (load-addr + n), append (boot-code (boot-lst, load-addr, word-size), a)) = get (1 + n, a)

Theorem: get-past-boot-code-sub1 (n ≄ 0) → (get ((load-addr + n) − 1,

append (boot-code (boot-lst, load-addr, word-size), a)) = get (n − 1, a))

Theorem: put-past-boot-code put (val, load-addr + n, append (boot-code (boot-lst, load-addr, word-size), a)) = append (boot-code (boot-lst, load-addr, word-size), put (val, n, a))

Theorem: put-past-boot-code-add1 put (val,

1 + (load-addr + n),

append (boot-code (boot-lst, load-addr, word-size), a)) = append (boot-code (boot-lst, load-addr, word-size), put (val, 1 + n, a))

Theorem: put-past-boot-code-sub1 (n ≄ 0) → (put (val,

(load-addr + n) − 1,

append (boot-code (boot-lst, load-addr, word-size), a)) = append (boot-code (boot-lst, load-addr, word-size),

put (val, n − 1, a)))

Theorem: length-boot-code-linear (load-addr ≮ length (boot-code (boot-lst, load-addr, word-size))) ∧ (length (boot-code (boot-lst, load-addr, word-size)) ≮ load-addr)

Event: Disable length-boot-code.

Theorem: current-instruction-i->m (i-state-types-okp (i) ∧ (adp-offset (untag (i-pc (i))) ∈ N) ∧ (adp-offset (untag (i-pc (i)))

< length (cdr (assoc (adp-name (untag (i-pc (i))), i-prog-segment (i))))) ∧ ((load-addr

+ segment-length (i-prog-segment (i)) + segment-length (i-usr-data-segment (i)) + segment-length (i-sys-data-segment (i))) < exp (2, 32))

∧ (i-word-size (i) = 32)) → (current-instruction (list (r0 ,

r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , nat-to-v (load-addr

+ segment-length (i-usr-data-segment (i)) + link-table-entry (adp-name (untag (i-pc (i))),

i-prog-segment (i))

+ adp-offset (untag (i-pc (i))),

32)),

append (boot-code (boot-lst, load-addr, 32),

append (link-segment (i-usr-data-segment (i),

i-link-tables (i,

load-addr),

                      32),

append (link-segment (i-prog-segment (i),

i-link-tables (i,

load-addr),

                             32),

data-mem))))

= link-word (unlabel (fetch (i-pc (i), i-prog-segment (i))), i-link-tables (i, load-addr), Event: Disable current-instruction.

; The following section of this file documents about a half-day's
; work.
; I am headed for a simple theorem, namely that the i-psw of
; i-ins-step is 'run.  This follows immediately by opening up
; the -step fn for each i-level opcode and observing that the
; i-psw in each is 'run.  But there is much case analysis.
; To help out, I will disable -- in fact, hands-off -- every
; function used by any of the -step fns.  In addition, I provide
; the following accelerators:

Theorem: equal-i-psw-if-1 (i-psw (if t1 then b1

else b2 endif)

 = 'run)

= if t1 then i-psw (b1 ) = 'run else i-psw (b2 ) = 'run endif

Theorem: equal-i-psw-if-2 (i-psw (if t1 then b1

elseif t2 then b2 else b3 endif)

 = 'run)

= if t1 then i-psw (b1 ) = 'run elseif t2 then i-psw (b2 ) = 'run else i-psw (b3 ) = 'run endif

Theorem: equal-i-psw-i-ins-step-run i-psw (i-ins-step (ins, i, load-addr)) = 'run

; Note: The hint above was mechanically generated; it is the list of
; all function symbols occurring in the body of any i-xxx-step fn, minus
; i-psw.  We clearly do not wish to keep hands off of (i-psw (i-state ...)).
; During the morning I have proved this theorem many times.  Here are
; some observations.  I don't remember what happens if you try it without
; any preparation, but either it explodes into many cases or it gets
; stack overflow.  I first included just a (hands-off i-state) under
; the mistaken belief that it would prevent all the (i-state ...)'s from

; being rewritten.  But it does not prevent the args to the i-state being
; rewritten so I disabled all the fns listed above.  However, that still
; permitted rewrite rules to be applied to them and so I did a hands-off
; on them instead.
; More interesting is the use of the two lemmas, equal-i-psw-if-1 and -2.
; The first I call the "single stripper" and the second the "double stripper."
; With just the single stripper around you get a stack overflow.  That is
; because rewrite recurses several times for every application of the
; lemma and there are so many opcodes.  My first attempt to solve this
; was to prove a backchaining version of the single stripper.  It said
; "if the psw of b and c are both 'run then the psw of (if a b c) is too."
; That causes fewer recursions in the rewriter and permitted the proof
; to go through, but cost 8538 seconds!
; Then I hit upon the idea of the double stripper, which cuts in half the
; number of applications -- and this recursions -- necessary.  If the
; double stripper is available but the single stripper is not, the
; proof goes through but generates 30 cases and takes 354 seconds.
; Analysis of this showed that the problem is that some of our -step
; fns generate terms of the form (if & (i-state ...) (i-state ...)) and
; the double stripper could not be applied to these.  They get elevated
; to explicit cases.
; If both strippers are present, the proof goes through without any
; visible cases and takes 46 seconds.
; End of aside.
; In the one-way correspondence theorems I have the hypothesis
; that (i-step i load-addr) does not produce an error and then I make a
; statement about (i->m (i-step i load-addr) boot-lst load-addr).  The two occurrences of
; i-step bother me and the following theorem lets me replace the
; first with a conjunction of predicates.

Theorem: i-psw-i-step-run (i-psw (i-step (i, load-addr)) = 'run) = ((i-psw (i) = 'run)

∧ i-state-okp (i, load-addr)

∧ i-ins-okp (i-current-instruction (i), i))

Theorem: i-link-tables-i-state ((link-table-for-segment (i-usr-data-segment, load-addr) = link-table-for-segment (i-usr-data-segment (i), load-addr)) ∧ (segment-length (i-usr-data-segment)

= segment-length (i-usr-data-segment (i))) ∧ (link-table-for-segment (i-sys-data-segment,

load-addr

+ segment-length (i-prog-segment (i))

+ segment-length (i-usr-data-segment (i)))

= link-table-for-segment (i-sys-data-segment (i), load-addr + segment-length (i-prog-segment (i)) + segment-length (i-usr-data-segment (i)))))

→ (i-link-tables (i-state (pc, cfp, csp, tsp, x, y, c-flg, v-flg, n-flg, z-flg, i-prog-segment (i), i-usr-data-segment, i-sys-data-segment, word-size, psw),

load-addr)

= i-link-tables (i, load-addr))

; Now I will embark on the proofs of each of one-way correspondence
; step theorems, starting with what I think is the simplest: the
; no-op case.

Event: Enable plus-add1.

Theorem: get-add1-cons get (1 + n, cons (x, y)) = get (n, y)

Theorem: get-0-cons get (0, cons (x, y)) = x

Event: Enable length-cons.

Theorem: length-reg-file length (list (r0 , r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , r15 )) = 16

Theorem: put-add1-cons put (val, 1 + n, cons (x, y)) = cons (x, put (val, n, y))

Theorem: put-zero-cons put (val, 0, cons (x, y)) = cons (val, y)

Theorem: boolp-bool-to-logical boolp (bool-to-logical (b))

Theorem: i-state-types-okp-property2 i-state-types-okp (i) → ((¬ icode-instructionp (i-pc (i)))

∧ (¬ icode-instructionp (i-cfp (i))) ∧ (¬ icode-instructionp (i-csp (i))) ∧ (¬ icode-instructionp (i-tsp (i))) ∧ (¬ icode-instructionp (i-c-flg (i))) ∧ (¬ icode-instructionp (i-v-flg (i))) ∧ (¬ icode-instructionp (i-n-flg (i))) ∧ (¬ icode-instructionp (i-z-flg (i))))

Theorem: not-icode-instructionp-tag ¬ icode-instructionp (tag (type, obj ))

Event: Disable icode-instructionp.

Theorem: length-put (n < length (lst)) → (length (put (v, n, lst)) = length (lst))

Theorem: nat-to-v-equivalence ((n ∈ N) ∧ (m ∈ N) ∧ (n < exp (2, word-size)) ∧ (m < exp (2, word-size))) → ((nat-to-v (n, word-size) = nat-to-v (m, word-size)) = (n = m))

; --- Here I take time out in my development to define a few
; functions used to make slides for my Piton talk.

Definition: list-of-bvs (lst) = if lst ≃ nil then nil

else cons (nat-to-v (car (lst), 32), list-of-bvs (cdr (lst))) endif Definition: n->m (n) = m-state (list-of-bvs (car (n)),

cadr (n), caddr (n), cadddr (n), caddddr (n), list-of-bvs (cadddddr (n)))

Definition: m->n (m) = list (list-of-nats (m-regs (m)),

m-c-flg (m), m-v-flg (m), m-n-flg (m), m-z-flg (m), list-of-nats (m-mem (m)))

Definition: n-step (n) = m->n (m-step (n->m (n)))

; --- end of aside
; Recall

;(prove-lemma get-link-table-entry-link-segment (rewrite)
;  (implies (and (definedp (adp-name adp) segment)
;               (lessp (adp-offset adp)
;                      (length (cdr (assoc (adp-name adp) segment)))))
;          (equal (get (plus (link-table-entry (adp-name adp) segment)
;                            (adp-offset adp))
;                      (link-segment segment table word-size))
;                 (link-word
;                   (unlabel
;                     (get (adp-offset adp)
;                          (cdr (assoc (adp-name adp) segment))))
;                   table
;                   word-size))))
;
; from above.  Analogous lemmas for the data segment and the
; stack segment are needed.  In addition, we need to be able to handle
; the arithmetically equivalent cases that arise from opening plus
; or incrementing and decrementing addresses.  We'll do that first

; and then turn to the other segments and the add1/sub1 cases for them.

Theorem: plus-zerop (y ∉ N) → ((x + y) = fix (x))

Theorem: get-link-table-entry-link-segment-add1 (definedp (adp-name (adp), segment) ∧ ((1 + adp-offset (adp)) < length (cdr (assoc (adp-name (adp), segment))))) → (get (1 + (link-table-entry (adp-name (adp), segment) + adp-offset (adp)),

link-segment (segment, table, word-size)) = link-word (unlabel (get (1 + adp-offset (adp),

cdr (assoc (adp-name (adp), segment)))),

table,

word-size))

Theorem: plus-sub1 (y ≄ 0) → ((x + (y − 1)) = ((x + y) − 1))

;  The above lemma causes infinite looping if plus opens and commutes.
;  So I'll disable it asap.

Theorem: get-link-table-entry-link-segment-sub1 (definedp (adp-name (adp), segment) ∧ ((adp-offset (adp) − 1) ≄ 0) ∧ (adp-offset (adp) < length (cdr (assoc (adp-name (adp), segment))))) → (get ((link-table-entry (adp-name (adp), segment) + adp-offset (adp)) − 1,

link-segment (segment, table, word-size)) = link-word (unlabel (get (adp-offset (adp) − 1,

cdr (assoc (adp-name (adp), segment)))),

table,

word-size))

Event: Disable plus-sub1.

; Before we work on the two data segments we do some
; similar trivial arithmetic for the add1/sub1 cases of
; the previously proved:
;
;(prove-lemma lessp-absolute-address-segment-length-adp-name (rewrite)
;  (implies (and (definedp (adp-name adp) segment)
;               (lessp (adp-offset adp)
;                      (length (cdr (assoc (adp-name adp) segment)))))

;          (lessp (plus (link-table-entry (adp-name adp) segment)
;                       (adp-offset adp))
;                 (segment-length segment)))
;  ((use (lessp-absolute-address-segment-length-generalized
;         (name (adp-name adp))
;         (offset (adp-offset adp))))))
;

Theorem: lessp-absolute-address-segment-length-adp-name-add1 (definedp (adp-name (adp), segment) ∧ (adp-offset (adp) < (length (cdr (assoc (adp-name (adp), segment))) − 1))) → ((1 + (link-table-entry (adp-name (adp), segment) + adp-offset (adp)))

< segment-length (segment))

;  We will undoubtedly need related facts about 'cstk and 'tsk, similar
; to lessp-absolute-address-segment-length-cfp, etc., above.  But I
; don't know the exact form we'll need so I'll wait...  Here however
; are the related lemmas in their pure form

;(prove-lemma  (rewrite)
;  (implies (and (definedp 'cstk (i-sys-data-segment i))
;               (lessp (adp-offset (untag (i-cfp i)))
;                      (length (cdr (assoc 'cstk
;                                          (i-sys-data-segment i))))))
;          (lessp (plus (link-table-entry 'cstk
;                                         (i-sys-data-segment i))
;                       (adp-offset (untag (i-cfp i))))
;                 (segment-length (i-sys-data-segment i))))
;  ((use (lessp-absolute-address-segment-length-generalized
;         (name 'cstk)
;         (offset (adp-offset (untag (i-cfp i))))
;         (segment (i-sys-data-segment i))))))
;
;(prove-lemma lessp-absolute-address-segment-length-csp (rewrite)
;  (implies (and (definedp 'cstk (i-sys-data-segment i))
;               (lessp (adp-offset (untag (i-csp i)))
;                      (length (cdr (assoc 'cstk
;                                          (i-sys-data-segment i))))))
;          (lessp (plus (link-table-entry 'cstk
;                                         (i-sys-data-segment i))

;                       (adp-offset (untag (i-csp i))))
;                 (segment-length (i-sys-data-segment i))))
;  ((use (lessp-absolute-address-segment-length-generalized
;         (name 'cstk)
;         (offset (adp-offset (untag (i-csp i))))
;         (segment (i-sys-data-segment i))))))
;
;(prove-lemma lessp-absolute-address-segment-length-tsp (rewrite)
;  (implies (and (definedp 'tstk (i-sys-data-segment i))
;               (lessp (adp-offset (untag (i-tsp i)))
;                      (length (cdr (assoc 'tstk
;                                          (i-sys-data-segment i))))))
;          (lessp (plus (link-table-entry 'tstk
;                                         (i-sys-data-segment i))
;                       (adp-offset (untag (i-tsp i))))
;                 (segment-length (i-sys-data-segment i))))
;  ((use (lessp-absolute-address-segment-length-generalized
;         (name 'tstk)
;         (offset (adp-offset (untag (i-tsp i))))
;         (segment (i-sys-data-segment i))))))

; The previously proved:
;
;(prove-lemma get-append-2 (rewrite)
;  (implies (equal n (length a))
;          (equal (get (plus n k) (append a b))
;                 (get k b))))
;
; also needs to be expanded to the add1/sub1 cases:

Theorem: get-append-2-add1 (n = length (a)) → (get (1 + (n + k), append (a, b)) = get (1 + k, b))

Theorem: get-append-2-sub1 ((n = length (a)) ∧ (k ≄ 0)) → (get ((n + k) − 1, append (a, b)) = get (k − 1, b))

Theorem: get-append-3-add1 ((n1 = length (a1 )) ∧ (n2 = length (a2 )))

→ (get (1 + (n2 + n1 + k), append (a1 , append (a2 , b))) = get (1 + k, b))

Theorem: get-append-3-sub1 ((n1 = length (a1 )) ∧ (n2 = length (a2 )) ∧ (k ≄ 0)) → (get ((n2 + n1 + k) − 1, append (a1 , append (a2 , b))) = get (k − 1, b))

; Now it turns out we never increment or decrement addresses into the
; usr-data segment.  So we don't need lemmas for that.  But we do both
; operations on sys-data addresses when pushing and popping.  There
; is no difference between the usr-data and the sys-data accessing
; but it will turn out that we know that (adp-name (untag (i-csp i)))
; is 'cstk so we have to phrase the lemma explicitly for 'cstk and another
; one for tstk.
; Now for the sys-data segment, we just use the result above,
; but acknowledge that (adp-name adp) will be either 'cstk or 'tstk
; in all of our uses...

Theorem: get-link-table-entry-link-segment-cstk (definedp ('cstk, segment) ∧ (adp-offset (adp) < length (cdr (assoc ('cstk, segment))))) → (get (link-table-entry ('cstk, segment) + adp-offset (adp),

link-segment (segment, table, word-size)) = link-word (unlabel (get (adp-offset (adp),

cdr (assoc ('cstk, segment)))),

table,

word-size))

Theorem: get-link-table-entry-link-segment-tstk (definedp ('tstk, segment) ∧ (adp-offset (adp) < length (cdr (assoc ('tstk, segment))))) → (get (link-table-entry ('tstk, segment) + adp-offset (adp),

link-segment (segment, table, word-size)) = link-word (unlabel (get (adp-offset (adp),

cdr (assoc ('tstk, segment)))),

table,

word-size))

; and now, for both cstk and tstk, we get the pushed and popped
; versions.

Theorem: get-link-table-entry-link-segment-cstk-add1 (definedp ('cstk, segment)

∧ (adp-offset (adp) < (length (cdr (assoc ('cstk, segment))) − 1))) → (get (1 + (link-table-entry ('cstk, segment) + adp-offset (adp)),

link-segment (segment, table, word-size)) = link-word (unlabel (get (1 + adp-offset (adp),

cdr (assoc ('cstk, segment)))),

table,

word-size))

Theorem: get-link-table-entry-link-segment-cstk-sub1 (definedp ('cstk, segment) ∧ (adp-offset (adp) ≄ 0) ∧ (adp-offset (adp) < length (cdr (assoc ('cstk, segment))))) → (get ((link-table-entry ('cstk, segment) + adp-offset (adp)) − 1,

link-segment (segment, table, word-size)) = link-word (unlabel (get (adp-offset (adp) − 1,

cdr (assoc ('cstk, segment)))),

table,

word-size))

Theorem: get-link-table-entry-link-segment-tstk-add1 (definedp ('tstk, segment) ∧ (adp-offset (adp) < (length (cdr (assoc ('tstk, segment))) − 1))) → (get (1 + (link-table-entry ('tstk, segment) + adp-offset (adp)),

link-segment (segment, table, word-size)) = link-word (unlabel (get (1 + adp-offset (adp),

cdr (assoc ('tstk, segment)))),

table,

word-size))

Theorem: get-link-table-entry-link-segment-tstk-sub1 (definedp ('tstk, segment) ∧ (adp-offset (adp) ≄ 0) ∧ (adp-offset (adp) < length (cdr (assoc ('tstk, segment))))) → (get ((link-table-entry ('tstk, segment) + adp-offset (adp)) − 1,

link-segment (segment, table, word-size)) = link-word (unlabel (get (adp-offset (adp) − 1,

cdr (assoc ('tstk, segment)))),

table,

word-size))

; We now need for put all of the stuff we have developed for get...

Theorem: put-append-1 (n < length (a)) → (put (val, n, append (a, b)) = append (put (val, n, a), b))

Theorem: put-append-2 (n = length (a)) → (put (val, n + k, append (a, b)) = append (a, put (val, k, b)))

Theorem: put-append-3 ((n1 = length (a1 )) ∧ (n2 = length (a2 ))) → (put (val, n2 + n1 + k, append (a1 , append (a2 , b)))

= append (a1 , append (a2 , put (val, k, b))))

Theorem: put-append-2-add1 (n = length (a)) → (put (val, 1 + (n + k), append (a, b)) = append (a, put (val, 1 + k, b)))

Theorem: put-append-2-sub1 ((n = length (a)) ∧ (k ≄ 0)) → (put (val, (n + k) − 1, append (a, b)) = append (a, put (val, k − 1, b)))

Theorem: put-append-3-add1 ((n1 = length (a1 )) ∧ (n2 = length (a2 ))) → (put (val, 1 + (n2 + n1 + k), append (a1 , append (a2 , b)))

= append (a1 , append (a2 , put (val, 1 + k, b))))

Theorem: put-append-3-sub1 ((n1 = length (a1 )) ∧ (n2 = length (a2 )) ∧ (k ≄ 0)) → (put (val, (n2 + n1 + k) − 1, append (a1 , append (a2 , b)))

= append (a1 , append (a2 , put (val, k − 1, b))))

Theorem: put-link-area (n < length (lst)) → (link-area (put (val, n, lst), tables, word-size)

= put (link-word (unlabel (val), tables, word-size), n, link-area (lst, tables, word-size)))

; Now we do for put and link-segment what we did for get and link-segment:

Theorem: put-link-segment (definedp (adp-name (adp), segment) ∧ (adp-offset (adp) < length (cdr (assoc (adp-name (adp), segment))))) → (link-segment (put-assoc (put (val,

adp-offset (adp),

cdr (assoc (adp-name (adp), segment))), adp-name (adp), segment), tables, word-size)

= put (link-word (unlabel (val), tables, word-size), link-table-entry (adp-name (adp), segment) + adp-offset (adp), link-segment (segment, tables, word-size)))

; And now we prove the cstk and tstk versions of the above, with
; the add1/sub1 variants.  These six lemmas, all just variations on
; the basic one above, should explain all of our deposits into the
; cstk and tstk areas.

Theorem: put-link-segment-cstk (definedp ('cstk, segment) ∧ (stk-ptr ∈ N) ∧ (stk-ptr < length (cdr (assoc ('cstk, segment))))) → (link-segment (put-assoc (put (val, stk-ptr, cdr (assoc ('cstk, segment))),

             'cstk,

segment),

tables, word-size)

= put (link-word (unlabel (val), tables, word-size), link-table-entry ('cstk, segment) + stk-ptr, link-segment (segment, tables, word-size)))

Theorem: put-link-segment-tstk (definedp ('tstk, segment) ∧ (stk-ptr ∈ N) ∧ (stk-ptr < length (cdr (assoc ('tstk, segment))))) → (link-segment (put-assoc (put (val, stk-ptr, cdr (assoc ('tstk, segment))),

             'tstk,

segment),

tables, word-size)

= put (link-word (unlabel (val), tables, word-size), link-table-entry ('tstk, segment) + stk-ptr, link-segment (segment, tables, word-size)))

Theorem: put-link-segment-cstk-add1 (definedp ('cstk, segment) ∧ ((1 + stk-ptr) < length (cdr (assoc ('cstk, segment))))) → (link-segment (put-assoc (put (val,

1 + stk-ptr,

cdr (assoc ('cstk, segment))),

'cstk,

segment),

tables, word-size)

= put (link-word (unlabel (val), tables, word-size), 1 + (link-table-entry ('cstk, segment) + stk-ptr), link-segment (segment, tables, word-size)))

Theorem: put-link-segment-cstk-sub1 (definedp ('cstk, segment) ∧ (stk-ptr ≄ 0) ∧ (stk-ptr < length (cdr (assoc ('cstk, segment))))) → (link-segment (put-assoc (put (val,

stk-ptr − 1,

cdr (assoc ('cstk, segment))),

'cstk,

segment),

tables, word-size)

= put (link-word (unlabel (val), tables, word-size), (link-table-entry ('cstk, segment) + stk-ptr) − 1, link-segment (segment, tables, word-size)))

Theorem: put-link-segment-tstk-add1 (definedp ('tstk, segment) ∧ ((1 + stk-ptr) < length (cdr (assoc ('tstk, segment))))) → (link-segment (put-assoc (put (val,

1 + stk-ptr,

cdr (assoc ('tstk, segment))),

'tstk,

segment),

tables, word-size)

= put (link-word (unlabel (val), tables, word-size), 1 + (link-table-entry ('tstk, segment) + stk-ptr), link-segment (segment, tables, word-size)))

Theorem: put-link-segment-tstk-sub1 (definedp ('tstk, segment) ∧ (stk-ptr ≄ 0) ∧ (stk-ptr < length (cdr (assoc ('tstk, segment))))) → (link-segment (put-assoc (put (val,

stk-ptr − 1,

cdr (assoc ('tstk, segment))),

'tstk,

segment),

tables, word-size)

= put (link-word (unlabel (val), tables, word-size), (link-table-entry ('tstk, segment) + stk-ptr) − 1, link-segment (segment, tables, word-size)))

Theorem: definedp-put-assoc definedp (name, put-assoc (val, name2 , segment)) = definedp (name, segment)

Theorem: link-table-entry-put-assoc (length (val) = length (cdr (assoc (name2 , segment)))) → (link-table-entry (name, put-assoc (val, name2 , segment))

= link-table-entry (name, segment))

Theorem: link-table-for-segment-put-assoc (length (val) = length (cdr (assoc (name2 , segment)))) → (link-table-for-segment (put-assoc (val, name2 , segment), addr)

= link-table-for-segment (segment, addr))

Theorem: equal-append (append (a, b) = append (a, c)) = (b = c)

; We also need...

Event: Disable i-objectp.

Theorem: unlabel-i-objectp i-objectp (x, i) → (unlabel (x) = x)

Theorem: unlabel-tagged-object (type (x) ≠ 'dl) → (unlabel (x) = x)

Theorem: link-area-put-unlabel i-objectp (unlabel (val), i) → (link-area (put (unlabel (val), n, lst), tables, word-size)

= link-area (put (val, n, lst), tables, word-size))

Theorem: link-segment-put-unlabel i-objectp (unlabel (val), i) → (link-segment (put-assoc (put (unlabel (val),

offset,

cdr (assoc (name, segment))), name, segment),

tables, word-size) = link-segment (put-assoc (put (val,

offset,

cdr (assoc (name, segment))), name, segment),

tables, word-size))

Theorem: difference-1 (x − 1) = (x − 1)

Event: Disable int-to-v.

Theorem: tc-add-is-iplus tc-add (x, y) = iplus (x, y)

Event: Disable add.

Theorem: tc-in-rangep-is-small-integerp (integerp (x) ∧ (word-size ≄ 0)) → (tc-in-rangep (x, word-size) = small-integerp (x, word-size))

Event: Disable tc-in-rangep.

Event: Enable integerp-iplus.

Theorem: small-integerp-implies-integerp small-integerp (x, word-size) → integerp (x)

Theorem: bitn-of-positive-is-f (i < exp (2, word-size − 1)) → (bitn (nat-to-v (i, word-size), word-size) = f)

Theorem: lessp-exp-sub1-exp (word-size ≄ 0) → (exp (2, word-size − 1) < exp (2, word-size))

Theorem: incr-f bvp (b) → (incr (f, b) = b)

Theorem: compl-compl bvp (b) → (v-not (v-not (b)) = b)

Theorem: v-to-int-inverts-int-to-v-lemma1 ((x ∈ N) ∧ (x ≠ 0) ∧ (exp (2, word-size − 1) ≮ x) ∧ (word-size ≠ 0) ∧ (word-size ∈ N)) → (v-to-nat (incr (t, v-not (incr (t, v-not (nat-to-v (x, word-size)))))) = x)

Theorem: bitn-nat-to-v-0 bitn (nat-to-v (0, k), i) = if i ≃ 0 then f

elseif k < i then 0 else f endif

; In fm8502 days we proved
; (prove-lemma not-zerop-size-implies-not-equal-bv-btm (rewrite)
;   (implies (not (zerop (length x)))
;            (not (equal x (btm)))))
; but I'm going with equal-length-0 now:

Event: Enable equal-length-0.

Theorem: bitn-compl ((n ≄ 0) ∧ (length (b) ≮ n)) → (bitn (v-not (b), n) = (¬ bitn (b, n)))

Theorem: times-non-numberp (x ∉ N) → ((y ∗ x) = 0)

Event: Enable difference-plus-cancellation.

Theorem: remainder-times ((x ∗ y) mod x) = 0

Theorem: remainder-exp-2-2 (exp (2, x) mod 2) = if x ≃ 0 then 1

else 0 endif

Theorem: my-quotient-times (x ≄ 0) → (((x ∗ y) ÷ x) = fix (y))

Theorem: quotient-exp-2-2 (x ≄ 0) → ((exp (2, x) ÷ 2) = exp (2, x − 1))

Theorem: bitn-exp-2-sub1-word-size (word-size ≄ 0) → (bitn (nat-to-v (exp (2, word-size − 1), word-size), word-size) = t)

Theorem: bitn-of-negatives-is-t-lemma ((word-size ≄ 0) ∧ (x ∈ N) ∧ (exp (2, word-size − 1) ≮ x)) → (bitn (nat-to-v (x, word-size), word-size)

= (x = exp (2, word-size − 1)))

Theorem: bitn-of-negatives-is-t-lemma-hyp ((word-size ≄ 0) ∧ (exp (2, word-size) ≮ i)) → (exp (2, word-size − 1) ≮ (i ÷ 2))

Theorem: incr-f-is-noop bitn (incr (f, v), n) = if length (v) < n then 0

elseif bitn (v, n) then t else f endif

Event: Disable plus-commutes2.

Theorem: bitn-cons bitn (cons (b, v), i) = if i ≃ 0 then f

elseif i = 1 then b else bitn (v, i − 1) endif

Theorem: bitn-of-negatives-is-t ((i ≄ 0) ∧ (word-size ≄ 0) ∧ (exp (2, word-size − 1) ≮ i)) → (bitn (incr (t, v-not (nat-to-v (i, word-size))), word-size) = t)

Event: Disable incr-f-is-noop.

Event: Disable bitn-cons.

Event: Disable bitn-of-negatives-is-t-lemma.

Event: Disable bitn-of-negatives-is-t-lemma-hyp.

Theorem: v-to-int-inverts-int-to-v (small-integerp (i, word-size) ∧ (word-size ≄ 0)) → (v-to-int (int-to-v (i, word-size)) = i)

Theorem: v-to-int-inverts-link-word ((type (x) = 'int) ∧ (cddr (x) = nil) ∧ small-integerp (untag (x), word-size) ∧ (word-size ≄ 0)) → (v-to-int (link-word (x, tables, word-size)) = untag (x))

Theorem: not-equal-link-word-btm listp (link-word (x, tables, 32))

Event: Enable commutativity-of-iplus.

; Initially, my owc step theorems were stated in terms of i-ins-okp
; and i-step.  But now I use the -okp and -step function specific to
; the given current-instruction.  Frequently the attempt to prove a
; owc step theorem exposes bugs in the -okp or -step function for
; the instruction.  If the previously proved owc step theorems are
; stated in terms of the i-ins-okp and i-step those previously proved
; theorems must be proved again when the -okp and -step functions for
; the current instruction are redefined.
; Here I have inserted a new theorem, m-step1-opener, that play the
; role that m-step1-expander did in fm8502.

Event: Enable remainder-plus-x-x-2.

Theorem: remainder-add1-plus-x-x-2 ((1 + (x + x)) mod 2) = 1

Theorem: nat-to-v-inverts-v-to-nat bvp (v) → (nat-to-v (v-to-nat (v), length (v)) = v)

Theorem: backchainer-trick (bvp (v) ∧ (length (v) ≮ word-size) ∧ (v-to-nat (v) = n)) → ((firstn (word-size, v) = nat-to-v (n, word-size)) = t)

Theorem: v-adder-t-0-is-nat-to-v-add1 ((pc ∈ N) ∧ (word-size ≄ 0) ∧ ((1 + pc) < exp (2, word-size))) → (firstn (word-size,

v-adder (t, nat-to-v (pc, word-size), nat-to-v (0, word-size))) = nat-to-v (1 + pc, word-size))

Theorem: v-adder-f-1-is-nat-to-v-sub1 ((pc ∈ N) ∧ (pc ≠ 0) ∧ (word-size ≄ 0) ∧ (pc < exp (2, word-size))) → (firstn (word-size,

v-adder (f, v-not (nat-to-v (0, word-size)), nat-to-v (pc, word-size)))

= nat-to-v (pc − 1, word-size))

Event: Disable backchainer-trick.

Event: Disable nat-to-v-inverts-v-to-nat.

Event: Disable remainder-add1-plus-x-x-2.

Event: Disable remainder-plus-x-x-2.

Theorem: v-inc-nat-to-v ((i ∈ N) ∧ (word-size ≄ 0) ∧ ((1 + i) < exp (2, word-size))) → (v-inc (nat-to-v (i, word-size)) = nat-to-v (1 + i, word-size))

Event: Disable v-inc.

Event: Enable bvp-nat-to-v.

Theorem: v-dec-nat-to-v ((i < exp (2, word-size)) ∧ (word-size ≄ 0)) → (v-dec (nat-to-v (i, word-size))

= if i ≃ 0 then nat-to-v (exp (2, word-size) − 1, word-size) else nat-to-v (i − 1, word-size) endif)

Event: Disable v-dec.

Theorem: m-step1-opener ((pc ∈ N) ∧ (word-size ≄ 0) ∧ ((1 + pc) < exp (2, word-size))) → (m-step1 (cons (ins0 , ins1-31 ),

m-state (list (r0 , r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , nat-to-v (pc, word-size)),

c, v, n, z, mem))

= m-operand-a (list (r0 , r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , nat-to-v (1 + pc, word-size)),

c, v, n, z, mem, cons (ins0 , ins1-31 )))

Event: Disable m-step1.

Theorem: bvp-bitv-to-v bvp (bitv-to-v (bv, word-size))

; A lemma bvp-int-to-v exists in fm9001.events, but it did not

; originally.  We accommodate this change by introducing the "my-"
; prefix below.

Theorem: my-bvp-int-to-v bvp (int-to-v (i, word-size))

Theorem: bvp-link-word bvp (link-word (x, link-tables, word-size))

Theorem: i-m-one-way-correspondence-step-move x x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move x x-okp (i) ∧ (i-current-instruction (i) = '(move x x))) → (i->m (i-move x x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; This next segment has been added during the fm9001 port, to speed up
; the processing of the new fns introduced there.
; I had this around in the fm9001 effort before backing up and
; disabling v-inc and v-dec...
;(prove-lemma v-adder-t-0-is-nat-to-v-add1-32 (rewrite)
;  (implies (and (numberp pc)
;               (lessp (add1 pc) (exp 2 32)))
;          (equal (firstn 32
;                         (v-adder t
;                                  (nat-to-v pc 32)
;                                  (LIST F F F F F F F F F F F F F F F F
;                                        F F F F F F F F F F F F F F F F)))
;                 (nat-to-v (add1 pc) 32)))
;  ((disable v-adder-t-0-is-nat-to-v-add1)
;   (use (v-adder-t-0-is-nat-to-v-add1 (word-size 32)))))
; The following theorem delays the opening of m-operand-a until the
; reg file has been put into normal form.  Note that this means we
; list all 16 regs and the pc is (NAT-TO-V & 32). Use of the free var
; regs in the hyp is arranged to save the repeated rewriting of it in
; the rhs of the concl.  The conclusion is just what (ppsd
; 'm-operand-a) prints, except for the list-expr in the regs slot on
; the lhs.

Theorem: m-operand-a-opener (regs = list (r0 ,

r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , nat-to-v (pc, 32)))

→ (m-operand-a (list (r0 , r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , nat-to-v (pc, 32)),

c, v, n, z, mem, ins)

= if a-immediate-p (ins)

then m-operand-b (regs, c, v, n, z, mem, ins, sign-extend (a-immediate (ins), 32))

elseif pre-dec-p (mode-a (ins)) then if reg-direct-p (mode-a (ins))

then m-operand-b (update-v-nth (rn-a (ins), regs, v-dec (v-nth1 (rn-a (ins),

regs))),

c, v, n, z, mem, ins, v-nth1 (rn-a (ins), regs))

else m-operand-b (update-v-nth (rn-a (ins), regs, v-dec (v-nth1 (rn-a (ins),

regs))),

c, v, n, z, mem, ins, v-nth1 (v-dec (v-nth1 (rn-a (ins),

regs)),

mem)) endif

elseif post-inc-p (mode-a (ins)) then if reg-direct-p (mode-a (ins))

then m-operand-b (update-v-nth (rn-a (ins), regs, v-inc (v-nth1 (rn-a (ins),

regs))),

c, v, n, z, mem, ins, v-nth1 (rn-a (ins), regs))

else m-operand-b (update-v-nth (rn-a (ins), regs, v-inc (v-nth1 (rn-a (ins),

regs))),

c, v, n, z, mem, ins, v-nth1 (v-nth1 (rn-a (ins), regs), mem)) endif

elseif reg-direct-p (mode-a (ins)) then m-operand-b (regs, c, v, n, z, mem, ins, v-nth1 (rn-a (ins), regs)) else m-operand-b (regs,

c, v, n, z, mem, ins, v-nth1 (v-nth1 (rn-a (ins), regs), mem)) endif)

Event: Disable m-operand-a.

; Now we repeat the exercise for m-operand-b.

Theorem: m-operand-b-opener (regs = list (r0 ,

r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , nat-to-v (pc, 32)))

→ (m-operand-b (list (r0 , r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , nat-to-v (pc, 32)),

c, v, n, z, mem, ins, operand-a)

= if pre-dec-p (mode-b (ins))

then if reg-direct-p (mode-b (ins))

then m-alu-operation (update-v-nth (rn-b (ins), regs, v-dec (v-nth1 (rn-b (ins),

regs))),

c, v, n, z, mem, ins, operand-a, v-nth1 (rn-b (ins), regs), v-dec (v-nth1 (rn-b (ins), regs)))

else m-alu-operation (update-v-nth (rn-b (ins), regs, v-dec (v-nth1 (rn-b (ins),

regs))),

c, v, n, z, mem, ins, operand-a, v-nth1 (v-dec (v-nth1 (rn-b (ins),

regs)),

mem), v-dec (v-nth1 (rn-b (ins), regs))) endif

elseif post-inc-p (mode-b (ins)) then if reg-direct-p (mode-b (ins))

then m-alu-operation (update-v-nth (rn-b (ins), regs, v-inc (v-nth1 (rn-b (ins),

regs))),

c, v, n, z, mem, ins, operand-a, v-nth1 (rn-b (ins), regs), v-nth1 (rn-b (ins), regs))

else m-alu-operation (update-v-nth (rn-b (ins), regs, v-inc (v-nth1 (rn-b (ins),

regs))),

c, v, n, z, mem, ins, operand-a, v-nth1 (v-nth1 (rn-b (ins), regs),

mem), v-nth1 (rn-b (ins), regs)) endif

elseif reg-direct-p (mode-b (ins)) then m-alu-operation (regs,

c, v, n, z, mem, ins, operand-a, v-nth1 (rn-b (ins), regs), v-nth1 (rn-b (ins), regs))

else m-alu-operation (regs, c, v, n, z, mem, ins, operand-a, v-nth1 (v-nth1 (rn-b (ins), regs), mem), v-nth1 (rn-b (ins), regs)) endif)

Event: Disable m-operand-b.

; In watching expansions we have found that the following fact comes up
; and causes a split, which we wish to avoid.  Note that we have
; generalized (I-SYS-DATA-SEGMENT I) to I-SYS-DATA-SEGMENT so we can
; induct here.

Theorem: non-zero-total-i-system-size (adp-offset (untag (i-tsp (i))) < length (cdr (assoc ('tstk, i-sys-data-segment)))) → ((load-addr

+ segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i)) + segment-length (i-sys-data-segment)) ≠ 0)

; And again for m-alu-operation...except this time we also eliminate the
; B-IF's in m-alu-operation (in favor of plain IFs, which we hypothesize
; have boolp args).

Event: Disable boolp.

; I am not sure if these two should be shut down or not.  But I will
; shut them down and we'll see...

Event: Disable zb.

Event: Disable n.

; To eliminate b-if without explosion, we have to be careful.

Theorem: b-if-is-if (boolp (a) ∧ boolp (b)) → (b-if (c, a, b)

= if c then a else b endif)

Event: Disable b-if.

Theorem: m-alu-operation-opener ((regs = list (r0 , r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , pc)) ∧ boolp (c) ∧ boolp (v) ∧ boolp (n) ∧ boolp (z) ∧ bvp (operand-a) ∧ (length (operand-a) ≠ 0)) → (m-alu-operation (list (r0 ,

r1 , r2 , r3 , r4 , r5 , r6 , r7 , r8 , r9 , r10 , r11 , r12 , r13 , r14 , pc),

c, v, n, z, mem, ins, operand-a, operand-b, b-address)

= if m-store-resultp (store-cc (ins), c, v, n, z)

then if reg-direct-p (mode-b (ins))

then m-state (update-v-nth (rn-b (ins), regs, bv (v-alu (c,

operand-a, operand-b, op-code (ins)))),

if c-set (set-flags (ins)) then c (v-alu (c,

operand-a, operand-b, op-code (ins)))

else c endif, if v-set (set-flags (ins)) then v (v-alu (c,

operand-a, operand-b, op-code (ins)))

else v endif, if n-set (set-flags (ins)) then n (v-alu (c,

operand-a, operand-b, op-code (ins)))

else n endif, if z-set (set-flags (ins)) then zb (v-alu (c,

operand-a, operand-b, op-code (ins)))

else z endif, mem)

else m-state (regs, if c-set (set-flags (ins)) then c (v-alu (c,

operand-a, operand-b, op-code (ins)))

else c endif, if v-set (set-flags (ins)) then v (v-alu (c,

operand-a, operand-b, op-code (ins)))

else v endif,

if n-set (set-flags (ins)) then n (v-alu (c,

operand-a, operand-b, op-code (ins)))

else n endif,

if z-set (set-flags (ins)) then zb (v-alu (c,

operand-a, operand-b, op-code (ins)))

else z endif,

update-v-nth (b-address, mem, bv (v-alu (c,

operand-a, operand-b, op-code (ins))))) endif

else m-state (regs, if c-set (set-flags (ins)) then c (v-alu (c,

operand-a, operand-b, op-code (ins)))

else c endif, if v-set (set-flags (ins)) then v (v-alu (c,

operand-a, operand-b, op-code (ins)))

else v endif, if n-set (set-flags (ins)) then n (v-alu (c,

operand-a, operand-b, op-code (ins)))

else n endif, if z-set (set-flags (ins)) then zb (v-alu (c, operand-a, operand-b, op-code (ins)))

else z endif, mem) endif)

Event: Disable m-alu-operation.

Theorem: i-m-one-way-correspondence-step-cpush * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpush *-okp (i) ∧ (i-current-instruction (i) = '(cpush *))) → (i->m (i-cpush *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-add <tsp>{i} x{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp>{i} x{i}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp>{i} x{i}))) → (i->m (i-add <tsp>{i} x{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-cpush cfp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpush cfp-okp (i) ∧ (i-current-instruction (i) = '(cpush cfp))) → (i->m (i-cpush cfp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move cfp csp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move cfp csp-okp (i)

∧ (i-current-instruction (i) = '(move cfp csp))) → (i->m (i-move cfp csp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-cpush <tsp>+ ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpush <tsp>+-okp (i) ∧ (i-current-instruction (i) = '(cpush <tsp>+))) → (i->m (i-cpush <tsp>+-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move csp cfp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move csp cfp-okp (i) ∧ (i-current-instruction (i) = '(move csp cfp))) → (i->m (i-move csp cfp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move x tsp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move x tsp-okp (i) ∧ (i-current-instruction (i) = '(move x tsp))) → (i->m (i-move x tsp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-cpop cfp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpop cfp-okp (i) ∧ (i-current-instruction (i) = '(cpop cfp))) → (i->m (i-cpop cfp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move x * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move x *-okp (i) ∧ (i-current-instruction (i) = '(move x *))) → (i->m (i-move x *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move y * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move y *-okp (i) ∧ (i-current-instruction (i) = '(move y *))) → (i->m (i-move y *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: icode-instructionp-data-word (cddr (x) = nil) → (icode-instructionp (x) = f)

Theorem: lessp-absolute-address-segment-length-rewrite (definedp (name, segment) ∧ (offset < length (cdr (assoc (name, segment))))) → ((link-table-entry (name, segment) + offset)

< segment-length (segment))

Theorem: i-m-one-way-correspondence-step-add x{n} csp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add x{n} csp-okp (i) ∧ (i-current-instruction (i) = '(add x{n} csp))) → (i->m (i-add x{n} csp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the theorem below work, I had to change the -okp fn to
; check that the fetch of sys-addr i-x produced an i-objectp.

Theorem: i-m-one-way-correspondence-step-move x <x{s}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run)

∧ (i-word-size (i) = 32) ∧ i-move x <x{s}>-okp (i) ∧ (i-current-instruction (i) = '(move x <x{s}>))) → (i->m (i-move x <x{s}>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move y <y{s}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move y <y{s}>-okp (i) ∧ (i-current-instruction (i) = '(move y <y{s}>))) → (i->m (i-move y <y{s}>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move y tsp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move y tsp-okp (i) ∧ (i-current-instruction (i) = '(move y tsp))) → (i->m (i-move y tsp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpush csp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush csp-okp (i) ∧ (i-current-instruction (i) = '(tpush csp))) → (i->m (i-tpush csp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpush tsp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush tsp-okp (i) ∧ (i-current-instruction (i) = '(tpush tsp))) → (i->m (i-tpush tsp-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpush x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush x-okp (i) ∧ (i-current-instruction (i) = '(tpush x))) → (i->m (i-tpush x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpush <x{s}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush <x{s}>-okp (i) ∧ (i-current-instruction (i) = '(tpush <x{s}>))) → (i->m (i-tpush <x{s}>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpush <x{a}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush <x{a}>-okp (i) ∧ (i-current-instruction (i) = '(tpush <x{a}>))) → (i->m (i-tpush <x{a}>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the theorem below work I had to change the -okp function
; to make sure that nextword was an i-objectp

Theorem: i-m-one-way-correspondence-step-tpush * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush *-okp (i) ∧ (i-current-instruction (i) = '(tpush *))) → (i->m (i-tpush *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the theorem below work I had to change the -okp function

; to make sure that the top of tsp was an i-objectp.

Theorem: i-m-one-way-correspondence-step-tpop x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop x-okp (i) ∧ (i-current-instruction (i) = '(tpop x))) → (i->m (i-tpop x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the theorem below work I had to change the -okp function
; to make sure that the top of tsp was an i-objectp.

Theorem: i-m-one-way-correspondence-step-tpop y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop y-okp (i) ∧ (i-current-instruction (i) = '(tpop y))) → (i->m (i-tpop y-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpop <x{s}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop <x{s}>-okp (i) ∧ (i-current-instruction (i) = '(tpop <x{s}>))) → (i->m (i-tpop <x{s}>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: segment-length-put-assoc (length (cdr (assoc (name, segment))) = length (val)) → (segment-length (put-assoc (val, name, segment))

= segment-length (segment))

Theorem: i-m-one-way-correspondence-step-tpop <x{a}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop <x{a}>-okp (i) ∧ (i-current-instruction (i) = '(tpop <x{a}>))) → (i->m (i-tpop <x{a}>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: car-assoc definedp (name, alist) → (car (assoc (name, alist)) = name)

Theorem: assoc-link-table-for-prog-labels ((addr0 ∈ N) ∧ definedp (name, segment)) → (cdr (assoc (name, link-table-for-prog-labels (segment, addr0 )))

= link-table-for-labels (definiens (name, segment), addr0 + link-table-entry (name, segment)))

Theorem: assoc-link-table-for-labels ((addr0 ∈ N) ∧ find-labelp (label, lst)) → (cdr (assoc (label, link-table-for-labels (lst, addr0 )))

= (addr0 + find-label (label, lst)))

Theorem: i-m-one-way-correspondence-step-jump * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump *-okp (i) ∧ (i-current-instruction (i) = '(jump *))) → (i->m (i-jump *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-cpop pc ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpop pc-okp (i) ∧ (i-current-instruction (i) = '(cpop pc))) → (i->m (i-cpop pc-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move <x{s}> <tsp> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run)

∧ (i-word-size (i) = 32) ∧ i-move <x{s}> <tsp>-okp (i) ∧ (i-current-instruction (i) = '(move <x{s}> <tsp>))) → (i->m (i-move <x{s}> <tsp>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move <x{a}> <tsp> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move <x{a}> <tsp>-okp (i) ∧ (i-current-instruction (i) = '(move <x{a}> <tsp>))) → (i->m (i-move <x{a}> <tsp>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-jump x{subr} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump x{subr}-okp (i) ∧ (i-current-instruction (i) = '(jump x{subr}))) → (i->m (i-jump x{subr}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: bool-to-logical-non-f (x ≠ 'f) → (bool-to-logical (x) = t)

Theorem: i-m-one-way-correspondence-step-jump-n x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-n x-okp (i) ∧ (i-current-instruction (i) = '(jump-n x))) → (i->m (i-jump-n x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-jump-nn x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-nn x-okp (i)

∧ (i-current-instruction (i) = '(jump-nn x))) → (i->m (i-jump-nn x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-jump-z x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-z x-okp (i) ∧ (i-current-instruction (i) = '(jump-z x))) → (i->m (i-jump-z x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-jump-nz x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-nz x-okp (i) ∧ (i-current-instruction (i) = '(jump-nz x))) → (i->m (i-jump-nz x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpop pc ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop pc-okp (i) ∧ (i-current-instruction (i) = '(tpop pc))) → (i->m (i-tpop pc-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the theorem below work I had to change the -okp fn to
; insure that the top of tsp was an i-objectp.

Theorem: i-m-one-way-correspondence-step-tpop <c> x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop <c> x-okp (i) ∧ (i-current-instruction (i) = '(tpop <c> x)))

→ (i->m (i-tpop <c> x-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the thm below work I had to redefine the -step function
; because it did not include an untag in the computation of the flag.
; A lemma v-nzerop-nat-to-v exists in fm9001.events, but it did not
; originally.  We accommodate this change by introducing the "my-"
; prefix below.

Theorem: my-v-nzerop-nat-to-v (n < exp (2, word-size)) → (v-nzerop (nat-to-v (n, word-size)) = (n ≄ 0))

Theorem: alu-thm bitv-zb-move-15 (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (zb (v-alu (c, a, b, list (t, t, t, t))) = (¬ v-nzerop (a)))

Theorem: i-m-one-way-correspondence-step-tpop{n} <z> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{n} <z> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{n} <z> y))) → (i->m (i-tpop{n} <z> y-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: size-int-to-v length (int-to-v (i, word-size)) = fix (word-size)

; These seem irrelevant and I'm going to skip them for the moment...
; They may have v-nzerop counterparts...
;(prove-lemma v-to-nat-incr-t (rewrite)
;  (equal (v-to-nat (incr t b))
;        (if (all-onesp b)
;            0
;            (add1 (v-to-nat b)))))
;(prove-lemma all-onesp-compl (rewrite)
;  (equal (all-onesp (v-not b))
;        (equal (v-to-nat b) 0)))

Theorem: zerop-v-to-nat-int-to-v ((word-size ≄ 0) ∧ small-integerp (i, word-size)) → ((v-to-nat (int-to-v (i, word-size)) = 0) = (i = 0))

; A lemma v-nzerop-int-to-v exists in fm9001.events, but it did not
; originally.  We accommodate this change by introducing the "my-"
; prefix below.

Theorem: my-v-nzerop-int-to-v ((word-size ≄ 0) ∧ small-integerp (i, word-size)) → (v-nzerop (int-to-v (i, word-size)) = (i ≠ 0))

Theorem: v-negp-nat-to-v ((w ≄ 0) ∧ (n < exp (2, w))) → (v-negp (nat-to-v (n, w)) = (n ≮ exp (2, w − 1)))

Theorem: v-negp-int-to-v ((word-size ≄ 0) ∧ small-integerp (i, word-size)) → (v-negp (int-to-v (i, word-size)) = negativep (i))

Event: Disable v-negp-nat-to-v.

; I had to change the -step fn below because it failed to set y!

Theorem: i-m-one-way-correspondence-step-tpop{i} <zn> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{i} <zn> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{i} <zn> y))) → (i->m (i-tpop{i} <zn> y-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-tpop{b} <z> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{b} <z> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{b} <z> y))) → (i->m (i-tpop{b} <z> y-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: all-zero-bitvp-not-v-nzerop-bitv-to-v all-zero-bitvp (b) = (¬ v-nzerop (bitv-to-v (b, length (b))))

Theorem: length-bit-vectorp bit-vectorp (b, word-size) → (length (b) = fix (word-size))

Theorem: i-m-one-way-correspondence-step-tpop{v} <z> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{v} <z> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{v} <z> y))) → (i->m (i-tpop{v} <z> y-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; For the next owc lemma it would be useful to have the
; commutativity of plus, but providing it messes up our
; rewrite rules.  We have implicitly assumed we had total
; knowledge of the shape of plus-nests.  The following rule,
; which is elegant in its own right, elevates the two
; plus expressions to the point where linear arithmetic
; can deal with them.

Theorem: put-equal (put (val1 , n, lst) = put (val2 , n, lst)) = (val1 = val2 )

Theorem: i-m-one-way-correspondence-step-add <tsp>{a} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp>{a} x{n}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp>{a} x{n}))) → (i->m (i-add <tsp>{a} x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-add tsp *{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add tsp *{n}-okp (i) ∧ (i-current-instruction (i) = '(add tsp *{n}))) → (i->m (i-add tsp *{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-add tsp x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add tsp x{n}-okp (i) ∧ (i-current-instruction (i) = '(add tsp x{n}))) → (i->m (i-add tsp x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-sub <tsp>{a} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{a} x{n}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{a} x{n}))) → (i->m (i-sub <tsp>{a} x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-sub x{s} y{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub x{s} y{n}-okp (i) ∧ (i-current-instruction (i) = '(sub x{s} y{n}))) → (i->m (i-sub x{s} y{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: all-zero-bitvp-xor-bitv (bit-vectorp (a, word-size) ∧ bit-vectorp (b, word-size)) → (all-zero-bitvp (xor-bitv (a, b)) = (a = b))

Theorem: equal-append-generalized (properp (a) ∧ properp (b) ∧ (length (a) = length (b))) → ((append (a, x) = append (b, y)) = ((a = b) ∧ (x = y)))

Theorem: properp-v-to-bitv properp (v-to-bitv (x))

Theorem: length-v-to-bitv length (v-to-bitv (a)) = length (a)

Theorem: equal-v-to-bitv (bvp (x) ∧ bvp (y) ∧ (length (x) = length (y))) → ((v-to-bitv (x) = v-to-bitv (y)) = (x = y))

Theorem: bit-vectorp-append-singleton (bitp (bit) ∧ properp (a)) → (bit-vectorp (append (a, list (bit)), n)

= if n ≃ 0 then f else bit-vectorp (a, n − 1) endif)

Definition: bit-vectorp-v-to-bitv-hint (a, word-size) = if (word-size ≃ 0) ∨ (¬ bvp (a)) ∨ (a ≃ nil) then t

else bit-vectorp-v-to-bitv-hint (cdr (a), word-size − 1) endif

Theorem: bit-vectorp-v-to-bitv-lemma bit-vectorp (v-to-bitv (a), length (a))

Theorem: bit-vectorp-v-to-bitv bit-vectorp (v-to-bitv (a), word-size) = (length (a) = fix (word-size))

Theorem: bit-vectorp-v-to-bitv-link-data-word bit-vectorp (v-to-bitv (link-data-word (x, tables, word-size)), word-size)

Theorem: equal-int-to-v ((word-size ≄ 0) ∧ small-integerp (i, word-size) ∧ small-integerp (j , word-size)) → ((int-to-v (i, word-size) = int-to-v (j , word-size)) = (i = j ))

Theorem: v-to-bitv-inverts-bitv-to-v bit-vectorp (x, word-size) → (v-to-bitv (bitv-to-v (x, word-size)) = x)

Theorem: equal-bitv-to-v (bit-vectorp (x, word-size) ∧ bit-vectorp (y, word-size)) → ((bitv-to-v (x, word-size) = bitv-to-v (y, word-size)) = (x = y))

Theorem: v-to-bool-inverts-bool-to-v ((word-size ≄ 0) ∧ booleanp (x)) → (v-to-bool (bool-to-v (x, word-size)) = x)

Theorem: equal-bool-to-v ((word-size ≄ 0) ∧ booleanp (x) ∧ booleanp (y)) → ((bool-to-v (x, word-size) = bool-to-v (y, word-size)) = (x = y))

; We now turn to the harder cases of linking, those involving
; the link tables.
; Three of the linkers, namely addr-to-v, sys-addr-to-v, and
; ipc-to-v, use the primitive function absolute-address to
; compute their values.  We therefore first establish that
; absolute-address can be inverted on the link table actually used.

Theorem: cons-adp-name-adp-offset listp (adp) → (cons (adp-name (adp), adp-offset (adp)) = adp)

Theorem: listp-link-table-for-segment listp (link-table-for-segment (segment, addr0 )) = listp (segment)

Theorem: cdar-link-table-for-segment listp (segment) → (cdar (link-table-for-segment (segment, addr0 )) = addr0 )

Theorem: find-containing-area-name-link-table-for-segment adpp (adp, segment) → (find-containing-area-name (cdr (assoc (adp-name (adp),

link-table-for-segment (segment,

addr0 )))

+ adp-offset (adp),

link-table-for-segment (segment, addr0 ))

= adp-name (adp))

Theorem: invert-absolute-address-inverts-absolute-address adpp (adp, segment) → (invert-absolute-address (absolute-address (adp,

link-table-for-segment (segment,

addr0 )),

link-table-for-segment (segment, addr0 ))

= adp)

; Now I prove the invertibility results and the equality results for
; each of the three linkers that use absolute-address:  ipc-to-v,
; addr-to-v, and sys-addr-to-v.
; Each linker is used with its own link table.  In fact, if we could
; completely characterize the link table properties we could avoid
; having different theorems for these three linkers and just have a
; general one.  Rather than do that I just prove the appropriate
; result for the link table used by each linker.
; In fact we prove three lemmas for each linker.  The first establishes
; that the absolute address computed for a given link table is small
; enough.  The second is the invertibility result for the link table.
; The third is the equality result.
; Here is the series for prog-segment addresses.
; The following lemma would not be necessary if absolute-address could be
; enabled in the lemma below this.  But the invertibility of absolute-address

; above requires that the fn be disabled.
; The (PLUS LOAD-ADDR ...) term below is just (i-loadablep i load-addr).
; But it is open because it contains the free-var load-addr and will be
; the term we look for to bind that var.

Theorem: lessp-absolute-address-ipc (adpp (adp, i-prog-segment (i)) ∧ ((load-addr

+ segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i)) + segment-length (i-sys-data-segment (i))) < exp (2, i-word-size (i))))

→ (absolute-address (adp,

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))))

< exp (2, i-word-size (i)))

; To prove the invertibility result for ipcs and keep it exactly
; symmetric with addrs and sys-addrs, it is necessary to define
; the inverter.  The inverter is not used in the main theorem.

Definition: v-to-ipc (bv, prog-links) = invert-absolute-address (v-to-nat (bv), prog-links)

Theorem: v-to-ipc-inverts-ipc-to-v (adpp (adp, i-prog-segment (i)) ∧ i-loadablep (i, load-addr)) → (v-to-ipc (ipc-to-v (adp,

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i)), link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))))

= adp)

Theorem: equal-ipc-to-v (adpp (adp1 , i-prog-segment (i)) ∧ adpp (adp2 , i-prog-segment (i)) ∧ i-loadablep (i, load-addr)) → ((ipc-to-v (adp1 , link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i)) = ipc-to-v (adp2 ,

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i)))

= (adp1 = adp2 ))

; So now we repeat the exercise for ADDRs.  That is, we use the usr-data
; segment and its link table...

Theorem: lessp-absolute-address-usr-data (adpp (adp, i-usr-data-segment (i)) ∧ ((load-addr

+ segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i)) + segment-length (i-sys-data-segment (i))) < exp (2, i-word-size (i)))

∧ (load-addr ∈ N)) → (absolute-address (adp,

link-table-for-segment (i-usr-data-segment (i),

load-addr))

< exp (2, i-word-size (i)))

Theorem: v-to-addr-inverts-addr-to-v ((load-addr ∈ N) ∧ adpp (adp, i-usr-data-segment (i)) ∧ i-loadablep (i, load-addr)) → (v-to-addr (addr-to-v (adp,

link-table-for-segment (i-usr-data-segment (i),

load-addr),

i-word-size (i)),

link-table-for-segment (i-usr-data-segment (i), load-addr))

= adp)

Theorem: equal-addr-to-v ((load-addr ∈ N) ∧ adpp (adp1 , i-usr-data-segment (i)) ∧ adpp (adp2 , i-usr-data-segment (i)) ∧ i-loadablep (i, load-addr)) → ((addr-to-v (adp1 ,

link-table-for-segment (i-usr-data-segment (i), load-addr), i-word-size (i))

= addr-to-v (adp2 ,

link-table-for-segment (i-usr-data-segment (i),

load-addr),

i-word-size (i)))

= (adp1 = adp2 ))

; And finally we do the SYS-ADDR type...

Theorem: lessp-absolute-address-sys-data (adpp (adp, i-sys-data-segment (i)) ∧ ((load-addr

+ segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i)) + segment-length (i-sys-data-segment (i))) < exp (2, i-word-size (i))))

→ (absolute-address (adp,

link-table-for-segment (i-sys-data-segment (i), load-addr + segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i))))

< exp (2, i-word-size (i)))

Theorem: v-to-sys-addr-inverts-sys-addr-to-v (adpp (adp, i-sys-data-segment (i)) ∧ i-loadablep (i, load-addr)) → (v-to-sys-addr (sys-addr-to-v (adp,

link-table-for-segment (i-sys-data-segment (i), load-addr + segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i))),

i-word-size (i)), link-table-for-segment (i-sys-data-segment (i),

load-addr

+ segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i))))

= adp)

Theorem: equal-sys-addr-to-v (adpp (adp1 , i-sys-data-segment (i)) ∧ adpp (adp2 , i-sys-data-segment (i)) ∧ i-loadablep (i, load-addr)) → ((sys-addr-to-v (adp1 ,

link-table-for-segment (i-sys-data-segment (i), load-addr + segment-length (i-prog-segment (i))

+ segment-length (i-usr-data-segment (i))),

i-word-size (i))

= sys-addr-to-v (adp2 ,

link-table-for-segment (i-sys-data-segment (i), load-addr + segment-length (i-prog-segment (i)) + segment-length (i-usr-data-segment (i))),

i-word-size (i)))

= (adp1 = adp2 ))

; Now I turn to the SUBR case.  It uses base-address instead of
; absolute-address.  The results we need could probably be
; obtained by creative instantiation of what we have.  But I
; prefer simply to prove them cold in perfect analogy with
; what we have done already.

Theorem: lessp-0-length listp (a) → (0 < length (a))

Theorem: invert-base-address-inverts-base-address-on-subrs adpp (cons (name, 0), segment) → (invert-base-address (base-address (name,

link-table-for-segment (segment,

addr0 )),

link-table-for-segment (segment, addr0 ))

= name)

Theorem: lessp-base-address-link-table-for-segment (adpp (cons (name, 0), i-prog-segment (i)) ∧ ((load-addr

+ segment-length (i-usr-data-segment (i)) + segment-length (i-prog-segment (i)) + segment-length (i-sys-data-segment (i))) < exp (2, i-word-size (i))))

→ (base-address (name,

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))))

< exp (2, i-word-size (i)))

Theorem: numberp-base-address-link-table-for-segment (addr0 ∈ N) → (base-address (name, link-table-for-segment (segment, addr0 )) ∈ N)

Theorem: v-to-subr-inverts-subr-to-v (adpp (cons (subr, 0), i-prog-segment (i)) ∧ i-loadablep (i, load-addr)) → (v-to-subr (subr-to-v (subr,

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i)),

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))))

= subr)

Theorem: equal-subr-to-v (adpp (cons (subr1 , 0), i-prog-segment (i)) ∧ adpp (cons (subr2 , 0), i-prog-segment (i)) ∧ i-loadablep (i, load-addr)) → ((subr-to-v (subr1 ,

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i))

= subr-to-v (subr2 ,

link-table-for-segment (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i)))

= (subr1 = subr2 ))

Theorem: lessp-find-label-length find-labelp (lab, lst) → (find-label (lab, lst) < length (lst))

Theorem: lessp-base-address-link-table-for-labels (icode-labelp (lab, i-prog-segment (i)) ∧ i-loadablep (i, load-addr)) → (base-address (lab,

link-table-for-labels (cdr (assoc (adp-name (lab),

i-prog-segment (i))),

load-addr

+ segment-length (i-usr-data-segment (i))

+ link-table-entry (adp-name (lab),

i-prog-segment (i))))

< exp (2, i-word-size (i)))

Theorem: numberp-base-address-link-table-for-labels (addr0 ∈ N) → (base-address (name, link-table-for-labels (lst, addr0 )) ∈ N)

Theorem: assoc-cdrp-link-table-for-labels-t ((addr0 ∈ N) ∧ find-labelp (lab, lst)) → assoc-cdrp (addr0 + find-label (lab, lst),

link-table-for-labels (lst, addr0 ))

Theorem: assoc-cdrp-link-table-for-labels-f (n ≮ (addr0 + length (lst))) → (¬ assoc-cdrp (n, link-table-for-labels (lst, addr0 )))

;The following lemma is a generalization of what we need.  We will
; instantiate it with addr0 = 0

Theorem: find-containing-label-table-base-address-generalized ((addr0 ∈ N) ∧ definedp (adp-name (lab), segment) ∧ find-labelp (lab, cdr (assoc (adp-name (lab), segment)))) → (find-containing-label-table (base-address (lab,

link-table-for-labels (cdr (assoc (adp-name (lab),

segment)),

addr0 + link-table-entry (adp-name (lab),

segment))),

link-table-for-prog-labels (segment, addr0 ))

= link-table-for-labels (cdr (assoc (adp-name (lab), segment)),

addr0 + link-table-entry (adp-name (lab), segment)))

Theorem: find-containing-label-table-base-address (definedp (adp-name (lab), segment) ∧ find-labelp (lab, cdr (assoc (adp-name (lab), segment)))) → (find-containing-label-table (base-address (lab,

link-table-for-labels (cdr (assoc (adp-name (lab),

segment)),

load-addr

+ segment-length (i-usr-data-segment (i)) + link-table-entry (adp-name (lab),

segment))),

link-table-for-prog-labels (segment,

load-addr + segment-length (i-usr-data-segment (i))))

= link-table-for-labels (cdr (assoc (adp-name (lab), segment)), load-addr + segment-length (i-usr-data-segment (i)) + link-table-entry (adp-name (lab),

segment)))

Theorem: lessp-cdar-link-table-for-labels listp (link-table-for-labels (lst, addr0 )) → (cdar (link-table-for-labels (lst, addr0 )) ≮ addr0 )

Theorem: lessp-find-label-cdar-link-table-for-labels find-labelp (lab, lst) → ((addr0 + find-label (lab, lst))

≮ cdar (link-table-for-labels (lst, addr0 )))

Theorem: find-labelp-implies-listp-link-table-for-labels find-labelp (lab, lst) → listp (link-table-for-labels (lst, addr0 ))

Theorem: invert-base-address-inverts-base-address-on-labels ((addr0 ∈ N) ∧ find-labelp (lab, lst)) → (invert-base-address (base-address (lab,

link-table-for-labels (lst, addr0 )),

link-table-for-labels (lst, addr0 ))

= lab)

Theorem: v-to-label-inverts-label-to-v (icode-labelp (lab, i-prog-segment (i)) ∧ i-loadablep (i, load-addr)) → (v-to-label (label-to-v (lab,

link-table-for-prog-labels (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i)),

link-table-for-prog-labels (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))))

= lab)

Theorem: equal-label-to-v (icode-labelp (lab1 , i-prog-segment (i)) ∧ icode-labelp (lab2 , i-prog-segment (i)) ∧ i-loadablep (i, load-addr)) → ((label-to-v (lab1 ,

link-table-for-prog-labels (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i))

= label-to-v (lab2 ,

link-table-for-prog-labels (i-prog-segment (i),

load-addr + segment-length (i-usr-data-segment (i))),

i-word-size (i)))

= (lab1 = lab2 ))

; The following little lemma would not be necessary if type and untag
; were opened to car and cadr and we were willing to suffer elims.

Theorem: equal-types-and-untags ((type (x) = type (y)) ∧ (cddr (x) = nil)

∧ (cddr (y) = nil) ∧ (x ≠ y)) → (untag (x) ≠ untag (y))

Theorem: equal-link-data-word ((load-addr ∈ N) ∧ (i-word-size (i) ≄ 0) ∧ i-loadablep (i, load-addr) ∧ i-objectp (x, i) ∧ i-objectp-type (type (x), y, i)) → ((link-data-word (x, i-link-tables (i, load-addr), i-word-size (i))

= link-data-word (y, i-link-tables (i, load-addr), i-word-size (i))) = (x = y))

; Note:  small-naturalp is not disabled above simply because I
; didn't provide what might be called equal-nat-to-v but rely
; instead on nat-to-v-equivalence, which has small-naturalp
; expanded in its hyps.

Theorem: bvp-link-data-word bvp (link-data-word (x, table, word-size))

Theorem: xor-xxx-is-equal ((load-addr ∈ N) ∧ (i-word-size (i) ≄ 0) ∧ i-loadablep (i, load-addr) ∧ i-objectp (x, i) ∧ i-objectp-type (type (x), y, i)) → (all-zero-bitvp (xor-xxx (x, y, i, load-addr)) = (x = y))

Theorem: v-to-nat-v-xor-xx v-to-nat (v-xor (x, x)) = 0

Theorem: v-xor-is-equal (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b))) → ((v-to-nat (v-xor (a, b)) = 0) = (a = b))

Theorem: equal-link-word-lemma1 i-objectp (x, i) → (¬ icode-instructionp (x))

Theorem: equal-link-word-lemma2 i-objectp-type (type, x, i) → (¬ icode-instructionp (x))

Theorem: equal-link-word ((load-addr ∈ N) ∧ (word-size = i-word-size (i)) ∧ (i-word-size (i) ≄ 0) ∧ i-loadablep (i, load-addr) ∧ i-objectp (x, i) ∧ i-objectp-type (type (x), y, i)) → ((link-word (x, i-link-tables (i, load-addr), word-size)

= link-word (y, i-link-tables (i, load-addr), word-size))

= (x = y))

Theorem: v-xor-append (bvp (x) ∧ bvp (y) ∧ (length (a) = length (b))) → (v-xor (append (a, x), append (b, y)) = append (v-xor (a, b), v-xor (x, y)))

Theorem: bitv-to-v-xor-bitv (length (a) = length (b)) → (bitv-to-v (xor-bitv (a, b), length (a))

= v-xor (bitv-to-v (a, length (a)), bitv-to-v (b, length (a))))

Theorem: bitv-to-v-inverts-v-to-bitv (bvp (a) ∧ (word-size = length (a))) → (bitv-to-v (v-to-bitv (a), word-size) = a)

Theorem: bitv-to-v-xor-xxx-is-v-xor-link-word ((load-addr ∈ N) ∧ (word-size = i-word-size (i)) ∧ (i-word-size (i) ∈ N) ∧ i-objectp (x, i) ∧ i-objectp-type (type (x), y, i)) → ((bitv-to-v (xor-xxx (x, y, i, load-addr), word-size)

= v-xor (link-word (x, i-link-tables (i, load-addr), word-size),

link-word (y, i-link-tables (i, load-addr), word-size)))

= t)

; The complications are neverending!  Ok.  The next problem is
; that the two machines use xor in opposite orders.  That is,
; the xor done by one is the commuted version of the one done
; by the other.  So

Theorem: commutativity-of-xor-bitv (length (x) = length (y)) → (xor-bitv (x, y) = xor-bitv (y, x))

Theorem: commutativity-of-xor-xxx xor-xxx (x, y, i, load-addr) = xor-xxx (y, x, i, load-addr)

Theorem: alu-thm bitv-zb-xor (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (zb (v-alu (c, a, b, list (t, t, f, t))) = (¬ v-nzerop (v-xor (a, b))))

; There is a certain amount of xor versus equal work above.  Unfortunately,
; I think it was all made irrelevant when FM9001 was introduced with its
; kind of bit vectors.

Theorem: v-nzerop-v-xor (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b))) → (v-nzerop (v-xor (a, b)) = (a ≠ b))

Theorem: i-m-one-way-correspondence-step-xor <z> <tsp> x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <z> <tsp> x-okp (i) ∧ (i-current-instruction (i) = '(xor <z> <tsp> x))) → (i->m (i-xor <z> <tsp> x-step (i, load-addr), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; The next owc uses xor to zero the top of stack.  I need

Theorem: v-xor-x-x-is-0 v-xor (x, x) = nat-to-v (0, length (x))

; This rule will clash with others, like (v-to-nat (v-xor x x)) = 0,
; but I don't think I'll need the other rules anymore.  Famous last
; words.  This will return to haunt me.

Theorem: i-m-one-way-correspondence-step-xor <tsp> <tsp> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp> <tsp>-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp> <tsp>))) → (i->m (i-xor <tsp> <tsp>-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the next theorem work I had to change the -okp fn to
; insure that the nextword was an i-objectp

Theorem: i-m-one-way-correspondence-step-move-z <tsp> * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-z <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move-z <tsp> *))) → (i->m (i-move-z <tsp> *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move-n x * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-n x *-okp (i) ∧ (i-current-instruction (i) = '(move-n x *))) → (i->m (i-move-n x *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move <tsp> * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move <tsp> *))) → (i->m (i-move <tsp> *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: listp-nat-to-v listp (nat-to-v (n, word-size)) = (word-size ≄ 0)

Theorem: listp-int-to-v listp (int-to-v (i, word-size)) = (word-size ≄ 0)

Theorem: i-m-one-way-correspondence-step-incr <tsp> <tsp>{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-incr <tsp> <tsp>{i}-okp (i) ∧ (i-current-instruction (i) = '(incr <tsp> <tsp>{i}))) → (i->m (i-incr <tsp> <tsp>{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-sub <tsp>{i} x{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{i} x{i}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{i} x{i}))) → (i->m (i-sub <tsp>{i} x{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-decr <tsp> <tsp>{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-decr <tsp> <tsp>{i}-okp (i) ∧ (i-current-instruction (i) = '(decr <tsp> <tsp>{i}))) → (i->m (i-decr <tsp> <tsp>{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-neg <tsp> <tsp>{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-neg <tsp> <tsp>{i}-okp (i) ∧ (i-current-instruction (i) = '(neg <tsp> <tsp>{i}))) → (i->m (i-neg <tsp> <tsp>{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-asr <c> <tsp> <tsp>{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-asr <c> <tsp> <tsp>{b}-okp (i) ∧ (i-current-instruction (i) = '(asr <c> <tsp> <tsp>{b}))) → (i->m (i-asr <c> <tsp> <tsp>{b}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: plus-1 (1 + x) = (1 + x)

Theorem: not-zerop-exp-2-32 0 < exp (2, 32)

Theorem: i-m-one-way-correspondence-step-addc <c> x{n} y{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-addc <c> x{n} y{n}-okp (i) ∧ (i-current-instruction (i) = '(addc <c> x{n} y{n}))) → (i->m (i-addc <c> x{n} y{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-add <tsp>{n} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp>{n} x{n}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp>{n} x{n}))) → (i->m (i-add <tsp>{n} x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-incr <tsp> <tsp>{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-incr <tsp> <tsp>{n}-okp (i) ∧ (i-current-instruction (i) = '(incr <tsp> <tsp>{n}))) → (i->m (i-incr <tsp> <tsp>{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-incr y y{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-incr y y{n}-okp (i) ∧ (i-current-instruction (i) = '(incr y y{n}))) → (i->m (i-incr y y{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; The following lemma, put-link-segment-no-op, states that it is a
; no-op to put into the link-segment of a segment a value that is
; the link-word of what is already at the corresponding position
; in the segment.  This lemma is what enables us to convert from
; one data type to another, e.g., from INT to NAT, by doing an

; explicit push in the i-level machine but a no-op in the m-level.
; To justify such an act all we need to know is that the link-word
; of what is being pushed is the link-word of what was already
; there.

Theorem: put-link-area-no-op ((offset ∈ N) ∧ (offset < length (v))) → (put (link-word (unlabel (get (offset, v)), link-tables, word-size),

offset,

link-area (v, link-tables, word-size)) = link-area (v, link-tables, word-size))

Theorem: put-link-segment-no-op (definedp (name, segment) ∧ (offset ∈ N) ∧ (offset < length (cdr (assoc (name, segment)))) ∧ (val = link-word (unlabel (get (offset, cdr (assoc (name, segment)))),

link-tables, word-size)))

→ ((put (val, link-table-entry (name, segment) + offset, link-segment (segment, link-tables, word-size)) = link-segment (segment, link-tables, word-size)) = t)

; For the INT-TO-NAT case the justification is then:

Theorem: int-to-v-is-nat-to-v-on-nats (n ∈ N) → (int-to-v (n, word-size) = nat-to-v (n, word-size))

Theorem: i-m-one-way-correspondence-step-int-to-nat ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-int-to-nat-okp (i) ∧ (i-current-instruction (i) = '(int-to-nat))) → (i->m (i-int-to-nat-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Event: Disable int-to-v-is-nat-to-v-on-nats.

Theorem: i-m-one-way-correspondence-step-decr <tsp> <tsp>{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-decr <tsp> <tsp>{n}-okp (i) ∧ (i-current-instruction (i) = '(decr <tsp> <tsp>{n}))) → (i->m (i-decr <tsp> <tsp>{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Event: Enable times-2.

Theorem: i-m-one-way-correspondence-step-add <c> x x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <c> x x{n}-okp (i) ∧ (i-current-instruction (i) = '(add <c> x x{n}))) → (i->m (i-add <c> x x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-add <tsp> <tsp>{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp> <tsp>{n}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp> <tsp>{n}))) → (i->m (i-add <tsp> <tsp>{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: remainder-by-2 ((x mod 2) ≠ 0) → ((x mod 2) = 1)

Theorem: i-m-one-way-correspondence-step-lsr <c> x x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-lsr <c> x x{n}-okp (i) ∧ (i-current-instruction (i) = '(lsr <c> x x{n}))) → (i->m (i-lsr <c> x x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-subb <c> x{n} y{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-subb <c> x{n} y{n}-okp (i) ∧ (i-current-instruction (i) = '(subb <c> x{n} y{n}))) → (i->m (i-subb <c> x{n} y{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; I redefined the -step fn below because it had the wrong parity on the
; c-flg!

Theorem: i-m-one-way-correspondence-step-sub <c> <tsp>{n} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <c> <tsp>{n} x{n}-okp (i) ∧ (i-current-instruction (i) = '(sub <c> <tsp>{n} x{n}))) → (i->m (i-sub <c> <tsp>{n} x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-sub <tsp>{n} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{n} x{n}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{n} x{n}))) → (i->m (i-sub <tsp>{n} x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; The use hint below is necessary here because we have the hypothesis
; that both the top of tsp and x are addresses into the same usr-data
; area.  The rewriter replaces references to the adp-name of the top
; of tsp with references to the adp-name of x because it is simpler.
; But that prevents the firing of our rewrite rules for establishing
; that addresses link to small-naturalps.

Theorem: i-m-one-way-correspondence-step-sub <c> <tsp>{a} x{a} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <c> <tsp>{a} x{a}-okp (i) ∧ (i-current-instruction (i) = '(sub <c> <tsp>{a} x{a}))) → (i->m (i-sub <c> <tsp>{a} x{a}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-sub <tsp>{s} x{s} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{s} x{s}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{s} x{s}))) → (i->m (i-sub <tsp>{s} x{s}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: v-nzerop-nat-to-v-bridge ((firstn = nat-to-v (n, word-size)) ∧ (n < exp (2, word-size))) → (v-nzerop (firstn) = (n ≄ 0))

Theorem: equal-difference-zero ((x − y) = 0) = (y ≮ x)

Theorem: equal-v-to-nat-v-to-nat (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b))) → ((v-to-nat (a) = v-to-nat (b)) = (a = b))

Event: Enable my-lessp-v-to-nat-exp.

Theorem: alu-thm bitv-zb-sub (bvp (a) ∧ bvp (b) ∧ (length (a) = length (b)) ∧ boolp (c)) → (zb (v-alu (c, a, b, list (t, t, t, f))) = (a = b))

Theorem: i-m-one-way-correspondence-step-sub <z> x{s} y{s} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <z> x{s} y{s}-okp (i) ∧ (i-current-instruction (i) = '(sub <z> x{s} y{s}))) → (i->m (i-sub <z> x{s} y{s}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To make the next thm work I changed the -okp fn to insure
; that nextword is an i-objectp.  I also changed the link instruction
; alist.

Theorem: i-m-one-way-correspondence-step-move-c <tsp> * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-c <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move-c <tsp> *))) → (i->m (i-move-c <tsp> *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-move-v <tsp> * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-v <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move-v <tsp> *))) → (i->m (i-move-v <tsp> *-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: v-or-append ((length (a) = length (b)) ∧ bvp (x) ∧ bvp (y)) → (v-or (append (a, x), append (b, y)) = append (v-or (a, b), v-or (x, y)))

Theorem: v-or-bitv-to-v (bit-vectorp (x, word-size) ∧ bit-vectorp (y, word-size)) → (v-or (bitv-to-v (x, word-size), bitv-to-v (y, word-size))

= bitv-to-v (or-bitv (x, y), word-size))

Theorem: commutativity-of-or-bitv (length (x) = length (y)) → (or-bitv (x, y) = or-bitv (y, x))

Theorem: i-m-one-way-correspondence-step-or <tsp>{v} x{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-or <tsp>{v} x{v}-okp (i) ∧ (i-current-instruction (i) = '(or <tsp>{v} x{v}))) → (i->m (i-or <tsp>{v} x{v}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: v-and-append ((length (a) = length (b)) ∧ bvp (x) ∧ bvp (y)) → (v-and (append (a, x), append (b, y)) = append (v-and (a, b), v-and (x, y)))

Theorem: v-and-bitv-to-v (bit-vectorp (x, word-size) ∧ bit-vectorp (y, word-size)) → (v-and (bitv-to-v (x, word-size), bitv-to-v (y, word-size))

= bitv-to-v (and-bitv (x, y), word-size))

Theorem: commutativity-of-and-bitv (length (x) = length (y)) → (and-bitv (x, y) = and-bitv (y, x))

Theorem: i-m-one-way-correspondence-step-and <tsp>{v} x{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-and <tsp>{v} x{v}-okp (i) ∧ (i-current-instruction (i) = '(and <tsp>{v} x{v}))) → (i->m (i-and <tsp>{v} x{v}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: v-not-append bvp (x) → (v-not (append (a, x)) = append (v-not (a), v-not (x)))

Theorem: v-not-bitv-to-v bit-vectorp (x, word-size) → (v-not (bitv-to-v (x, word-size)) = bitv-to-v (not-bitv (x), word-size))

Theorem: i-m-one-way-correspondence-step-not <tsp> <tsp>{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-not <tsp> <tsp>{v}-okp (i) ∧ (i-current-instruction (i) = '(not <tsp> <tsp>{v}))) → (i->m (i-not <tsp> <tsp>{v}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: v-xor-bitv-to-v (bit-vectorp (x, word-size) ∧ bit-vectorp (y, word-size)) → (v-xor (bitv-to-v (x, word-size), bitv-to-v (y, word-size))

= bitv-to-v (xor-bitv (x, y), word-size))

Theorem: i-m-one-way-correspondence-step-xor <tsp>{v} x{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp>{v} x{v}-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp>{v} x{v}))) → (i->m (i-xor <tsp>{v} x{v}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: cdr-bitv-to-v (listp (x) ∧ bit-vectorp (x, word-size)) → (cdr (bitv-to-v (x, word-size))

= bitv-to-v (all-but-last (x), word-size − 1))

Theorem: listp-append listp (append (a, b)) = (listp (a) ∨ listp (b))

Theorem: cdr-append cdr (append (a, b)) = if listp (a) then append (cdr (a), b)

else cdr (b) endif

Theorem: v-buf-append v-buf (append (a, b)) = append (v-buf (a), v-buf (b))

Theorem: v-lsr-bitv-to-v bit-vectorp (x, word-size) → (v-lsr (bitv-to-v (x, word-size)) = bitv-to-v (rsh-bitv (x), word-size))

; The following two disables are motivated merely by the fact that the
; named lemmas were proved for the fm9001 effort and hence might get
; in the way.

Event: Disable v-buf-append.

Event: Disable cdr-append.

Theorem: i-m-one-way-correspondence-step-lsr <tsp> <tsp>{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-lsr <tsp> <tsp>{v}-okp (i)

∧ (i-current-instruction (i) = '(lsr <tsp> <tsp>{v}))) → (i->m (i-lsr <tsp> <tsp>{v}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: lsh-lemma-1 (bit-vectorp (x, word-size) ∧ (word-size ≄ 0)) → (bitv-to-v (append (cdr (x), '(0)), word-size)

= cons (f, bitv-to-v (cdr (x), word-size − 1)))

; Four of the next six lemmas use (plus x x y y) where (plus i i) could be
; used and then instantiated with (plus x y) and rearranged.  But
; they are, as stated, exactly what is needed and they go through
; without help.

Theorem: remainder-add1-xxyy-2 ((1 + (x + x + y + y)) mod 2) = 1

Theorem: quotient-add1-xxyy-2 ((1 + (x + x + y + y)) ÷ 2) = (x + y)

Theorem: remainder-xx-2 ((x + x) mod 2) = 0

Theorem: quotient-xx-2 ((x + x) ÷ 2) = fix (x)

Theorem: remainder-xxyy-2 ((x + x + y + y) mod 2) = 0

Theorem: quotient-xxyy-2 ((x + x + y + y) ÷ 2) = (x + y)

Theorem: lsh-lemma-2 nat-to-v (z + exp (2, word-size), word-size) = nat-to-v (z, word-size)

Theorem: lsh-lemma-3 nat-to-v (z + exp (2, word-size) + u, word-size) = nat-to-v (z + u, word-size)

Theorem: lsh-lemma-4 nat-to-v (z + (exp (2, word-size) ∗ v), word-size) = nat-to-v (z, word-size)

Event: Disable times-commutes.

Theorem: lsh-lemma-5 (x ∈ N) → (nat-to-v (x mod exp (2, word-size), word-size)

= nat-to-v (x, word-size))

Theorem: lsh-lemma-6 (word-size ≄ 0) → (nat-to-v (x + x, word-size) = cons (f, nat-to-v (x, word-size − 1)))

Theorem: remainder-add1-xx-2 ((1 + (x + x)) mod 2) = 1

Theorem: quotient-add1-xx-2 ((1 + (x + x)) ÷ 2) = fix (x)

Theorem: lsh-lemma-7 (bvp (x) ∧ (k = length (x))) → (nat-to-v (v-to-nat (append (x, y)), k) = x)

Event: Enable bvp-append.

Theorem: i-m-one-way-correspondence-step-add <tsp> <tsp>{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp> <tsp>{v}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp> <tsp>{v}))) → (i->m (i-add <tsp> <tsp>{v}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-or <tsp>{b} x{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-or <tsp>{b} x{b}-okp (i) ∧ (i-current-instruction (i) = '(or <tsp>{b} x{b}))) → (i->m (i-or <tsp>{b} x{b}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-and <tsp>{b} x{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run)

∧ (i-word-size (i) = 32) ∧ i-and <tsp>{b} x{b}-okp (i) ∧ (i-current-instruction (i) = '(and <tsp>{b} x{b}))) → (i->m (i-and <tsp>{b} x{b}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-xor <tsp>{b} *{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp>{b} *{b}-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp>{b} *{b}))) → (i->m (i-xor <tsp>{b} *{b}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-xor <tsp>{b} x{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp>{b} x{b}-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp>{b} x{b}))) → (i->m (i-xor <tsp>{b} x{b}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; The following lemma is just enough arithmetic to get the add_pc_x{n}
; lemma.  As noted before, I've adopted the strategy of not automatically
; rewriting arithmetic expressions.  I could perhaps get the proof with
; associativity and commutativity available, but I don't want to even
; bother trying.

Theorem: commutativity-of-plus-hack (load-addr + segment-length (i-usr-data-segment (i)) + link-table-entry (adp-name (untag (i-pc (i))), i-prog-segment (i)) + adp-offset (untag (i-pc (i))) + untag (i-x (i))) = (untag (i-x (i))

+ load-addr

+ segment-length (i-usr-data-segment (i))

+ link-table-entry (adp-name (untag (i-pc (i))), i-prog-segment (i)) + adp-offset (untag (i-pc (i))))

Event: Disable equal-length-0.

Event: Disable remainder-opener.

Theorem: i-m-one-way-correspondence-step-add pc x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add pc x{n}-okp (i) ∧ (i-current-instruction (i) = '(add pc x{n}))) → (i->m (i-add pc x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step-add x x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add x x{n}-okp (i) ∧ (i-current-instruction (i) = '(add x x{n}))) → (i->m (i-add x x{n}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Event: Enable associativity-of-iplus.

Event: Enable commutativity2-of-iplus.

Theorem: i-m-one-way-correspondence-step-addc <v> x{i} y{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-addc <v> x{i} y{i}-okp (i) ∧ (i-current-instruction (i) = '(addc <v> x{i} y{i}))) → (i->m (i-addc <v> x{i} y{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: tc-minus-is-inegate tc-minus (x) = inegate (x)

Event: Disable tc-minus.

Theorem: integerp-inegate integerp (inegate (x))

Theorem: ineg-is-inegate ineg (x) = inegate (x)

Event: Disable ineg.

Theorem: i-m-one-way-correspondence-step-subb <v> x{i} y{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-subb <v> x{i} y{i}-okp (i) ∧ (i-current-instruction (i) = '(subb <v> x{i} y{i}))) → (i->m (i-subb <v> x{i} y{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

; To relieve one of the hypotheses above we need the following lemma.
; Intuitively it says that (inegate x) is a small-integerp if x is.
; That's not true, because x might be the most negative integer, which
; has no small opposite.  But in the case in question we know that
; (inegate x) + y is negative, so things work out to tell us that  x isn't
; the most negative.

Theorem: small-integerp-inegate ((word-size ≄ 0) ∧ small-integerp (x, word-size) ∧ negativep (iplus (inegate (x), y)) ∧ small-integerp (y, word-size)) → small-integerp (inegate (x), word-size)

Theorem: small-integerp-fix-small-integer-case-1 (small-integerp (x, word-size) ∧ small-integerp (y, word-size) ∧ (word-size ≄ 0) ∧ (¬ small-integerp (iplus (inegate (x), y), word-size)) ∧ negativep (iplus (inegate (x), y))) → small-integerp (iplus (exp (2, word-size), iplus (inegate (x), y)), word-size)

Theorem: small-integerp-fix-small-integer-case-2 (small-integerp (x, word-size) ∧ small-integerp (y, word-size) ∧ (word-size ≄ 0)

∧ (¬ small-integerp (iplus (inegate (x), y), word-size)) ∧ (¬ negativep (iplus (inegate (x), y)))) → small-integerp (iplus (− exp (2, word-size), iplus (inegate (x), y)),

word-size)

Theorem: i-m-one-way-correspondence-step-sub <nv> <tsp>{i} x{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <nv> <tsp>{i} x{i}-okp (i) ∧ (i-current-instruction (i) = '(sub <nv> <tsp>{i} x{i}))) → (i->m (i-sub <nv> <tsp>{i} x{i}-step (i), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-current-instruction-packer-lemma ((car (ins) = pack (opcode)) ∧ (cdr (ins) = nil)) → (ins = list (pack (opcode)))

Theorem: i-current-instruction-packer ((car (i-current-instruction (i)) = pack (opcode)) ∧ (cdr (i-current-instruction (i)) = nil)) → (i-current-instruction (i) = list (pack (opcode)))

Theorem: i-m-one-way-correspondence-ins-okp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-ins-okp (i-current-instruction (i), i)) → (i->m (i-ins-step (i-current-instruction (i), i, load-addr),

boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-m-one-way-correspondence-step ((load-addr ∈ N) ∧ (i-psw (i-step (i, load-addr)) = 'run) ∧ (i-word-size (i) = 32)) → (i->m (i-step (i, load-addr), boot-lst, load-addr)

= m-step (i->m (i, boot-lst, load-addr)))

Theorem: i-word-size-i-halt i-word-size (i-halt (i, psw)) = i-word-size (i)

; The following two lemmas and then i-word-size-i-ins-step follow exactly
; the same strategy described above for i-psw-i-ins-step.

Theorem: equal-i-word-size-if-1 (i-word-size (if t1 then b1

else b2 endif)

= w) = if t1 then i-word-size (b1 ) = w

else i-word-size (b2 ) = w endif

Theorem: equal-i-word-size-if-2 (i-word-size (if t1 then b1

elseif t2 then b2 else b3 endif)

= w) = if t1 then i-word-size (b1 ) = w

elseif t2 then i-word-size (b2 ) = w else i-word-size (b3 ) = w endif

Theorem: i-word-size-i-ins-step i-word-size (i-ins-step (ins, i, load-addr)) = i-word-size (i)

; The hint above is mechanically generated as in i-psw case mentioned
; above, except that it does not include i-word-size.

Theorem: i-word-size-i-step i-word-size (i-step (i, load-addr)) = i-word-size (i)

Theorem: i-psw-i-run (i-psw (i (i, n, load-addr)) = 'run) → (i-psw (i) = 'run)

Theorem: i-m-one-way-correspondence ((load-addr ∈ N) ∧ (i-psw (i (i, n, load-addr)) = 'run) ∧ (i-word-size (i) = 32)) → (i->m (i (i, n, load-addr), boot-lst, load-addr)

= m (i->m (i, boot-lst, load-addr), n))

;  We now prove that i-state-okp is preserved by i-step.  We do
;  it in a very predictable way:  we prove it for each stepper.
;  First a few lemmas...

Theorem: assoc-put-assoc definedp (name2 , alist) → (assoc (name1 , put-assoc (val, name2 , alist))

= if name1 = name2 then cons (name1 , val) else assoc (name1 , alist) endif)

Theorem: cddr-tag cddr (tag (type, obj )) = nil

;  Now comes the litany of instructions.
;  After the first two, the hints for all of these preservation lemmas
;  are derived mechanically from the hint for the corresponding
;  one-way-correspondence lemma above by simply adding to the old hint
;  the disabling of the restructuring lemma and the enabling of
;  i-state-okp.

Theorem: i-state-okp-i-move x x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move x x-okp (i)) → i-state-okp (i-move x x-step (i), load-addr)

Theorem: i-state-okp-i-cpush *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-cpush *-okp (i)) → i-state-okp (i-cpush *-step (i), load-addr)

Theorem: i-state-okp-i-add <tsp>{i} x{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add <tsp>{i} x{i}-okp (i)) → i-state-okp (i-add <tsp>{i} x{i}-step (i), load-addr)

Theorem: i-state-okp-i-move cfp csp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move cfp csp-okp (i)) → i-state-okp (i-move cfp csp-step (i), load-addr)

Theorem: i-state-okp-i-cpush <tsp>+-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-cpush <tsp>+-okp (i)) → i-state-okp (i-cpush <tsp>+-step (i), load-addr)

Theorem: i-state-okp-i-move csp cfp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move csp cfp-okp (i)) → i-state-okp (i-move csp cfp-step (i), load-addr)

Theorem: i-state-okp-i-move x tsp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move x tsp-okp (i)) → i-state-okp (i-move x tsp-step (i), load-addr)

Theorem: i-state-okp-i-cpop cfp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-cpop cfp-okp (i)) → i-state-okp (i-cpop cfp-step (i), load-addr)

Theorem: i-state-okp-i-move x *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move x *-okp (i)) → i-state-okp (i-move x *-step (i), load-addr)

Theorem: i-state-okp-i-move y *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move y *-okp (i)) → i-state-okp (i-move y *-step (i), load-addr)

Theorem: i-state-okp-i-add x{n} csp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ i-add x{n} csp-okp (i)) → i-state-okp (i-add x{n} csp-step (i), load-addr)

Theorem: i-state-okp-i-move x <x{s}>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move x <x{s}>-okp (i)) → i-state-okp (i-move x <x{s}>-step (i), load-addr)

Theorem: i-state-okp-i-move y <y{s}>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move y <y{s}>-okp (i)) → i-state-okp (i-move y <y{s}>-step (i), load-addr)

Theorem: i-state-okp-i-move y tsp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move y tsp-okp (i)) → i-state-okp (i-move y tsp-step (i), load-addr)

Theorem: i-state-okp-i-tpush csp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpush csp-okp (i)) → i-state-okp (i-tpush csp-step (i), load-addr)

Theorem: i-state-okp-i-tpush tsp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpush tsp-okp (i)) → i-state-okp (i-tpush tsp-step (i), load-addr)

Theorem: i-state-okp-i-tpush x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpush x-okp (i)) → i-state-okp (i-tpush x-step (i), load-addr)

Theorem: i-state-okp-i-tpush <x{s}>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpush <x{s}>-okp (i)) → i-state-okp (i-tpush <x{s}>-step (i), load-addr)

Theorem: i-state-okp-i-tpush <x{a}>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpush <x{a}>-okp (i)) → i-state-okp (i-tpush <x{a}>-step (i), load-addr)

Theorem: i-state-okp-i-tpush *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpush *-okp (i)) → i-state-okp (i-tpush *-step (i), load-addr)

Theorem: i-state-okp-i-tpop x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop x-okp (i)) → i-state-okp (i-tpop x-step (i), load-addr)

Theorem: i-state-okp-i-tpop y-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop y-okp (i)) → i-state-okp (i-tpop y-step (i), load-addr)

Theorem: i-state-okp-i-tpop <x{s}>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop <x{s}>-okp (i)) → i-state-okp (i-tpop <x{s}>-step (i), load-addr)

Theorem: i-state-okp-i-tpop <x{a}>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ i-tpop <x{a}>-okp (i)) → i-state-okp (i-tpop <x{a}>-step (i), load-addr)

Theorem: i-state-okp-i-jump *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-jump *-okp (i)) → i-state-okp (i-jump *-step (i), load-addr)

Theorem: i-state-okp-i-cpop pc-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-cpop pc-okp (i)) → i-state-okp (i-cpop pc-step (i), load-addr)

Theorem: i-state-okp-i-move <x{s}> <tsp>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move <x{s}> <tsp>-okp (i)) → i-state-okp (i-move <x{s}> <tsp>-step (i), load-addr)

Theorem: i-state-okp-i-move <x{a}> <tsp>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move <x{a}> <tsp>-okp (i)) → i-state-okp (i-move <x{a}> <tsp>-step (i), load-addr)

Theorem: i-state-okp-i-jump x{subr}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-jump x{subr}-okp (i)) → i-state-okp (i-jump x{subr}-step (i), load-addr)

Theorem: i-state-okp-i-jump-n x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-jump-n x-okp (i)) → i-state-okp (i-jump-n x-step (i), load-addr)

Theorem: i-state-okp-i-jump-nn x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-jump-nn x-okp (i)) → i-state-okp (i-jump-nn x-step (i), load-addr)

Theorem: i-state-okp-i-jump-z x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-jump-z x-okp (i)) → i-state-okp (i-jump-z x-step (i), load-addr)

Theorem: i-state-okp-i-jump-nz x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-jump-nz x-okp (i)) → i-state-okp (i-jump-nz x-step (i), load-addr)

Theorem: i-state-okp-i-tpop pc-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop pc-okp (i)) → i-state-okp (i-tpop pc-step (i), load-addr)

Theorem: i-state-okp-i-tpop <c> x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop <c> x-okp (i)) → i-state-okp (i-tpop <c> x-step (i), load-addr)

Theorem: i-state-okp-i-tpop{n} <z> y-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop{n} <z> y-okp (i)) → i-state-okp (i-tpop{n} <z> y-step (i), load-addr)

Theorem: i-state-okp-i-tpop{i} <zn> y-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ i-tpop{i} <zn> y-okp (i)) → i-state-okp (i-tpop{i} <zn> y-step (i), load-addr)

Theorem: i-state-okp-i-tpop{b} <z> y-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop{b} <z> y-okp (i)) → i-state-okp (i-tpop{b} <z> y-step (i), load-addr)

Theorem: i-state-okp-i-tpop{v} <z> y-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-tpop{v} <z> y-okp (i)) → i-state-okp (i-tpop{v} <z> y-step (i), load-addr)

Theorem: i-state-okp-i-add <tsp>{a} x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add <tsp>{a} x{n}-okp (i)) → i-state-okp (i-add <tsp>{a} x{n}-step (i), load-addr)

Theorem: i-state-okp-i-add tsp *{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add tsp *{n}-okp (i)) → i-state-okp (i-add tsp *{n}-step (i), load-addr)

Theorem: i-state-okp-i-add tsp x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add tsp x{n}-okp (i)) → i-state-okp (i-add tsp x{n}-step (i), load-addr)

Theorem: i-state-okp-i-sub <tsp>{a} x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <tsp>{a} x{n}-okp (i)) → i-state-okp (i-sub <tsp>{a} x{n}-step (i), load-addr)

Theorem: i-state-okp-i-sub x{s} y{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub x{s} y{n}-okp (i)) → i-state-okp (i-sub x{s} y{n}-step (i), load-addr)

Theorem: i-state-okp-i-xor <tsp> <tsp>-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-xor <tsp> <tsp>-okp (i)) → i-state-okp (i-xor <tsp> <tsp>-step (i), load-addr)

Theorem: i-state-okp-i-move-z <tsp> *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move-z <tsp> *-okp (i)) → i-state-okp (i-move-z <tsp> *-step (i), load-addr)

Theorem: i-state-okp-i-move-n x *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move-n x *-okp (i)) → i-state-okp (i-move-n x *-step (i), load-addr)

Theorem: i-state-okp-i-move <tsp> *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move <tsp> *-okp (i)) → i-state-okp (i-move <tsp> *-step (i), load-addr)

Theorem: i-state-okp-i-incr <tsp> <tsp>{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-incr <tsp> <tsp>{i}-okp (i)) → i-state-okp (i-incr <tsp> <tsp>{i}-step (i), load-addr)

Theorem: i-state-okp-i-xor <z> <tsp> x-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ i-xor <z> <tsp> x-okp (i)) → i-state-okp (i-xor <z> <tsp> x-step (i, load-addr), load-addr)

Theorem: i-state-okp-i-sub <tsp>{i} x{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <tsp>{i} x{i}-okp (i)) → i-state-okp (i-sub <tsp>{i} x{i}-step (i), load-addr)

Theorem: i-state-okp-i-decr <tsp> <tsp>{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-decr <tsp> <tsp>{i}-okp (i)) → i-state-okp (i-decr <tsp> <tsp>{i}-step (i), load-addr)

Theorem: i-state-okp-i-neg <tsp> <tsp>{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-neg <tsp> <tsp>{i}-okp (i)) → i-state-okp (i-neg <tsp> <tsp>{i}-step (i), load-addr)

Theorem: i-state-okp-i-asr <c> <tsp> <tsp>{b}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-asr <c> <tsp> <tsp>{b}-okp (i)) → i-state-okp (i-asr <c> <tsp> <tsp>{b}-step (i), load-addr)

Theorem: i-state-okp-i-addc <c> x{n} y{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-addc <c> x{n} y{n}-okp (i)) → i-state-okp (i-addc <c> x{n} y{n}-step (i), load-addr)

Theorem: i-state-okp-i-add <tsp>{n} x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add <tsp>{n} x{n}-okp (i)) → i-state-okp (i-add <tsp>{n} x{n}-step (i), load-addr)

Theorem: i-state-okp-i-incr <tsp> <tsp>{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-incr <tsp> <tsp>{n}-okp (i)) → i-state-okp (i-incr <tsp> <tsp>{n}-step (i), load-addr)

Theorem: i-state-okp-i-incr y y{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-incr y y{n}-okp (i)) → i-state-okp (i-incr y y{n}-step (i), load-addr)

Theorem: i-state-okp-i-int-to-nat-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-int-to-nat-okp (i)) → i-state-okp (i-int-to-nat-step (i), load-addr)

Theorem: i-state-okp-i-decr <tsp> <tsp>{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-decr <tsp> <tsp>{n}-okp (i)) → i-state-okp (i-decr <tsp> <tsp>{n}-step (i), load-addr)

Theorem: i-state-okp-i-add <c> x x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add <c> x x{n}-okp (i)) → i-state-okp (i-add <c> x x{n}-step (i), load-addr)

Theorem: i-state-okp-i-add <tsp> <tsp>{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add <tsp> <tsp>{n}-okp (i)) → i-state-okp (i-add <tsp> <tsp>{n}-step (i), load-addr)

Theorem: i-state-okp-i-lsr <c> x x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ i-lsr <c> x x{n}-okp (i)) → i-state-okp (i-lsr <c> x x{n}-step (i), load-addr)

Theorem: i-state-okp-i-subb <c> x{n} y{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-subb <c> x{n} y{n}-okp (i)) → i-state-okp (i-subb <c> x{n} y{n}-step (i), load-addr)

Theorem: i-state-okp-i-sub <c> <tsp>{n} x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <c> <tsp>{n} x{n}-okp (i)) → i-state-okp (i-sub <c> <tsp>{n} x{n}-step (i), load-addr)

; I got to here, but ran out of CONS space and can't save my lib.

Theorem: i-state-okp-i-sub <nv> <tsp>{i} x{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <nv> <tsp>{i} x{i}-okp (i)) → i-state-okp (i-sub <nv> <tsp>{i} x{i}-step (i), load-addr)

Theorem: i-state-okp-i-sub <tsp>{n} x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <tsp>{n} x{n}-okp (i)) → i-state-okp (i-sub <tsp>{n} x{n}-step (i), load-addr)

Theorem: i-state-okp-i-sub <c> <tsp>{a} x{a}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <c> <tsp>{a} x{a}-okp (i)) → i-state-okp (i-sub <c> <tsp>{a} x{a}-step (i), load-addr)

Theorem: i-state-okp-i-sub <tsp>{s} x{s}-step ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <tsp>{s} x{s}-okp (i)) → i-state-okp (i-sub <tsp>{s} x{s}-step (i), load-addr)

Theorem: i-state-okp-i-move-c <tsp> *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move-c <tsp> *-okp (i)) → i-state-okp (i-move-c <tsp> *-step (i), load-addr)

Theorem: i-state-okp-i-move-v <tsp> *-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-move-v <tsp> *-okp (i)) → i-state-okp (i-move-v <tsp> *-step (i), load-addr)

Theorem: i-state-okp-i-or <tsp>{v} x{v}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-or <tsp>{v} x{v}-okp (i)) → i-state-okp (i-or <tsp>{v} x{v}-step (i), load-addr)

Theorem: i-state-okp-i-and <tsp>{v} x{v}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-and <tsp>{v} x{v}-okp (i)) → i-state-okp (i-and <tsp>{v} x{v}-step (i), load-addr)

Theorem: i-state-okp-i-not <tsp> <tsp>{v}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-not <tsp> <tsp>{v}-okp (i)) → i-state-okp (i-not <tsp> <tsp>{v}-step (i), load-addr)

Theorem: i-state-okp-i-xor <tsp>{v} x{v}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-xor <tsp>{v} x{v}-okp (i)) → i-state-okp (i-xor <tsp>{v} x{v}-step (i), load-addr)

Theorem: i-state-okp-i-lsr <tsp> <tsp>{v}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-lsr <tsp> <tsp>{v}-okp (i)) → i-state-okp (i-lsr <tsp> <tsp>{v}-step (i), load-addr)

Theorem: i-state-okp-i-add <tsp> <tsp>{v}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add <tsp> <tsp>{v}-okp (i)) → i-state-okp (i-add <tsp> <tsp>{v}-step (i), load-addr)

Theorem: i-state-okp-i-or <tsp>{b} x{b}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-or <tsp>{b} x{b}-okp (i)) → i-state-okp (i-or <tsp>{b} x{b}-step (i), load-addr)

Theorem: i-state-okp-i-and <tsp>{b} x{b}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-and <tsp>{b} x{b}-okp (i)) → i-state-okp (i-and <tsp>{b} x{b}-step (i), load-addr)

Theorem: i-state-okp-i-xor <tsp>{b} *{b}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-xor <tsp>{b} *{b}-okp (i)) → i-state-okp (i-xor <tsp>{b} *{b}-step (i), load-addr)

Theorem: i-state-okp-i-xor <tsp>{b} x{b}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-xor <tsp>{b} x{b}-okp (i)) → i-state-okp (i-xor <tsp>{b} x{b}-step (i), load-addr)

Theorem: i-state-okp-i-add pc x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)

∧ (i-psw (i) = 'run) ∧ i-add pc x{n}-okp (i)) → i-state-okp (i-add pc x{n}-step (i), load-addr)

Theorem: i-state-okp-i-add x x{n}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-add x x{n}-okp (i)) → i-state-okp (i-add x x{n}-step (i), load-addr)

Theorem: i-state-okp-i-addc <v> x{i} y{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-addc <v> x{i} y{i}-okp (i)) → i-state-okp (i-addc <v> x{i} y{i}-step (i), load-addr)

Theorem: i-state-okp-i-subb <v> x{i} y{i}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-subb <v> x{i} y{i}-okp (i)) → i-state-okp (i-subb <v> x{i} y{i}-step (i), load-addr)

Theorem: i-state-okp-i-cpush cfp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-cpush cfp-okp (i)) → i-state-okp (i-cpush cfp-step (i), load-addr)

Theorem: i-state-okp-i-sub <z> x{s} y{s}-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-sub <z> x{s} y{s}-okp (i)) → i-state-okp (i-sub <z> x{s} y{s}-step (i), load-addr)

Theorem: i-state-okp-i-ins-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ i-ins-okp (ins, i)) → i-state-okp (i-ins-step (ins, i, load-addr), load-addr)

Theorem: i-state-okp-i-halt i-state-okp (i-halt (i, psw), load-addr) = i-state-okp (i, load-addr)

Theorem: i-state-okp-i-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)) → i-state-okp (i-step (i, load-addr), load-addr)

; The link tables in display-data-segment play two roles.  One is
; to let us get at that section of memory containing a certain
; area.  The other is to map the objects in that section up.
; I wish to distinguish these two roles because I need to do some
; inductions in which one of the tables is fixed and the other
; varies.  In addition, I need to separate the process of fetching
; the objects from the process of mapping them up.  So I will define
; the functions that do these separate jobs and prove their equivalence
; to display-data-segment.

Definition: get-array (n, m-addr, m-mem) = if n ≃ 0 then nil

else cons (get (m-addr, m-mem), get-array (n − 1, 1 + m-addr, m-mem)) endif

Definition: unlink-data-word-array (type-lst, obj-lst, link-tables) = if type-lst ≃ nil then nil

else cons (unlink-data-word (car (type-lst), car (obj-lst), link-tables),

unlink-data-word-array (cdr (type-lst), cdr (obj-lst), link-tables)) endif

Definition: get-areas (type-spec, usr-data-links, m-mem) = if type-spec ≃ nil then nil

else cons (cons (caar (type-spec),

get-array (length (cdar (type-spec)),

base-address (caar (type-spec),

usr-data-links),

m-mem)),

get-areas (cdr (type-spec), usr-data-links, m-mem)) endif

Definition: unlink-areas (type-spec, segment, link-tables)

= if type-spec ≃ nil then nil

else cons (cons (caar (type-spec),

unlink-data-word-array (cdar (type-spec), cdar (segment), link-tables)),

unlink-areas (cdr (type-spec), cdr (segment), link-tables)) endif

Definition: display-array (type-lst, n, m-mem, link-tables) = if type-lst ≃ nil then nil

else cons (unlink-data-word (car (type-lst), get (n, m-mem), link-tables),

display-array (cdr (type-lst), 1 + n, m-mem, link-tables)) endif

Definition: display-data-area (area-type-spec, m-mem, link-tables) = cons (car (area-type-spec),

display-array (cdr (area-type-spec),

base-address (car (area-type-spec),

usr-data-links (link-tables)),

m-mem, link-tables))

Definition: display-data-segment (type-spec, m-mem, link-tables) = if type-spec ≃ nil then nil

else cons (display-data-area (car (type-spec), m-mem, link-tables), display-data-segment (cdr (type-spec), m-mem, link-tables)) endif

Definition: display-m-data-segment (m, type-spec, link-tables) = display-data-segment (type-spec, m-mem (m), link-tables)

Theorem: display-array-decomposition display-array (type-lst, m-addr, m-mem, link-tables) = unlink-data-word-array (type-lst,

get-array (length (type-lst), m-addr, m-mem), link-tables)

Theorem: display-data-segment-decomposition display-data-segment (type-spec, m-mem, i-link-tables (i, load-addr)) = unlink-areas (type-spec,

get-areas (type-spec, link-table-for-segment (i-usr-data-segment (i),

load-addr),

m-mem), i-link-tables (i, load-addr))

; The key steps to proving that display-data-segment inverts is to
; show that (a) get-areas retrieves the linked areas and (b)
; unlink-areas inverts link-areas.  We begin with the get-segment
; part.
; Link-areas, mentioned above, is like link-segment, only it
; preserves the areas instead of flattening them.

Definition: link-areas (segment, link-tables, word-size) = if segment ≃ nil then nil

else cons (cons (caar (segment),

link-area (cdar (segment), link-tables, word-size)), link-areas (cdr (segment), link-tables, word-size)) endif

; To show that get-areas on a linked memory gives link-areas, it is
; necessary to know that get-array gets a link-area.

Definition: cdr-n (n, lst) = if n ≃ 0 then lst

else cdr-n (n − 1, cdr (lst)) endif

Event: Enable equal-length-0.

Theorem: lessp-link-table-entry (definedp (name, segment) ∧ listp (cdr (assoc (name, segment)))) → (link-table-entry (name, segment) < segment-length (segment))

Theorem: get-link-table-entry-link-segment-generalized (definedp (name, segment) ∧ (i < length (cdr (assoc (name, segment))))) → (get (i + link-table-entry (name, segment),

link-segment (segment, table, word-size)) = link-word (unlabel (get (i, cdr (assoc (name, segment)))),

table,

word-size))

Theorem: plus-equal-0 ((x + y) = 0) = ((x ≃ 0) ∧ (y ≃ 0))

Theorem: car-cdr-n-is-get car (cdr-n (n, lst)) = get (n, lst)

Theorem: cdr-cdr-n cdr (cdr-n (n, lst)) = cdr-n (n, cdr (lst))

; This lemma was excrutiatingly hard for me to get.
; The reason, I think, is that I've just come back to
; the im level proofs after 3 months of working elsewhere
; and I no longer have the required mastery of the rules.
; This theorem was hard to invent too.  The main reason is
; that I had to get a sufficiently general version to permit
; inductive proof.  The trick was the introduction of i.

Definition: first-n (n, x) = if n ≃ 0 then nil

else cons (car (x), first-n (n − 1, cdr (x))) endif

Theorem: get-array-link-mem (definedp (name, usr-data-segment) ∧ (length (cdr (assoc (name, usr-data-segment))) ≮ (i + n)) ∧ (i ∈ N) ∧ (n ∈ N)) → (get-array (n,

load-addr + (i + link-table-entry (name,

usr-data-segment)),

append (boot-code (boot-lst, load-addr, word-size),

append (link-segment (usr-data-segment, tables, word-size),

rest)))

= link-area (first-n (n,

cdr-n (i, cdr (assoc (name, usr-data-segment)))), tables, word-size))

; Now I instantiate the above theorem to get the rule I need.
; The following lemma has a link-area around a familiar identity
; just so I can avoid bringing up a properp hypothesis.

Theorem: first-n-length-embedded link-area (first-n (length (lst), lst), tables, word-size) = link-area (lst, tables, word-size)

Theorem: get-array-link-mem-instance (definedp (name, usr-data-segment) ∧ (n = length (cdr (assoc (name, usr-data-segment))))) → (get-array (n,

load-addr + link-table-entry (name, usr-data-segment), append (boot-code (boot-lst, load-addr, word-size),

append (link-segment (usr-data-segment, tables, word-size),

rest)))

= link-area (cdr (assoc (name, usr-data-segment)), tables, word-size))

; To formulate a suitably general version of the get-areas
; theorem I need the concept that one segment is an extension
; of another.  By that I mean that everything that occurs in
; the one is identically defined in the other.
; Notice that this concept is not reflexive
; unless we know the segment contains no duplicate area names.
; This whole concept is fairly subtle in its interaction with
; the proof of the get-areas lemma.  The first three lemmas
; below are the crucial properties of subsegmentp for that
; proof.  Reflexivity is needed only for the final use of
; the get-areas theorem.

Definition: subsegmentp (segment1 , segment2 ) = if segment1 ≃ nil then t

else definedp (caar (segment1 ), segment2 ) ∧ (assoc (caar (segment1 ), segment2 ) = car (segment1 )) ∧ subsegmentp (cdr (segment1 ), segment2 ) endif

Theorem: subsegmentp-cdr (listp (x) ∧ subsegmentp (x, y)) → subsegmentp (cdr (x), y)

Theorem: subsegmentp-implies-definedp (listp (segment) ∧ subsegmentp (segment, usr-data-segment)) → definedp (caar (segment), usr-data-segment)

Theorem: subsegmentp-implies-equal-assoc (listp (segment) ∧ subsegmentp (segment, usr-data-segment)) → (assoc (caar (segment), usr-data-segment) = car (segment))

Theorem: subsegmentp-reflexive-lemma (subsegmentp (x, cdr (y)) ∧ (¬ definedp (caar (y), x))) → subsegmentp (x, y)

Theorem: subsegmentp-reflexive proper-i-usr-data-segmentp (segment, i) → subsegmentp (segment, segment)

Theorem: length-type-lst length (type-lst (area)) = length (area)

; The following theorem is key step (a) above, when the theorem is
; instantiated with segment replaced by usr-data-segment.

Theorem: get-areas-link-mem ((load-addr ∈ N) ∧ subsegmentp (segment, usr-data-segment)) → (get-areas (type-specification (segment),

link-table-for-segment (usr-data-segment, load-addr), append (boot-code (boot-lst, load-addr, word-size),

append (link-segment (usr-data-segment, tables, word-size),

rest)))

= link-areas (segment, tables, word-size))

Theorem: not-icode-instructionp i-objectp (x, i) → (¬ icode-instructionp (x))

; We now have to prove that if i-state-okp holds then i-word-size is
; non-0.  This is necessary because otherwise booleans don't invert!

Theorem: cstk-implies-not-zerop-segment-length (n < length (cdr (assoc ('cstk, segment)))) → (segment-length (segment) ≄ 0)

Theorem: i-loadablep-and-cstk-implies-not-zerop-i-word-size (i-loadablep (i, load-addr) ∧ (adp-offset (untag (i-cfp (i)))

< length (cdr (assoc ('cstk, i-sys-data-segment (i)))))) → ((i-word-size (i) ∈ N) ∧ (0 < i-word-size (i)))

Theorem: car-cdr-elim-accelerator (listp (x) ∧ (cddr (x) = nil) ∧ (type = car (x))) → (list (type, cadr (x)) = x)

; Here is the key invertibility lemma.
; The list of disabled functions, after icode-instructionp, in the
; hint below was mechanically generated.  It contains all the
; functions used to link and unlink individual data types.  The list
; could be shortened.

Theorem: unlink-data-word-link-data-word ((load-addr ∈ N) ∧ i-usr-data-objectp (x, i) ∧ i-state-okp (i, load-addr)) → (unlink-data-word (type (x),

link-data-word (x, i-link-tables (i, load-addr), i-word-size (i)),

i-link-tables (i, load-addr))

= x)

Theorem: unlink-data-word-array-link-area ((load-addr ∈ N) ∧ all-i-usr-data-objectps (array, i) ∧ i-state-okp (i, load-addr)) → (unlink-data-word-array (type-lst (array),

link-area (array, i-link-tables (i, load-addr), i-word-size (i)),

i-link-tables (i, load-addr))

= array)

Theorem: unlink-areas-link-areas ((load-addr ∈ N) ∧ proper-i-usr-data-segmentp (segment, i) ∧ i-state-okp (i, load-addr)) → (unlink-areas (type-specification (segment),

link-areas (segment, i-link-tables (i, load-addr), i-word-size (i)),

i-link-tables (i, load-addr))

= segment)

Theorem: display-m-data-segment-inverts-i->m ((load-addr ∈ N) ∧ proper-i-usr-data-segmentp (i-usr-data-segment (i), i) ∧ i-state-okp (i, load-addr)) → (display-m-data-segment (i->m (i, boot-lst, load-addr),

type-specification (i-usr-data-segment (i)),

i-link-tables (i, load-addr))

= i-usr-data-segment (i))

Theorem: i-link-tables-step-move x x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move x x-okp (i) ∧ (i-current-instruction (i) = '(move x x))) → (i-link-tables (i-move x x-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-cpush * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpush *-okp (i) ∧ (i-current-instruction (i) = '(cpush *))) → (i-link-tables (i-cpush *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add <tsp>{i} x{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp>{i} x{i}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp>{i} x{i}))) → (i-link-tables (i-add <tsp>{i} x{i}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-cpush cfp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpush cfp-okp (i) ∧ (i-current-instruction (i) = '(cpush cfp))) → (i-link-tables (i-cpush cfp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move cfp csp ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move cfp csp-okp (i) ∧ (i-current-instruction (i) = '(move cfp csp))) → (i-link-tables (i-move cfp csp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-cpush <tsp>+ ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpush <tsp>+-okp (i) ∧ (i-current-instruction (i) = '(cpush <tsp>+))) → (i-link-tables (i-cpush <tsp>+-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move csp cfp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move csp cfp-okp (i) ∧ (i-current-instruction (i) = '(move csp cfp))) → (i-link-tables (i-move csp cfp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move x tsp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move x tsp-okp (i) ∧ (i-current-instruction (i) = '(move x tsp))) → (i-link-tables (i-move x tsp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-cpop cfp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpop cfp-okp (i) ∧ (i-current-instruction (i) = '(cpop cfp)))

→ (i-link-tables (i-cpop cfp-step (i), load-addr) = i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move x * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move x *-okp (i) ∧ (i-current-instruction (i) = '(move x *))) → (i-link-tables (i-move x *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move y * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move y *-okp (i) ∧ (i-current-instruction (i) = '(move y *))) → (i-link-tables (i-move y *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add x{n} csp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add x{n} csp-okp (i) ∧ (i-current-instruction (i) = '(add x{n} csp))) → (i-link-tables (i-add x{n} csp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move x <x{s}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move x <x{s}>-okp (i) ∧ (i-current-instruction (i) = '(move x <x{s}>))) → (i-link-tables (i-move x <x{s}>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move y <y{s}> ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move y <y{s}>-okp (i) ∧ (i-current-instruction (i) = '(move y <y{s}>))) → (i-link-tables (i-move y <y{s}>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move y tsp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move y tsp-okp (i) ∧ (i-current-instruction (i) = '(move y tsp))) → (i-link-tables (i-move y tsp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpush csp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush csp-okp (i) ∧ (i-current-instruction (i) = '(tpush csp))) → (i-link-tables (i-tpush csp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpush tsp ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush tsp-okp (i) ∧ (i-current-instruction (i) = '(tpush tsp))) → (i-link-tables (i-tpush tsp-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpush x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush x-okp (i) ∧ (i-current-instruction (i) = '(tpush x)))

→ (i-link-tables (i-tpush x-step (i), load-addr) = i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpush <x{s}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush <x{s}>-okp (i) ∧ (i-current-instruction (i) = '(tpush <x{s}>))) → (i-link-tables (i-tpush <x{s}>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpush <x{a}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush <x{a}>-okp (i) ∧ (i-current-instruction (i) = '(tpush <x{a}>))) → (i-link-tables (i-tpush <x{a}>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpush * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpush *-okp (i) ∧ (i-current-instruction (i) = '(tpush *))) → (i-link-tables (i-tpush *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop x-okp (i) ∧ (i-current-instruction (i) = '(tpop x))) → (i-link-tables (i-tpop x-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop y ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop y-okp (i) ∧ (i-current-instruction (i) = '(tpop y))) → (i-link-tables (i-tpop y-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop <x{s}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop <x{s}>-okp (i) ∧ (i-current-instruction (i) = '(tpop <x{s}>))) → (i-link-tables (i-tpop <x{s}>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop <x{a}> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop <x{a}>-okp (i) ∧ (i-current-instruction (i) = '(tpop <x{a}>))) → (i-link-tables (i-tpop <x{a}>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-jump * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump *-okp (i) ∧ (i-current-instruction (i) = '(jump *))) → (i-link-tables (i-jump *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-cpop pc ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-cpop pc-okp (i) ∧ (i-current-instruction (i) = '(cpop pc)))

→ (i-link-tables (i-cpop pc-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move <x{s}> <tsp> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move <x{s}> <tsp>-okp (i) ∧ (i-current-instruction (i) = '(move <x{s}> <tsp>))) → (i-link-tables (i-move <x{s}> <tsp>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move <x{a}> <tsp> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move <x{a}> <tsp>-okp (i) ∧ (i-current-instruction (i) = '(move <x{a}> <tsp>))) → (i-link-tables (i-move <x{a}> <tsp>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-jump x{subr} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump x{subr}-okp (i) ∧ (i-current-instruction (i) = '(jump x{subr}))) → (i-link-tables (i-jump x{subr}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-jump-n x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-n x-okp (i) ∧ (i-current-instruction (i) = '(jump-n x))) → (i-link-tables (i-jump-n x-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-jump-nn x ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-nn x-okp (i) ∧ (i-current-instruction (i) = '(jump-nn x))) → (i-link-tables (i-jump-nn x-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-jump-z x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-z x-okp (i) ∧ (i-current-instruction (i) = '(jump-z x))) → (i-link-tables (i-jump-z x-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-jump-nz x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-jump-nz x-okp (i) ∧ (i-current-instruction (i) = '(jump-nz x))) → (i-link-tables (i-jump-nz x-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop pc ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop pc-okp (i) ∧ (i-current-instruction (i) = '(tpop pc))) → (i-link-tables (i-tpop pc-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop <c> x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop <c> x-okp (i) ∧ (i-current-instruction (i) = '(tpop <c> x)))

→ (i-link-tables (i-tpop <c> x-step (i), load-addr) = i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop{n} <z> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{n} <z> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{n} <z> y))) → (i-link-tables (i-tpop{n} <z> y-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop{i} <zn> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{i} <zn> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{i} <zn> y))) → (i-link-tables (i-tpop{i} <zn> y-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop{b} <z> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{b} <z> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{b} <z> y))) → (i-link-tables (i-tpop{b} <z> y-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-tpop{v} <z> y ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-tpop{v} <z> y-okp (i) ∧ (i-current-instruction (i) = '(tpop{v} <z> y))) → (i-link-tables (i-tpop{v} <z> y-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add <tsp>{a} x{n} ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp>{a} x{n}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp>{a} x{n}))) → (i-link-tables (i-add <tsp>{a} x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add tsp *{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add tsp *{n}-okp (i) ∧ (i-current-instruction (i) = '(add tsp *{n}))) → (i-link-tables (i-add tsp *{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add tsp x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add tsp x{n}-okp (i) ∧ (i-current-instruction (i) = '(add tsp x{n}))) → (i-link-tables (i-add tsp x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <tsp>{a} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{a} x{n}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{a} x{n}))) → (i-link-tables (i-sub <tsp>{a} x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub x{s} y{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub x{s} y{n}-okp (i) ∧ (i-current-instruction (i) = '(sub x{s} y{n})))

→ (i-link-tables (i-sub x{s} y{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-xor <z> <tsp> x ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <z> <tsp> x-okp (i) ∧ (i-current-instruction (i) = '(xor <z> <tsp> x))) → (i-link-tables (i-xor <z> <tsp> x-step (i, load-addr), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-xor <tsp> <tsp> ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp> <tsp>-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp> <tsp>))) → (i-link-tables (i-xor <tsp> <tsp>-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move-z <tsp> * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-z <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move-z <tsp> *))) → (i-link-tables (i-move-z <tsp> *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move-n x * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-n x *-okp (i) ∧ (i-current-instruction (i) = '(move-n x *))) → (i-link-tables (i-move-n x *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move <tsp> * ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move <tsp> *))) → (i-link-tables (i-move <tsp> *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-incr <tsp> <tsp>{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-incr <tsp> <tsp>{i}-okp (i) ∧ (i-current-instruction (i) = '(incr <tsp> <tsp>{i}))) → (i-link-tables (i-incr <tsp> <tsp>{i}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <tsp>{i} x{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{i} x{i}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{i} x{i}))) → (i-link-tables (i-sub <tsp>{i} x{i}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-decr <tsp> <tsp>{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-decr <tsp> <tsp>{i}-okp (i) ∧ (i-current-instruction (i) = '(decr <tsp> <tsp>{i}))) → (i-link-tables (i-decr <tsp> <tsp>{i}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-neg <tsp> <tsp>{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-neg <tsp> <tsp>{i}-okp (i) ∧ (i-current-instruction (i) = '(neg <tsp> <tsp>{i})))

→ (i-link-tables (i-neg <tsp> <tsp>{i}-step (i), load-addr) = i-link-tables (i, load-addr))

Theorem: i-link-tables-step-asr <c> <tsp> <tsp>{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-asr <c> <tsp> <tsp>{b}-okp (i) ∧ (i-current-instruction (i) = '(asr <c> <tsp> <tsp>{b}))) → (i-link-tables (i-asr <c> <tsp> <tsp>{b}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-addc <c> x{n} y{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-addc <c> x{n} y{n}-okp (i) ∧ (i-current-instruction (i) = '(addc <c> x{n} y{n}))) → (i-link-tables (i-addc <c> x{n} y{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add <tsp>{n} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp>{n} x{n}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp>{n} x{n}))) → (i-link-tables (i-add <tsp>{n} x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-incr <tsp> <tsp>{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-incr <tsp> <tsp>{n}-okp (i) ∧ (i-current-instruction (i) = '(incr <tsp> <tsp>{n}))) → (i-link-tables (i-incr <tsp> <tsp>{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-incr y y{n} ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-incr y y{n}-okp (i) ∧ (i-current-instruction (i) = '(incr y y{n}))) → (i-link-tables (i-incr y y{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-int-to-nat ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-int-to-nat-okp (i) ∧ (i-current-instruction (i) = '(int-to-nat))) → (i-link-tables (i-int-to-nat-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-decr <tsp> <tsp>{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-decr <tsp> <tsp>{n}-okp (i) ∧ (i-current-instruction (i) = '(decr <tsp> <tsp>{n}))) → (i-link-tables (i-decr <tsp> <tsp>{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add <c> x x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <c> x x{n}-okp (i) ∧ (i-current-instruction (i) = '(add <c> x x{n}))) → (i-link-tables (i-add <c> x x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add <tsp> <tsp>{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp> <tsp>{n}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp> <tsp>{n})))

→ (i-link-tables (i-add <tsp> <tsp>{n}-step (i), load-addr) = i-link-tables (i, load-addr))

Theorem: i-link-tables-step-lsr <c> x x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-lsr <c> x x{n}-okp (i) ∧ (i-current-instruction (i) = '(lsr <c> x x{n}))) → (i-link-tables (i-lsr <c> x x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-subb <c> x{n} y{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-subb <c> x{n} y{n}-okp (i) ∧ (i-current-instruction (i) = '(subb <c> x{n} y{n}))) → (i-link-tables (i-subb <c> x{n} y{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <c> <tsp>{n} x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <c> <tsp>{n} x{n}-okp (i) ∧ (i-current-instruction (i) = '(sub <c> <tsp>{n} x{n}))) → (i-link-tables (i-sub <c> <tsp>{n} x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <nv> <tsp>{i} x{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <nv> <tsp>{i} x{i}-okp (i) ∧ (i-current-instruction (i) = '(sub <nv> <tsp>{i} x{i}))) → (i-link-tables (i-sub <nv> <tsp>{i} x{i}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <tsp>{n} x{n} ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{n} x{n}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{n} x{n}))) → (i-link-tables (i-sub <tsp>{n} x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <c> <tsp>{a} x{a} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <c> <tsp>{a} x{a}-okp (i) ∧ (i-current-instruction (i) = '(sub <c> <tsp>{a} x{a}))) → (i-link-tables (i-sub <c> <tsp>{a} x{a}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <tsp>{s} x{s} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <tsp>{s} x{s}-okp (i) ∧ (i-current-instruction (i) = '(sub <tsp>{s} x{s}))) → (i-link-tables (i-sub <tsp>{s} x{s}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-sub <z> x{s} y{s} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-sub <z> x{s} y{s}-okp (i) ∧ (i-current-instruction (i) = '(sub <z> x{s} y{s}))) → (i-link-tables (i-sub <z> x{s} y{s}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move-c <tsp> * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-c <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move-c <tsp> *)))

→ (i-link-tables (i-move-c <tsp> *-step (i), load-addr) = i-link-tables (i, load-addr))

Theorem: i-link-tables-step-move-v <tsp> * ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-move-v <tsp> *-okp (i) ∧ (i-current-instruction (i) = '(move-v <tsp> *))) → (i-link-tables (i-move-v <tsp> *-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-or <tsp>{v} x{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-or <tsp>{v} x{v}-okp (i) ∧ (i-current-instruction (i) = '(or <tsp>{v} x{v}))) → (i-link-tables (i-or <tsp>{v} x{v}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-and <tsp>{v} x{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-and <tsp>{v} x{v}-okp (i) ∧ (i-current-instruction (i) = '(and <tsp>{v} x{v}))) → (i-link-tables (i-and <tsp>{v} x{v}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-not <tsp> <tsp>{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-not <tsp> <tsp>{v}-okp (i) ∧ (i-current-instruction (i) = '(not <tsp> <tsp>{v}))) → (i-link-tables (i-not <tsp> <tsp>{v}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-xor <tsp>{v} x{v} ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp>{v} x{v}-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp>{v} x{v}))) → (i-link-tables (i-xor <tsp>{v} x{v}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-lsr <tsp> <tsp>{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-lsr <tsp> <tsp>{v}-okp (i) ∧ (i-current-instruction (i) = '(lsr <tsp> <tsp>{v}))) → (i-link-tables (i-lsr <tsp> <tsp>{v}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add <tsp> <tsp>{v} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add <tsp> <tsp>{v}-okp (i) ∧ (i-current-instruction (i) = '(add <tsp> <tsp>{v}))) → (i-link-tables (i-add <tsp> <tsp>{v}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-or <tsp>{b} x{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-or <tsp>{b} x{b}-okp (i) ∧ (i-current-instruction (i) = '(or <tsp>{b} x{b}))) → (i-link-tables (i-or <tsp>{b} x{b}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-and <tsp>{b} x{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-and <tsp>{b} x{b}-okp (i) ∧ (i-current-instruction (i) = '(and <tsp>{b} x{b})))

→ (i-link-tables (i-and <tsp>{b} x{b}-step (i), load-addr) = i-link-tables (i, load-addr))

Theorem: i-link-tables-step-xor <tsp>{b} *{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp>{b} *{b}-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp>{b} *{b}))) → (i-link-tables (i-xor <tsp>{b} *{b}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-xor <tsp>{b} x{b} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-xor <tsp>{b} x{b}-okp (i) ∧ (i-current-instruction (i) = '(xor <tsp>{b} x{b}))) → (i-link-tables (i-xor <tsp>{b} x{b}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add pc x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add pc x{n}-okp (i) ∧ (i-current-instruction (i) = '(add pc x{n}))) → (i-link-tables (i-add pc x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-add x x{n} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-add x x{n}-okp (i) ∧ (i-current-instruction (i) = '(add x x{n}))) → (i-link-tables (i-add x x{n}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-addc <v> x{i} y{i} ((load-addr ∈ N)

∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-addc <v> x{i} y{i}-okp (i) ∧ (i-current-instruction (i) = '(addc <v> x{i} y{i}))) → (i-link-tables (i-addc <v> x{i} y{i}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step-subb <v> x{i} y{i} ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-subb <v> x{i} y{i}-okp (i) ∧ (i-current-instruction (i) = '(subb <v> x{i} y{i}))) → (i-link-tables (i-subb <v> x{i} y{i}-step (i), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-ins-okp-step ((load-addr ∈ N) ∧ i-state-okp (i, load-addr) ∧ (i-psw (i) = 'run) ∧ (i-word-size (i) = 32) ∧ i-ins-okp (i-current-instruction (i), i)) → (i-link-tables (i-ins-step (i-current-instruction (i), i, load-addr),

load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-step ((load-addr ∈ N) ∧ (i-psw (i-step (i, load-addr)) = 'run) ∧ (i-word-size (i) = 32)) → (i-link-tables (i-step (i, load-addr), load-addr)

= i-link-tables (i, load-addr))

Theorem: i-link-tables-i ((load-addr ∈ N) ∧ (i-psw (i (i, n, load-addr)) = 'run) ∧ (i-word-size (i) = 32)) → (i-link-tables (i (i, n, load-addr), load-addr)

= i-link-tables (i, load-addr))

Theorem: read-mem-ram-tree-is-get ((exp (2, word-size) ≮ length (lst)) ∧ (n < length (lst))) → (read-mem (nat-to-v (n, word-size), ram-tree (lst, exp (2, word-size)))

= get (n, lst))

Theorem: one-way-correspondence-display-array (bvp-listp (mem) ∧ (exp (2, 32) ≮ length (mem)) ∧ (length (mem) ≮ (n + length (type-lst)))) → (display-fm9001-array (type-lst, n, ram-tree (mem, exp (2, 32)), link-tables)

= display-array (type-lst, n, mem, link-tables))

Definition: plausible-data-link-tablep (type-spec, n, usr-data-link-table) = if type-spec ≃ nil then t

else (n ≮ (cdr (assoc (caar (type-spec), usr-data-link-table))

+ length (cdar (type-spec)))) ∧ plausible-data-link-tablep (cdr (type-spec),

n,

usr-data-link-table) endif

Theorem: one-way-correspondence-display-fm9001-data-segment1 (bvp-listp (mem) ∧ (exp (2, 32) ≮ length (mem)) ∧ plausible-data-link-tablep (type-spec,

length (mem),

usr-data-links (link-tables)))

→ (display-fm9001-data-segment1 (type-spec, ram-tree (mem, exp (2, 32)), link-tables)

= display-data-segment (type-spec, mem, link-tables))

Theorem: display-fm9001-data-segment-m->fm9001 (proper-m-statep (m) ∧ plausible-data-link-tablep (type-spec,

length (m-mem (m)),

usr-data-links (link-tables)))

→ (display-fm9001-data-segment (m->fm9001 (m), type-spec, link-tables) = display-m-data-segment (m, type-spec, link-tables))

; We will have to return to the question of a plausible data link table once we have
; finished the other levels.  The problem is that we have to show that the
; actual data link table generated is plausible and we will do that with
; arguments about the various levels preserving the signatures of the
; the various segments.  But these concepts are not available yet and so
; we complete our work at the m v. fm9001 level by just leaving plausibility
; for later.
; Book:  r.events.  Now we introduce the r machine.

Event: Set the status of all events. The status of each event is to be set as follows. Each ‘boot-strap’ satellite is to be returned to the initial condition. Each ‘add-shell’ satellite is to be enabled. enabled. Anything not otherwise mentioned is to be disabled. Name this event ‘close-data-base-3’.

; We now build r-i.events from its subbooks.

Definition: strip-cadrs (alist) = if alist ≃ nil then nil

else cons (cadar (alist), strip-cadrs (cdr (alist))) endif

Definition: pcpp (x, segment) = (listp (x)

∧ (adp-offset (x) ∈ N)

∧ definedp (adp-name (x), segment)

∧ (adp-offset (x)

< length (program-body (definition (adp-name (x), segment)))))

Definition: not-bool (x) = if x = 'f then 't

else 'f endif

Definition: p-test-natp (flg, x) = if flg = 'zero then x = 0

else x ≠ 0 endif

Definition: p-test-intp (flg, x) = case on flg:

case = zero then x = 0 case = not-zero then x ≠ 0 case = neg then negativep (x) case = not-neg then ¬ negativep (x) case = pos then (x ∈ N) ∧ (x ≠ 0) otherwise (x = 0) ∨ negativep (x) endcase Definition: p-test-boolp (flg, x) = if flg = 't then x = 't

else x = 'f endif

Definition: p-test-bitvp (flg, x) = if flg = 'all-zero then all-zero-bitvp (x)

else ¬ all-zero-bitvp (x) endif

Definition: piton-opcodes

= '(call ret locn push-constant push-local push-global
      push-ctrl-stk-free-size push-temp-stk-free-size
      push-temp-stk-index jump-if-temp-stk-full
      jump-if-temp-stk-empty pop pop* popn pop-local
      pop-global pop-locn pop-call fetch-temp-stk
      deposit-temp-stk jump jump-case pushj popj set-local
      set-global test-nat-and-jump test-int-and-jump
      test-bool-and-jump test-bitv-and-jump no-op add-addr
      sub-addr eq lt-addr fetch deposit add-int
      add-int-with-carry add1-int sub-int sub-int-with-carry
      sub1-int neg-int lt-int int-to-nat add-nat
      add-nat-with-carry add1-nat sub-nat sub-nat-with-carry
      sub1-nat lt-nat mult2-nat mult2-nat-with-carry-out
      div2-nat or-bitv and-bitv not-bitv xor-bitv rsh-bitv
      lsh-bitv or-bool and-bool not-bool)

Definition: legal-labelp (ins) = (labelledp (ins) → litatom (cadr (ins)))

Definition: r-objectp (x, r) = (listp (x)

∧ (cddr (x) = nil) ∧ case on type (x): case = nat then small-naturalp (untag (x), r-word-size (r)) case = int then small-integerp (untag (x), r-word-size (r)) case = bitv then bit-vectorp (untag (x), r-word-size (r)) case = bool then booleanp (untag (x)) case = addr then adpp (untag (x), r-usr-data-segment (r)) case = pc then pcpp (untag (x), r-prog-segment (r)) case = subr then definedp (untag (x), r-prog-segment (r)) case = sys-addr then adpp (untag (x), r-sys-data-segment (r)) otherwise f endcase)

Definition: r-objectp-type (type, x, r) = ((type (x) = type) ∧ r-objectp (x, r))

Definition: all-r-objectps (lst, r) = if lst ≃ nil then lst = nil

else r-objectp (car (lst), r) ∧ all-r-objectps (cdr (lst), r) endif

Definition: r-usr-data-typep (type)

= (type ∈ '(nat int bitv bool addr subr pc))

Definition: r-usr-data-objectp (x, r) = (r-objectp (x, r) ∧ r-usr-data-typep (type (x)))

Definition: push-stk-n (n, sys-addr) = sub-addr (sys-addr, n)

Definition: pop-stk-n (n, sys-addr) = add-addr (sys-addr, n)

Definition: fetch-n (n, addr, segment) = if n ≃ 0 then nil

else cons (fetch (addr, segment), fetch-n (n − 1, pop-stk (addr), segment)) endif

Definition: deposit-lst (lst, addr, segment) = if lst ≃ nil then segment

else deposit-lst (cdr (lst), push-stk (addr), deposit (car (lst), addr, segment)) endif

Definition: total-r-system-size (r, load-addr) = (load-addr

+ segment-length (r-usr-data-segment (r))

+ segment-length (icompile (r-prog-segment (r)))

+ segment-length (r-sys-data-segment (r)))

Definition: r-loadablep (r, load-addr) = (total-r-system-size (r, load-addr) < exp (2, r-word-size (r)))

Definition: r-instructionp (ins) = ((car (ins) ∈ piton-opcodes)

    ∧ ((car (ins) = 'push-constant)

→ (¬ labelledp (cadr (ins)))))

Definition: r-program-bodyp (lst) = if lst ≃ nil then lst = nil

else legal-labelp (car (lst))

∧ r-instructionp (unlabel (car (lst))) ∧ r-program-bodyp (cdr (lst)) endif

Definition: r-temp-var-dclsp (temp-var-dcls) = if listp (temp-var-dcls)

then (¬ labelledp (cadar (temp-var-dcls)))

∧ r-temp-var-dclsp (cdr (temp-var-dcls)) else t endif

Definition: r-programp (prog) = (litatom (name (prog))

∧ r-temp-var-dclsp (temp-var-dcls (prog))

∧ listp (program-body (prog))

∧ r-program-bodyp (program-body (prog)))

Definition: r-prog-segmentp (segment) = if segment ≃ nil then segment = nil

else r-programp (car (segment))

∧ r-prog-segmentp (cdr (segment)) endif

Definition: all-r-usr-data-objectps (lst, r) = if lst ≃ nil then lst = nil

else r-usr-data-objectp (car (lst), r)

∧ all-r-usr-data-objectps (cdr (lst), r) endif

Definition: proper-r-usr-data-area (area, r)

= (litatom (car (area))

∧ listp (cdr (area)) ∧ all-r-usr-data-objectps (cdr (area), r))

Definition: proper-r-usr-data-segmentp (data-segment, r) = if data-segment ≃ nil then data-segment = nil

else proper-r-usr-data-area (car (data-segment), r) ∧ (¬ definedp (caar (data-segment), cdr (data-segment))) ∧ proper-r-usr-data-segmentp (cdr (data-segment), r) endif

Definition: proper-r-statep (r, load-addr) = (r-statep (r)

∧ r-objectp-type ('pc, r-pc (r), r) ∧ cstkp (r-cfp (r), r-sys-data-segment (r)) ∧ cstkp (r-csp (r), r-sys-data-segment (r)) ∧ tstkp (r-tsp (r), r-sys-data-segment (r)) ∧ (definition ('full-ctrl-stk-addr, r-sys-data-segment (r))

    = list ('full-ctrl-stk-addr,
           tag ('sys-addr, '(cstk . 0))))

∧ (definition ('full-temp-stk-addr, r-sys-data-segment (r))

    = list ('full-temp-stk-addr,
           tag ('sys-addr, '(tstk . 0))))

∧ (definition ('empty-temp-stk-addr, r-sys-data-segment (r))

    = list ('empty-temp-stk-addr,
           tag ('sys-addr,

cons ('tstk,

length (definiens ('tstk,

r-sys-data-segment (r))) − 1))))

∧ r-objectp-type ('bool, r-c-flg (r), r) ∧ r-objectp-type ('bool, r-v-flg (r), r) ∧ r-objectp-type ('bool, r-n-flg (r), r) ∧ r-objectp-type ('bool, r-z-flg (r), r) ∧ r-prog-segmentp (r-prog-segment (r)) ∧ proper-r-usr-data-segmentp (r-usr-data-segment (r), r) ∧ r-loadablep (r, load-addr))

Event: Enable pathological-difference.

Definition: stk-equal (sp, segment1 , segment2 ) = if empty-stkp (sp, segment1 ) then t

else (fetch (sp, segment1 ) = fetch (sp, segment2 )) ∧ stk-equal (pop-stk (sp), segment1 , segment2 ) endif Definition: signature (area) = cons (car (area), length (area))

Definition: same-signature (segment1 , segment2 ) = if listp (segment1 )

then listp (segment2 )

∧ (signature (car (segment1 )) = signature (car (segment2 ))) ∧ same-signature (cdr (segment1 ), cdr (segment2 ))

else segment2 ≃ nil endif

Definition: r-equal (r1 , r2 ) = (r-statep (r1 )

∧ r-statep (r2 )

∧ (r-pc (r1 ) = r-pc (r2 )) ∧ (r-cfp (r1 ) = r-cfp (r2 )) ∧ (r-csp (r1 ) = r-csp (r2 )) ∧ (r-tsp (r1 ) = r-tsp (r2 )) ∧ (r-prog-segment (r1 ) = r-prog-segment (r2 )) ∧ (r-usr-data-segment (r1 ) = r-usr-data-segment (r2 )) ∧ stk-equal (r-csp (r1 ),

r-sys-data-segment (r1 ), r-sys-data-segment (r2 ))

∧ stk-equal (r-tsp (r1 ), r-sys-data-segment (r1 ), r-sys-data-segment (r2 ))

∧ same-signature (r-sys-data-segment (r1 ), r-sys-data-segment (r2 )) ∧ (r-word-size (r1 ) = r-word-size (r2 )) ∧ (r-psw (r1 ) = r-psw (r2 )))

Definition: add1-r-pc (r) = add1-addr (r-pc (r))

Definition: add1-r-pcp (r) = pcpp (untag (add1-addr (r-pc (r))), r-prog-segment (r))

Definition: r-current-program (r) = definition (area-name (r-pc (r)), r-prog-segment (r))

Definition: r-current-instruction (r) = unlabel (get (offset (r-pc (r)), program-body (r-current-program (r))))

Definition: r-halt (r, psw) = r-state (r-pc (r), r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r), psw)

Definition: r-call-okp (ins, r) = (definedp (cadr (ins), r-prog-segment (r))

∧ (free-stk-size (r-csp (r))

≮ (1 + (1 + length (local-vars (definition (cadr (ins),

r-prog-segment (r)))))))

∧ (stk-length (r-tsp (r), r-sys-data-segment (r))

≮ length (formal-vars (definition (cadr (ins),

r-prog-segment (r)))))

∧ add1-r-pcp (r) ∧ all-r-objectps (strip-cadrs (temp-var-dcls (definition (cadr (ins),

r-prog-segment (r)))),

r))

Definition: r-call-step (ins, r) = r-state (tag ('pc, cons (cadr (ins), 0)),

push-stk-n (2, r-csp (r)), push-stk-n (2

+ length (formal-vars (definition (cadr (ins),

r-prog-segment (r))))

+ length (temp-var-dcls (definition (cadr (ins),

r-prog-segment (r)))),

r-csp (r)),

pop-stk-n (length (formal-vars (definition (cadr (ins),

r-prog-segment (r)))),

r-tsp (r)),

r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit-lst (append (list (add1-addr (r-pc (r)), r-cfp (r)),

append (rev (strip-cadrs (temp-var-dcls (definition (cadr (ins),

r-prog-segment (r))))),

fetch-n (length (formal-vars (definition (cadr (ins),

r-prog-segment (r)))),

r-tsp (r),

r-sys-data-segment (r)))),

push-stk (r-csp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-call-step-clock (ins, r) = (2

+ 2

+ length (temp-var-dcls (definition (cadr (ins), r-prog-segment (r)))) + length (formal-vars (definition (cadr (ins), r-prog-segment (r)))))

Definition: r-ret-okp (ins, r) = ((¬ empty-stkp (r-cfp (r), r-sys-data-segment (r)))

∧ (¬ empty-stkp (pop-stk (r-cfp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('pc,

fetch (pop-stk (r-cfp (r)), r-sys-data-segment (r)), r)

∧ (area-name (r-cfp (r)) = 'cstk) ∧ (area-name (r-csp (r)) = 'cstk) ∧ (offset (r-cfp (r)) ≮ offset (r-csp (r))) ∧ cstkp (fetch (r-cfp (r), r-sys-data-segment (r)),

r-sys-data-segment (r)))

Definition: r-ret-step (ins, r) = if empty-stkp (pop-stk (pop-stk (r-cfp (r))), r-sys-data-segment (r))

then r-halt (r, 'halt) else r-state (fetch (pop-stk (r-cfp (r)), r-sys-data-segment (r)),

fetch (r-cfp (r), r-sys-data-segment (r)), pop-stk (pop-stk (r-cfp (r))), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r), 'run) endif

Definition: r-ret-step-clock (ins, r) = if empty-stkp (pop-stk (pop-stk (r-cfp (r))), r-sys-data-segment (r))

then 0 else 1 + 3 endif

Definition: r-locn-okp (ins, r) = (add1-r-pcp (r)

∧ r-objectp-type ('sys-addr,

add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r)

∧ r-objectp-type ('nat,

fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)), r)

∧ r-objectp-type ('sys-addr,

add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r)

∧ (¬ empty-stkp (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))

∧ (¬ empty-stkp (add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r-sys-data-segment (r)))

∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-locn-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)), add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r-sys-data-segment (r)), push-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-locn-step-clock (ins, r) = 5

Definition: r-push-constant-okp (ins, r) = (add1-r-pcp (r)

∧ (r-objectp (cadr (ins), r)

∨ (cadr (ins) = 'pc) ∨ ((cadr (ins) ≃ nil)

∧ find-labelp (cadr (ins),

program-body (r-current-program (r)))))

∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-push-constant-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (if cadr (ins) = 'pc then add1-r-pc (r)

elseif cadr (ins) ≃ nil

then pc (cadr (ins), r-current-program (r)) else cadr (ins) endif, push-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-push-constant-step-clock (ins, r) = 1

Definition: r-push-local-okp (ins, r) = (add1-r-pcp (r)

∧ r-objectp-type ('sys-addr,

add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r)

∧ (¬ empty-stkp (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))

∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-push-local-step (ins, r)

= r-state (add1-r-pc (r), r-cfp (r), r-csp (r), push-stk (r-tsp (r)), add-addr (r-csp (r),

offset-from-csp (cadr (ins), r-current-program (r))),

r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)), push-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-push-local-step-clock (ins, r) = 3

Definition: r-push-global-okp (ins, r) = (add1-r-pcp (r)

∧ definedp (cadr (ins), r-usr-data-segment (r)) ∧ listp (definiens (cadr (ins), r-usr-data-segment (r))) ∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-push-global-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)), tag ('addr, cons (cadr (ins), 0)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (tag ('addr, cons (cadr (ins), 0)),

r-usr-data-segment (r)), push-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-push-global-step-clock (ins, r) = 2

Definition: r-push-ctrl-stk-free-size-okp (ins, r) = (add1-r-pcp (r) ∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-push-ctrl-stk-free-size-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)),

fetch ('(sys-addr (full-ctrl-stk-addr . 0)),

r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat, free-stk-size (r-csp (r))),

push-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-push-ctrl-stk-free-size-step-clock (ins, r) = 4

Definition: r-push-temp-stk-free-size-okp (ins, r) = (add1-r-pcp (r) ∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-push-temp-stk-free-size-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)),

fetch ('(sys-addr (full-temp-stk-addr . 0)),

r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat, free-stk-size (r-tsp (r))),

push-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-push-temp-stk-free-size-step-clock (ins, r) = 4

Definition: r-push-temp-stk-index-okp (ins, r) = (add1-r-pcp (r)

∧ (free-stk-size (r-tsp (r)) ≄ 0) ∧ (cadr (ins) ∈ N) ∧ (cadr (ins) < stk-length (r-tsp (r), r-sys-data-segment (r))))

Definition: r-push-temp-stk-index-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)), tag ('nat, 1 + cadr (ins)), r-tsp (r), r-c-flg (r), r-v-flg (r), r-n-flg (r),

'(bool f),

r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

(stk-length (r-tsp (r), r-sys-data-segment (r)) − 1) − cadr (ins)), push-stk (r-tsp (r)), r-sys-data-segment (r)),

'run)

r-word-size (r), Definition: r-push-temp-stk-index-step-clock (ins, r) = 7

Definition: r-jump-if-temp-stk-full-okp (ins, r) = if free-stk-size (r-tsp (r)) ≃ 0

then find-labelp (cadr (ins), program-body (r-current-program (r))) else add1-r-pcp (r) endif

Definition: r-jump-if-temp-stk-full-step (ins, r) = r-state (if free-stk-size (r-tsp (r)) ≃ 0

then pc (cadr (ins), r-current-program (r)) else add1-r-pc (r) endif, r-cfp (r), r-csp (r), r-tsp (r), pc (cadr (ins), r-current-program (r)),

'(sys-addr (tstk . 0)),

r-c-flg (r), r-v-flg (r), r-n-flg (r), bool (free-stk-size (r-tsp (r)) ≃ 0), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-jump-if-temp-stk-full-step-clock (ins, r) = 6

Definition: r-jump-if-temp-stk-empty-okp (ins, r) = if empty-stkp (r-tsp (r), r-sys-data-segment (r))

then find-labelp (cadr (ins), program-body (r-current-program (r))) else add1-r-pcp (r) endif

Definition: r-jump-if-temp-stk-empty-step (ins, r) = r-state (if empty-stkp (r-tsp (r), r-sys-data-segment (r))

then pc (cadr (ins), r-current-program (r)) else add1-r-pc (r) endif, r-cfp (r), r-csp (r), r-tsp (r), pc (cadr (ins), r-current-program (r)), r-tsp (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), bool (empty-stkp (r-tsp (r), r-sys-data-segment (r))), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-jump-if-temp-stk-empty-step-clock (ins, r) = 6

Definition: r-pop-okp (ins, r) = (add1-r-pcp (r)

∧ r-objectp (fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))))

Definition: r-pop-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-pop-step-clock (ins, r) = 1

Definition: r-pop*-okp (ins, r) = (add1-r-pcp (r)

∧ (cadr (ins) ∈ N) ∧ r-objectp-type ('sys-addr, pop-stk-n (cadr (ins), r-tsp (r)), r))

Definition: r-pop*-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk-n (cadr (ins), r-tsp (r)), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-pop*-step-clock (ins, r) = 1

Definition: r-popn-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('sys-addr,

pop-stk-n (1 + untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-tsp (r)),

r))

Definition: r-popn-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk-n (1 + untag (fetch (r-tsp (r), r-sys-data-segment (r))),

r-tsp (r)),

fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-popn-step-clock (ins, r) = 2

Definition: r-pop-local-okp (ins, r) = (add1-r-pcp (r)

∧ r-objectp-type ('sys-addr,

add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r)

∧ (¬ empty-stkp (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))))

Definition: r-pop-local-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), add-addr (r-csp (r),

offset-from-csp (cadr (ins), r-current-program (r))),

r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (r-tsp (r), r-sys-data-segment (r)),

add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-pop-local-step-clock (ins, r) = 3 Definition: r-pop-global-okp (ins, r) = (add1-r-pcp (r)

∧ definedp (cadr (ins), r-usr-data-segment (r)) ∧ listp (definiens (cadr (ins), r-usr-data-segment (r))) ∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-usr-data-objectp (fetch (r-tsp (r), r-sys-data-segment (r)), r))

Definition: r-pop-global-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), tag ('addr, cons (cadr (ins), 0)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), deposit (fetch (r-tsp (r), r-sys-data-segment (r)),

tag ('addr, cons (cadr (ins), 0)), r-usr-data-segment (r)),

r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-pop-global-step-clock (ins, r) = 2

Definition: r-pop-locn-okp (ins, r) = (add1-r-pcp (r)

∧ r-objectp-type ('sys-addr,

add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r)

∧ r-objectp-type ('nat,

fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)), r)

∧ r-objectp-type ('sys-addr, add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r)

∧ (¬ empty-stkp (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))

∧ (¬ empty-stkp (add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r-sys-data-segment (r)))

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))))

Definition: r-pop-locn-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (r-tsp (r), r-sys-data-segment (r)),

add-addr (r-csp (r),

untag (fetch (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))),

r-sys-data-segment (r)), r-word-size (r), Definition: r-pop-locn-step-clock (ins, r) = 5

Definition: r-pop-call-okp (ins, r) = ((¬ empty-stkp (r-tsp (r), r-sys-data-segment (r)))

∧ r-objectp-type ('subr, fetch (r-tsp (r), r-sys-data-segment (r)), r)

∧ r-call-okp (list ('call,

untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-state (r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)))

Definition: r-pop-call-step (ins, r) = r-call-step (list ('call, untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

r-state (r-pc (r), r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

         'run))

Definition: r-pop-call-step-clock (ins, r) = (3

+ 2

+ length (temp-var-dcls (definition (untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-prog-segment (r))))

+ length (formal-vars (definition (untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-prog-segment (r)))))

Definition: r-fetch-temp-stk-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (untag (fetch (r-tsp (r), r-sys-data-segment (r)))

< stk-length (r-tsp (r), r-sys-data-segment (r))))

Definition: r-fetch-temp-stk-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), sub-addr (tag ('sys-addr,

cons ('tstk,

length (definiens ('tstk,

r-sys-data-segment (r))) − 1)),

1 + untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

tag ('nat, 1 + untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (sub-addr (tag ('sys-addr,

cons ('tstk,

length (definiens ('tstk,

r-sys-data-segment (r))) − 1)),

1 + untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

r-sys-data-segment (r)), r-tsp (r), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-fetch-temp-stk-step-clock (ins, r) = 6

Definition: r-deposit-temp-stk-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (untag (fetch (r-tsp (r), r-sys-data-segment (r)))

< stk-length (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))

∧ r-usr-data-objectp (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)), r))

Definition: r-deposit-temp-stk-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (pop-stk (r-tsp (r))), sub-addr (tag ('sys-addr,

cons ('tstk,

length (definiens ('tstk,

r-sys-data-segment (r))) − 1)),

1 + untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

tag ('nat, 1 + untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)),

sub-addr (tag ('sys-addr,

cons ('tstk,

length (definiens ('tstk,

r-sys-data-segment (r))) − 1)),

1 + untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-deposit-temp-stk-step-clock (ins, r) = 6

Definition: r-jump-okp (ins, r) = find-labelp (cadr (ins), program-body (r-current-program (r)))

Definition: r-jump-step (ins, r) = r-state (pc (cadr (ins), r-current-program (r)),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-jump-step-clock (ins, r) = 1

Definition: r-jump-case-okp (ins, r) = ((¬ empty-stkp (r-tsp (r), r-sys-data-segment (r)))

∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (untag (fetch (r-tsp (r), r-sys-data-segment (r)))

< length (cdr (ins))) ∧ find-labelp (get (untag (fetch (r-tsp (r), r-sys-data-segment (r))),

cdr (ins)), program-body (r-current-program (r))))

Definition: r-jump-case-step (ins, r) = r-state (pc (get (untag (fetch (r-tsp (r), r-sys-data-segment (r))), cdr (ins)),

r-current-program (r)), r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), tag ('nat, 2 ∗ untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-jump-case-step-clock (ins, r) = 4

Definition: r-pushj-okp (ins, r) = (add1-r-pcp (r)

∧ find-labelp (cadr (ins), program-body (r-current-program (r))) ∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-pushj-step (ins, r) = r-state (pc (cadr (ins), r-current-program (r)),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (add1-r-pc (r), push-stk (r-tsp (r)), r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-pushj-step-clock (ins, r) = 2

Definition: r-popj-okp (ins, r)

= (r-objectp-type ('pc, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))))

Definition: r-popj-step (ins, r) = r-state (fetch (r-tsp (r), r-sys-data-segment (r)),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-popj-step-clock (ins, r) = 1

Definition: r-set-local-okp (ins, r) = (add1-r-pcp (r)

∧ r-objectp-type ('sys-addr,

add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r)

∧ (¬ empty-stkp (add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)))

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))))

Definition: r-set-local-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), add-addr (r-csp (r),

offset-from-csp (cadr (ins), r-current-program (r))), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (r-tsp (r), r-sys-data-segment (r)),

add-addr (r-csp (r),

offset-from-csp (cadr (ins),

r-current-program (r))),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-set-local-step-clock (ins, r) = 3

Definition: r-set-global-okp (ins, r) = (add1-r-pcp (r)

∧ definedp (cadr (ins), r-usr-data-segment (r)) ∧ listp (definiens (cadr (ins), r-usr-data-segment (r))) ∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-usr-data-objectp (fetch (r-tsp (r), r-sys-data-segment (r)), r))

Definition: r-set-global-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), tag ('addr, cons (cadr (ins), 0)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), deposit (fetch (r-tsp (r), r-sys-data-segment (r)),

tag ('addr, cons (cadr (ins), 0)), r-usr-data-segment (r)),

r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-set-global-step-clock (ins, r) = 2

Definition: r-test-and-jump-okp (ins, type, test, r) = ((¬ empty-stkp (r-tsp (r), r-sys-data-segment (r)))

∧ r-objectp-type (type, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ if test

then find-labelp (caddr (ins),

program-body (r-current-program (r)))

else add1-r-pcp (r) endif)

Definition: r-test-and-jump-step (test, lab, x, y, c, v, n, z, r) = if test

then r-state (pc (lab, r-current-program (r)), r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), x, y, c, v, n, z, r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

else r-state (add1-r-pc (r), r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), x, y, c, v, n, z, r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r), 'run) endif Definition: r-test-nat-and-jump-okp (ins, r) = r-test-and-jump-okp (ins,

                     'nat,

p-test-natp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r)

Definition: r-test-nat-and-jump-step (ins, r) = r-test-and-jump-step (p-test-natp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

caddr (ins),

pc (caddr (ins), r-current-program (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-c-flg (r), r-v-flg (r), r-n-flg (r), bool (untag (fetch (r-tsp (r), r-sys-data-segment (r)))

= 0), r)

Definition: r-test-nat-and-jump-step-clock (ins, r) = 3

Definition: r-test-int-and-jump-okp (ins, r) = r-test-and-jump-okp (ins,

                     'int,

p-test-intp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r)

Definition: r-test-int-and-jump-step (ins, r) = r-test-and-jump-step (p-test-intp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

caddr (ins),

if cadr (ins) = 'pos then add1-addr (r-pc (r)) else pc (caddr (ins), r-current-program (r)) endif, fetch (r-tsp (r), r-sys-data-segment (r)), r-c-flg (r), r-v-flg (r), bool (negativep (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

bool (untag (fetch (r-tsp (r), r-sys-data-segment (r)))

= 0), r)

Definition: r-test-int-and-jump-step-clock (ins, r) = case on car (cdr (ins)):

case = zero then 3 case = not-zero then 3 case = neg then 3 case = not-neg then 3 case = pos then 2 + if negativep (untag (fetch (r-tsp (r), r-sys-data-segment (r))))

then 1

elseif untag (fetch (r-tsp (r), r-sys-data-segment (r))) ≃ 0 then 2 else 3 endif

otherwise if negativep (untag (fetch (r-tsp (r), r-sys-data-segment (r)))) then 3 else 4 endif endcase

Definition: r-test-bool-and-jump-okp (ins, r) = r-test-and-jump-okp (ins,

                     'bool,

p-test-boolp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r)

Definition: r-test-bool-and-jump-step (ins, r) = r-test-and-jump-step (p-test-boolp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

caddr (ins),

pc (caddr (ins), r-current-program (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-c-flg (r), r-v-flg (r), r-n-flg (r),

tag ('bool,

not-bool (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r)

Definition: r-test-bool-and-jump-step-clock (ins, r) = 3

Definition: r-test-bitv-and-jump-okp (ins, r) = r-test-and-jump-okp (ins,

'bitv,

p-test-bitvp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r)

Definition: r-test-bitv-and-jump-step (ins, r) = r-test-and-jump-step (p-test-bitvp (cadr (ins),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

caddr (ins), pc (caddr (ins), r-current-program (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-c-flg (r), r-v-flg (r), r-n-flg (r), bool (all-zero-bitvp (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r)

Definition: r-test-bitv-and-jump-step-clock (ins, r) = 3

Definition: r-no-op-okp (ins, r) = add1-r-pcp (r)

Definition: r-no-op-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-no-op-step-clock (ins, r) = 1

Definition: r-add-addr-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('addr,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ r-objectp-type ('addr,

add-addr (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)), untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r))

Definition: r-add-addr-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (add-addr (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)),

untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-add-addr-step-clock (ins, r) = 2

Definition: r-sub-addr-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('addr,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ (offset (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ≮ untag (fetch (r-tsp (r), r-sys-data-segment (r)))))

Definition: r-sub-addr-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (sub-addr (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)), untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-sub-addr-step-clock (ins, r) = 2

Definition: r-eq-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-usr-data-objectp (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)), r)

∧ r-usr-data-objectp (fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (type (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)))

= type (fetch (r-tsp (r), r-sys-data-segment (r)))))

Definition: r-eq-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), bool (untag (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)))

= untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-prog-segment (r), r-usr-data-segment (r), deposit (bool (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

= untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-eq-step-clock (ins, r) = 4

Definition: r-lt-addr-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('addr,

fetch (r-tsp (r), r-sys-data-segment (r)), r)

∧ r-objectp-type ('addr, fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ (area-name (fetch (r-tsp (r), r-sys-data-segment (r)))

= area-name (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)))))

Definition: r-lt-addr-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), bool (offset (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)))

< offset (fetch (r-tsp (r), r-sys-data-segment (r)))), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (bool (offset (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

< offset (fetch (r-tsp (r),

r-sys-data-segment (r)))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-lt-addr-step-clock (ins, r) = 4

Definition: r-fetch-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('addr,

fetch (r-tsp (r), r-sys-data-segment (r)),

r))

Definition: r-fetch-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (fetch (fetch (r-tsp (r), r-sys-data-segment (r)),

r-usr-data-segment (r)), r-tsp (r), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-fetch-step-clock (ins, r) = 2

Definition: r-deposit-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('addr,

fetch (r-tsp (r), r-sys-data-segment (r)), r)

∧ r-usr-data-objectp (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)), r))

Definition: r-deposit-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (pop-stk (r-tsp (r))), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), deposit (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-usr-data-segment (r)),

r-sys-data-segment (r), r-word-size (r),

'run)

Definition: r-deposit-step-clock (ins, r) = 2

Definition: r-add-int-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('int,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ small-integerp (iplus (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-word-size (r)))

Definition: r-add-int-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('int,

iplus (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))), untag (fetch (r-tsp (r), r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-add-int-step-clock (ins, r) = 2

Definition: r-add-int-with-carry-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))

∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('int,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ r-objectp-type ('bool,

fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r)),

r))

Definition: r-add-int-with-carry-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), tag ('int,

fix-small-integer (iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))),

iplus (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r)), bool (¬ small-integerp (iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))),

iplus (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('int,

fix-small-integer (iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))),

iplus (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

pop-stk (r-tsp (r)),

deposit (bool (¬ small-integerp (iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))),

iplus (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r))),

r-word-size (r),

'run)

Definition: r-add-int-with-carry-step-clock (ins, r) = 6

Definition: r-add1-int-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ small-integerp (iplus (1,

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-word-size (r)))

Definition: r-add1-int-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('int,

iplus (1,

untag (fetch (r-tsp (r), r-sys-data-segment (r))))),

r-tsp (r),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-add1-int-step-clock (ins, r) = 1

Definition: r-sub-int-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('int,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ small-integerp (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-word-size (r)))

Definition: r-sub-int-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('int,

idifference (untag (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r))), untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-sub-int-step-clock (ins, r) = 2

Definition: r-sub-int-with-carry-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))

∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('int,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ r-objectp-type ('bool,

fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r)),

r))

Definition: r-sub-int-with-carry-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), tag ('int,

fix-small-integer (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

fetch (r-tsp (r), r-sys-data-segment (r)), fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r)), bool (¬ small-integerp (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r)))), untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('int,

fix-small-integer (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

pop-stk (r-tsp (r)),

deposit (bool (¬ small-integerp (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

iplus (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-word-size (r))),

pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r))),

r-word-size (r),

'run)

Definition: r-sub-int-with-carry-step-clock (ins, r) = 6

Definition: r-sub1-int-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ small-integerp (idifference (untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

1),

r-word-size (r)))

Definition: r-sub1-int-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('int,

idifference (untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

1)),

r-tsp (r),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-sub1-int-step-clock (ins, r) = 1

Definition: r-neg-int-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ small-integerp (inegate (untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-word-size (r)))

Definition: r-neg-int-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('int,

inegate (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-tsp (r),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-neg-int-step-clock (ins, r) = 1

Definition: r-lt-int-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('int,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r))

Definition: r-lt-int-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), bool (negativep (fix-small-integer (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-word-size (r)))),

r-y (r), r-c-flg (r), bool (¬ small-integerp (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-word-size (r))),

bool (negativep (fix-small-integer (idifference (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

r-word-size (r)))),

r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (bool (ilessp (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-lt-int-step-clock (ins, r) = 7

Definition: r-int-to-nat-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('int, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (¬ negativep (untag (fetch (r-tsp (r), r-sys-data-segment (r))))))

Definition: r-int-to-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-tsp (r), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-int-to-nat-step-clock (ins, r) = 1

Definition: r-add-nat-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r)))

∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('nat,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ small-naturalp (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

+ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r)))

Definition: r-add-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))) + untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-add-nat-step-clock (ins, r) = 2

Definition: r-add-nat-with-carry-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))

∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('nat,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r)

∧ r-objectp-type ('bool,

fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r)),

r))

Definition: r-add-nat-with-carry-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), tag ('nat,

fix-small-natural (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r))))

+ untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

+ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), bool (¬ small-naturalp (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r))))

+ untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

+ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

fix-small-natural (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r))))

+ untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

+ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

pop-stk (r-tsp (r)),

deposit (bool (¬ small-naturalp (bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r))))

+ untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

+ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r))),

r-word-size (r),

'run)

Definition: r-add-nat-with-carry-step-clock (ins, r) = 6

Definition: r-add1-nat-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ small-naturalp (1 + untag (fetch (r-tsp (r), r-sys-data-segment (r))),

r-word-size (r)))

Definition: r-add1-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

1 + untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-tsp (r), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-add1-nat-step-clock (ins, r) = 1

Definition: r-sub1-nat-okp (ins, r)

= (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (untag (fetch (r-tsp (r), r-sys-data-segment (r))) ≄ 0))

Definition: r-sub1-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

untag (fetch (r-tsp (r), r-sys-data-segment (r))) − 1), r-tsp (r), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-sub1-nat-step-clock (ins, r) = 1

Definition: r-sub-nat-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('nat,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ (untag (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ≮ untag (fetch (r-tsp (r), r-sys-data-segment (r)))))

Definition: r-sub-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))) − untag (fetch (r-tsp (r), r-sys-data-segment (r)))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-sub-nat-step-clock (ins, r) = 2

Definition: r-sub-nat-with-carry-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))

∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('nat,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r)

∧ r-objectp-type ('bool,

fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r)),

r))

Definition: r-sub-nat-with-carry-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), tag ('nat,

if untag (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r))) < (untag (fetch (r-tsp (r), r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))))

then exp (2, r-word-size (r))

− ((untag (fetch (r-tsp (r), r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))))

− untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))))

else untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

− (untag (fetch (r-tsp (r),

r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r))))) endif),

fetch (r-tsp (r), r-sys-data-segment (r)), bool (untag (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)))

< (untag (fetch (r-tsp (r), r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))))),

r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

if untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

< (untag (fetch (r-tsp (r),

r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))))

then exp (2, r-word-size (r))

− ((untag (fetch (r-tsp (r),

r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))))

− untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))))

else untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

− (untag (fetch (r-tsp (r),

r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r))))) endif), pop-stk (r-tsp (r)), deposit (bool (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

< (untag (fetch (r-tsp (r),

r-sys-data-segment (r)))

+ bool-to-nat (untag (fetch (pop-stk (pop-stk (r-tsp (r))),

r-sys-data-segment (r)))))),

pop-stk (pop-stk (r-tsp (r))), r-sys-data-segment (r))),

r-word-size (r),

'run)

Definition: r-sub-nat-with-carry-step-clock (ins, r) = 6

Definition: r-lt-nat-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ r-objectp-type ('nat,

fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r))

Definition: r-lt-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), bool (untag (fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)))

< untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (bool (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r)))

< untag (fetch (r-tsp (r),

r-sys-data-segment (r)))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-lt-nat-step-clock (ins, r) = 4

Definition: r-mult2-nat-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ small-naturalp (2 ∗ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r)))

Definition: r-mult2-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

2 ∗ untag (fetch (r-tsp (r), r-sys-data-segment (r)))), r-tsp (r), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-mult2-nat-step-clock (ins, r) = 1

Definition: r-mult2-nat-with-carry-out-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-mult2-nat-with-carry-out-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)), tag ('nat,

fix-small-natural (2 ∗ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

r-y (r), bool (¬ small-naturalp (2 ∗ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

fix-small-natural (2 ∗ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

push-stk (r-tsp (r)),

deposit (bool (¬ small-naturalp (2 ∗ untag (fetch (r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r))),

r-tsp (r),

r-sys-data-segment (r))),

r-word-size (r),

'run)

Definition: r-mult2-nat-with-carry-out-step-clock (ins, r) = 5

Definition: r-div2-nat-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('nat, fetch (r-tsp (r), r-sys-data-segment (r)), r) ∧ (free-stk-size (r-tsp (r)) ≄ 0))

Definition: r-div2-nat-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), push-stk (r-tsp (r)), tag ('nat, untag (fetch (r-tsp (r), r-sys-data-segment (r)))

÷ 2),

r-y (r), bool ((untag (fetch (r-tsp (r), r-sys-data-segment (r))) mod 2)

= 1), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('nat,

untag (fetch (r-tsp (r), r-sys-data-segment (r))) mod 2), push-stk (r-tsp (r)), deposit (tag ('nat,

untag (fetch (r-tsp (r),

r-sys-data-segment (r)))

÷ 2), r-tsp (r), r-sys-data-segment (r))),

r-word-size (r),

'run)

Definition: r-div2-nat-step-clock (ins, r) = 5

Definition: r-or-bitv-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('bitv,

fetch (r-tsp (r), r-sys-data-segment (r)),

r)

∧ r-objectp-type ('bitv, fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r))

Definition: r-or-bitv-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bitv,

or-bitv (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-or-bitv-step-clock (ins, r) = 2

Definition: r-and-bitv-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('bitv,

fetch (r-tsp (r), r-sys-data-segment (r)),

r)

∧ r-objectp-type ('bitv, fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r))

Definition: r-and-bitv-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bitv,

and-bitv (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-and-bitv-step-clock (ins, r) = 2

Definition: r-not-bitv-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('bitv,

fetch (r-tsp (r), r-sys-data-segment (r)), r))

Definition: r-not-bitv-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bitv,

not-bitv (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-tsp (r),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-not-bitv-step-clock (ins, r) = 1

Definition: r-xor-bitv-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('bitv,

fetch (r-tsp (r), r-sys-data-segment (r)),

r)

∧ r-objectp-type ('bitv, fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r))

Definition: r-xor-bitv-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bitv,

xor-bitv (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-xor-bitv-step-clock (ins, r) = 2

Definition: r-rsh-bitv-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('bitv,

fetch (r-tsp (r), r-sys-data-segment (r)),

r))

Definition: r-rsh-bitv-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bitv,

rsh-bitv (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-tsp (r),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-rsh-bitv-step-clock (ins, r) = 1

Definition: r-lsh-bitv-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('bitv,

fetch (r-tsp (r), r-sys-data-segment (r)), r))

Definition: r-lsh-bitv-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bitv,

lsh-bitv (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-tsp (r),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-lsh-bitv-step-clock (ins, r) = 1

Definition: r-or-bool-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('bool,

fetch (r-tsp (r), r-sys-data-segment (r)),

r)

∧ r-objectp-type ('bool, fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r))

Definition: r-or-bool-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bool,

or-bool (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r), Definition: r-or-bool-step-clock (ins, r) = 2

Definition: r-and-bool-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ (¬ empty-stkp (pop-stk (r-tsp (r)), r-sys-data-segment (r))) ∧ r-objectp-type ('bool,

fetch (r-tsp (r), r-sys-data-segment (r)),

r)

∧ r-objectp-type ('bool, fetch (pop-stk (r-tsp (r)), r-sys-data-segment (r)), r))

Definition: r-and-bool-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), pop-stk (r-tsp (r)), fetch (r-tsp (r), r-sys-data-segment (r)), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bool,

and-bool (untag (fetch (pop-stk (r-tsp (r)),

r-sys-data-segment (r))),

untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

pop-stk (r-tsp (r)), r-sys-data-segment (r)),

r-word-size (r),

'run)

Definition: r-and-bool-step-clock (ins, r) = 2

Definition: r-not-bool-okp (ins, r) = (add1-r-pcp (r)

∧ (¬ empty-stkp (r-tsp (r), r-sys-data-segment (r))) ∧ r-objectp-type ('bool,

fetch (r-tsp (r), r-sys-data-segment (r)), r))

Definition: r-not-bool-step (ins, r) = r-state (add1-r-pc (r),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), r-prog-segment (r), r-usr-data-segment (r), deposit (tag ('bool,

not-bool (untag (fetch (r-tsp (r),

r-sys-data-segment (r))))),

r-tsp (r),

r-sys-data-segment (r)), r-word-size (r),

'run)

Definition: r-not-bool-step-clock (ins, r) = 1

Definition: r-ins-okp (ins, r) = case on car (ins):

case = call then r-call-okp (ins, r) case = ret then r-ret-okp (ins, r) case = locn then r-locn-okp (ins, r) case = push-constant then r-push-constant-okp (ins, r) case = push-local then r-push-local-okp (ins, r) case = push-global then r-push-global-okp (ins, r) case = push-ctrl-stk-free-size then r-push-ctrl-stk-free-size-okp (ins, r) case = push-temp-stk-free-size then r-push-temp-stk-free-size-okp (ins, r) case = push-temp-stk-index then r-push-temp-stk-index-okp (ins, r) case = jump-if-temp-stk-full then r-jump-if-temp-stk-full-okp (ins, r) case = jump-if-temp-stk-empty then r-jump-if-temp-stk-empty-okp (ins, r) case = pop then r-pop-okp (ins, r) case = pop* then r-pop*-okp (ins, r) case = popn then r-popn-okp (ins, r) case = pop-local then r-pop-local-okp (ins, r) case = pop-global then r-pop-global-okp (ins, r) case = pop-locn then r-pop-locn-okp (ins, r) case = pop-call then r-pop-call-okp (ins, r) case = fetch-temp-stk then r-fetch-temp-stk-okp (ins, r) case = deposit-temp-stk then r-deposit-temp-stk-okp (ins, r) case = jump then r-jump-okp (ins, r) case = jump-case then r-jump-case-okp (ins, r) case = pushj then r-pushj-okp (ins, r) case = popj then r-popj-okp (ins, r) case = set-local then r-set-local-okp (ins, r) case = set-global then r-set-global-okp (ins, r) case = test-nat-and-jump then r-test-nat-and-jump-okp (ins, r) case = test-int-and-jump then r-test-int-and-jump-okp (ins, r) case = test-bool-and-jump then r-test-bool-and-jump-okp (ins, r) case = test-bitv-and-jump then r-test-bitv-and-jump-okp (ins, r) case = no-op then r-no-op-okp (ins, r) case = add-addr then r-add-addr-okp (ins, r) case = sub-addr then r-sub-addr-okp (ins, r) case = eq then r-eq-okp (ins, r) case = lt-addr then r-lt-addr-okp (ins, r) case = fetch then r-fetch-okp (ins, r) case = deposit then r-deposit-okp (ins, r) case = add-int then r-add-int-okp (ins, r) case = add-int-with-carry then r-add-int-with-carry-okp (ins, r) case = add1-int then r-add1-int-okp (ins, r) case = sub-int then r-sub-int-okp (ins, r) case = sub-int-with-carry then r-sub-int-with-carry-okp (ins, r) case = sub1-int then r-sub1-int-okp (ins, r) case = neg-int then r-neg-int-okp (ins, r) case = lt-int then r-lt-int-okp (ins, r) case = int-to-nat then r-int-to-nat-okp (ins, r) case = add-nat then r-add-nat-okp (ins, r) case = add-nat-with-carry then r-add-nat-with-carry-okp (ins, r) case = add1-nat then r-add1-nat-okp (ins, r) case = sub-nat then r-sub-nat-okp (ins, r) case = sub-nat-with-carry then r-sub-nat-with-carry-okp (ins, r) case = sub1-nat then r-sub1-nat-okp (ins, r) case = lt-nat then r-lt-nat-okp (ins, r) case = mult2-nat then r-mult2-nat-okp (ins, r) case = mult2-nat-with-carry-out then r-mult2-nat-with-carry-out-okp (ins, r) case = div2-nat then r-div2-nat-okp (ins, r) case = or-bitv then r-or-bitv-okp (ins, r) case = and-bitv then r-and-bitv-okp (ins, r) case = not-bitv then r-not-bitv-okp (ins, r) case = xor-bitv then r-xor-bitv-okp (ins, r) case = rsh-bitv then r-rsh-bitv-okp (ins, r) case = lsh-bitv then r-lsh-bitv-okp (ins, r) case = or-bool then r-or-bool-okp (ins, r) case = and-bool then r-and-bool-okp (ins, r) case = not-bool then r-not-bool-okp (ins, r) otherwise f endcase

Definition: r-ins-step (ins, r) = case on car (ins):

case = call then r-call-step (ins, r) case = ret then r-ret-step (ins, r) case = locn then r-locn-step (ins, r) case = push-constant then r-push-constant-step (ins, r) case = push-local then r-push-local-step (ins, r) case = push-global then r-push-global-step (ins, r) case = push-ctrl-stk-free-size then r-push-ctrl-stk-free-size-step (ins, r) case = push-temp-stk-free-size then r-push-temp-stk-free-size-step (ins, r) case = push-temp-stk-index then r-push-temp-stk-index-step (ins, r) case = jump-if-temp-stk-full then r-jump-if-temp-stk-full-step (ins, r) case = jump-if-temp-stk-empty then r-jump-if-temp-stk-empty-step (ins, r) case = pop then r-pop-step (ins, r) case = pop* then r-pop*-step (ins, r) case = popn then r-popn-step (ins, r) case = pop-local then r-pop-local-step (ins, r) case = pop-global then r-pop-global-step (ins, r) case = pop-locn then r-pop-locn-step (ins, r) case = pop-call then r-pop-call-step (ins, r) case = fetch-temp-stk then r-fetch-temp-stk-step (ins, r) case = deposit-temp-stk then r-deposit-temp-stk-step (ins, r) case = jump then r-jump-step (ins, r) case = jump-case then r-jump-case-step (ins, r) case = pushj then r-pushj-step (ins, r) case = popj then r-popj-step (ins, r) case = set-local then r-set-local-step (ins, r) case = set-global then r-set-global-step (ins, r) case = test-nat-and-jump then r-test-nat-and-jump-step (ins, r) case = test-int-and-jump then r-test-int-and-jump-step (ins, r) case = test-bool-and-jump then r-test-bool-and-jump-step (ins, r) case = test-bitv-and-jump then r-test-bitv-and-jump-step (ins, r) case = no-op then r-no-op-step (ins, r) case = add-addr then r-add-addr-step (ins, r) case = sub-addr then r-sub-addr-step (ins, r) case = eq then r-eq-step (ins, r) case = lt-addr then r-lt-addr-step (ins, r) case = fetch then r-fetch-step (ins, r) case = deposit then r-deposit-step (ins, r) case = add-int then r-add-int-step (ins, r) case = add-int-with-carry then r-add-int-with-carry-step (ins, r) case = add1-int then r-add1-int-step (ins, r) case = sub-int then r-sub-int-step (ins, r) case = sub-int-with-carry then r-sub-int-with-carry-step (ins, r) case = sub1-int then r-sub1-int-step (ins, r) case = neg-int then r-neg-int-step (ins, r) case = lt-int then r-lt-int-step (ins, r) case = int-to-nat then r-int-to-nat-step (ins, r) case = add-nat then r-add-nat-step (ins, r) case = add-nat-with-carry then r-add-nat-with-carry-step (ins, r) case = add1-nat then r-add1-nat-step (ins, r) case = sub-nat then r-sub-nat-step (ins, r) case = sub-nat-with-carry then r-sub-nat-with-carry-step (ins, r) case = sub1-nat then r-sub1-nat-step (ins, r) case = lt-nat then r-lt-nat-step (ins, r) case = mult2-nat then r-mult2-nat-step (ins, r) case = mult2-nat-with-carry-out then r-mult2-nat-with-carry-out-step (ins, r) case = div2-nat then r-div2-nat-step (ins, r) case = or-bitv then r-or-bitv-step (ins, r) case = and-bitv then r-and-bitv-step (ins, r) case = not-bitv then r-not-bitv-step (ins, r) case = xor-bitv then r-xor-bitv-step (ins, r) case = rsh-bitv then r-rsh-bitv-step (ins, r) case = lsh-bitv then r-lsh-bitv-step (ins, r) case = or-bool then r-or-bool-step (ins, r) case = and-bool then r-and-bool-step (ins, r) case = not-bool then r-not-bool-step (ins, r) otherwise r-halt (r, 'run) endcase

Definition: r-step1 (ins, r) = if r-ins-okp (ins, r) then r-ins-step (ins, r)

else r-halt (r, x-y-error-msg ('r, car (ins))) endif

Definition: r-step (r) = if r-psw (r) = 'run then r-step1 (r-current-instruction (r), r)

else r endif

Definition: r (r, n) = if n ≃ 0 then r

else r (r-step (r), n − 1) endif

Definition: r-ins-step-clock (ins, r) = case on car (ins):

case = call then r-call-step-clock (ins, r) case = ret then r-ret-step-clock (ins, r) case = locn then r-locn-step-clock (ins, r) case = push-constant then r-push-constant-step-clock (ins, r) case = push-local then r-push-local-step-clock (ins, r) case = push-global then r-push-global-step-clock (ins, r) case = push-ctrl-stk-free-size then r-push-ctrl-stk-free-size-step-clock (ins, r) case = push-temp-stk-free-size then r-push-temp-stk-free-size-step-clock (ins, r) case = push-temp-stk-index then r-push-temp-stk-index-step-clock (ins, r) case = jump-if-temp-stk-full then r-jump-if-temp-stk-full-step-clock (ins, r) case = jump-if-temp-stk-empty then r-jump-if-temp-stk-empty-step-clock (ins, r) case = pop then r-pop-step-clock (ins, r) case = pop* then r-pop*-step-clock (ins, r) case = popn then r-popn-step-clock (ins, r) case = pop-local then r-pop-local-step-clock (ins, r) case = pop-global then r-pop-global-step-clock (ins, r) case = pop-locn then r-pop-locn-step-clock (ins, r) case = pop-call then r-pop-call-step-clock (ins, r) case = fetch-temp-stk then r-fetch-temp-stk-step-clock (ins, r) case = deposit-temp-stk then r-deposit-temp-stk-step-clock (ins, r) case = jump then r-jump-step-clock (ins, r) case = jump-case then r-jump-case-step-clock (ins, r) case = pushj then r-pushj-step-clock (ins, r) case = popj then r-popj-step-clock (ins, r) case = set-local then r-set-local-step-clock (ins, r) case = set-global then r-set-global-step-clock (ins, r) case = test-nat-and-jump then r-test-nat-and-jump-step-clock (ins, r) case = test-int-and-jump then r-test-int-and-jump-step-clock (ins, r) case = test-bool-and-jump then r-test-bool-and-jump-step-clock (ins, r) case = test-bitv-and-jump then r-test-bitv-and-jump-step-clock (ins, r) case = no-op then r-no-op-step-clock (ins, r) case = add-addr then r-add-addr-step-clock (ins, r) case = sub-addr then r-sub-addr-step-clock (ins, r) case = eq then r-eq-step-clock (ins, r) case = lt-addr then r-lt-addr-step-clock (ins, r) case = fetch then r-fetch-step-clock (ins, r) case = deposit then r-deposit-step-clock (ins, r) case = add-int then r-add-int-step-clock (ins, r) case = add-int-with-carry then r-add-int-with-carry-step-clock (ins, r) case = add1-int then r-add1-int-step-clock (ins, r) case = sub-int then r-sub-int-step-clock (ins, r) case = sub-int-with-carry then r-sub-int-with-carry-step-clock (ins, r) case = sub1-int then r-sub1-int-step-clock (ins, r) case = neg-int then r-neg-int-step-clock (ins, r) case = lt-int then r-lt-int-step-clock (ins, r) case = int-to-nat then r-int-to-nat-step-clock (ins, r) case = add-nat then r-add-nat-step-clock (ins, r) case = add-nat-with-carry then r-add-nat-with-carry-step-clock (ins, r) case = add1-nat then r-add1-nat-step-clock (ins, r) case = sub-nat then r-sub-nat-step-clock (ins, r) case = sub-nat-with-carry then r-sub-nat-with-carry-step-clock (ins, r) case = sub1-nat then r-sub1-nat-step-clock (ins, r) case = lt-nat then r-lt-nat-step-clock (ins, r) case = mult2-nat then r-mult2-nat-step-clock (ins, r) case = mult2-nat-with-carry-out then r-mult2-nat-with-carry-out-step-clock (ins, r) case = div2-nat then r-div2-nat-step-clock (ins, r) case = or-bitv then r-or-bitv-step-clock (ins, r) case = and-bitv then r-and-bitv-step-clock (ins, r) case = not-bitv then r-not-bitv-step-clock (ins, r) case = xor-bitv then r-xor-bitv-step-clock (ins, r) case = rsh-bitv then r-rsh-bitv-step-clock (ins, r) case = lsh-bitv then r-lsh-bitv-step-clock (ins, r) case = or-bool then r-or-bool-step-clock (ins, r) case = and-bool then r-and-bool-step-clock (ins, r) case = not-bool then r-not-bool-step-clock (ins, r) otherwise 0 endcase

Definition: r-step1-clock (ins, r) = if r-ins-okp (ins, r) then r-ins-step-clock (ins, r)

else 0 endif

Definition: r-step-clock (r) = if r-psw (r) = 'run then r-step1-clock (r-current-instruction (r), r)

else 0 endif

Definition: clock (r, n) = if n ≃ 0 then 0

else r-step-clock (r) + clock (r-step (r), n − 1) endif

; Book: r-i.events.  In this section we prove that the r machine
; is correctly implemented on the i machine.

Event: Disable unlabel.

Event: Disable r-usr-data-typep.

Event: Disable r-instructionp.

Event: Disable i-usr-data-typep.

Theorem: r-instructionp-observation r-instructionp (unlabel (ins)) → (car (unlabel (ins)) ≠ 'dcl)

Theorem: r-push-constant-observation (r-instructionp (unlabel (ins)) ∧ (car (unlabel (ins)) = 'push-constant)) → (caadr (unlabel (ins)) ≠ 'dl)

; This section is stolen from im.events.

Event: Enable i-objectp-type-simplifier. Event: Disable i-objectp-type.

; I will disable type, tag and untag for sanity's sake,
; but prove the obvious relationships first.

Event: Enable type-tag. Event: Enable untag-tag. Event: Disable type. Event: Disable tag. Event: Disable untag.

; And I will do a similar thing for the adp handlers

Event: Enable adp-name-cons. Event: Enable adp-offset-cons. Event: Enable adp-name-add-adp. Event: Enable adp-offset-add-adp. Event: Enable adp-name-sub-adp. Event: Enable adp-offset-sub-adp. Event: Disable sub-adp. Event: Disable add-adp.

Event: Disable adp-name.

Event: Disable adp-offset.

; The function BOOLEANP is a killer because it
; causes everything to split.  I will disable it
; and prove what I need about it as necessary.

Event: Disable booleanp.

Event: Disable bool-to-logical.

; Some accellerators for psw handling...

Event: Enable not-equal-x-y-error-msg-run.

Theorem: not-equal-x-y-error-msg-halt x-y-error-msg (x, y) ≠ 'halt

Event: Disable x-y-error-msg.

Event: Enable i-psw-i-halt.

Event: Disable i-halt.

; Now I repeat the i-objectp-type exercise for r-objectp-type:

Theorem: r-objectp-type-simplifier (r-objectp-type ('nat, x, r) = ((type (x) = 'nat)

∧ (cddr (x) = nil)

∧ small-naturalp (untag (x), r-word-size (r)))) ∧ (r-objectp-type ('int, x, r)

= ((type (x) = 'int) ∧ (cddr (x) = nil) ∧ small-integerp (untag (x), r-word-size (r))))

∧ (r-objectp-type ('bitv, x, r) = ((type (x) = 'bitv)

∧ (cddr (x) = nil) ∧ bit-vectorp (untag (x), r-word-size (r))))

∧ (r-objectp-type ('bool, x, r)

= ((type (x) = 'bool)

∧ (cddr (x) = nil) ∧ booleanp (untag (x))))

∧ (r-objectp-type ('addr, x, r)

= ((type (x) = 'addr)

∧ (cddr (x) = nil) ∧ adpp (untag (x), r-usr-data-segment (r))))

∧ (r-objectp-type ('pc, x, r)

= ((type (x) = 'pc)

∧ (cddr (x) = nil) ∧ pcpp (untag (x), r-prog-segment (r))))

∧ (r-objectp-type ('subr, x, r)

= ((type (x) = 'subr)

∧ (cddr (x) = nil) ∧ definedp (untag (x), r-prog-segment (r))))

∧ (r-objectp-type ('sys-addr, x, r)

= ((type (x) = 'sys-addr) ∧ (cddr (x) = nil) ∧ adpp (untag (x), r-sys-data-segment (r))))

Event: Disable r-objectp-type.

; The notion of r-usr-data-objectp is important in the definition
; of proper r states.  It is defined as a conjunction of
; r-objectp and r-usr-data-typep.  We do not allow either of those
; to expand in our proofs, except under careful control because they
; case case splits.

Event: Disable r-objectp.

Event: Disable r-usr-data-typep.

; I disable icode1 and will enable it when it is needed.

Event: Disable icode1.

; We now prove a lemma that is basically equivalent to

; (implies (proper-r-statep r load-addr) body-of-proper-r-statep)
; except that the body has been simplified so that it is
; in normal form.  The point is to permit me
; to keep proper-r-statep disabled but to allow each of
; its conjuncts to be proved by backchaining into the
; (proper-r-statep r load-addr) hypothesis that governs every main
; theorem.  I have also tossed in few other facts that
; follow from those conjuncts.
; The following embarrassing rule is needed to cause the
; rewriter to replace the (assoc & &) by the nearly
; explicit albeit larger list expression.

Theorem: equality-stuffer (assoc (name, alist) = list (name, tag (type, obj ))) → (cdr (assoc (name, alist)) = list (tag (type, obj )))

Theorem: listp-assoc-implies-definedp listp (assoc (name, alist)) → definedp (name, alist)

Theorem: proper-r-statep-properties proper-r-statep (r, load-addr) → (r-statep (r)

∧ (type (r-pc (r)) = 'pc) ∧ (cddr (r-pc (r)) = nil) ∧ listp (untag (r-pc (r))) ∧ definedp (adp-name (untag (r-pc (r))), r-prog-segment (r)) ∧ (adp-offset (untag (r-pc (r))) ∈ N) ∧ (adp-offset (untag (r-pc (r)))

< length (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))))

∧ (type (r-cfp (r)) = 'sys-addr) ∧ listp (untag (r-cfp (r))) ∧ (adp-name (untag (r-cfp (r))) = 'cstk) ∧ (cddr (r-cfp (r)) = nil) ∧ adpp (untag (r-cfp (r)), r-sys-data-segment (r)) ∧ definedp ('cstk, r-sys-data-segment (r)) ∧ (adp-offset (untag (r-cfp (r))) ∈ N) ∧ (adp-offset (untag (r-cfp (r)))

< length (cdr (assoc ('cstk, r-sys-data-segment (r))))) ∧ listp (cdr (assoc ('cstk, r-sys-data-segment (r)))) ∧ (type (r-csp (r)) = 'sys-addr)

∧ listp (untag (r-csp (r))) ∧ (adp-name (untag (r-csp (r))) = 'cstk) ∧ (cddr (r-csp (r)) = nil) ∧ adpp (untag (r-csp (r)), r-sys-data-segment (r)) ∧ (adp-offset (untag (r-csp (r))) ∈ N) ∧ (adp-offset (untag (r-csp (r)))

< length (cdr (assoc ('cstk, r-sys-data-segment (r))))) ∧ (type (r-tsp (r)) = 'sys-addr) ∧ listp (untag (r-tsp (r))) ∧ (adp-name (untag (r-tsp (r))) = 'tstk) ∧ (cddr (r-tsp (r)) = nil) ∧ adpp (untag (r-tsp (r)), r-sys-data-segment (r)) ∧ definedp ('tstk, r-sys-data-segment (r)) ∧ (adp-offset (untag (r-tsp (r))) ∈ N) ∧ (adp-offset (untag (r-tsp (r)))

< length (cdr (assoc ('tstk, r-sys-data-segment (r))))) ∧ listp (cdr (assoc ('tstk, r-sys-data-segment (r)))) ∧ (assoc ('full-ctrl-stk-addr, r-sys-data-segment (r))

    = '(full-ctrl-stk-addr
          (sys-addr (cstk . 0))))

∧ (assoc ('full-temp-stk-addr, r-sys-data-segment (r))

    = '(full-temp-stk-addr
          (sys-addr (tstk . 0))))

∧ (assoc ('empty-temp-stk-addr, r-sys-data-segment (r))

    = list ('empty-temp-stk-addr,
           tag ('sys-addr,

cons ('tstk,

length (cdr (assoc ('tstk,

r-sys-data-segment (r)))) − 1))))

∧ adpp ('(full-ctrl-stk-addr . 0), r-sys-data-segment (r)) ∧ adpp ('(full-temp-stk-addr . 0), r-sys-data-segment (r)) ∧ adpp ('(empty-temp-stk-addr . 0), r-sys-data-segment (r))

∧ (fetch-adp ('(full-ctrl-stk-addr . 0),

r-sys-data-segment (r))

    = '(sys-addr (cstk . 0)))
∧ (fetch-adp ('(full-temp-stk-addr . 0),

r-sys-data-segment (r))

    = '(sys-addr (tstk . 0)))
∧ (fetch-adp ('(empty-temp-stk-addr . 0),

r-sys-data-segment (r))

    = tag ('sys-addr,

cons ('tstk,

length (cdr (assoc ('tstk, r-sys-data-segment (r)))) − 1)))

∧ (type (r-c-flg (r)) = 'bool) ∧ (cddr (r-c-flg (r)) = nil) ∧ booleanp (untag (r-c-flg (r))) ∧ (type (r-v-flg (r)) = 'bool) ∧ (cddr (r-v-flg (r)) = nil) ∧ booleanp (untag (r-v-flg (r))) ∧ (type (r-n-flg (r)) = 'bool) ∧ (cddr (r-n-flg (r)) = nil) ∧ booleanp (untag (r-n-flg (r))) ∧ (type (r-z-flg (r)) = 'bool) ∧ (cddr (r-z-flg (r)) = nil) ∧ booleanp (untag (r-z-flg (r))) ∧ r-prog-segmentp (r-prog-segment (r)) ∧ proper-r-usr-data-segmentp (r-usr-data-segment (r), r) ∧ ((load-addr

+ segment-length (icompile (r-prog-segment (r))) + segment-length (r-usr-data-segment (r)) + segment-length (r-sys-data-segment (r))) < exp (2, r-word-size (r))))

Event: Disable listp-assoc-implies-definedp.

Event: Disable equality-stuffer.

; Having proved that, we will

Event: Disable proper-r-statep.

; I now begin the study of find-label and pc mapping

Theorem: find-labelp-is-find-label find-labelp (lab, lst) = (find-label (lab, lst) < length (lst))

Theorem: find-label-append find-label (lab, append (a, b)) = if find-labelp (lab, a) then find-label (lab, a)

else length (a) + find-label (lab, b) endif

Event: Enable difference-x-x.

Event: Enable length-append.

; The following odd rule is needed because we sometimes treat
; a tagged object, e.g., the constant following a move_x_*,
; as an instruction and ask if it is labelled.

Theorem: car-tag car (tag (type, obj )) = type

Theorem: find-label-jump *-lst find-label (lab, jump *-lst (lst, program)) = length (jump *-lst (lst, program))

Theorem: find-label-if find-label (lab,

if a then b else c endif)

= if a then find-label (lab, b)

else find-label (lab, c) endif

Theorem: length-if{jsm} length (if a then b

else c endif) = if a then length (b)

else length (c) endif

; The icode1 fn is too big for the theorem prover's rewriter to
; explore on the standard akcl stack.   So I cut the function
; into two parts:

Definition: icode12 (ins, pcn, prog) = case on car (ins):

case = eq

then icode-eq (ins, pcn, prog)

case = lt-addr

then icode-lt-addr (ins, pcn, prog)

case = fetch

then icode-fetch (ins, pcn, prog)

case = deposit

then icode-deposit (ins, pcn, prog)

case = add-int

then icode-add-int (ins, pcn, prog)

case = add-int-with-carry then icode-add-int-with-carry (ins, pcn, prog) case = add1-int then icode-add1-int (ins, pcn, prog) case = sub-int then icode-sub-int (ins, pcn, prog) case = sub-int-with-carry then icode-sub-int-with-carry (ins, pcn, prog) case = sub1-int then icode-sub1-int (ins, pcn, prog) case = neg-int then icode-neg-int (ins, pcn, prog) case = lt-int then icode-lt-int (ins, pcn, prog) case = int-to-nat then icode-int-to-nat (ins, pcn, prog) case = add-nat then icode-add-nat (ins, pcn, prog) case = add-nat-with-carry then icode-add-nat-with-carry (ins, pcn, prog) case = add1-nat then icode-add1-nat (ins, pcn, prog) case = sub-nat then icode-sub-nat (ins, pcn, prog) case = sub-nat-with-carry then icode-sub-nat-with-carry (ins, pcn, prog) case = sub1-nat then icode-sub1-nat (ins, pcn, prog) case = lt-nat then icode-lt-nat (ins, pcn, prog) case = mult2-nat then icode-mult2-nat (ins, pcn, prog) case = mult2-nat-with-carry-out then icode-mult2-nat-with-carry-out (ins, pcn, prog) case = div2-nat then icode-div2-nat (ins, pcn, prog) case = or-bitv then icode-or-bitv (ins, pcn, prog) case = and-bitv then icode-and-bitv (ins, pcn, prog) case = not-bitv then icode-not-bitv (ins, pcn, prog) case = xor-bitv then icode-xor-bitv (ins, pcn, prog) case = rsh-bitv then icode-rsh-bitv (ins, pcn, prog) case = lsh-bitv then icode-lsh-bitv (ins, pcn, prog) case = or-bool then icode-or-bool (ins, pcn, prog) case = and-bool then icode-and-bool (ins, pcn, prog) case = not-bool then icode-not-bool (ins, pcn, prog) otherwise '((error)) endcase

Definition: icode11 (ins, pcn, prog) = case on car (ins):

case = call then icode-call (ins, pcn, prog) case = ret then icode-ret (ins, pcn, prog) case = locn then icode-locn (ins, pcn, prog) case = push-constant then icode-push-constant (ins, pcn, prog) case = push-local then icode-push-local (ins, pcn, prog) case = push-global then icode-push-global (ins, pcn, prog) case = push-ctrl-stk-free-size then icode-push-ctrl-stk-free-size (ins, pcn, prog) case = push-temp-stk-free-size then icode-push-temp-stk-free-size (ins, pcn, prog) case = push-temp-stk-index then icode-push-temp-stk-index (ins, pcn, prog) case = jump-if-temp-stk-full then icode-jump-if-temp-stk-full (ins, pcn, prog) case = jump-if-temp-stk-empty then icode-jump-if-temp-stk-empty (ins, pcn, prog) case = pop then icode-pop (ins, pcn, prog) case = pop* then icode-pop* (ins, pcn, prog) case = popn then icode-popn (ins, pcn, prog) case = pop-local then icode-pop-local (ins, pcn, prog) case = pop-global then icode-pop-global (ins, pcn, prog) case = pop-locn then icode-pop-locn (ins, pcn, prog) case = pop-call then icode-pop-call (ins, pcn, prog) case = fetch-temp-stk then icode-fetch-temp-stk (ins, pcn, prog) case = deposit-temp-stk then icode-deposit-temp-stk (ins, pcn, prog) case = jump then icode-jump (ins, pcn, prog) case = jump-case then icode-jump-case (ins, pcn, prog) case = pushj then icode-pushj (ins, pcn, prog) case = popj then icode-popj (ins, pcn, prog) case = set-local then icode-set-local (ins, pcn, prog) case = set-global then icode-set-global (ins, pcn, prog) case = test-nat-and-jump then icode-test-nat-and-jump (ins, pcn, prog) case = test-int-and-jump then icode-test-int-and-jump (ins, pcn, prog) case = test-bool-and-jump then icode-test-bool-and-jump (ins, pcn, prog) case = test-bitv-and-jump then icode-test-bitv-and-jump (ins, pcn, prog) case = no-op then icode-no-op (ins, pcn, prog) case = add-addr then icode-add-addr (ins, pcn, prog) case = sub-addr then icode-sub-addr (ins, pcn, prog) otherwise icode12 (ins, pcn, prog) endcase

Theorem: icode1-is-icode11 icode1 (ins, pcn, prog) = icode11 (ins, pcn, prog)

Event: Disable icode11.

Event: Disable icode12.

Theorem: find-label-icode12 r-instructionp (unlabel (ins)) → (find-label (lab, icode12 (unlabel (ins), pcn, program))

= length (icode12 (unlabel (ins), pcn, program)))

Theorem: find-label-icode1 r-instructionp (unlabel (ins)) → (find-label (lab, icode1 (unlabel (ins), pcn, program))

= length (icode1 (unlabel (ins), pcn, program)))

Event: Disable icode1-is-icode11.

Theorem: find-label-failure-extends-to-cdr (find-label (lab, lst) = length (lst)) → (find-label (lab, cdr (lst)) = length (cdr (lst)))

Theorem: find-label-icode r-instructionp (unlabel (ins)) → (find-label (lab, icode (ins, pcn, program))

= if lab = cons (name (program), pcn) then 0 else length (icode (ins, pcn, program)) endif)

Theorem: find-label-icompile-program-body-lemma1 (listp (lab) ∧ (car (lab) = car (program)) ∧ (cdr (lab) = pcn)) → (find-label (lab, icompile-program-body (body, pcn, program)) = 0)

Event: Enable equal-length-0.

Theorem: listp-first-n listp (first-n (n, x)) = (n ≄ 0)

Theorem: length-first-n length (first-n (n, x)) = fix (n)

Theorem: zerop-difference ((x − y) = 0) = (y ≮ x)

Theorem: car-first-n car (first-n (n, x)) = if n ≃ 0 then 0

else car (x) endif

Theorem: find-label-icompile-program-body-lemma2 (pcn < n) → (first-n ((n − 1) − pcn, cdr (b)) = cdr (first-n (n − pcn, b)))

; The following hackish lemma is dangerous because it folds up
; difference.  I'll disable it as soon as it has done its bit.
; The term (cdr lab) could be replaced by n and the four hyps could
; be replaced by (lessp pcn n), but things are this way so it
; finds immediate use in the next proof.

Theorem: find-label-icompile-program-body-lemma3 (listp (lab) ∧ (cdr (lab) ∈ N) ∧ (pcn ∈ N) ∧ (cdr (lab) ≮ pcn) ∧ (lab ≠ cons (car (lab), pcn))) → (first-n ((cdr (lab) − 1) − pcn, cdr (b))

= cdr (first-n (cdr (lab) − pcn, b)))

; In the useful statement of the relationship below, lab is an pcpp,
; namely an untagged r-level pc.  But for the proof itself lab is
; a cons pair.  So we have to enable adp-name and adp-offset.

Theorem: find-label-icompile-program-body (listp (lab) ∧ (adp-name (lab) = name (program)) ∧ (adp-offset (lab) ∈ N) ∧ (pcn ∈ N) ∧ (adp-offset (lab) ≮ pcn) ∧ ((pcn + length (body)) ≮ adp-offset (lab)) ∧ r-program-bodyp (body)) → (find-label (lab, icompile-program-body (body, pcn, program))

= length (icompile-program-body (first-n (adp-offset (lab) − pcn,

body), pcn, program)))

Event: Disable find-label-icompile-program-body-lemma3.

Theorem: assoc-of-append append (append (a, b), c) = append (a, append (b, c))

; !!! Here we enable plus-add1 (which is a conjunct that hits an add1
; in either side of a plus) to replace a lemma that hit (plus x (add1 y))
; only.

Event: Enable plus-add1.

Theorem: icompile-program-body-append (pcn ∈ N) → (icompile-program-body (append (body1 , body2 ), pcn, program)

= append (icompile-program-body (body1 , pcn, program), icompile-program-body (body2 ,

length (body1 ) + pcn, program)))

; !!! Plus-0 is more powerful than the rule we're replacing,
; (plus x 0) = (fix x).

Event: Enable plus-0.

Theorem: plus-difference ((x − y) + y) = if x < y then fix (y)

else fix (x) endif

; The next two lemmas are of questionable value in indiscriminant
; use so they will be disabled as soon as they've been used where needed.

Theorem: difference-add1 (x ≮ y) → (((1 + x) − y) = (1 + (x − y)))

Theorem: open-first-n-at-high-end first-n (1 + n, x) = append (first-n (n, x), list (get (n, x)))

Theorem: find-label-add-adp-1-icompile-program-body (listp (r-pc) ∧ (name (program) = adp-name (r-pc)) ∧ (adp-offset (r-pc) ∈ N) ∧ (pcn ∈ N) ∧ (adp-offset (r-pc) ≮ pcn) ∧ (adp-offset (r-pc) < (pcn + length (body))) ∧ r-program-bodyp (body)) → (find-label (add-adp (r-pc, 1), icompile-program-body (body, pcn, program))

= (find-label (r-pc, icompile-program-body (body, pcn, program)) + length (icode (get (adp-offset (r-pc) − pcn, body), adp-offset (r-pc), program))))

Event: Disable difference-add1.

Event: Disable open-first-n-at-high-end.

; We are next headed for the result that no labels occur in the prelude
; (at least, no labels of the form (cons name n) where n is numeric).
; However, we will first

Event: Disable name.

Event: Disable formal-vars.

Event: Disable temp-var-dcls.

Event: Disable program-body.

; This probably could be done much earlier.

Event: Enable length-rev.

Event: Enable associativity-of-plus.

Theorem: find-label-generate-prelude1 r-temp-var-dclsp (var-dcls) → (find-label (lab, generate-prelude1 (var-dcls))

= length (generate-prelude1 (var-dcls)))

Theorem: not-find-label-generate-prelude2 find-label (lab, generate-prelude2 (formal-vars)) = length (generate-prelude2 (formal-vars))

Theorem: r-temp-var-dclsp-append r-temp-var-dclsp (append (var-dcls1 , var-dcls2 )) = (r-temp-var-dclsp (var-dcls1 ) ∧ r-temp-var-dclsp (var-dcls2 ))

Theorem: r-temp-var-dclsp-rev r-temp-var-dclsp (rev (var-dcls)) = r-temp-var-dclsp (var-dcls)

; The following is necessary because generate-prelude was defined
; with REVERSE (which is REV1) rather than with REV.

Theorem: reverse-is-rev reverse (x) = rev (x)

Event: Disable reverse.

Theorem: find-label-generate-prelude (r-temp-var-dclsp (temp-var-dcls (prog)) ∧ (adp-offset (lab) ∈ N)) → (find-label (lab, generate-prelude (prog))

= length (generate-prelude (prog)))

Event: Disable generate-prelude.

Event: Disable generate-postlude.

; Now we begin the study of labels in the icompiled body

Theorem: member-assoc definedp (x, a) → (assoc (x, a) ∈ a)

Theorem: difference-x-0 (x − 0) = fix (x)

Event: Enable car-assoc.

Event: Enable length-cons.

Theorem: listp-if listp (if a then b

else c endif) = if a then listp (b)

else listp (c) endif

; Note that the following lemma is stored as a type-prescription and
; hence the dependency of subsequent facts on this may not be apparent.

Theorem: listp-icode12 listp (icode12 (ins, pcn, prog))

Theorem: listp-icode1 listp (icode1 (ins, pcn, prog))

Theorem: listp-icompile-program-body listp (icompile-program-body (body, pcn, prog)) = listp (body)

Definition: induct-hint1 (n, body, pcn) = if n ≃ 0 then t

elseif body ≃ nil then t

else induct-hint1 (n − 1, cdr (body), 1 + pcn) endif

Theorem: weak-monotonicity-of-icompile-program-body ((n < length (body)) ∧ (pcn ∈ N)) → (length (icompile-program-body (body, pcn, prog))

≮ (length (icompile-program-body (first-n (n, body), pcn, prog)) + length (icode (get (n, body), n + pcn, prog))))

; The next major goal is R->I_PC-TAG-ADD-ADP-1, which has the hypothesis
; that R is a proper-r-statep.  We need to be able to recover various
; things from that.  We get those lemmas now.  The trick to the lemmas
; below is that we don't want free vars in them.  So I prove the
; interesting fact as a lemma of class nil and then instantiate
; it to components of the proper-r-statep r.  In the "instantiated"
; version I also backchain through the proper-r-statep-observations
; to get the single hypothesis (proper-r-statep r load-addr).

Theorem: r-program-bodyp-program-body-lemma (r-prog-segmentp (prog-segment) ∧ (prog ∈ prog-segment)) → r-program-bodyp (program-body (prog))

Theorem: r-program-bodyp-program-body proper-r-statep (r, load-addr) → r-program-bodyp (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))

Theorem: r-temp-var-dclsp-temp-var-dcls-lemma (r-prog-segmentp (prog-segment) ∧ (prog ∈ prog-segment)) → r-temp-var-dclsp (temp-var-dcls (prog))

Theorem: r-temp-var-dclsp-temp-var-dcls proper-r-statep (r, load-addr) → r-temp-var-dclsp (temp-var-dcls (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))

; Now we begin our attack directly on the lemma that says
; you can map down an incremented r-pc by mapping down the
; the r-pc and then incrementing by the length of icode.

Theorem: equal-tag (tag (t1 , obj1 ) = tag (t2 , obj2 )) = ((t1 = t2 ) ∧ (obj1 = obj2 ))

Theorem: add-adp-cons add-adp (cons (name, n), m) = cons (name, n + m)

Theorem: name-assoc definedp (name, alist) → (name (assoc (name, alist)) = name)

Theorem: find-label-generate-postlude find-label (lab, generate-postlude (prog)) = if lab = cons (name (prog), length (program-body (prog))) then 0

else length (generate-postlude (prog)) endif

Theorem: equal-add-adp-cons-adp-name (add-adp (x, n) = cons (adp-name (x), y)) = ((adp-offset (x) + n) = y)

Theorem: weak-monotonicity-of-icompile-program-body-0 ((n < length (body)) ∧ (n ∈ N)) → (length (icompile-program-body (body, 0, prog))

≮ (length (icompile-program-body (first-n (n, body), 0, prog)) + length (icode (get (n, body), n, prog))))

Theorem: leq-means-lessp-is-not-equal ((b ≮ (a + i)) ∧ (b ∈ N)) → (((a + i) < b) = ((a + i) ≠ b))

Theorem: equal-plus-cancellation1 (x = (x + y)) = ((x ∈ N) ∧ (y ≃ 0))

Theorem: last-instruction ((n < length (body)) ∧ (n ∈ N) ∧ (pcn ∈ N)) → (((length (icompile-program-body (first-n (n, body), pcn, prog))

+ length (icode (get (n, body), n + pcn, prog))) = length (icompile-program-body (body, pcn, prog))) = (n = (length (body) − 1)))

Theorem: last-instruction-0 ((n < length (body)) ∧ (n ∈ N)) → (((length (icompile-program-body (first-n (n, body), 0, prog))

+ length (icode (get (n, body), n, prog)))

= length (icompile-program-body (body, 0, prog)))

= (n = (length (body) − 1)))

Theorem: equal-plus-cancellation2 ((x + y) = (x + z)) = (fix (y) = fix (z))

Theorem: r->i pc-tag-add-adp-1-lemma1 (((1 + n) = length (body)) ∧ (n ∈ N) ∧ (pcn ∈ N)) → ((length (icompile-program-body (body, pcn, prog))

= (length (icompile-program-body (first-n (n, body), pcn, prog)) + length (icode (get (n, body), n + pcn, prog))))

= t)

Theorem: r->i pc-tag-add-adp-1-lemma1-0 (((1 + n) = length (body)) ∧ (n ∈ N)) → ((length (icompile-program-body (body, 0, prog))

= (length (icompile-program-body (first-n (n, body), 0, prog))

+ length (icode (get (n, body), n, prog)))) = t)

Theorem: r->i pc-tag-add-adp-1-lemma2 ((n ∈ N) ∧ (pcn ∈ N)) → ((length (icompile-program-body (body, pcn, prog))

= length (icompile-program-body (first-n (n, body), pcn, prog))) = (n = length (body)))

Theorem: r->i pc-tag-add-adp-1 proper-r-statep (r, load-addr) → (r->i pc (tag ('pc, add-adp (untag (r-pc (r)), 1)), r-prog-segment (r))

= add-addr (r->i pc (r-pc (r), r-prog-segment (r)),

length (icode (get (offset (r-pc (r)),

program-body (r-current-program (r))), offset (r-pc (r)), definition (adp-name (untag (r-pc (r))),

r-prog-segment (r))))))

Theorem: assoc-icompile definedp (name, progs) → (assoc (name, icompile (progs))

= icompile-program (definition (name, progs)))

Theorem: get-car-cdr-n get (n, x) = car (cdr-n (n, x))

Theorem: cdr-n-plus cdr-n (m + n, x) = cdr-n (n, cdr-n (m, x))

Theorem: cdr-n-append (length (a) ≮ n) → (cdr-n (n, append (a, b)) = append (cdr-n (n, a), b))

Theorem: listp-cdr-n listp (cdr-n (n, x)) = (n < length (x))

Theorem: not-lessp-length-find-label length (x) ≮ find-label (lab, x)

; I used to prove this but I'm not sure I'll use it so it has been skipped
;(prove-lemma first-n-cdr-n (rewrite)
;  (implies (lessp n (length x))
;          (equal (append (first-n n x) (cdr-n n x)) x)))

Theorem: car-append listp (a) → (car (append (a, b)) = car (a))

; here is my new version of what is shown below...

Theorem: cdr-n-length-icompile-program-body-first-n ((length (body) ≮ n) ∧ (n ∈ N) ∧ (pcn ∈ N)) → (cdr-n (length (icompile-program-body (first-n (n, body), pcn, prog)),

icompile-program-body (body, pcn, prog)) = icompile-program-body (cdr-n (n, body), n + pcn, prog))

Theorem: icompile-program-body-cdr-n-expander proper-r-statep (r, load-addr) → (icompile-program-body (cdr-n (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))),

adp-offset (untag (r-pc (r))),

assoc (adp-name (untag (r-pc (r))), r-prog-segment (r)))

= append (icode (car (cdr-n (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))),

adp-offset (untag (r-pc (r))),

assoc (adp-name (untag (r-pc (r))), r-prog-segment (r))), icompile-program-body (cdr (cdr-n (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))),

1 + adp-offset (untag (r-pc (r))), assoc (adp-name (untag (r-pc (r))), r-prog-segment (r)))))

Theorem: fetch-adp-add-adp-untag-r->i (proper-r-statep (r, load-addr) ∧ (n < length (icode (get (offset (r-pc (r)),

program-body (definition (adp-name (untag (r-pc (r))),

r-prog-segment (r)))),

offset (r-pc (r)),

definition (adp-name (untag (r-pc (r))),

r-prog-segment (r))))))

→ (fetch-adp (add-adp (untag (r->i pc (r-pc (r), r-prog-segment (r))), n),

icompile (r-prog-segment (r)))

= get (n,

icode (get (offset (r-pc (r)),

program-body (definition (area-name (r-pc (r)),

r-prog-segment (r)))),

offset (r-pc (r)),

definition (area-name (r-pc (r)), r-prog-segment (r)))))

; This is really a crucial result because it tells us how to get the i-level
; instruction corresponding to a given r level one.  In the future I prefer
; to see get rather than cdr-n, so now that cdr-n has done its job I'm going
; to disable to rewrite rule that introduces it.

Event: Disable get-car-cdr-n.

; In order for the above lemma to be used, R->I_PC must be disabled.
; We need the following about it:

Theorem: adp-name-untag-r->i pc adp-name (untag (r->i pc (r-pc (r), r-prog-segment (r)))) = adp-name (untag (r-pc (r)))

Event: Disable r->i pc.

Theorem: definedp-icompile definedp (name, icompile (list)) = definedp (name, list)

Theorem: length-generate-prelude1 length (generate-prelude1 (temp-var-dcls)) = (length (temp-var-dcls) ∗ 2)

Theorem: length-generate-prelude2 length (generate-prelude2 (formal-vars)) = length (formal-vars)

Theorem: length-generate-prelude length (generate-prelude (program)) = (2

+ (length (temp-var-dcls (program)) ∗ 2) + length (formal-vars (program)))

Theorem: length-generate-postlude length (generate-postlude (prog)) = 3

Theorem: find-label-cdr-icompile-program (((1 + adp-offset (lab)) < length (program-body (prog))) ∧ r-temp-var-dclsp (temp-var-dcls (prog)) ∧ (adp-offset (lab) ∈ N) ∧ r-program-bodyp (program-body (prog)) ∧ (adp-name (lab) = name (prog)) ∧ listp (lab)) → ((1 + find-label (lab, cdr (icompile-program (prog))))

< length (cdr (icompile-program (prog))))

Event: Disable length-generate-prelude.

Theorem: addp-add-adp-untag-r->i pc (proper-r-statep (r, load-addr) ∧ (length (icode (get (offset (r-pc (r)),

program-body (definition (adp-name (untag (r-pc (r))),

r-prog-segment (r)))),

offset (r-pc (r)),

definition (adp-name (untag (r-pc (r))), r-prog-segment (r))))

≮ n)) → adpp (add-adp (untag (r->i pc (r-pc (r), r-prog-segment (r))), n),

icompile (r-prog-segment (r)))

; The following disable is necessary because adpp is used in the concl above.
; This could have been done earlier, when we disabled the other adp fns.
; If it is moved, however, we must remember to enable it for the proof above.

Event: Disable adpp.

; The following lemma establishes that every label of the form
; (cons name n) where name is less than the length of the program
; occurs in the icompiled program.  It follows from our
; FIND-LABEL-ICOMPILE-PROGRAM-BODY but we wish to have that

; rewrite rule disabled so as not to rewrite FIND-LABEL
; expressions in the future.

Theorem: lessp-find-label-icompile-program (listp (lab) ∧ (adp-name (lab) = name (program)) ∧ (adp-offset (lab) ∈ N) ∧ (length (program-body (program)) ≮ adp-offset (lab)) ∧ r-programp (program)) → (find-label (lab, cdr (icompile-program (program)))

< length (cdr (icompile-program (program))))

; To relieve the hypothesis about r-programp we will need:

Theorem: r-prog-segmentp-contains-r-programp (r-prog-segmentp (segment) ∧ (prog ∈ segment)) → r-programp (prog)

Theorem: proper-r-statep-implies-r-programp (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r))) → r-programp (assoc (name, r-prog-segment (r)))

Event: Disable r-programp.

; At this point I think we have completely dealt with all issues concerning
; FIND-LABEL and we will disable the lemmas surrounding it.

Event: Disable find-label-generate-postlude.

Event: Disable find-label-generate-prelude.

Event: Disable not-find-label-generate-prelude2.

Event: Disable find-label-generate-prelude1.

Event: Disable find-label-add-adp-1-icompile-program-body.

Event: Disable find-label-icompile-program-body.

Event: Disable find-label-icompile-program-body-lemma1.

Event: Disable find-label-icode.

Event: Disable find-label-failure-extends-to-cdr.

Event: Disable find-label-icode1.

Event: Disable find-label-jump *-lst.

Event: Disable find-label-append.

; We have also exhausted our patience with icompile-program and will
; shut it down.

Theorem: name-cons name (cons (x, y)) = x

Theorem: name-icompile-program name (icompile-program (program)) = name (program)

Event: Disable icompile-program.

; Now in order for these lemmas mentioning (icode (get & &) ...) to be used
; we have to force icode to expand when we know what the instr opcode is.
; That is what the following theorems do:

Theorem: icode-opener (car (unlabel (ins)) = pack (xxx)) → (icode (ins, pcn, prog)

= dl-block (cons (name (prog), pcn), ins, case on car (unlabel (ins)): case = call then icode-call (unlabel (ins), pcn, prog) case = ret then icode-ret (unlabel (ins), pcn, prog) case = locn then icode-locn (unlabel (ins), pcn, prog) case = push-constant then icode-push-constant (unlabel (ins), pcn, prog) case = push-local then icode-push-local (unlabel (ins), pcn, prog) case = push-global then icode-push-global (unlabel (ins), pcn, prog) case = push-ctrl-stk-free-size then icode-push-ctrl-stk-free-size (unlabel (ins),

pcn, prog)

case = push-temp-stk-free-size then icode-push-temp-stk-free-size (unlabel (ins),

pcn, prog)

case = push-temp-stk-index then icode-push-temp-stk-index (unlabel (ins),

pcn, prog)

case = jump-if-temp-stk-full then icode-jump-if-temp-stk-full (unlabel (ins),

pcn, prog)

case = jump-if-temp-stk-empty then icode-jump-if-temp-stk-empty (unlabel (ins),

pcn, prog)

case = pop then icode-pop (unlabel (ins), pcn, prog) case = pop* then icode-pop* (unlabel (ins), pcn, prog) case = popn then icode-popn (unlabel (ins), pcn, prog) case = pop-local then icode-pop-local (unlabel (ins), pcn, prog) case = pop-global then icode-pop-global (unlabel (ins), pcn, prog) case = pop-locn then icode-pop-locn (unlabel (ins), pcn, prog) case = pop-call then icode-pop-call (unlabel (ins), pcn, prog) case = fetch-temp-stk then icode-fetch-temp-stk (unlabel (ins), pcn, prog) case = deposit-temp-stk then icode-deposit-temp-stk (unlabel (ins), pcn, prog) case = jump then icode-jump (unlabel (ins), pcn, prog) case = jump-case then icode-jump-case (unlabel (ins), pcn, prog) case = pushj then icode-pushj (unlabel (ins), pcn, prog) case = popj then icode-popj (unlabel (ins), pcn, prog) case = set-local then icode-set-local (unlabel (ins), pcn, prog) case = set-global then icode-set-global (unlabel (ins), pcn, prog) case = test-nat-and-jump then icode-test-nat-and-jump (unlabel (ins), pcn, prog) case = test-int-and-jump then icode-test-int-and-jump (unlabel (ins), pcn, prog) case = test-bool-and-jump then icode-test-bool-and-jump (unlabel (ins),

pcn, prog)

case = test-bitv-and-jump then icode-test-bitv-and-jump (unlabel (ins),

pcn, prog)

case = no-op then icode-no-op (unlabel (ins), pcn, prog) case = add-addr then icode-add-addr (unlabel (ins), pcn, prog) case = sub-addr then icode-sub-addr (unlabel (ins), pcn, prog) case = eq then icode-eq (unlabel (ins), pcn, prog) case = lt-addr then icode-lt-addr (unlabel (ins), pcn, prog) case = fetch then icode-fetch (unlabel (ins), pcn, prog) case = deposit then icode-deposit (unlabel (ins), pcn, prog) case = add-int then icode-add-int (unlabel (ins), pcn, prog) case = add-int-with-carry then icode-add-int-with-carry (unlabel (ins),

pcn, prog)

case = add1-int then icode-add1-int (unlabel (ins), pcn, prog) case = sub-int then icode-sub-int (unlabel (ins), pcn, prog) case = sub-int-with-carry then icode-sub-int-with-carry (unlabel (ins),

pcn, prog)

case = sub1-int then icode-sub1-int (unlabel (ins), pcn, prog) case = neg-int then icode-neg-int (unlabel (ins), pcn, prog) case = lt-int then icode-lt-int (unlabel (ins), pcn, prog) case = int-to-nat then icode-int-to-nat (unlabel (ins), pcn, prog) case = add-nat then icode-add-nat (unlabel (ins), pcn, prog) case = add-nat-with-carry then icode-add-nat-with-carry (unlabel (ins),

pcn, prog)

case = add1-nat then icode-add1-nat (unlabel (ins), pcn, prog) case = sub-nat then icode-sub-nat (unlabel (ins), pcn, prog) case = sub-nat-with-carry then icode-sub-nat-with-carry (unlabel (ins),

pcn, prog)

case = sub1-nat then icode-sub1-nat (unlabel (ins), pcn, prog) case = lt-nat then icode-lt-nat (unlabel (ins), pcn, prog) case = mult2-nat then icode-mult2-nat (unlabel (ins), pcn, prog) case = mult2-nat-with-carry-out then icode-mult2-nat-with-carry-out (unlabel (ins),

pcn, prog)

case = div2-nat then icode-div2-nat (unlabel (ins), pcn, prog) case = or-bitv then icode-or-bitv (unlabel (ins), pcn, prog) case = and-bitv then icode-and-bitv (unlabel (ins), pcn, prog) case = not-bitv then icode-not-bitv (unlabel (ins), pcn, prog) case = xor-bitv then icode-xor-bitv (unlabel (ins), pcn, prog) case = rsh-bitv then icode-rsh-bitv (unlabel (ins), pcn, prog) case = lsh-bitv then icode-lsh-bitv (unlabel (ins), pcn, prog) case = or-bool then icode-or-bool (unlabel (ins), pcn, prog) case = and-bool then icode-and-bool (unlabel (ins), pcn, prog) case = not-bool then icode-not-bool (unlabel (ins), pcn, prog) otherwise '((error)) endcase))

Event: Disable icode.

Theorem: fetch-adp-add-adp-untag-r->i-0 proper-r-statep (r, load-addr) → (fetch-adp (untag (r->i pc (r-pc (r), r-prog-segment (r))),

icompile (r-prog-segment (r)))

= car (icode (get (offset (r-pc (r)),

program-body (definition (area-name (r-pc (r)),

r-prog-segment (r)))),

offset (r-pc (r)), definition (area-name (r-pc (r)), r-prog-segment (r)))))

; I also want to disable deposit-adp.  But I need to prove the
; fundamental relationships between fetch and deposit first.

Theorem: assoc-put-assoc{gen} assoc (u1 , put-assoc (val, u2 , segment)) = if u1 = u2

then if definedp (u1 , segment) then cons (u1 , val)

else f endif else assoc (u1 , segment) endif

Theorem: get-nlistp (x ≃ nil) → (get (n, x) = 0)

Theorem: get-put ((n ∈ N) ∧ (k ∈ N)) → (get (n, put (val, k, lst))

= if n = k then val else get (n, lst) endif)

Theorem: put-assoc-put-assoc put-assoc (val1 , name, put-assoc (val2 , name, alist)) = put-assoc (val1 , name, alist)

Theorem: put-put put (val1 , n, put (val2 , n, lst)) = put (val1 , n, lst)

Theorem: adpp-put-assoc (length (val) = length (definiens (name, alist))) → (adpp (x, put-assoc (val, name, alist)) = adpp (x, alist))

Event: Enable length-put.

Theorem: adpp-deposit-adp adpp (adp2 , segment) → (adpp (adp1 , deposit-adp (val, adp2 , segment)) = adpp (adp1 , segment))

Theorem: fetch-adp-deposit-adp (adpp (adp1 , segment) ∧ adpp (adp2 , segment)) → (fetch-adp (adp1 , deposit-adp (val, adp2 , segment))

= if adp1 = adp2 then val else fetch-adp (adp1 , segment) endif)

Theorem: deposit-adp-deposit-adp deposit-adp (val1 , adp, deposit-adp (val2 , adp, segment)) = deposit-adp (val1 , adp, segment)

; That concludes our first pass at fetch-adp and deposit-adp lemmas.

Event: Disable deposit-adp.

Event: Disable fetch-adp.

Theorem: unlabel-dl unlabel (dl (a, b, c)) = c

Event: Disable dl.

Theorem: type-r->i pc type (r->i pc (r-pc, r-prog-segment)) = 'ipc

Theorem: cddr-r->i pc cddr (r->i pc (r-pc, r-prog-segment)) = nil Theorem: addp-add-adp-untag-r->i pc-0 proper-r-statep (r, load-addr) → adpp (untag (r->i pc (r-pc (r), r-prog-segment (r))),

icompile (r-prog-segment (r)))

Theorem: add-adp-add-adp add-adp (add-adp (adp, i), j ) = add-adp (adp, i + j )

; We are now headed into the block of lemmas that are responsible
; for expanding (i * 3 load-addr) for various 3's.  Very roughly speaking,
; we expand (I * 3 load-addr) to (I-STEP (I-STEP (I-STEP *))).  But there
; are various problems, all more or less having to do with the
; fact that we wish to simplify that nest of I-STEPs from the
; inside out, thus symbolically executing the i-level code.
; So imagine that * above is just any intermediate state produced
; in this process.
; The first problem is we call the "I-STATE-OKP problem."
; The sequence of function calls from I is
; I -> I-STEP -> I-STEP1 -> I-STATE-OKP, I-INS-OKP & I-INS-STEP.
; We will need to prove (I-STATE-OKP * load-addr).  But we have from the
; im level proofs:

Event: Enable i-state-okp-i-ins-step.

Event: Disable i-ins-step.

Event: Disable i-ins-okp.

#|
(include-book i-m-book "i-m" t nil)
; Now we disable all of the just imported events except for
; i-state-okp-i-ins-step and we also disable i-ins-step and i-ins-okp.
; This inclusion also introduces many function symbols.  Most we
; keep disabled.  But we used PROPERP in a theorem far below (without
; really knowing when it came into the chronology) and then discovered
; when a proof failed that it was introduced here and was disabled.
; We need it enabled.  One way to look at this inclusion is that we
; looked at "i-m" and saw two things we need, i-state-okp-i-ins-step

; and properp.
(status i-m-book-status
        (set-difference (union (@ *e* add-adp-add-adp)
                               '(i-state-okp-i-ins-step properp))
                        '(i-ins-step i-ins-okp)))
|#
; Thus, on every unfolding of I we get for free the I-STATE-OKP
; if we have it initially (which we do).  But the invariant
; lemma above can't be used if * has been simplified out to
; an I-STATE shell.  So our first move is to replace (I * n load-addr)
; by (I* * n load-addr), where I* is like I but does not have the I-STATE-OKP
; check at all.  We prove that I is I* if the initial state is OKP.

Definition: i* (i, n, load-addr) = if n ≃ 0 then i

elseif i-psw (i) = 'run

then if i-ins-okp (i-current-instruction (i), i)

then i* (i-ins-step (i-current-instruction (i), i, load-addr), n − 1, load-addr)

else i-halt (i,

x-y-error-msg ('i,

car (i-current-instruction (i)))) endif

else i endif

; A little lemma to deal with the fact that I* halts on the first non-RUN
; psw while I chugs onward.

Theorem: i-id-on-non-run (i-psw (i) ≠ 'run) → (i (i, n, load-addr) = i)

; The solution to the I-STATE-OKP problem:

Theorem: i-state-okp-implies-i-is-i* ((load-addr ∈ N) ∧ i-state-okp (i, load-addr)) → (i (i, n, load-addr) = i* (i, n, load-addr))

Event: Disable i.

; So now (I s n load-addr) stays in the problem until we can show that s is
; okp and then it changes to I*.
; There is only one s for which we need to prove i-state-okp, and
; that is the opened up version of (r->i r):

Theorem: proper-r-statep-implies-i-state-okp-r->i-opened proper-r-statep (r, load-addr) → i-state-okp (i-state (r->i pc (r-pc (r), r-prog-segment (r)),

r-cfp (r), r-csp (r), r-tsp (r), r-x (r), r-y (r), r-c-flg (r), r-v-flg (r), r-n-flg (r), r-z-flg (r), icompile (r-prog-segment (r)), r-usr-data-segment (r), r-sys-data-segment (r), r-word-size (r),

'run),

load-addr)

Event: Disable i-state-okp.

; Aside:  We will want the elegant version later so we prove it now:

Theorem: proper-r-statep-implies-i-state-okp-r->i (proper-r-statep (r, load-addr) ∧ (¬ errorp (r-psw (r)))) → i-state-okp (r->i (r), load-addr)

; Next we want to expand (I* s (ADD1 n) load-addr).  But we want this to
; happen only if s has been reduced to an explicit state.  That way
; we avoid a proliferation of case splits.

Theorem: i*-opener (ins = i-current-instruction (i-state (i-pc,

i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

→ (i* (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

1 + n, load-addr)

= if i-psw = 'run

then if i-ins-okp (ins,

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

then i* (i-ins-step (ins,

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr),

n, load-addr)

else i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, x-y-error-msg ('i, car (ins))) endif

else i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw) endif)

Theorem: i*-done i* (i, 0, load-addr) = i

Event: Disable i*.

; So now the only way (i* i n load-addr) will open is if n is 0 or n is an ADD1
; and i is an explicit state.
; Next we consider the problem of opening up I-INS-OKP and I-INS-STEP.
; We wish to open these fns only when the instruction is known and
; the state is explicit.
; Because the i machine has instructions that are all constants --
; there are no operands (unlike the r-level ICODE-OPENER case) --
; we just prove a set of unconditional equalities

Theorem: i-ins-okp-opener (i-ins-okp ('(add <c> x x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add <c> x x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add <tsp> <tsp>{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add <tsp> <tsp>{v}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size,

i-psw)))

∧ (i-ins-okp ('(add <tsp> <tsp>{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add <tsp> <tsp>{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add <tsp>{a} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add <tsp>{a} x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add tsp *{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add tsp *{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add tsp x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add tsp x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add <tsp>{i} x{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add <tsp>{i} x{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add <tsp>{n} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add <tsp>{n} x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add pc x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add pc x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add x x{n}), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-add x x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(add x{n} csp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size,

i-psw))

= i-add x{n} csp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(addc <c> x{n} y{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-addc <c> x{n} y{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(addc <v> x{i} y{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-addc <v> x{i} y{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(and <tsp>{v} x{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-and <tsp>{v} x{v}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(and <tsp>{b} x{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-and <tsp>{b} x{b}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(asr <c> <tsp> <tsp>{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-asr <c> <tsp> <tsp>{b}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(cpop cfp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-cpop cfp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(cpop pc),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-cpop pc-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(cpush *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-cpush *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(cpush <tsp>+),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-cpush <tsp>+-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(cpush cfp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-cpush cfp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(decr <tsp> <tsp>{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-decr <tsp> <tsp>{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(decr <tsp> <tsp>{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-decr <tsp> <tsp>{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(incr <tsp> <tsp>{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-incr <tsp> <tsp>{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(incr <tsp> <tsp>{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-incr <tsp> <tsp>{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(incr y y{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-incr y y{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(int-to-nat),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-int-to-nat-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(jump-n x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-jump-n x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(jump-nn x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-jump-nn x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(jump-nz x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-jump-nz x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(jump-z x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-jump-z x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(jump *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-jump *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(jump x{subr}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-jump x{subr}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(lsr <c> x x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-lsr <c> x x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(lsr <tsp> <tsp>{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-lsr <tsp> <tsp>{v}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move-c <tsp> *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move-c <tsp> *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move-v <tsp> *), i-state (i-pc,

i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move-v <tsp> *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move-z <tsp> *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move-z <tsp> *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move-n x *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move-n x *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move <tsp> *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move <tsp> *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move <x{a}> <tsp>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move <x{a}> <tsp>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move <x{s}> <tsp>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move <x{s}> <tsp>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move cfp csp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move cfp csp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move csp cfp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move csp cfp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move x *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move x *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move x <x{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move x <x{s}>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size,

i-psw)))

∧ (i-ins-okp ('(move x tsp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move x tsp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move x x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move x x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move y *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move y *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move y <y{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move y <y{s}>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(move y tsp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-move y tsp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(neg <tsp> <tsp>{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-neg <tsp> <tsp>{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(not <tsp> <tsp>{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-not <tsp> <tsp>{v}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(or <tsp>{v} x{v}), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-or <tsp>{v} x{v}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(or <tsp>{b} x{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size,

i-psw))

= i-or <tsp>{b} x{b}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <c> <tsp>{a} x{a}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <c> <tsp>{a} x{a}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <c> <tsp>{n} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <c> <tsp>{n} x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <nv> <tsp>{i} x{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <nv> <tsp>{i} x{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <tsp>{a} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <tsp>{a} x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub x{s} y{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub x{s} y{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <tsp>{i} x{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <tsp>{i} x{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <tsp>{n} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <tsp>{n} x{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <tsp>{s} x{s}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <tsp>{s} x{s}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(sub <z> x{s} y{s}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-sub <z> x{s} y{s}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(subb <c> x{n} y{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-subb <c> x{n} y{n}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(subb <v> x{i} y{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-subb <v> x{i} y{i}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop <c> x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop <c> x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop <x{a}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop <x{a}>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop <x{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop <x{s}>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop pc),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop pc-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop y-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop{v} <z> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop{v} <z> y-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop{b} <z> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop{b} <z> y-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop{i} <zn> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop{i} <zn> y-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpop{n} <z> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpop{n} <z> y-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpush *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpush *-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpush <x{a}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpush <x{a}>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpush <x{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpush <x{s}>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpush csp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpush csp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpush tsp), i-state (i-pc,

i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpush tsp-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(tpush x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-tpush x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(xor <tsp> <tsp>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-xor <tsp> <tsp>-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(xor <tsp>{v} x{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-xor <tsp>{v} x{v}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(xor <tsp>{b} *{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-xor <tsp>{b} *{b}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(xor <tsp>{b} x{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-xor <tsp>{b} x{b}-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-okp ('(xor <z> <tsp> x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw))

= i-xor <z> <tsp> x-okp (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

Theorem: i-ins-step-opener (i-ins-step ('(add <c> x x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add <c> x x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add <tsp> <tsp>{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add <tsp> <tsp>{v}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add <tsp> <tsp>{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add <tsp> <tsp>{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add <tsp>{a} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add <tsp>{a} x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add tsp *{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add tsp *{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add tsp x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add tsp x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add <tsp>{i} x{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add <tsp>{i} x{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add <tsp>{n} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add <tsp>{n} x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add pc x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add pc x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add x x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add x x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(add x{n} csp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-add x{n} csp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(addc <c> x{n} y{n}), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-addc <c> x{n} y{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(addc <v> x{i} y{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-addc <v> x{i} y{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(and <tsp>{v} x{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-and <tsp>{v} x{v}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(and <tsp>{b} x{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-and <tsp>{b} x{b}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(asr <c> <tsp> <tsp>{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-asr <c> <tsp> <tsp>{b}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(cpop cfp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-cpop cfp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(cpop pc),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-cpop pc-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(cpush *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-cpush *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(cpush <tsp>+),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-cpush <tsp>+-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(cpush cfp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-cpush cfp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(decr <tsp> <tsp>{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-decr <tsp> <tsp>{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(decr <tsp> <tsp>{n}), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-decr <tsp> <tsp>{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(incr <tsp> <tsp>{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-incr <tsp> <tsp>{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(incr <tsp> <tsp>{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-incr <tsp> <tsp>{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(incr y y{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-incr y y{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(int-to-nat),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-int-to-nat-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(jump-n x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-jump-n x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(jump-nn x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-jump-nn x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(jump-nz x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-jump-nz x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(jump-z x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-jump-z x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(jump *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-jump *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(jump x{subr}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-jump x{subr}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(lsr <c> x x{n}), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-lsr <c> x x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(lsr <tsp> <tsp>{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-lsr <tsp> <tsp>{v}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move-c <tsp> *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move-c <tsp> *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move-v <tsp> *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move-v <tsp> *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move-z <tsp> *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move-z <tsp> *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move-n x *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move-n x *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move <tsp> *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move <tsp> *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move <x{a}> <tsp>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move <x{a}> <tsp>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move <x{s}> <tsp>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move <x{s}> <tsp>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move cfp csp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move cfp csp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move csp cfp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move csp cfp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move x *), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move x *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move x <x{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move x <x{s}>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move x tsp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move x tsp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move x x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move x x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move y *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move y *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move y <y{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move y <y{s}>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(move y tsp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-move y tsp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(neg <tsp> <tsp>{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-neg <tsp> <tsp>{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(not <tsp> <tsp>{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-not <tsp> <tsp>{v}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(or <tsp>{v} x{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-or <tsp>{v} x{v}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(or <tsp>{b} x{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-or <tsp>{b} x{b}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <c> <tsp>{a} x{a}), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <c> <tsp>{a} x{a}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <c> <tsp>{n} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <c> <tsp>{n} x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <nv> <tsp>{i} x{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <nv> <tsp>{i} x{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <tsp>{a} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <tsp>{a} x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub x{s} y{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub x{s} y{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <tsp>{i} x{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <tsp>{i} x{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <tsp>{n} x{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <tsp>{n} x{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <tsp>{s} x{s}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <tsp>{s} x{s}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(sub <z> x{s} y{s}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-sub <z> x{s} y{s}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(subb <c> x{n} y{n}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-subb <c> x{n} y{n}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(subb <v> x{i} y{i}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-subb <v> x{i} y{i}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop <c> x), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop <c> x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop <x{a}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop <x{a}>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop <x{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop <x{s}>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop pc),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop pc-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop y-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop{v} <z> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop{v} <z> y-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop{b} <z> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop{b} <z> y-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop{i} <zn> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop{i} <zn> y-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpop{n} <z> y),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpop{n} <z> y-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpush *),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpush *-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpush <x{a}>), i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpush <x{a}>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpush <x{s}>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpush <x{s}>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpush csp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpush csp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpush tsp),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpush tsp-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(tpush x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-tpush x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(xor <tsp> <tsp>),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-xor <tsp> <tsp>-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(xor <tsp>{v} x{v}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-xor <tsp>{v} x{v}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(xor <tsp>{b} *{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-xor <tsp>{b} *{b}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(xor <tsp>{b} x{b}),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-xor <tsp>{b} x{b}-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw)))

∧ (i-ins-step ('(xor <z> <tsp> x),

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr)

= i-xor <z> <tsp> x-step (i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, i-prog-segment, i-usr-data-segment, i-sys-data-segment, i-word-size, i-psw),

load-addr))

; Empty-stkp introduces difference, which slows things down a lot.
; We avoid opening it by proving:

Theorem: powerful-length-put length (put (val, n, lst)) = if n < length (lst) then length (lst)

else 1 + n endif

Theorem: empty-stkp-deposit-adp (¬ empty-stkp (sp, segment)) → (¬ empty-stkp (sp, deposit-adp (val, adp, segment)))

; Under what conditions is a pushed stack empty?  What does empty
; mean?  It means there is no room left.  When is there no room?  When
; the stack pointer is one less than the length of the stack area.
; A push moves the stack pointer down -- provided the pointer is not
; zero (i.e., provided the stack is not already full).  So, summarizing,
; a pushed stack pointer is non-empty provided it wasn't full before
; the push.  In addition, it had better be a legal stack pointer
; initially or else the push could just bring it down onto the
; upper limit!

Theorem: not-empty-stkp-push (adpp (untag (sp), segment) ∧ (adp-offset (untag (sp)) ≄ 0)) → (¬ empty-stkp (tag ('sys-addr, sub-adp (untag (sp), 1 + n)), segment))

Event: Disable empty-stkp.

; The following lemma temporarily opens up adpp by backchaining into
; its defn.

Theorem: adpp-backchainer (listp (x) ∧ (adp-offset (x) ∈ N) ∧ definedp (adp-name (x), segment) ∧ (adp-offset (x) < length (definiens (adp-name (x), segment)))) → adpp (x, segment)

; We need to

Event: Disable i-objectp.

; we will deduce what we have to from it.

Theorem: unlabel-tag unlabel (tag (type, obj )) = if type = 'dl then 0

else tag (type, obj ) endif

Event: Enable cddr-tag.

; I am now heading for the lemma that states that if x is an r-objectp
; in r then it is an i-objectp in an appropriately corresponding i state.

Theorem: same-signature-implies-adpp same-signature (segment1 , segment2 ) → (adpp (x, segment1 ) = adpp (x, segment2 ))

Theorem: r-program-bodyp-program-body-any (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r))) → r-program-bodyp (program-body (assoc (name, r-prog-segment (r))))

Theorem: listp-cdr-icompile-program listp (cdr (icompile-program (program)))

; So here is the r-objectp -> i-objectp lemma.
; The proper-r-statep below is required to show that the labels show up
; properly in the i-level code.

Theorem: r-objectp-implies-i-objectp (proper-r-statep (r, load-addr)

∧ r-objectp (x, r) ∧ same-signature (r-sys-data-segment (r), i-sys-data-segment) ∧ same-signature (r-usr-data-segment (r), i-usr-data-segment)) → i-objectp (x,

i-state (i-pc, i-cfp, i-csp, i-tsp, i-x, i-y, i-c-flg, i-v-flg, i-n-flg, i-z-flg, icompile (r-prog-segment (r)), i-usr-data-segment, i-sys-data-segment, r-word-size (r), i-psw))

Theorem: same-signature-reflexive same-signature (segment, segment)

Theorem: same-signature-put-assoc (litatom (name) ∧ definedp (name, segment2 ) ∧ (length (definiens (name, segment2 )) = length (val))) → (same-signature (segment1 , put-assoc (val, name, segment2 ))

= same-signature (segment1 , segment2 ))

; The litatom hyp in the same-signature lemma will be relieved, I think,
; by:

Definition: proper-alistp (alist) = if alist ≃ nil then alist = nil

else listp (car (alist)) ∧ litatom (caar (alist)) ∧ proper-alistp (cdr (alist)) endif

Theorem: litatom-adp-name (definedp (adp-name (adp), segment) ∧ proper-alistp (segment)) → litatom (adp-name (adp))

; The lemma above has nothing to do with adp-name -- it could be generalized
; to an arbitrary name.  But it has been so instantiated to be useful.
; To establish the proper-alistp above we'll need something like the following
; two lemmas.  The first dives past all the modifications to the
; usr-data-segment and the second (or third) backchains into the
; proper-r-statep.

Theorem: proper-alistp-put-assoc proper-alistp (put-assoc (val, name, alist)) = proper-alistp (alist)

Theorem: proper-r-usr-data-segmentp-implies-proper-alistp proper-r-usr-data-segmentp (segment, r) → proper-alistp (segment)

Theorem: proper-alistp-r-usr-data-segment proper-r-statep (r, load-addr) → proper-alistp (r-usr-data-segment (r))

; The r-objectp hyp of the i-objectp lemma will often be relieved by the
; next lemma when fetching from the r-usr-data-segment.

Theorem: r-objectp-get-all-r-usr-data-objectps ((n < length (lst)) ∧ all-r-usr-data-objectps (lst, r)) → r-objectp (get (n, lst), r)

Theorem: all-r-usr-data-objectps-cdr-assoc (proper-r-usr-data-segmentp (segment, r) ∧ definedp (name, segment)) → all-r-usr-data-objectps (cdr (assoc (name, segment)), r)

Theorem: r-objectp-fetch-adp-r-usr-data-segment (proper-r-statep (r, load-addr) ∧ adpp (adp, r-usr-data-segment (r))) → r-objectp (fetch-adp (adp, r-usr-data-segment (r)), r)

Theorem: r-objectp-opener ((type (x) = 'nat) → (r-objectp (x, r)

= ((cddr (x) = nil)

∧ small-naturalp (untag (x), r-word-size (r)))))

∧ ((type (x) = 'int)

→ (r-objectp (x, r)

= ((cddr (x) = nil)

∧ small-integerp (untag (x), r-word-size (r)))))

∧ ((type (x) = 'bitv)

→ (r-objectp (x, r)

= ((cddr (x) = nil)

∧ bit-vectorp (untag (x), r-word-size (r)))))

∧ ((type (x) = 'bool)

→ (r-objectp (x, r)

= ((cddr (x) = nil) ∧ booleanp (untag (x)))))

∧ ((type (x) = 'addr)

→ (r-objectp (x, r)

= ((cddr (x) = nil)

∧ adpp (untag (x), r-usr-data-segment (r)))))

∧ ((type (x) = 'pc)

→ (r-objectp (x, r)

= ((cddr (x) = nil)

∧ pcpp (untag (x), r-prog-segment (r)))))

∧ ((type (x) = 'subr)

→ (r-objectp (x, r)

= ((cddr (x) = nil)

∧ definedp (untag (x), r-prog-segment (r)))))

∧ ((type (x) = 'sys-addr)

→ (r-objectp (x, r)

= ((cddr (x) = nil)

∧ adpp (untag (x), r-sys-data-segment (r)))))

Theorem: i-objectp-tag (i-objectp (tag ('nat, x), i) = small-naturalp (x, i-word-size (i))) ∧ (i-objectp (tag ('int, x), i) = small-integerp (x, i-word-size (i))) ∧ (i-objectp (tag ('bitv, x), i) = bit-vectorp (x, i-word-size (i))) ∧ (i-objectp (tag ('bool, x), i) = booleanp (x)) ∧ (i-objectp (tag ('addr, x), i) = adpp (x, i-usr-data-segment (i))) ∧ (i-objectp (tag ('pc, x), i) = icode-labelp (x, i-prog-segment (i))) ∧ (i-objectp (tag ('subr, x), i) = adpp (cons (x, 0), i-prog-segment (i))) ∧ (i-objectp (tag ('sys-addr, x), i) = adpp (x, i-sys-data-segment (i))) ∧ (i-objectp (tag ('ipc, x), i) = adpp (x, i-prog-segment (i)))

; Now we begin the one way correspondence proofs for each instruction.

Theorem: no-op-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'no-op) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-no-op-okp (r-current-instruction (r), r)) → (r->i (r-no-op-step (r-current-instruction (r), r))

= i (r->i (r), r-no-op-step-clock (r-current-instruction (r), r),

load-addr))

Theorem: push-global-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-global) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-push-global-okp (r-current-instruction (r), r)) → (r->i (r-push-global-step (r-current-instruction (r), r))

= i (r->i (r), r-push-global-step-clock (r-current-instruction (r), r), load-addr))

Theorem: lessp-find-position-of-var length (x) ≮ find-position-of-var (name, x)

Theorem: lessp-length-icompile-program (prog ∈ progs) → (segment-length (icompile (progs))

≮ length (cdr (icompile-program (prog))))

Theorem: times-add1{gen} (x ∗ (1 + y)) = (x + (x ∗ y))

Theorem: length-strip-cars length (strip-cars (x)) = length (x)

Theorem: lessp-length-local-vars length (local-vars (d)) < length (generate-prelude (d))

Theorem: lessp-find-position-of-var-exp (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r))) → (find-position-of-var (var,

append (formal-vars (assoc (name, r-prog-segment (r))), strip-cars (temp-var-dcls (assoc (name,

r-prog-segment (r))))))

< exp (2, r-word-size (r)))

Theorem: push-local-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-local) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-push-local-okp (r-current-instruction (r), r)) → (r->i (r-push-local-step (r-current-instruction (r), r))

= i (r->i (r), r-push-local-step-clock (r-current-instruction (r), r), load-addr))

Theorem: add-addp-1-folded cons (adp-name (untag (r-pc (r))), 1 + adp-offset (untag (r-pc (r)))) = add-adp (untag (r-pc (r)), 1)

Theorem: unlabel-non-dl (car (x) ≠ 'dl) → (unlabel (x) = x)

Theorem: r-program-bodyp-contains-r-instructionps (r-program-bodyp (lst) ∧ (ins ∈ lst)) → r-instructionp (unlabel (ins))

Theorem: r-prog-segmentp-contains-r-program-bodyps (r-prog-segmentp (segment) ∧ (prog ∈ segment)) → r-program-bodyp (program-body (prog))

Theorem: member-get (n < length (lst)) → (get (n, lst) ∈ lst)

Theorem: proper-r-statep-implies-r-instructionp (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r)) ∧ (n < length (program-body (assoc (name, r-prog-segment (r)))))) → r-instructionp (unlabel (get (n,

program-body (assoc (name, r-prog-segment (r))))))

Theorem: pcpp-cons (definedp (name, r-prog-segment (r)) ∧ (n ∈ N) ∧ (n < length (program-body (assoc (name, r-prog-segment (r)))))) → pcpp (cons (name, n), r-prog-segment (r))

Theorem: not-r-objectp (¬ listp (x)) → (¬ r-objectp (x, r))

Theorem: push-constant-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-constant) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-push-constant-okp (r-current-instruction (r), r)) → (r->i (r-push-constant-step (r-current-instruction (r), r))

= i (r->i (r), r-push-constant-step-clock (r-current-instruction (r), r), load-addr))

Theorem: i-objectp-cons-sys-addr i-objectp (list ('sys-addr, adp), i) = adpp (adp, i-sys-data-segment (i))

Theorem: sub-adp-sub-adp sub-adp (sub-adp (adp, i), j ) = sub-adp (adp, i + j )

Theorem: equal-sub-adp-cons-adp-name (sub-adp (x, n) = cons (adp-name (x), y)) = ((adp-offset (x) − n) = y)

Theorem: length-cdr-assoc-deposit-adp adpp (adp, segment) → (length (cdr (assoc (name, deposit-adp (val, adp, segment))))

= length (cdr (assoc (name, segment))))

Theorem: push-ctrl-stk-free-size-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-ctrl-stk-free-size) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-push-ctrl-stk-free-size-okp (r-current-instruction (r), r)) → (r->i (r-push-ctrl-stk-free-size-step (r-current-instruction (r), r))

= i (r->i (r),

r-push-ctrl-stk-free-size-step-clock (r-current-instruction (r),

r),

load-addr))

Theorem: push-temp-stk-free-size-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-temp-stk-free-size) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-push-temp-stk-free-size-okp (r-current-instruction (r), r)) → (r->i (r-push-temp-stk-free-size-step (r-current-instruction (r), r))

= i (r->i (r),

r-push-temp-stk-free-size-step-clock (r-current-instruction (r),

r),

load-addr))

Theorem: sub1-difference ((x − y) − 1) = ((x − 1) − y)

Theorem: lessp-length-assoc-segment-length segment-length (segment) ≮ length (cdr (assoc (name, segment)))

Theorem: lessp-length-assoc-tstk-exp-2-word-size proper-r-statep (r, load-addr) → (length (cdr (assoc ('tstk, r-sys-data-segment (r))))

< exp (2, r-word-size (r)))

Theorem: push-temp-stk-index-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-temp-stk-index) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-push-temp-stk-index-okp (r-current-instruction (r), r)) → (r->i (r-push-temp-stk-index-step (r-current-instruction (r), r))

= i (r->i (r), r-push-temp-stk-index-step-clock (r-current-instruction (r), r), load-addr))

Event: Disable sub1-difference.

Theorem: pop-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-pop-okp (r-current-instruction (r), r)) → (r->i (r-pop-step (r-current-instruction (r), r))

= i (r->i (r), r-pop-step-clock (r-current-instruction (r), r), load-addr))

; r-pop*-okp just checks that tsp + n is a stack address, but the
; i machine needs to know n is a small-naturalp.  The following
; lemma establishes that.

Theorem: adpp-implies-lessp-exp-2-word-size (proper-r-statep (r, load-addr) ∧ adpp (add-adp (a, n), r-sys-data-segment (r))) → ((n < exp (2, r-word-size (r))) = t)

Theorem: pop*-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop*) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-pop*-okp (r-current-instruction (r), r)) → (r->i (r-pop*-step (r-current-instruction (r), r))

= i (r->i (r), r-pop*-step-clock (r-current-instruction (r), r), load-addr))

Theorem: plus-add1-first ((1 + i) + j ) = (1 + (i + j ))

Theorem: popn-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'popn) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-popn-okp (r-current-instruction (r), r)) → (r->i (r-popn-step (r-current-instruction (r), r))

= i (r->i (r), r-popn-step-clock (r-current-instruction (r), r), load-addr))

Theorem: pop-local-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-local) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-pop-local-okp (r-current-instruction (r), r)) → (r->i (r-pop-local-step (r-current-instruction (r), r))

= i (r->i (r), r-pop-local-step-clock (r-current-instruction (r), r), load-addr))

Theorem: pop-global-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-global) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-pop-global-okp (r-current-instruction (r), r)) → (r->i (r-pop-global-step (r-current-instruction (r), r))

= i (r->i (r), r-pop-global-step-clock (r-current-instruction (r), r), load-addr))

Event: Enable get-add1-cons.

Theorem: get-0 get (0, lst) = car (lst)

Theorem: set-local-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'set-local)

∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-set-local-okp (r-current-instruction (r), r)) → (r->i (r-set-local-step (r-current-instruction (r), r))

= i (r->i (r), r-set-local-step-clock (r-current-instruction (r), r), load-addr))

Theorem: set-global-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'set-global) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-set-global-okp (r-current-instruction (r), r)) → (r->i (r-set-global-step (r-current-instruction (r), r))

= i (r->i (r), r-set-global-step-clock (r-current-instruction (r), r), load-addr))

; The following lemma really just opens up r->i_pc in the
; special case that arises for the jump instruction.

Theorem: r->i pc-opener-in-jump-case r->i pc (tag ('pc,

cons (name,

find-label (lab, program-body (assoc (name, r-prog-segment (r)))))),

r-prog-segment (r)) = tag ('ipc,

cons (name,

find-label (cons (name,

find-label (lab,

program-body (assoc (name,

r-prog-segment (r))))),

cdr (icompile-program (definition (name, r-prog-segment (r)))))))

Theorem: jump-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-jump-okp (r-current-instruction (r), r)) → (r->i (r-jump-step (r-current-instruction (r), r))

= i (r->i (r), r-jump-step-clock (r-current-instruction (r), r), load-addr))

Theorem: pushj-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pushj) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-pushj-okp (r-current-instruction (r), r)) → (r->i (r-pushj-step (r-current-instruction (r), r))

= i (r->i (r), r-pushj-step-clock (r-current-instruction (r), r), load-addr))

Theorem: r->i pc-opener-in-popj-case r->i pc (fetch-adp (untag (r-tsp (r)), r-sys-data-segment (r)), r-prog-segment (r)) = tag ('ipc,

cons (area-name (fetch-adp (untag (r-tsp (r)), r-sys-data-segment (r))),

find-label (untag (fetch-adp (untag (r-tsp (r)),

r-sys-data-segment (r))),

cdr (icompile-program (definition (area-name (fetch-adp (untag (r-tsp (r)),

r-sys-data-segment (r))),

r-prog-segment (r)))))))

Theorem: popj-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'popj) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-popj-okp (r-current-instruction (r), r)) → (r->i (r-popj-step (r-current-instruction (r), r))

= i (r->i (r), r-popj-step-clock (r-current-instruction (r), r), load-addr))

Theorem: add-addr-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-addr) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-add-addr-okp (r-current-instruction (r), r)) → (r->i (r-add-addr-step (r-current-instruction (r), r))

= i (r->i (r), r-add-addr-step-clock (r-current-instruction (r), r), load-addr))

Theorem: sub-addr-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-addr) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-sub-addr-okp (r-current-instruction (r), r)) → (r->i (r-sub-addr-step (r-current-instruction (r), r))

= i (r->i (r), r-sub-addr-step-clock (r-current-instruction (r), r), load-addr))

; In all of the xor instructions we should be careful not to
; expand the xors.  This also holds for the other boolean
; instructions.  It especially holds for any instruction involving
; the hideous:

Event: Disable xor-xxx.

Theorem: i-usr-data-typep-is-r-usr-data-typep i-usr-data-typep (x) = r-usr-data-typep (x)

Theorem: listp-cdr-assoc-deposit-adp adpp (adp, segment) → (listp (cdr (assoc (name, deposit-adp (val, adp, segment))))

= listp (cdr (assoc (name, segment))))

Theorem: i-objectp-bool i-objectp (bool (x), s)

Theorem: type-bool type (bool (x)) = 'bool

Theorem: cddr-bool cddr (bool (x)) = nil

Theorem: booleanp-untag-bool booleanp (untag (bool (x)))

Theorem: equal-untag-bool-t (untag (bool (x)) = 't) = if x then t

else f endif

Theorem: equal-untag-bool-f (untag (bool (x)) = 'f) = (¬ x)

Event: Disable bool.

; Despite the disabling of bool above, we still sometimes
; see '(bool t) because we write it explicitly in some
; definitions and assembly code.

Theorem: i-objectp-quote-bool i-objectp ('(bool t), s) ∧ i-objectp ('(bool f), s)

; The following lemma has nothing to do with fetch-adp
; but is so instantiated to control its consideration.
; We first prove the general version.

Theorem: r-objectps-of-same-type-equal-iff-untags-equal (r-objectp (x, r) ∧ r-objectp (y, r) ∧ (type (x) = type (y))) → ((untag (x) = untag (y)) = (x = y))

; and then instantiate it:

Theorem: r-objectps-of-same-type-equal-iff-untags-equal-rewrite (r-objectp (fetch-adp (adp1 , segment1 ), r) ∧ r-objectp (fetch-adp (adp2 , segment2 ), r) ∧ (type (fetch-adp (adp1 , segment1 )) = type (fetch-adp (adp2 , segment2 )))) → ((untag (fetch-adp (adp1 , segment1 )) = untag (fetch-adp (adp2 , segment2 )))

= (fetch-adp (adp1 , segment1 ) = fetch-adp (adp2 , segment2 )))

Theorem: eq-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'eq) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-eq-okp (r-current-instruction (r), r)) → (r->i (r-eq-step (r-current-instruction (r), r))

= i (r->i (r), r-eq-step-clock (r-current-instruction (r), r), load-addr))

Theorem: lt-addr-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'lt-addr) ∧ proper-r-statep (r, load-addr)

∧ (load-addr ∈ N) ∧ r-lt-addr-okp (r-current-instruction (r), r)) → (r->i (r-lt-addr-step (r-current-instruction (r), r))

= i (r->i (r), r-lt-addr-step-clock (r-current-instruction (r), r), load-addr))

; I might need a more general version of the following lemma.
; But right now I need this and the more general versions I have
; thought of are messy because they introduce cases on the
; relative magnitudes of the increment, decrement, and initial
; offset.
; The hypothesis below is weaker than (adpp adp segment) because
; that stronger hyp has the free variable segment in it.

Theorem: sub1-adp-add1-adp (listp (adp) ∧ (adp-offset (adp) ∈ N)) → (sub-adp (add-adp (adp, 1), 1) = adp)

; The following lemma has free vars in the hyp that cannot be
; relieved in the actual application needed, so I use lemma class
; nil and instantiate it,  backchaining on into the proper-r-statep.

Theorem: tag-untag (r-objectp (x, r) ∧ (type (x) = type)) → (tag (type, untag (x)) = x)

Theorem: tag-untag-r-tsp proper-r-statep (r, load-addr) → (tag ('sys-addr, untag (r-tsp (r))) = r-tsp (r))

Theorem: fetch-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'fetch) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-fetch-okp (r-current-instruction (r), r)) → (r->i (r-fetch-step (r-current-instruction (r), r))

= i (r->i (r), r-fetch-step-clock (r-current-instruction (r), r), load-addr))

Theorem: deposit-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'deposit) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-deposit-okp (r-current-instruction (r), r)) → (r->i (r-deposit-step (r-current-instruction (r), r))

= i (r->i (r), r-deposit-step-clock (r-current-instruction (r), r), load-addr))

Theorem: fetch-temp-stk-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'fetch-temp-stk) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-fetch-temp-stk-okp (r-current-instruction (r), r)) → (r->i (r-fetch-temp-stk-step (r-current-instruction (r), r))

= i (r->i (r), r-fetch-temp-stk-step-clock (r-current-instruction (r), r), load-addr))

Theorem: deposit-temp-stk-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'deposit-temp-stk) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-deposit-temp-stk-okp (r-current-instruction (r), r)) → (r->i (r-deposit-temp-stk-step (r-current-instruction (r), r))

= i (r->i (r), r-deposit-temp-stk-step-clock (r-current-instruction (r), r), load-addr))

; Here is the second of the promised sub-adp-add-adp lemmas.

Theorem: sub1-adp-add2-adp (listp (adp) ∧ (adp-offset (adp) ∈ N)) → (sub-adp (add-adp (adp, 2), 1) = add-adp (adp, 1))

; The following simple identity needs the hypothesis that x is an integerp.
; But since we have that it is actually a small-integerp, I'll use that
; and save the trouble of backchaining through small-integerp implies
; integerp.

Theorem: iplus-0{special} small-integerp (x, word-size) → (iplus (0, x) = x)

Event: Enable commutativity-of-iplus.

Theorem: small-integerp-fix-small-integer-plus-case (small-integerp (x, word-size) ∧ small-integerp (y, word-size)) → small-integerp (fix-small-integer (iplus (bool-to-nat (c), iplus (x, y)),

word-size),

word-size)

Theorem: small-integerp-fix-small-integer-difference-case (small-integerp (x, word-size) ∧ small-integerp (y, word-size)) → small-integerp (fix-small-integer (idifference (x,

iplus (y, bool-to-nat (c))),

word-size),

word-size)

Event: Disable fix-small-integer.

Event: Disable bool-to-nat.

Event: Disable iplus.

Event: Disable idifference.

Event: Disable ilessp.

Event: Disable integerp.

Event: Disable small-integerp.

Theorem: add-int-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-int) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-add-int-okp (r-current-instruction (r), r)) → (r->i (r-add-int-step (r-current-instruction (r), r))

= i (r->i (r), r-add-int-step-clock (r-current-instruction (r), r), load-addr))

Theorem: add-int-with-carry-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-int-with-carry) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-add-int-with-carry-okp (r-current-instruction (r), r)) → (r->i (r-add-int-with-carry-step (r-current-instruction (r), r))

= i (r->i (r), r-add-int-with-carry-step-clock (r-current-instruction (r), r), load-addr))

Theorem: add1-int-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add1-int) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-add1-int-okp (r-current-instruction (r), r)) → (r->i (r-add1-int-step (r-current-instruction (r), r))

= i (r->i (r), r-add1-int-step-clock (r-current-instruction (r), r), load-addr))

Theorem: sub-int-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-int) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-sub-int-okp (r-current-instruction (r), r)) → (r->i (r-sub-int-step (r-current-instruction (r), r))

= i (r->i (r), r-sub-int-step-clock (r-current-instruction (r), r), load-addr))

Theorem: sub-int-with-carry-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-int-with-carry) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-sub-int-with-carry-okp (r-current-instruction (r), r)) → (r->i (r-sub-int-with-carry-step (r-current-instruction (r), r))

= i (r->i (r), r-sub-int-with-carry-step-clock (r-current-instruction (r), r), load-addr))

Theorem: sub1-int-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub1-int) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-sub1-int-okp (r-current-instruction (r), r)) → (r->i (r-sub1-int-step (r-current-instruction (r), r))

= i (r->i (r), r-sub1-int-step-clock (r-current-instruction (r), r), load-addr))

Theorem: neg-int-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'neg-int) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-neg-int-okp (r-current-instruction (r), r)) → (r->i (r-neg-int-step (r-current-instruction (r), r))

= i (r->i (r), r-neg-int-step-clock (r-current-instruction (r), r), load-addr))

Event: Disable xor-bool.

Theorem: not-empty-stkp-implies-adpp-pop (adpp (untag (sp), segment) ∧ (¬ empty-stkp (sp, segment))) → adpp (add-adp (untag (sp), 1), segment)

; We are about to go into a really silly little section.  We need to
; know that the word-size is not 0.  To get that, we
; use R-LOADABLEP and the fact that the sys-data-segment is
; non-empty.

Theorem: r-loadablep-and-cstk-implies-not-zerop-r-word-size (proper-r-statep (r, load-addr) ∧ (adp-offset (untag (r-cfp (r)))

< length (cdr (assoc ('cstk, r-sys-data-segment (r)))))) → (r-word-size (r) ≄ 0)

Theorem: proper-r-statep-implies-r-loadablep-and-cstk proper-r-statep (r, load-addr) → (r-loadablep (r, load-addr)

∧ (adp-offset (untag (r-cfp (r))) < length (cdr (assoc ('cstk, r-sys-data-segment (r))))))

Theorem: proper-r-statep-implies-lessp-0-r-word-size proper-r-statep (r, load-addr) → ((r-word-size (r) ∈ N) ∧ (0 < r-word-size (r)))

; We now prove the key fact:  (ilessp x y) is equivalent to
; the xor of the v-flg and the n-flg.  Because of case splits
; caused by the paths through the icode-lt-int code, we need to
; prove this fact in 4 different versions, as though xor had
; opened up:

Theorem: ilessp-is-xor-case1 (small-integerp (x, word-size) ∧ small-integerp (y, word-size) ∧ (word-size ≄ 0) ∧ small-integerp (idifference (x, y), word-size) ∧ negativep (fix-small-integer (idifference (x, y), word-size))) → ilessp (x, y)

Theorem: ilessp-is-xor-case2 (small-integerp (x, word-size) ∧ small-integerp (y, word-size) ∧ (word-size ≄ 0) ∧ (¬ small-integerp (idifference (x, y), word-size)) ∧ negativep (fix-small-integer (idifference (x, y), word-size))) → (¬ ilessp (x, y))

Theorem: ilessp-is-xor-case3 (small-integerp (x, word-size) ∧ small-integerp (y, word-size) ∧ (word-size ≄ 0) ∧ small-integerp (idifference (x, y), word-size) ∧ (¬ negativep (fix-small-integer (idifference (x, y), word-size)))) → (¬ ilessp (x, y))

Theorem: ilessp-is-xor-case4 (small-integerp (x, word-size) ∧ small-integerp (y, word-size) ∧ (word-size ≄ 0) ∧ (¬ small-integerp (idifference (x, y), word-size)) ∧ (¬ negativep (fix-small-integer (idifference (x, y), word-size)))) → ilessp (x, y)

Theorem: lt-int-one-way-correspondence-r-i ((r-psw (r) = 'run)

∧ (car (r-current-instruction (r)) = 'lt-int) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-lt-int-okp (r-current-instruction (r), r)) → (r->i (r-lt-int-step (r-current-instruction (r), r))

= i (r->i (r), r-lt-int-step-clock (r-current-instruction (r), r), load-addr))

Theorem: int-to-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'int-to-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-int-to-nat-okp (r-current-instruction (r), r)) → (r->i (r-int-to-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-int-to-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: add-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-add-nat-okp (r-current-instruction (r), r)) → (r->i (r-add-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-add-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: lessp-remainder{special} (y ≄ 0) → ((x mod y) < y)

Theorem: add-nat-with-carry-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-nat-with-carry) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-add-nat-with-carry-okp (r-current-instruction (r), r)) → (r->i (r-add-nat-with-carry-step (r-current-instruction (r), r))

= i (r->i (r), r-add-nat-with-carry-step-clock (r-current-instruction (r), r), load-addr))

Theorem: add1-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add1-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-add1-nat-okp (r-current-instruction (r), r)) → (r->i (r-add1-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-add1-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: sub-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-sub-nat-okp (r-current-instruction (r), r)) → (r->i (r-sub-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-sub-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: sub-nat-with-carry-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-nat-with-carry) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-sub-nat-with-carry-okp (r-current-instruction (r), r)) → (r->i (r-sub-nat-with-carry-step (r-current-instruction (r), r))

= i (r->i (r), r-sub-nat-with-carry-step-clock (r-current-instruction (r), r), load-addr))

Theorem: sub1-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub1-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-sub1-nat-okp (r-current-instruction (r), r)) → (r->i (r-sub1-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-sub1-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: lt-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'lt-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-lt-nat-okp (r-current-instruction (r), r)) → (r->i (r-lt-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-lt-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: mult2-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'mult2-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-mult2-nat-okp (r-current-instruction (r), r)) → (r->i (r-mult2-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-mult2-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: mult2-nat-with-carry-out-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'mult2-nat-with-carry-out) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-mult2-nat-with-carry-out-okp (r-current-instruction (r), r)) → (r->i (r-mult2-nat-with-carry-out-step (r-current-instruction (r), r))

= i (r->i (r),

r-mult2-nat-with-carry-out-step-clock (r-current-instruction (r),

r),

load-addr))

Theorem: lessp-quotient{special} x ≮ (x ÷ y)

; The following lemma is just an instance of the much prettier fact
; that (remainder x 2) is 0 or 1.  But I couldn't think of a way to
; state that fact without causing a lot of backchaining.  So I'll
; just do it this way.

Theorem: remainder-by-2-not-1-lemma ((untag (fetch-adp (untag (r-tsp (r)), r-sys-data-segment (r))) mod 2) ≠ 1) → ((untag (fetch-adp (untag (r-tsp (r)), r-sys-data-segment (r))) mod 2)

= 0)

Theorem: exp-2-at-least-2 (i ≄ 0) → (1 < exp (2, i))

Theorem: i-objectp-nat-0 (0 < i-word-size (i)) → i-objectp ('(nat 0), i)

Theorem: i-objectp-nat-1 (0 < i-word-size (i)) → i-objectp ('(nat 1), i)

; Thus ends the silly little section.

Theorem: div2-nat-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'div2-nat) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-div2-nat-okp (r-current-instruction (r), r)) → (r->i (r-div2-nat-step (r-current-instruction (r), r))

= i (r->i (r), r-div2-nat-step-clock (r-current-instruction (r), r), load-addr))

Theorem: or-bitv-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'or-bitv) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-or-bitv-okp (r-current-instruction (r), r)) → (r->i (r-or-bitv-step (r-current-instruction (r), r))

= i (r->i (r), r-or-bitv-step-clock (r-current-instruction (r), r), load-addr))

Theorem: and-bitv-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'and-bitv) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-and-bitv-okp (r-current-instruction (r), r)) → (r->i (r-and-bitv-step (r-current-instruction (r), r))

= i (r->i (r), r-and-bitv-step-clock (r-current-instruction (r), r), load-addr))

Theorem: not-bitv-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'not-bitv) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-not-bitv-okp (r-current-instruction (r), r)) → (r->i (r-not-bitv-step (r-current-instruction (r), r))

= i (r->i (r), r-not-bitv-step-clock (r-current-instruction (r), r), load-addr))

Theorem: xor-bitv-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'xor-bitv) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-xor-bitv-okp (r-current-instruction (r), r)) → (r->i (r-xor-bitv-step (r-current-instruction (r), r))

= i (r->i (r), r-xor-bitv-step-clock (r-current-instruction (r), r), load-addr))

Theorem: rsh-bitv-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'rsh-bitv) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-rsh-bitv-okp (r-current-instruction (r), r)) → (r->i (r-rsh-bitv-step (r-current-instruction (r), r))

= i (r->i (r), r-rsh-bitv-step-clock (r-current-instruction (r), r), load-addr))

Theorem: lsh-bitv-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'lsh-bitv) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-lsh-bitv-okp (r-current-instruction (r), r)) → (r->i (r-lsh-bitv-step (r-current-instruction (r), r))

= i (r->i (r), r-lsh-bitv-step-clock (r-current-instruction (r), r), load-addr))

Event: Disable or-bool.

Event: Disable and-bool.

Event: Disable not-bool.

Theorem: or-bool-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'or-bool) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-or-bool-okp (r-current-instruction (r), r)) → (r->i (r-or-bool-step (r-current-instruction (r), r))

= i (r->i (r), r-or-bool-step-clock (r-current-instruction (r), r), load-addr))

Theorem: and-bool-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'and-bool) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-and-bool-okp (r-current-instruction (r), r)) → (r->i (r-and-bool-step (r-current-instruction (r), r))

= i (r->i (r), r-and-bool-step-clock (r-current-instruction (r), r), load-addr))

Theorem: xor-bool-t-is-not-bool xor-bool (x, 't) = not-bool (x)

Theorem: not-bool-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'not-bool) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-not-bool-okp (r-current-instruction (r), r)) → (r->i (r-not-bool-step (r-current-instruction (r), r))

= i (r->i (r), r-not-bool-step-clock (r-current-instruction (r), r), load-addr))

Theorem: jump-if-temp-stk-full-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump-if-temp-stk-full) ∧ proper-r-statep (r, load-addr)

∧ (load-addr ∈ N) ∧ r-jump-if-temp-stk-full-okp (r-current-instruction (r), r)) → (r->i (r-jump-if-temp-stk-full-step (r-current-instruction (r), r))

= i (r->i (r),

r-jump-if-temp-stk-full-step-clock (r-current-instruction (r),

r),

load-addr))

Theorem: jump-if-temp-stk-empty-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump-if-temp-stk-empty) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-jump-if-temp-stk-empty-okp (r-current-instruction (r), r)) → (r->i (r-jump-if-temp-stk-empty-step (r-current-instruction (r), r))

= i (r->i (r),

r-jump-if-temp-stk-empty-step-clock (r-current-instruction (r),

r),

load-addr))

Theorem: test-nat-and-jump-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-nat-and-jump) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-test-nat-and-jump-okp (r-current-instruction (r), r)) → (r->i (r-test-nat-and-jump-step (r-current-instruction (r), r))

= i (r->i (r), r-test-nat-and-jump-step-clock (r-current-instruction (r), r), load-addr))

; The following lemma recognizes a certain opened up
; r->i_pc and folds it back together.  This is needed
; in test-int-and-jump.

Theorem: r->i pc-folder-test-int-and-jump-case cons (adp-name (untag (r-pc (r))),

find-label (add-adp (untag (r-pc (r)), 1),

cdr (icompile-program (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))))

= untag (r->i pc (add1-addr (r-pc (r)), r-prog-segment (r)))

Theorem: small-integerp-subtypes (small-integerp (untag (obj ), word-size) ∧ (untag (obj ) ∉ N)) → negativep (untag (obj ))

Theorem: test-int-and-jump-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-int-and-jump) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-test-int-and-jump-okp (r-current-instruction (r), r)) → (r->i (r-test-int-and-jump-step (r-current-instruction (r), r))

= i (r->i (r), r-test-int-and-jump-step-clock (r-current-instruction (r), r), load-addr))

; The following lemma makes the arbitrary convention that we'll represent
; all comparisions on Booleans as comparisons with 'F.

Theorem: booleanp-subtypes booleanp (untag (obj )) → ((untag (obj ) = 't) = (untag (obj ) ≠ 'f))

; Now we'll pay for that decision:

Theorem: not-bool-of-non-f (untag (obj ) ≠ 'f) → (not-bool (untag (obj )) = 'f)

Theorem: test-bool-and-jump-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-bool-and-jump) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-test-bool-and-jump-okp (r-current-instruction (r), r)) → (r->i (r-test-bool-and-jump-step (r-current-instruction (r), r))

= i (r->i (r), r-test-bool-and-jump-step-clock (r-current-instruction (r), r), load-addr))

Theorem: test-bitv-and-jump-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-bitv-and-jump) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-test-bitv-and-jump-okp (r-current-instruction (r), r)) → (r->i (r-test-bitv-and-jump-step (r-current-instruction (r), r))

= i (r->i (r), r-test-bitv-and-jump-step-clock (r-current-instruction (r), r), load-addr))

Theorem: pop-locn-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-locn) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-pop-locn-okp (r-current-instruction (r), r)) → (r->i (r-pop-locn-step (r-current-instruction (r), r))

= i (r->i (r), r-pop-locn-step-clock (r-current-instruction (r), r), load-addr))

Theorem: locn-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'locn) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-locn-okp (r-current-instruction (r), r)) → (r->i (r-locn-step (r-current-instruction (r), r))

= i (r->i (r), r-locn-step-clock (r-current-instruction (r), r), load-addr))

; The code generated for the jump-case instruction pops a number, n,
; off the stack and doubles it, as part of the computation of the
; index into a jump table.  We must prove that 2n is representable.
; We do it by observing that 2n is less than the number of labels
; supplied in the jump-case, that the number of labels is dominated
; by the length of the icode, that the length of the icode for an instruction
; is dominated by the length of the icompile-program, that the length
; of the program is dominated by the segment-length, and that the
; segment length is representable.

Theorem: length-jump *-lst length (jump *-lst (labs, program)) = (2 ∗ length (labs))

Theorem: jump-case-instruction-is-much-shorter-than-icode (car (unlabel (ins)) = 'jump-case) → ((2 ∗ length (cdr (unlabel (ins)))) < length (icode (ins, pcn, body)))

Theorem: icode-is-shorter-than-icompile-program ((n < length (program-body (prog))) ∧ (n ∈ N)) → (length (icode (get (n, program-body (prog)), n, prog))

< length (icompile-program (prog)))

; In the following theorem, the (untag (fetch-adp ...)) could
; be generalized to the variable case-number.

Theorem: jump-case-number-is-very-small (proper-r-statep (r, load-addr) ∧ (car (unlabel (get (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))))

     = 'jump-case)

∧ (untag (fetch-adp (untag (r-tsp (r)), r-sys-data-segment (r)))

< length (cdr (unlabel (get (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))))))))

→ ((2 ∗ untag (fetch-adp (untag (r-tsp (r)), r-sys-data-segment (r)))) < exp (2, r-word-size (r)))

Theorem: times-0 (z ≃ 0) → ((x ∗ z) = 0)

Theorem: get-2n-jump *-lst (n < length (labs)) → (get (2 ∗ n, jump *-lst (labs, prog)) = '(jump *))

Theorem: get-add1-2n-jump *-lst (n < length (labs)) → (get (1 + (2 ∗ n), jump *-lst (labs, prog)) = pc (get (n, labs), prog))

Theorem: jump-case-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump-case) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-jump-case-okp (r-current-instruction (r), r)) → (r->i (r-jump-case-step (r-current-instruction (r), r))

= i (r->i (r), r-jump-case-step-clock (r-current-instruction (r), r), load-addr))

Theorem: find-label-prelude (name = name (program)) → (find-label (cons (name, '(prelude)), cdr (icompile-program (program)))

= 0)

Theorem: fetch-adp-prelude-0 definedp (name, prog-segment) → (fetch-adp (cons (name, 0), icompile (prog-segment))

     = dl (cons (name, '(prelude)), '(prelude), '(cpush cfp)))

Theorem: fetch-adp-prelude-1 definedp (name, prog-segment) → (fetch-adp (cons (name, 1), icompile (prog-segment))

     = '(move cfp csp))

Theorem: adpp-prelude (definedp (name, prog-segment) ∧ (n ∈ N) ∧ (length (generate-prelude (assoc (name, prog-segment))) ≮ n)) → adpp (cons (name, n), icompile (prog-segment))

Event: Enable length-generate-prelude.

Theorem: i*-plus i* (s, i + j , load-addr) = i* (i* (s, i, load-addr), j , load-addr)

; The following theorem is just an instance of the i*-plus theorem above.
; However, I don't want the i*-plus theorem as a rewrite rule because I
; don't want the i* expression rewritten until we have done all the work
; we can.

Theorem: i*-plus-prelude1-prelude2 i* (s, length (temp-var-dcls (prog)) + length (formal-vars (prog)), load-addr) = i* (i* (s, length (temp-var-dcls (prog)), load-addr),

length (formal-vars (prog)), load-addr)

; We now wish to package up the execution of prelude1.  See i*-prelude1
; below.  To prove it, we must prove the more general i*-prelude1-generalized
; We start by establishing what fetch-adp returns on both even and odd
; addresses into the prelude1.  The main theorems of this section are
; fetch-adp-prelude1-even and fetch-adp-prelude1-odd.

Theorem: sub-adp-0 adpp (x, segment) → (sub-adp (x, 0) = x)

Theorem: tag-type-untag ((type (x) = type) ∧ (cddr (x) = nil)) → (tag (type, untag (x)) = x)

Theorem: adpp-sub-adp adpp (x, segment) → adpp (sub-adp (x, 1), segment)

Theorem: fetch-adp-prelude1-even-lemma (n < length (rev-temp-var-dcls)) → (car (cdr-n (n + n, generate-prelude1 (rev-temp-var-dcls)))

     = '(cpush *))

Theorem: fetch-adp-prelude1-even (definedp (name, prog-segment) ∧ (n < length (temp-var-dcls (assoc (name, prog-segment))))) → (fetch-adp (cons (name, 1 + (1 + (n + n))), icompile (prog-segment))

     = '(cpush *))

Theorem: listp-rev listp (rev (x)) = listp (x)

Theorem: get-append (n < length (a)) → (get (n, append (a, b)) = get (n, a))

Theorem: fetch-adp-prelude1-odd-lemma (n < length (rev-temp-var-dcls)) → (get (1 + (n + n), generate-prelude1 (rev-temp-var-dcls))

= cadr (get (n, rev-temp-var-dcls)))

Theorem: fetch-adp-prelude1-odd (definedp (name, prog-segment) ∧ (n < length (temp-var-dcls (assoc (name, prog-segment))))) → (fetch-adp (cons (name, 1 + (1 + (1 + (n + n)))),

icompile (prog-segment))

= cadr (get (n, rev (temp-var-dcls (assoc (name, prog-segment))))))

; We need establish that what the CPUSH_* pushes is an i-objectp
; in the current i-state.  We know that everything r-call-step
; pushes is an r-objectp in the initial r state.  We need to make
; the connections.  The key here is our previously proved lemma
; that r-objectp-implies-i-objectp.  We first establish that what
; is pushed at the i-level is an r-object.

Theorem: adpp-implies-numberp-adp-offset adpp (x, segment) → (adp-offset (x) ∈ N)

Theorem: all-r-objectps-implies-r-objectp-get ((n < length (var-dcls)) ∧ all-r-objectps (strip-cadrs (var-dcls), r)) → r-objectp (cadr (get (n, var-dcls)), r)

; Unfortunately, what the icompiler lays down is not elements of
; (strip-cadrs var-dcls) but elements of its reverse.  So we need
; to prove that the reverse doesn't affect the argument above.

Theorem: strip-cadrs-append strip-cadrs (append (a, b)) = append (strip-cadrs (a), strip-cadrs (b))

Theorem: all-r-objectps-append properp (a) → (all-r-objectps (append (a, b), r)

= (all-r-objectps (a, r) ∧ all-r-objectps (b, r)))

Theorem: properp-strip-cadrs properp (strip-cadrs (x))

Theorem: all-r-objectps-strip-cadrs-rev all-r-objectps (strip-cadrs (rev (x)), r) = all-r-objectps (strip-cadrs (x), r)

; The work above is sufficient to relieve the r-objectp hyp
; in r-objectp-implies-i-objectp.
; We also have to establish that the signature of the r state
; is the same as that of the i state.  This follows from:

Theorem: same-signature-deposit-adp (litatom (adp-name (adp)) ∧ adpp (adp, segment2 )) → (same-signature (segment1 , deposit-adp (val, adp, segment2 ))

= same-signature (segment1 , segment2 ))

; Now once the i machine has fetched the element it UNLABELs it.
; We need to show that it is not a DL.  That follows from the
; fact that we have a proper-r-statep which thus contains
; a r-programp which thus contains r-temp-var-dclsp,
; none of which is a DL.  Again we have to worry about the
; reverse.

Event: Enable member-append.

Theorem: member-rev (x ∈ rev (l)) = (x ∈ l)

Theorem: unlabel-cadr-get-rev-temp-var-dcls-lemma ((var-dcl ∈ temp-var-dcls) ∧ r-temp-var-dclsp (temp-var-dcls)) → (unlabel (cadr (var-dcl)) = cadr (var-dcl))

Theorem: unconditional-get-append get (n, append (a, b)) = if n < length (a) then get (n, a)

else get (n − length (a), b) endif

Theorem: get-rev (n < length (l)) → (get (n, rev (l)) = get ((length (l) − n) − 1, l))

Event: Disable unconditional-get-append.

Theorem: member-get-rev (n < length (l)) → (get (n, rev (l)) ∈ l)

Theorem: unlabel-cadr-get-rev-temp-var-dcls (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r)) ∧ (n < length (temp-var-dcls (assoc (name, r-prog-segment (r)))))) → (unlabel (cadr (get (n, rev (temp-var-dcls (assoc (name, r-prog-segment (r)))))))

= cadr (get (n, rev (temp-var-dcls (assoc (name, r-prog-segment (r)))))))

; In the prelude1 proof we have difference disabled and the following lemma
; comes in at just the right place and reduces the pc in the induction
; conclusion to that in the induction hypothesis.

Theorem: add4-plus-difference-difference (n ≮ (1 + z)) → ((1 + (1 + (1 + (1 + ((n − (1 + z)) + (n − (1 + z)))))))

= (1 + (1 + ((n − z) + (n − z)))))

; Finally, we need to show that depositing one element and then the
; rest is the same as depositing them all.

Theorem: deposit-lst-append adpp (untag (sp), segment) → (deposit-lst (append (a, b), sp, segment)

= deposit-lst (b, push-stk-n (length (a), sp), deposit-lst (a, sp, segment)))

Theorem: first-n-opener-right-end (z < length (lst)) → (first-n (1 + z, lst) = append (first-n (z, lst), list (get (z, lst))))

Event: Enable properp-rev.

Theorem: append-right-id properp (a) → (append (a, nil) = a)

Event: Enable rev-append.

Theorem: get-difference-sub1-length-rev (z < length (temp-var-dcls)) → (get ((length (temp-var-dcls) − 1) − z, rev (temp-var-dcls))

= get (z, temp-var-dcls))

; The basic idea of the execution of i*-prelude1-generalized is that
; we start in the middle of the prelude (with n pushes left to go)
; and execute those n.  We then describe what happens to the stack.
; The lemma below is the key observation.  To understand it, it is
; really necessary to see the prelude1 theorem first.

Theorem: deposit-lst-equivalence (adpp (sub-adp (untag (csp), 1), sys-data-segment) ∧ (z ∈ N) ∧ (z < length (temp-var-dcls))) → (deposit-lst (rev (strip-cadrs (first-n (z, temp-var-dcls))),

tag ('sys-addr, sub-adp (untag (csp), 2)),

deposit-adp (cadr (get (length (temp-var-dcls) − (1 + z),

rev (temp-var-dcls))),

sub-adp (untag (csp), 1), sys-data-segment)) = deposit-lst (rev (strip-cadrs (first-n (1 + z, temp-var-dcls))),

tag ('sys-addr, sub-adp (untag (csp), 1)), sys-data-segment))

; i*-prelude1-generalized requires a complicated induction.  The
; idea is to execute one clock tick and say what happens to
; csp (it is pushed by one) and sys-data-segment (one of the
; temp-var-dcls' initial values is deposited).

Definition: hint-prelude1 (n, csp, sys-data-segment, name, r) = if n ≃ 0 then t

else hint-prelude1 (n − 1, push-stk (csp), deposit (cadr (get (length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

− n,

rev (temp-var-dcls (assoc (name,

r-prog-segment (r)))))),

push-stk (csp), sys-data-segment),

name,

r) endif

; Crucial to this proof is that we elim (SUB1 N).  This introduces
; an (I* s (ADD1 Z) load-addr) where we had an (I* s N load-addr).  Then I* can be
; opened.  But the elimination on (SUB1 N) is not the first elimination
; available -- we can also elim on CDR and on the accessors to the
; R-STATEs.  Thus, I disable those elim lemmas.  I also keep first-n
; and difference closed up, manipulating them completely with the
; lemmas above.

Theorem: i*-prelude1-generalized (proper-r-statep (r, load-addr) ∧ all-r-objectps (strip-cadrs (temp-var-dcls (assoc (name,

r-prog-segment (r)))),

r)

∧ definedp (name, r-prog-segment (r)) ∧ same-signature (r-sys-data-segment (r), sys-data-segment) ∧ (n ∈ N) ∧ (length (temp-var-dcls (assoc (name, r-prog-segment (r)))) ≮ n) ∧ cstkp (csp, sys-data-segment) ∧ (adp-offset (untag (csp)) ≮ n)) → (i* (i-state (tag ('ipc,

cons (name,

1 + (1 + (2 ∗ (length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

− n))))),

cfp, csp, tsp, x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), sys-data-segment, r-word-size (r),

'run),

n, load-addr)

= i-state (tag ('ipc,

cons (name,

1 + (1 + (2 ∗ length (temp-var-dcls (assoc (name,

r-prog-segment (r)))))))),

cfp, push-stk-n (n, csp), tsp, x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), deposit-lst (rev (strip-cadrs (first-n (n,

temp-var-dcls (assoc (name,

r-prog-segment (r)))))),

push-stk (csp), sys-data-segment),

r-word-size (r),

'run))
; The above theorem tells us what happens if we execute the last n
; instructions in prelude1.  Now we instantiate n with the number
; of executable instructions in prelude1 and deduce what happens when
; we execute the prelude1.
; To prove the instance we need the trivial:

Event: Disable first-n-opener-right-end.

Theorem: first-n-length strip-cadrs (first-n (length (lst), lst)) = strip-cadrs (lst)

; The above theorem is essentially just a first-n property and has
; almost nothing to do with strip-cadrs:  (first-n (length lst) lst)
; is lst.  That is not true if lst is not proper.  Rather than set up

; the lemmas necessary to get that the temp-var-dcls are proper, I'll
; just observe that in our application we strip-cadrs the result and
; that does the same thing whether lst is proper or not.

Theorem: i*-prelude1 (proper-r-statep (r, load-addr) ∧ all-r-objectps (strip-cadrs (temp-var-dcls (assoc (name,

r-prog-segment (r)))),

r)

∧ definedp (name, r-prog-segment (r)) ∧ same-signature (r-sys-data-segment (r), sys-data-segment) ∧ cstkp (csp, sys-data-segment) ∧ (adp-offset (untag (csp))

≮ length (temp-var-dcls (assoc (name, r-prog-segment (r)))))) → (i* (i-state (tag ('ipc, cons (name, 2)),

cfp, csp, tsp, x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), sys-data-segment, r-word-size (r),

'run),

length (temp-var-dcls (assoc (name, r-prog-segment (r)))), load-addr)

= i-state (tag ('ipc,

cons (name,

1 + (1 + (2 ∗ length (temp-var-dcls (assoc (name,

r-prog-segment (r)))))))),

cfp, push-stk-n (length (temp-var-dcls (assoc (name,

r-prog-segment (r)))),

csp),

tsp, x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), deposit-lst (rev (strip-cadrs (temp-var-dcls (assoc (name,

r-prog-segment (r))))),

push-stk (csp), sys-data-segment),

r-word-size (r),

               'run))
; That completes our work on prelude1.
; We now turn to prelude2.
; For some reason the proof of the call one-way-correspondence theorem
; raises the possibility that the sum of the lengths of the temp-var-dcls
; and the formal-vars is 0.  Rather than prevent this case split, I just
; deal with it.  The following lemma reduces that case to the case that
; there are not temp or formal variables.

Event: Enable equal-plus-0.

; In the case where both formals and temp-var-dcls is empty, we
; immediately get to the end of the prelude and the only remaining
; problem is dealing with the two pc expressions.  On the r level
; we have (r->i_pc (tag 'pc (cons name 0)) (r-prog-segment r))
; while at the i level we have
; (tag 'ipc (cons name length-prelude)).  We will rewrite the former
; to the latter.  We have all the necessary machinery to do this.
; We do have to appeal to the fact that the temp-var-dcls of the
; program are well-formed, e.g., r-temp-var-dclsp, if the
; program is in the program segment of a proper r state.  That was
; proved earlier, but for an instance in which name was derived from
; the current pc.  We need it for the subroutine name now.  So we
; just instantiate the necessary lemma.

Theorem: r->i pc-prelude (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r))) → (r->i pc (tag ('pc, cons (name, 0)), r-prog-segment (r))

= tag ('ipc, cons (name,

length (generate-prelude (assoc (name, r-prog-segment (r)))))))

; In this pathological case we also have to know:

Theorem: add-adp-0-untag-r-tsp (listp (x) ∧ (adp-offset (x) ∈ N)) → (add-adp (x, 0) = x)

; We might as well get the sub-adp analogue:

Theorem: sub-adp-0-untag-r-tsp (listp (x) ∧ (adp-offset (x) ∈ N)) → (sub-adp (x, 0) = x)

; Embarassing anomoly:  The LENGTH-GENERATE-PRELUDE lemma introduces a term
; of the form (TIMES x 2) which is replaced by (PLUS x x) by the
; TIMES-ADD1{gen} lemma.  But I*-PRELUDE introduces (TIMES 2 x) which is
; left alone.  I could reformulate LENGTH-GENERATE-PRELUDE.  But
; instead I will just prove (TIMES 2 X) = (PLUS X X) and keep
; TIMES out of the problem henceforth.

Event: Enable times-2.

; We start our study of prelude2 just like that of prelude1,
; by determining what instruction you get when you fetch from the prelude2.

Theorem: fetch-adp-prelude2-lemma (n < length (formal-vars)) → (get (n, generate-prelude2 (formal-vars)) = '(cpush <tsp>+))

Theorem: difference-plus-k-k-length (((k + k) = length (a)) ∧ (n ∈ N)) → (((k + k + n) − length (a)) = n)

Theorem: get-append-bridge (((k + k) = length (a)) ∧ (n ∈ N)) → (get (k + (k + n), append (a, b)) = get (n, b))

Theorem: fetch-adp-prelude2 (definedp (name, prog-segment) ∧ (n ∈ N) ∧ (n < length (formal-vars (assoc (name, prog-segment)))))

→ (fetch-adp (cons (name,

1 + (1 + (length (temp-var-dcls (assoc (name,

prog-segment)))

+ length (temp-var-dcls (assoc (name,

prog-segment)))

+ n))),

icompile (prog-segment))

     = '(cpush <tsp>+))

Event: Disable get-append-bridge.

; We specify the induction for prelude2 with:

Definition: hint-prelude2 (n, csp, tsp, sys-data-segment, name, r) = if n ≃ 0 then t

else hint-prelude2 (n − 1, push-stk (csp), pop-stk (tsp), deposit (fetch-adp (untag (tsp),

sys-data-segment),

push-stk (csp), sys-data-segment),

name,

r) endif

; Just as in the prelude1 case, we have disabled difference and use
; tweezers to manipulate such expressions.  This lemma shows that
; the pc in the induction conclusion is equal to that in the induction
; hypothesis.

Theorem: add1-add1-plus-length-length-difference-length-add1 (length (formal-vars (assoc (name, r-prog-segment (r)))) ≮ (1 + z)) → ((1 + (1 + (1 + (length (temp-var-dcls (assoc (name, r-prog-segment (r))))

+ length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ (length (formal-vars (assoc (name,

r-prog-segment (r))))

− (1 + z))))))

= (1 + (1 + (length (temp-var-dcls (assoc (name, r-prog-segment (r)))) + length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ (length (formal-vars (assoc (name,

r-prog-segment (r))))

− z)))))

; We also have to show that if you fetch n things from the tstk all
; at once that it is equivalent to fetching them interspersed with
; writes to the cstk.  In particular:

Theorem: fetch-n-tstk-deposit-adp-cstk (adpp (csp-adp, sys-data-segment) ∧ (adp-name (csp-adp) = 'cstk) ∧ tstkp (tsp, sys-data-segment) ∧ (stk-length (tsp, sys-data-segment) ≮ z)) → (fetch-n (z, tsp, deposit-adp (val, csp-adp, sys-data-segment))

= fetch-n (z, tsp, sys-data-segment))

; So here is the generalized version of i*-prelude2.

Theorem: i*-prelude2-generalized (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r)) ∧ cstkp (csp, sys-data-segment) ∧ tstkp (tsp, sys-data-segment) ∧ (adp-offset (untag (csp)) ≮ n) ∧ (stk-length (tsp, sys-data-segment) ≮ n) ∧ (n ∈ N) ∧ (length (formal-vars (assoc (name, r-prog-segment (r)))) ≮ n)) → (i* (i-state (tag ('ipc,

cons (name,

1 + (1 + (length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ (length (formal-vars (assoc (name,

r-prog-segment (r))))

− n))))),

cfp, csp, tsp, x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), sys-data-segment, r-word-size (r),

'run),

n, load-addr)

= i-state (tag ('ipc,

cons (name,

1 + (1 + (length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ length (formal-vars (assoc (name,

r-prog-segment (r)))))))),

cfp, push-stk-n (n, csp), pop-stk-n (n, tsp), x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), deposit-lst (fetch-n (n, tsp, sys-data-segment),

push-stk (csp), sys-data-segment),

r-word-size (r),

'run))

Theorem: i*-prelude2 (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r)) ∧ cstkp (csp, sys-data-segment) ∧ tstkp (tsp, sys-data-segment) ∧ (adp-offset (untag (csp))

≮ length (formal-vars (assoc (name, r-prog-segment (r))))) ∧ (stk-length (tsp, sys-data-segment)

≮ length (formal-vars (assoc (name, r-prog-segment (r)))))) → (i* (i-state (tag ('ipc, cons (name,

1 + (1 + (length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ length (temp-var-dcls (assoc (name,

r-prog-segment (r)))))))),

cfp, csp, tsp, x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), sys-data-segment, r-word-size (r),

'run),

length (formal-vars (assoc (name, r-prog-segment (r)))), load-addr)

= i-state (tag ('ipc,

cons (name,

1 + (1 + (length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ length (temp-var-dcls (assoc (name,

r-prog-segment (r))))

+ length (formal-vars (assoc (name,

r-prog-segment (r)))))))),

cfp, push-stk-n (length (formal-vars (assoc (name,

r-prog-segment (r)))),

csp),

pop-stk-n (length (formal-vars (assoc (name,

r-prog-segment (r)))),

tsp),

x, y, c-flg, v-flg, n-flg, z-flg, icompile (r-prog-segment (r)), r-usr-data-segment (r), deposit-lst (fetch-n (length (formal-vars (assoc (name,

r-prog-segment (r)))),

tsp,

sys-data-segment), push-stk (csp), sys-data-segment),

r-word-size (r),

               'run))

Event: Disable adpp-sub-adp.

Theorem: adpp-sub-adp-generalize adpp (x, segment) → adpp (sub-adp (x, n), segment)

Theorem: length-strip-cadrs length (strip-cadrs (x)) = length (x)

Theorem: definedp-put-assoc{special} definedp (name1 , segment) → definedp (name1 , put-assoc (val, name2 , segment))

; We have some theorems like these, but they rewrite
; (adpp ... (deposit-adp ... segment)) to (adpp ... segment)
; under hyps about the legality of the deposit address.  I have
; since gotten tired of proving the legality of the addresses and
; wish to observe that even if the address is illegal the worst
; case is that the area written into becomes longer.  So the
; legal addresses after the deposit include the legal addresses
; before.

Theorem: adpp-deposit-adp-generalized adpp (adp1 , segment) → adpp (adp1 , deposit-adp (val, adp2 , segment))

Theorem: adpp-deposit-lst adpp (adp1 , segment) → adpp (adp1 , deposit-lst (lst, adp2 , segment))

; The following crappy lemma is used in relieving the fifth hypothesis
; of the i*-prelude2 lemma.  This undoubtedly could be generalized
; but I just got tired of finding elegant solutions.  This fact is
; immediate from linear arithmetic; unfortunately, it involves a little
; case analysis and is not caught during back chaining.

Theorem: i*-prelude2-hyp-5-reliever (((adp-offset (untag (r-csp (r))) − 1) ≠ 0)

∧ (((adp-offset (untag (r-csp (r))) − 1) − 1)

≮ (length (formal-vars (assoc (cadr (unlabel (get (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))))),

r-prog-segment (r)))) + length (temp-var-dcls (assoc (cadr (unlabel (get (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))))),

r-prog-segment (r)))))))

→ (((((adp-offset (untag (r-csp (r))) − 1) − 1)

− length (temp-var-dcls (assoc (cadr (unlabel (get (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))))),

r-prog-segment (r)))))

< length (formal-vars (assoc (cadr (unlabel (get (adp-offset (untag (r-pc (r))),

program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))))),

r-prog-segment (r)))))

= f)

; The sixth hypothesis of i*-prelude2 also requires work.  The problem
; is that by the time we get around to asking the stk-length of tstk for
; prelude2 we have done some deposits into sys-data-segment and we must know
; that we haven't changed its length.  We have already proved that
; deposit-adp doesn't change the length, but now we must deal with
; deposit-lst.  In the case in point, we know the deposits have all
; gone into the cstk and we are interested in the length of the tstk.
; Rather than argue that no deposit-lst changes the length  of its
; area -- a theorem that requires the additional hypothesis that the
; length of the list scanned is sufficiently short -- I will prove
; this one:

Theorem: length-cdr-assoc-deposit-lst (name ≠ adp-name (untag (adp))) → (length (cdr (assoc (name, deposit-lst (lst, adp, segment))))

= length (cdr (assoc (name, segment))))

; Now we finally turn to the arithmetic battles suggested by the fact
; that we don't know plus is commutative.  I don't want to add that
; rule; I don't want to even take the chance that it'll mess things
; up.  Instead I will prove each instance I need.

Theorem: commutativity-of-plus-application (sub-adp (untag (r-csp (r)),

1 + (1 + (length (formal-vars (assoc (name, r-prog-segment (r))))

+ length (temp-var-dcls (assoc (name, r-prog-segment (r)))))))

= sub-adp (untag (r-csp (r)),

1 + (1 + (length (temp-var-dcls (assoc (name, r-prog-segment (r))))

+ length (formal-vars (assoc (name,

r-prog-segment (r))))))))

= t

; And again, we have to consider the fact that the r level machine
; fetches all the args from tsp and then deposits them in csp
; while the i level machine does the fetches and deposits in an
; interleaved fashion.  We exploit, once again, the fact that
; we are fetching from one area and depositing into another.

Theorem: assoc-deposit-lst (name ≠ adp-name (untag (csp))) → (assoc (name, deposit-lst (lst, csp, segment)) = assoc (name, segment))

Theorem: fetch-n-tstk-deposit-lst-cstk (adp-name (untag (tsp)) ≠ adp-name (untag (csp))) → (fetch-n (n, tsp, deposit-lst (lst, csp, segment))

= fetch-n (n, tsp, segment))

Theorem: call-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'call) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-call-okp (r-current-instruction (r), r)) → (r->i (r-call-step (r-current-instruction (r), r))

= i (r->i (r), r-call-step-clock (r-current-instruction (r), r), load-addr))

; We now turn to the pop-call instruction, which has basically
; the same proof as that just done.  There are a few
; minor differences.  Pop-call starts by doing a pop and
; requires that the tstk be non-empty:

Theorem: proper-r-state-implies-legal-r-tsp proper-r-statep (r, load-addr) → (adp-offset (untag (r-tsp (r)))

< length (cdr (assoc ('tstk, r-sys-data-segment (r)))))

Theorem: assoc-tstk proper-r-statep (r, load-addr) → listp (cdr (assoc ('tstk, r-sys-data-segment (r))))

; When r-pop-call-okp checks that the call is ok, it uses
; r-call-okp on a faked up r state.  r-call-okp checks, among
; other things, that all the temp-var-dcl values are r-objects
; in that faked up state.  But the 2nd hypothesis of i*-prelude1
; requires that they all be objects in r.  The following lemma
; establishes that:

Theorem: same-signature-implies-r-objectp (r-objectp (x, r2 ) ∧ (r-prog-segment (r1 ) = r-prog-segment (r2 )) ∧ same-signature (r-usr-data-segment (r1 ), r-usr-data-segment (r2 )) ∧ same-signature (r-sys-data-segment (r1 ), r-sys-data-segment (r2 )) ∧ (r-word-size (r1 ) = r-word-size (r2 ))) → r-objectp (x, r1 )

Theorem: same-signature-implies-all-r-objectps (all-r-objectps (lst, r2 ) ∧ (r-prog-segment (r1 ) = r-prog-segment (r2 )) ∧ same-signature (r-usr-data-segment (r1 ), r-usr-data-segment (r2 )) ∧ same-signature (r-sys-data-segment (r1 ), r-sys-data-segment (r2 )) ∧ (r-word-size (r1 ) = r-word-size (r2 ))) → all-r-objectps (lst, r1 )

Event: Disable same-signature-implies-r-objectp.

; So now we can do pop-call.

Theorem: pop-call-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-call) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-pop-call-okp (r-current-instruction (r), r)) → (r->i (r-pop-call-step (r-current-instruction (r), r))

= i (r->i (r), r-pop-call-step-clock (r-current-instruction (r), r), load-addr))

; So, now we turn to the ret instruction.  We begin with the study
; of the postlude.  First, you've got to find it.

Theorem: first-n-length-properp properp (lst) → (first-n (length (lst), lst) = lst)

Theorem: r-program-bodyp-implies-properp r-program-bodyp (body) → properp (body)

Theorem: properp-program-body proper-r-statep (r, load-addr) → properp (program-body (assoc (adp-name (untag (r-pc (r))), r-prog-segment (r))))

Theorem: find-label-postlude proper-r-statep (r, load-addr) → (find-label (cons (adp-name (untag (r-pc (r))),

length (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))),

cdr (icompile-program (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))))

= (length (generate-prelude (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))) + length (icompile-program-body (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))),

                                        0,

assoc (adp-name (untag (r-pc (r))), r-prog-segment (r))))))

; Then you've got to know what you get when you fetch from it:

Theorem: fetch-adp-postlude0 proper-r-statep (r, load-addr) → (fetch-adp (cons (adp-name (untag (r-pc (r))),

length (generate-prelude (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))) + length (icompile-program-body (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))),

                                                 0,

assoc (adp-name (untag (r-pc (r))), r-prog-segment (r))))),

icompile (r-prog-segment (r)))

= dl (cons (adp-name (untag (r-pc (r))), length (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))))),

            '(postlude),
            '(move csp cfp)))

Theorem: difference-add1-plus-i-j-i ((1 + (i + j )) − i) = (1 + j )

Theorem: difference-add1-i-i ((1 + i) − i) = 1

Theorem: fetch-adp-postlude1 proper-r-statep (r, load-addr) → (fetch-adp (cons (adp-name (untag (r-pc (r))),

1 + (length (generate-prelude (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))) + length (icompile-program-body (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))),

                                                     0,

assoc (adp-name (untag (r-pc (r))), r-prog-segment (r)))))),

icompile (r-prog-segment (r)))

     = '(cpop cfp))

Event: Disable difference-add1-plus-i-j-i.

Event: Disable difference-add1-i-i.

Theorem: difference-add2-plus-i-j-i ((1 + (1 + (i + j ))) − i) = (1 + (1 + j ))

Theorem: difference-add2-i-i ((1 + (1 + i)) − i) = 2

Theorem: fetch-adp-postlude2 proper-r-statep (r, load-addr) → (fetch-adp (cons (adp-name (untag (r-pc (r))),

1 + (1 + (length (generate-prelude (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r)))) + length (icompile-program-body (program-body (assoc (adp-name (untag (r-pc (r))),

r-prog-segment (r))),

                                                          0,

assoc (adp-name (untag (r-pc (r))), r-prog-segment (r))))))),

icompile (r-prog-segment (r)))

     = '(cpop pc))

Event: Disable difference-add2-plus-i-j-i.

Event: Disable difference-add2-i-i.

Event: Disable length-generate-prelude.

Theorem: length-icompile-program length (cdr (icompile-program (prog))) = (length (generate-prelude (prog))

+ length (icompile-program-body (program-body (prog), 0, prog)) + 3)

; As usual in the cases involving jump we have to open up r->i_pc in
; the internal application (not in the fetch-execute cycle for this
; instruction).

Theorem: r->i pc-folder-ret-case tag ('ipc,

cons (adp-name (untag (fetch-adp (add-adp (untag (r-cfp (r)), 1),

r-sys-data-segment (r)))),

find-label (untag (fetch-adp (add-adp (untag (r-cfp (r)), 1),

r-sys-data-segment (r))),

cdr (icompile-program (assoc (adp-name (untag (fetch-adp (add-adp (untag (r-cfp (r)),

1), r-sys-data-segment (r)))),

r-prog-segment (r)))))))

= r->i pc (fetch-adp (add-adp (untag (r-cfp (r)), 1), r-sys-data-segment (r)), r-prog-segment (r))

Theorem: ret-one-way-correspondence-r-i ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'ret) ∧ proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-ret-okp (r-current-instruction (r), r)) → (r->i (r-ret-step (r-current-instruction (r), r))

= i (r->i (r), r-ret-step-clock (r-current-instruction (r), r), load-addr))

; We now begin the proof of the invariance of proper-r-statep
; under the r-step function.  The theorem is needed to relieve the

; proper-r-statep hypothesis in our induction hypothesis for the
; owc theorem.
; The proof proceeds exactly as you would expect, one lemma for
; each r-level instruction.
; First, however, we prove a key fact about proper-r-statep.
; The idea is that if r is proper and r' is obtained from r by
; modifying certain of the fields, e.g., pushing on r-tsp,
; what must we establish to show that r' is proper?  We
; lay all this out in the proper-r-statep-r-state lemma below.

Theorem: equal-lessp-rewriter ((x < y) = z) = (((x < y) → (t = z)) ∧ ((x ≮ y) → (f = z)))

Theorem: same-signature-segment-length same-signature (segment1 , segment2 ) → (segment-length (segment2 ) = segment-length (segment1 ))

Theorem: same-signature-implies-r-objectp-rewriter (proper-r-statep (r, load-addr) ∧ same-signature (r-sys-data-segment (r), r-sys-data-segment) ∧ same-signature (r-usr-data-segment (r), r-usr-data-segment)) → (r-objectp (x,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, r-prog-segment (r), r-usr-data-segment, r-sys-data-segment, r-word-size (r), r-psw))

= r-objectp (x, r))

Theorem: same-signature-implies-all-r-usr-data-objectps (proper-r-statep (r, load-addr)

∧ same-signature (r-sys-data-segment (r), r-sys-data-segment) ∧ same-signature (r-usr-data-segment (r), r-usr-data-segment)) → (all-r-usr-data-objectps (lst,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, r-prog-segment (r), r-usr-data-segment, r-sys-data-segment, r-word-size (r), r-psw))

= all-r-usr-data-objectps (lst, r))

Theorem: same-signature-implies-proper-r-usr-data-segmentp (proper-r-statep (r, load-addr) ∧ same-signature (r-sys-data-segment (r), r-sys-data-segment) ∧ same-signature (r-usr-data-segment (r), r-usr-data-segment)) → (proper-r-usr-data-segmentp (lst,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, r-prog-segment (r), r-usr-data-segment, r-sys-data-segment, r-word-size (r), r-psw))

= proper-r-usr-data-segmentp (lst, r))

; Here is the main theorem of this section.  This is really a
; beautiful result because it says that proper-r-statep can

; be opened up on an explicit r-state, r', that is weakly related
; to another r-state, r,  (as delivered by the
; step functions) provided  r was proper and
; has the same signatures for the sys and usr data segments.
; These hypotheses should be easy to get, given our existing
; work.
; But when we "open" proper-r-statep on r' we don't actually use
; r' but r in the various checks.  For example, we require that
; the new r-tsp be a tstkp in r, not in r' as the defn would
; require.  They are equivalent, of course, but by reducing
; the conditions to facts about r we render most of them obvious.
; The reason for this is that a typical step will change a few of
; the fields and leave the rest untouched.  Those that are untouched
; will be proper by the properness of r.
; The hint below, to expand (proper-r-statep r' load-addr), is ugly.  At first
; I just enabled proper-r-statep.  But that is suicide.  The reason is
; that we have an enormous number of rules that back chain to proper-r-statep
; and if it is enabled, those rules kill us.

Theorem: proper-r-statep-r-state (proper-r-statep (r, load-addr) ∧ same-signature (r-sys-data-segment (r), r-sys-data-segment) ∧ same-signature (r-usr-data-segment (r), r-usr-data-segment)) → (proper-r-statep (r-state (r-pc,

r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, r-prog-segment (r), r-usr-data-segment, r-sys-data-segment, r-word-size (r), r-psw),

load-addr)

= (r-objectp-type ('pc, r-pc, r) ∧ cstkp (r-cfp, r-sys-data-segment (r))

∧ cstkp (r-csp, r-sys-data-segment (r)) ∧ tstkp (r-tsp, r-sys-data-segment (r))

∧ (definition ('full-ctrl-stk-addr,

r-sys-data-segment)

    = list ('full-ctrl-stk-addr,
           tag ('sys-addr, '(cstk . 0))))
∧ (definition ('full-temp-stk-addr,

r-sys-data-segment)

    = list ('full-temp-stk-addr,
           tag ('sys-addr, '(tstk . 0))))
∧ (definition ('empty-temp-stk-addr,

r-sys-data-segment)

    = list ('empty-temp-stk-addr,
           tag ('sys-addr,

cons ('tstk,

length (definiens ('tstk,

r-sys-data-segment)) − 1))))

∧ r-objectp-type ('bool, r-c-flg, r) ∧ r-objectp-type ('bool, r-v-flg, r) ∧ r-objectp-type ('bool, r-n-flg, r) ∧ r-objectp-type ('bool, r-z-flg, r) ∧ proper-r-usr-data-segmentp (r-usr-data-segment, r)))

Event: Disable same-signature-segment-length.

Event: Disable equal-lessp-rewriter.

Theorem: no-op-preserves-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-no-op-okp (r-current-instruction (r), r)) → proper-r-statep (r-no-op-step (r-current-instruction (r), r), load-addr)

; This lemma is similar to fetch-adp-deposit-adp, but we are
; interested in the entire area assoc finds, not just the
; contents of a given location.

Theorem: assoc-deposit-adp (name ≠ adp-name (adp)) → (assoc (name, deposit-adp (val, adp, segment)) = assoc (name, segment))

Theorem: push-global-proper-r-statep ((r-psw (r) = 'run)

∧ proper-r-statep (r, load-addr) ∧ r-push-global-okp (r-current-instruction (r), r)) → proper-r-statep (r-push-global-step (r-current-instruction (r), r),

load-addr)

Theorem: push-local-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-push-local-okp (r-current-instruction (r), r)) → proper-r-statep (r-push-local-step (r-current-instruction (r), r),

load-addr)

Theorem: push-constant-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-push-constant-okp (r-current-instruction (r), r)) → proper-r-statep (r-push-constant-step (r-current-instruction (r), r),

load-addr)

Theorem: push-ctrl-stk-free-size-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-push-ctrl-stk-free-size-okp (r-current-instruction (r), r)) → proper-r-statep (r-push-ctrl-stk-free-size-step (r-current-instruction (r),

r),

load-addr)

Theorem: push-temp-stk-free-size-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-push-temp-stk-free-size-okp (r-current-instruction (r), r)) → proper-r-statep (r-push-temp-stk-free-size-step (r-current-instruction (r),

r),

load-addr)

Theorem: push-temp-stk-index-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-push-temp-stk-index-okp (r-current-instruction (r), r)) → proper-r-statep (r-push-temp-stk-index-step (r-current-instruction (r), r),

load-addr)

Theorem: pop-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-pop-okp (r-current-instruction (r), r)) → proper-r-statep (r-pop-step (r-current-instruction (r), r), load-addr)

Theorem: pop*-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-pop*-okp (r-current-instruction (r), r)) → proper-r-statep (r-pop*-step (r-current-instruction (r), r), load-addr)

Theorem: popn-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-popn-okp (r-current-instruction (r), r)) → proper-r-statep (r-popn-step (r-current-instruction (r), r), load-addr)

Theorem: pop-local-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-pop-local-okp (r-current-instruction (r), r)) → proper-r-statep (r-pop-local-step (r-current-instruction (r), r),

load-addr)

; This lemma is just like litatom-adp-name above except
; is about (cadr (unlabel x)) instead of (adp-name adp).
; As noted earlier, it actually has nothing to do with
; cadr or adp-name; it is an instance of a more general
; (but unusable) rule about proper-alists and litatom.

Theorem: litatom-cadr-unlabel (definedp (cadr (unlabel (x)), segment) ∧ proper-alistp (segment)) → litatom (cadr (unlabel (x)))

; Here is another fundamental fact:

Theorem: all-r-usr-data-objectps-put ((n < length (lst)) ∧ r-usr-data-objectp (x, r) ∧ all-r-usr-data-objectps (lst, r)) → all-r-usr-data-objectps (put (x, n, lst), r)

Theorem: not-definedp-put-assoc (¬ definedp (name1 , alist)) → (¬ definedp (name1 , put-assoc (val, name2 , alist)))

Theorem: proper-r-usr-data-segmentp-deposit-adp (adpp (adp, segment) ∧ proper-r-usr-data-segmentp (segment, r) ∧ r-usr-data-objectp (val, r)) → proper-r-usr-data-segmentp (deposit-adp (val, adp, segment), r)

Theorem: pop-global-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-pop-global-okp (r-current-instruction (r), r)) → proper-r-statep (r-pop-global-step (r-current-instruction (r), r),

load-addr)

Theorem: set-local-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-set-local-okp (r-current-instruction (r), r)) → proper-r-statep (r-set-local-step (r-current-instruction (r), r),

load-addr)

Theorem: set-global-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-set-global-okp (r-current-instruction (r), r)) → proper-r-statep (r-set-global-step (r-current-instruction (r), r),

load-addr)

Theorem: jump-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-jump-okp (r-current-instruction (r), r)) → proper-r-statep (r-jump-step (r-current-instruction (r), r), load-addr)

Theorem: pushj-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-pushj-okp (r-current-instruction (r), r)) → proper-r-statep (r-pushj-step (r-current-instruction (r), r), load-addr)

Theorem: popj-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-popj-okp (r-current-instruction (r), r)) → proper-r-statep (r-popj-step (r-current-instruction (r), r), load-addr)

Theorem: add-addr-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-add-addr-okp (r-current-instruction (r), r)) → proper-r-statep (r-add-addr-step (r-current-instruction (r), r), load-addr)

Theorem: sub-addr-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-sub-addr-okp (r-current-instruction (r), r)) → proper-r-statep (r-sub-addr-step (r-current-instruction (r), r), load-addr)

Theorem: eq-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-eq-okp (r-current-instruction (r), r)) → proper-r-statep (r-eq-step (r-current-instruction (r), r), load-addr)

Theorem: lt-addr-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-lt-addr-okp (r-current-instruction (r), r)) → proper-r-statep (r-lt-addr-step (r-current-instruction (r), r), load-addr)

Theorem: fetch-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-fetch-okp (r-current-instruction (r), r)) → proper-r-statep (r-fetch-step (r-current-instruction (r), r), load-addr)

Theorem: litatom-adp-name-instance (adpp (untag (fetch-adp (untag (r-tsp (r)), r-sys-data-segment (r))),

r-usr-data-segment (r)) ∧ proper-alistp (r-usr-data-segment (r))) → litatom (adp-name (untag (fetch-adp (untag (r-tsp (r)),

r-sys-data-segment (r)))))

Theorem: not-zerop-sub1-difference (((x − y) − 1) = 0) = (y ≮ (x − 1))

Theorem: not-empty-stkp-implies-adpp-add-adp (adpp (adp, segment) ∧ (¬ empty-stkp (tag ('sys-addr, add-adp (adp, n)), segment)) ∧ (n ∈ N)) → adpp (add-adp (adp, 1 + n), segment)

Theorem: deposit-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-deposit-okp (r-current-instruction (r), r)) → proper-r-statep (r-deposit-step (r-current-instruction (r), r), load-addr)

Theorem: fetch-temp-stk-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-fetch-temp-stk-okp (r-current-instruction (r), r)) → proper-r-statep (r-fetch-temp-stk-step (r-current-instruction (r), r),

load-addr)

Theorem: deposit-temp-stk-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-deposit-temp-stk-okp (r-current-instruction (r), r)) → proper-r-statep (r-deposit-temp-stk-step (r-current-instruction (r), r),

load-addr)

Theorem: add-int-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-add-int-okp (r-current-instruction (r), r)) → proper-r-statep (r-add-int-step (r-current-instruction (r), r), load-addr)

Theorem: add-int-with-carry-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-add-int-with-carry-okp (r-current-instruction (r), r)) → proper-r-statep (r-add-int-with-carry-step (r-current-instruction (r), r),

load-addr)

Theorem: add1-int-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-add1-int-okp (r-current-instruction (r), r)) → proper-r-statep (r-add1-int-step (r-current-instruction (r), r), load-addr)

Theorem: sub-int-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-sub-int-okp (r-current-instruction (r), r)) → proper-r-statep (r-sub-int-step (r-current-instruction (r), r), load-addr)

Theorem: sub-int-with-carry-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-sub-int-with-carry-okp (r-current-instruction (r), r)) → proper-r-statep (r-sub-int-with-carry-step (r-current-instruction (r), r),

load-addr)

Theorem: sub1-int-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-sub1-int-okp (r-current-instruction (r), r)) → proper-r-statep (r-sub1-int-step (r-current-instruction (r), r), load-addr)

Theorem: neg-int-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-neg-int-okp (r-current-instruction (r), r)) → proper-r-statep (r-neg-int-step (r-current-instruction (r), r), load-addr)

Theorem: lt-int-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-lt-int-okp (r-current-instruction (r), r)) → proper-r-statep (r-lt-int-step (r-current-instruction (r), r), load-addr)

Theorem: int-to-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-int-to-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-int-to-nat-step (r-current-instruction (r), r),

load-addr)

Theorem: add-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-add-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-add-nat-step (r-current-instruction (r), r), load-addr)

Theorem: add-nat-with-carry-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-add-nat-with-carry-okp (r-current-instruction (r), r)) → proper-r-statep (r-add-nat-with-carry-step (r-current-instruction (r), r),

load-addr)

Theorem: add1-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-add1-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-add1-nat-step (r-current-instruction (r), r), load-addr)

Theorem: sub-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-sub-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-sub-nat-step (r-current-instruction (r), r), load-addr)

Theorem: sub-nat-with-carry-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-sub-nat-with-carry-okp (r-current-instruction (r), r)) → proper-r-statep (r-sub-nat-with-carry-step (r-current-instruction (r), r),

load-addr)

Theorem: sub1-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-sub1-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-sub1-nat-step (r-current-instruction (r), r), load-addr)

Theorem: lt-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-lt-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-lt-nat-step (r-current-instruction (r), r), load-addr)

Theorem: mult2-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-mult2-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-mult2-nat-step (r-current-instruction (r), r),

load-addr)

Theorem: mult2-nat-with-carry-out-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-mult2-nat-with-carry-out-okp (r-current-instruction (r), r)) → proper-r-statep (r-mult2-nat-with-carry-out-step (r-current-instruction (r),

r),

load-addr)

Theorem: div2-nat-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-div2-nat-okp (r-current-instruction (r), r)) → proper-r-statep (r-div2-nat-step (r-current-instruction (r), r), load-addr)

Theorem: or-bitv-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-or-bitv-okp (r-current-instruction (r), r)) → proper-r-statep (r-or-bitv-step (r-current-instruction (r), r), load-addr)

Theorem: and-bitv-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-and-bitv-okp (r-current-instruction (r), r)) → proper-r-statep (r-and-bitv-step (r-current-instruction (r), r), load-addr)

Theorem: not-bitv-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-not-bitv-okp (r-current-instruction (r), r)) → proper-r-statep (r-not-bitv-step (r-current-instruction (r), r), load-addr)

Theorem: xor-bitv-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-xor-bitv-okp (r-current-instruction (r), r)) → proper-r-statep (r-xor-bitv-step (r-current-instruction (r), r), load-addr)

Theorem: rsh-bitv-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-rsh-bitv-okp (r-current-instruction (r), r)) → proper-r-statep (r-rsh-bitv-step (r-current-instruction (r), r), load-addr)

Theorem: lsh-bitv-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-lsh-bitv-okp (r-current-instruction (r), r)) → proper-r-statep (r-lsh-bitv-step (r-current-instruction (r), r), load-addr)

Theorem: or-bool-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-or-bool-okp (r-current-instruction (r), r)) → proper-r-statep (r-or-bool-step (r-current-instruction (r), r), load-addr)

Theorem: and-bool-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-and-bool-okp (r-current-instruction (r), r)) → proper-r-statep (r-and-bool-step (r-current-instruction (r), r), load-addr)

Theorem: not-bool-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-not-bool-okp (r-current-instruction (r), r)) → proper-r-statep (r-not-bool-step (r-current-instruction (r), r), load-addr)

Theorem: jump-if-temp-stk-full-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-jump-if-temp-stk-full-okp (r-current-instruction (r), r)) → proper-r-statep (r-jump-if-temp-stk-full-step (r-current-instruction (r),

r),

load-addr)

Theorem: jump-if-temp-stk-empty-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-jump-if-temp-stk-empty-okp (r-current-instruction (r), r)) → proper-r-statep (r-jump-if-temp-stk-empty-step (r-current-instruction (r),

r),

load-addr)

Theorem: test-nat-and-jump-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-test-nat-and-jump-okp (r-current-instruction (r), r)) → proper-r-statep (r-test-nat-and-jump-step (r-current-instruction (r), r),

load-addr)

Theorem: test-int-and-jump-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-test-int-and-jump-okp (r-current-instruction (r), r)) → proper-r-statep (r-test-int-and-jump-step (r-current-instruction (r), r),

load-addr)

Theorem: test-bool-and-jump-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-test-bool-and-jump-okp (r-current-instruction (r), r)) → proper-r-statep (r-test-bool-and-jump-step (r-current-instruction (r), r),

load-addr)

Theorem: test-bitv-and-jump-proper-r-statep ((r-psw (r) = 'run)

∧ proper-r-statep (r, load-addr) ∧ r-test-bitv-and-jump-okp (r-current-instruction (r), r)) → proper-r-statep (r-test-bitv-and-jump-step (r-current-instruction (r), r),

load-addr)

Theorem: pop-locn-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-pop-locn-okp (r-current-instruction (r), r)) → proper-r-statep (r-pop-locn-step (r-current-instruction (r), r), load-addr)

Theorem: locn-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-locn-okp (r-current-instruction (r), r)) → proper-r-statep (r-locn-step (r-current-instruction (r), r), load-addr)

Theorem: jump-case-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-jump-case-okp (r-current-instruction (r), r)) → proper-r-statep (r-jump-case-step (r-current-instruction (r), r),

load-addr)

Theorem: same-signature-deposit-lst (adpp (untag (sp), segment2 ) ∧ litatom (adp-name (untag (sp))) ∧ ((1 + adp-offset (untag (sp))) ≮ length (lst))) → (same-signature (segment1 , deposit-lst (lst, sp, segment2 ))

= same-signature (segment1 , segment2 ))

Theorem: length-fetch-n length (fetch-n (n, sp, segment)) = fix (n)

; In the call case, the same-signature-deposit-lst lemma is used twice
; in establishing the sys-data-segment same-signature hyp of the
; proper-r-statep-r-state theorem.  The first time is to strip off
; the deposit-lst across the formals and the second is to strip off
; the deposit-lst across the temp-var-dcls.  Both times we have to
; prove the third hyp of same-signature-deposit-lst lemma, the one
; that says there is enough room on the stack to push everything in
; the list.  The problem, as always, is that DIFFERENCE is messing
; things up.  We need a lemma for each occasion.

Theorem: same-signature-deposit-lst-hyp-3-reliever-1 (c ≮ (y + x)) → ((if c = 0 then 0

else (c − 1) − x endif < (y − 1)) = f)

Theorem: same-signature-deposit-lst-hyp-3-reliever-2 (c ≮ (y + x)) → ((if c = 0 then 0

else c − 1 endif < (x − 1)) = f)

; Historical Note:  Until I got to the call case, I was unaware that
; it has been assumed that program bodies are always listps.  Otherwise,
; setting the pc to 0 on call would be illegal.  I had to add the listp
; requirement to r-programp to get call to go through.

Theorem: listp-program-body-generalized (r-prog-segmentp (segment) ∧ definedp (name, segment)) → listp (program-body (assoc (name, segment)))

Theorem: listp-program-body (proper-r-statep (r, load-addr) ∧ definedp (name, r-prog-segment (r))) → listp (program-body (assoc (name, r-prog-segment (r))))

Theorem: call-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-call-okp (r-current-instruction (r), r)) → proper-r-statep (r-call-step (r-current-instruction (r), r), load-addr)

Theorem: pop-call-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-pop-call-okp (r-current-instruction (r), r)) → proper-r-statep (r-pop-call-step (r-current-instruction (r), r), load-addr)

Theorem: ret-proper-r-statep ((r-psw (r) = 'run) ∧ proper-r-statep (r, load-addr) ∧ r-ret-okp (r-current-instruction (r), r)) → proper-r-statep (r-ret-step (r-current-instruction (r), r), load-addr)

; I will now disable all the individual okp, step, and clock functions.

Event: Disable r-call-okp. Event: Disable r-call-step. Event: Disable r-call-step-clock. Event: Disable r-ret-okp. Event: Disable r-ret-step. Event: Disable r-ret-step-clock. Event: Disable r-locn-okp. Event: Disable r-locn-step. Event: Disable r-locn-step-clock. Event: Disable r-push-constant-okp. Event: Disable r-push-constant-step. Event: Disable r-push-constant-step-clock. Event: Disable r-push-local-okp. Event: Disable r-push-local-step. Event: Disable r-push-local-step-clock. Event: Disable r-push-global-okp. Event: Disable r-push-global-step.

Event: Disable r-push-global-step-clock. Event: Disable r-push-ctrl-stk-free-size-okp. Event: Disable r-push-ctrl-stk-free-size-step. Event: Disable r-push-ctrl-stk-free-size-step-clock. Event: Disable r-push-temp-stk-free-size-okp. Event: Disable r-push-temp-stk-free-size-step. Event: Disable r-push-temp-stk-free-size-step-clock. Event: Disable r-push-temp-stk-index-okp. Event: Disable r-push-temp-stk-index-step. Event: Disable r-push-temp-stk-index-step-clock. Event: Disable r-jump-if-temp-stk-full-okp. Event: Disable r-jump-if-temp-stk-full-step. Event: Disable r-jump-if-temp-stk-full-step-clock. Event: Disable r-jump-if-temp-stk-empty-okp. Event: Disable r-jump-if-temp-stk-empty-step. Event: Disable r-jump-if-temp-stk-empty-step-clock. Event: Disable r-pop-okp. Event: Disable r-pop-step.

Event: Disable r-pop-step-clock. Event: Disable r-pop*-okp. Event: Disable r-pop*-step. Event: Disable r-pop*-step-clock. Event: Disable r-popn-okp. Event: Disable r-popn-step. Event: Disable r-popn-step-clock. Event: Disable r-pop-local-okp. Event: Disable r-pop-local-step. Event: Disable r-pop-local-step-clock. Event: Disable r-pop-global-okp. Event: Disable r-pop-global-step. Event: Disable r-pop-global-step-clock. Event: Disable r-pop-locn-okp. Event: Disable r-pop-locn-step. Event: Disable r-pop-locn-step-clock. Event: Disable r-pop-call-okp. Event: Disable r-pop-call-step.

Event: Disable r-pop-call-step-clock. Event: Disable r-fetch-temp-stk-okp. Event: Disable r-fetch-temp-stk-step. Event: Disable r-fetch-temp-stk-step-clock. Event: Disable r-deposit-temp-stk-okp. Event: Disable r-deposit-temp-stk-step. Event: Disable r-deposit-temp-stk-step-clock. Event: Disable r-jump-okp. Event: Disable r-jump-step. Event: Disable r-jump-step-clock. Event: Disable r-jump-case-okp. Event: Disable r-jump-case-step. Event: Disable r-jump-case-step-clock. Event: Disable r-pushj-okp. Event: Disable r-pushj-step. Event: Disable r-pushj-step-clock. Event: Disable r-popj-okp. Event: Disable r-popj-step.

Event: Disable r-popj-step-clock. Event: Disable r-set-local-okp. Event: Disable r-set-local-step. Event: Disable r-set-local-step-clock. Event: Disable r-set-global-okp. Event: Disable r-set-global-step. Event: Disable r-set-global-step-clock. Event: Disable r-test-nat-and-jump-okp. Event: Disable r-test-nat-and-jump-step. Event: Disable r-test-nat-and-jump-step-clock. Event: Disable r-test-int-and-jump-okp. Event: Disable r-test-int-and-jump-step. Event: Disable r-test-int-and-jump-step-clock. Event: Disable r-test-bool-and-jump-okp. Event: Disable r-test-bool-and-jump-step. Event: Disable r-test-bool-and-jump-step-clock. Event: Disable r-test-bitv-and-jump-okp. Event: Disable r-test-bitv-and-jump-step.

Event: Disable r-test-bitv-and-jump-step-clock. Event: Disable r-no-op-okp. Event: Disable r-no-op-step. Event: Disable r-no-op-step-clock. Event: Disable r-add-addr-okp. Event: Disable r-add-addr-step. Event: Disable r-add-addr-step-clock. Event: Disable r-sub-addr-okp. Event: Disable r-sub-addr-step. Event: Disable r-sub-addr-step-clock. Event: Disable r-eq-okp. Event: Disable r-eq-step. Event: Disable r-eq-step-clock. Event: Disable r-lt-addr-okp. Event: Disable r-lt-addr-step. Event: Disable r-lt-addr-step-clock. Event: Disable r-fetch-okp. Event: Disable r-fetch-step.

Event: Disable r-fetch-step-clock. Event: Disable r-deposit-okp. Event: Disable r-deposit-step. Event: Disable r-deposit-step-clock. Event: Disable r-add-int-okp. Event: Disable r-add-int-step. Event: Disable r-add-int-step-clock. Event: Disable r-add-int-with-carry-okp. Event: Disable r-add-int-with-carry-step. Event: Disable r-add-int-with-carry-step-clock. Event: Disable r-add1-int-okp. Event: Disable r-add1-int-step. Event: Disable r-add1-int-step-clock. Event: Disable r-sub-int-okp. Event: Disable r-sub-int-step. Event: Disable r-sub-int-step-clock. Event: Disable r-sub-int-with-carry-okp. Event: Disable r-sub-int-with-carry-step.

Event: Disable r-sub-int-with-carry-step-clock. Event: Disable r-sub1-int-okp. Event: Disable r-sub1-int-step. Event: Disable r-sub1-int-step-clock. Event: Disable r-neg-int-okp. Event: Disable r-neg-int-step. Event: Disable r-neg-int-step-clock. Event: Disable r-lt-int-okp. Event: Disable r-lt-int-step. Event: Disable r-lt-int-step-clock. Event: Disable r-int-to-nat-okp. Event: Disable r-int-to-nat-step. Event: Disable r-int-to-nat-step-clock. Event: Disable r-add-nat-okp. Event: Disable r-add-nat-step. Event: Disable r-add-nat-step-clock. Event: Disable r-add-nat-with-carry-okp. Event: Disable r-add-nat-with-carry-step.

Event: Disable r-add-nat-with-carry-step-clock. Event: Disable r-add1-nat-okp. Event: Disable r-add1-nat-step. Event: Disable r-add1-nat-step-clock. Event: Disable r-sub-nat-okp. Event: Disable r-sub-nat-step. Event: Disable r-sub-nat-step-clock. Event: Disable r-sub-nat-with-carry-okp. Event: Disable r-sub-nat-with-carry-step. Event: Disable r-sub-nat-with-carry-step-clock. Event: Disable r-sub1-nat-okp. Event: Disable r-sub1-nat-step. Event: Disable r-sub1-nat-step-clock. Event: Disable r-lt-nat-okp. Event: Disable r-lt-nat-step. Event: Disable r-lt-nat-step-clock. Event: Disable r-mult2-nat-okp. Event: Disable r-mult2-nat-step.

Event: Disable r-mult2-nat-step-clock. Event: Disable r-mult2-nat-with-carry-out-okp. Event: Disable r-mult2-nat-with-carry-out-step. Event: Disable r-mult2-nat-with-carry-out-step-clock. Event: Disable r-div2-nat-okp. Event: Disable r-div2-nat-step. Event: Disable r-div2-nat-step-clock. Event: Disable r-or-bitv-okp. Event: Disable r-or-bitv-step. Event: Disable r-or-bitv-step-clock. Event: Disable r-and-bitv-okp. Event: Disable r-and-bitv-step. Event: Disable r-and-bitv-step-clock. Event: Disable r-not-bitv-okp. Event: Disable r-not-bitv-step. Event: Disable r-not-bitv-step-clock. Event: Disable r-xor-bitv-okp. Event: Disable r-xor-bitv-step.

Event: Disable r-xor-bitv-step-clock. Event: Disable r-rsh-bitv-okp. Event: Disable r-rsh-bitv-step. Event: Disable r-rsh-bitv-step-clock. Event: Disable r-lsh-bitv-okp. Event: Disable r-lsh-bitv-step. Event: Disable r-lsh-bitv-step-clock. Event: Disable r-or-bool-okp. Event: Disable r-or-bool-step. Event: Disable r-or-bool-step-clock. Event: Disable r-and-bool-okp. Event: Disable r-and-bool-step. Event: Disable r-and-bool-step-clock. Event: Disable r-not-bool-okp. Event: Disable r-not-bool-step. Event: Disable r-not-bool-step-clock.

; I now proceed to package all this up into two lemmas
; about r-step.  The first is that it preserves proper-r-statep.
; The second is the one-way-correspondence theorem for it.

Theorem: proper-r-statep-r-halt proper-r-statep (r, load-addr) → proper-r-statep (r-halt (r, psw), load-addr)

; I am trying to control the case explosion produced by r-step.
; It has two sources, r-ins-okp and r-ins-step.  I have arbitrarily
; decided to disable r-ins-okp and let r-ins-step drive the case
; expansion.  To get away with disabling r-ins-okp I need to be
; able to establish all of the individual instruction okps from
; (r-ins-okp ins r).  Then, when the previously proved lemmas
; for particular instructions need a particular okp, they will
; find it here:

Theorem: r-ins-okp-backchainer r-ins-okp (ins, r) → (((car (ins) = 'call) → r-call-okp (ins, r))

∧ ((car (ins) = 'ret) → r-ret-okp (ins, r)) ∧ ((car (ins) = 'locn) → r-locn-okp (ins, r))

∧ ((car (ins) = 'push-constant)

→ r-push-constant-okp (ins, r)) ∧ ((car (ins) = 'push-local) → r-push-local-okp (ins, r)) ∧ ((car (ins) = 'push-global) → r-push-global-okp (ins, r))

∧ ((car (ins) = 'push-ctrl-stk-free-size)

→ r-push-ctrl-stk-free-size-okp (ins, r))

∧ ((car (ins) = 'push-temp-stk-free-size)

→ r-push-temp-stk-free-size-okp (ins, r))

∧ ((car (ins) = 'push-temp-stk-index)

→ r-push-temp-stk-index-okp (ins, r))

∧ ((car (ins) = 'jump-if-temp-stk-full)

→ r-jump-if-temp-stk-full-okp (ins, r))

∧ ((car (ins) = 'jump-if-temp-stk-empty)

→ r-jump-if-temp-stk-empty-okp (ins, r)) ∧ ((car (ins) = 'pop) → r-pop-okp (ins, r)) ∧ ((car (ins) = 'pop*) → r-pop*-okp (ins, r)) ∧ ((car (ins) = 'popn) → r-popn-okp (ins, r)) ∧ ((car (ins) = 'pop-local) → r-pop-local-okp (ins, r)) ∧ ((car (ins) = 'pop-global) → r-pop-global-okp (ins, r)) ∧ ((car (ins) = 'pop-locn) → r-pop-locn-okp (ins, r)) ∧ ((car (ins) = 'pop-call) → r-pop-call-okp (ins, r))

∧ ((car (ins) = 'fetch-temp-stk)

→ r-fetch-temp-stk-okp (ins, r))

∧ ((car (ins) = 'deposit-temp-stk)

→ r-deposit-temp-stk-okp (ins, r)) ∧ ((car (ins) = 'jump) → r-jump-okp (ins, r))

∧ ((car (ins) = 'jump-case) → r-jump-case-okp (ins, r)) ∧ ((car (ins) = 'pushj) → r-pushj-okp (ins, r)) ∧ ((car (ins) = 'popj) → r-popj-okp (ins, r)) ∧ ((car (ins) = 'set-local) → r-set-local-okp (ins, r)) ∧ ((car (ins) = 'set-global) → r-set-global-okp (ins, r))

∧ ((car (ins) = 'test-nat-and-jump)

→ r-test-nat-and-jump-okp (ins, r))

∧ ((car (ins) = 'test-int-and-jump)

→ r-test-int-and-jump-okp (ins, r))

∧ ((car (ins) = 'test-bool-and-jump)

→ r-test-bool-and-jump-okp (ins, r))

∧ ((car (ins) = 'test-bitv-and-jump)

→ r-test-bitv-and-jump-okp (ins, r)) ∧ ((car (ins) = 'no-op) → r-no-op-okp (ins, r)) ∧ ((car (ins) = 'add-addr) → r-add-addr-okp (ins, r)) ∧ ((car (ins) = 'sub-addr) → r-sub-addr-okp (ins, r)) ∧ ((car (ins) = 'eq) → r-eq-okp (ins, r)) ∧ ((car (ins) = 'lt-addr) → r-lt-addr-okp (ins, r)) ∧ ((car (ins) = 'fetch) → r-fetch-okp (ins, r)) ∧ ((car (ins) = 'deposit) → r-deposit-okp (ins, r)) ∧ ((car (ins) = 'add-int) → r-add-int-okp (ins, r))

∧ ((car (ins) = 'add-int-with-carry)

→ r-add-int-with-carry-okp (ins, r)) ∧ ((car (ins) = 'add1-int) → r-add1-int-okp (ins, r)) ∧ ((car (ins) = 'sub-int) → r-sub-int-okp (ins, r))

∧ ((car (ins) = 'sub-int-with-carry)

→ r-sub-int-with-carry-okp (ins, r)) ∧ ((car (ins) = 'sub1-int) → r-sub1-int-okp (ins, r)) ∧ ((car (ins) = 'neg-int) → r-neg-int-okp (ins, r)) ∧ ((car (ins) = 'lt-int) → r-lt-int-okp (ins, r)) ∧ ((car (ins) = 'int-to-nat) → r-int-to-nat-okp (ins, r)) ∧ ((car (ins) = 'add-nat) → r-add-nat-okp (ins, r))

∧ ((car (ins) = 'add-nat-with-carry)

→ r-add-nat-with-carry-okp (ins, r)) ∧ ((car (ins) = 'add1-nat) → r-add1-nat-okp (ins, r)) ∧ ((car (ins) = 'sub-nat) → r-sub-nat-okp (ins, r))

∧ ((car (ins) = 'sub-nat-with-carry)

→ r-sub-nat-with-carry-okp (ins, r)) ∧ ((car (ins) = 'sub1-nat) → r-sub1-nat-okp (ins, r)) ∧ ((car (ins) = 'lt-nat) → r-lt-nat-okp (ins, r)) ∧ ((car (ins) = 'mult2-nat) → r-mult2-nat-okp (ins, r))

∧ ((car (ins) = 'mult2-nat-with-carry-out)

→ r-mult2-nat-with-carry-out-okp (ins, r)) ∧ ((car (ins) = 'div2-nat) → r-div2-nat-okp (ins, r))

∧ ((car (ins) = 'or-bitv) → r-or-bitv-okp (ins, r)) ∧ ((car (ins) = 'and-bitv) → r-and-bitv-okp (ins, r)) ∧ ((car (ins) = 'not-bitv) → r-not-bitv-okp (ins, r)) ∧ ((car (ins) = 'xor-bitv) → r-xor-bitv-okp (ins, r)) ∧ ((car (ins) = 'rsh-bitv) → r-rsh-bitv-okp (ins, r)) ∧ ((car (ins) = 'lsh-bitv) → r-lsh-bitv-okp (ins, r)) ∧ ((car (ins) = 'or-bool) → r-or-bool-okp (ins, r)) ∧ ((car (ins) = 'and-bool) → r-and-bool-okp (ins, r)) ∧ ((car (ins) = 'not-bool) → r-not-bool-okp (ins, r)))

Event: Disable r-ins-okp.

; The proof strategy I have in mind requires that the machine be able
; to walk all the way down the IF tree inside of a single r-ins-step.
; Unfortunately, we run out of stack space before we get there.  The
; solution is to define new versions of r-ins-step and
; r-ins-step-clock that are composed of two functions, each of which
; handles half of the instructions.

Definition: r-ins-step2 (ins, r) = case on car (ins):

case = eq then r-eq-step (ins, r) case = lt-addr then r-lt-addr-step (ins, r) case = fetch then r-fetch-step (ins, r) case = deposit then r-deposit-step (ins, r) case = add-int then r-add-int-step (ins, r) case = add-int-with-carry then r-add-int-with-carry-step (ins, r) case = add1-int then r-add1-int-step (ins, r) case = sub-int then r-sub-int-step (ins, r) case = sub-int-with-carry then r-sub-int-with-carry-step (ins, r) case = sub1-int then r-sub1-int-step (ins, r) case = neg-int then r-neg-int-step (ins, r) case = lt-int then r-lt-int-step (ins, r) case = int-to-nat then r-int-to-nat-step (ins, r) case = add-nat then r-add-nat-step (ins, r) case = add-nat-with-carry then r-add-nat-with-carry-step (ins, r) case = add1-nat then r-add1-nat-step (ins, r) case = sub-nat then r-sub-nat-step (ins, r) case = sub-nat-with-carry then r-sub-nat-with-carry-step (ins, r) case = sub1-nat then r-sub1-nat-step (ins, r) case = lt-nat then r-lt-nat-step (ins, r) case = mult2-nat then r-mult2-nat-step (ins, r) case = mult2-nat-with-carry-out then r-mult2-nat-with-carry-out-step (ins, r) case = div2-nat then r-div2-nat-step (ins, r) case = or-bitv then r-or-bitv-step (ins, r) case = and-bitv then r-and-bitv-step (ins, r) case = not-bitv then r-not-bitv-step (ins, r) case = xor-bitv then r-xor-bitv-step (ins, r) case = rsh-bitv then r-rsh-bitv-step (ins, r) case = lsh-bitv then r-lsh-bitv-step (ins, r) case = or-bool then r-or-bool-step (ins, r) case = and-bool then r-and-bool-step (ins, r) case = not-bool then r-not-bool-step (ins, r) otherwise r-halt (r, 'run) endcase Definition: r-ins-step1 (ins, r) = case on car (ins):

case = call then r-call-step (ins, r) case = ret then r-ret-step (ins, r) case = locn then r-locn-step (ins, r) case = push-constant then r-push-constant-step (ins, r) case = push-local then r-push-local-step (ins, r) case = push-global then r-push-global-step (ins, r) case = push-ctrl-stk-free-size then r-push-ctrl-stk-free-size-step (ins, r) case = push-temp-stk-free-size then r-push-temp-stk-free-size-step (ins, r) case = push-temp-stk-index then r-push-temp-stk-index-step (ins, r) case = jump-if-temp-stk-full then r-jump-if-temp-stk-full-step (ins, r) case = jump-if-temp-stk-empty then r-jump-if-temp-stk-empty-step (ins, r) case = pop then r-pop-step (ins, r) case = pop* then r-pop*-step (ins, r) case = popn then r-popn-step (ins, r) case = pop-local then r-pop-local-step (ins, r) case = pop-global then r-pop-global-step (ins, r) case = pop-locn then r-pop-locn-step (ins, r) case = pop-call then r-pop-call-step (ins, r) case = fetch-temp-stk then r-fetch-temp-stk-step (ins, r) case = deposit-temp-stk then r-deposit-temp-stk-step (ins, r) case = jump then r-jump-step (ins, r) case = jump-case then r-jump-case-step (ins, r) case = pushj then r-pushj-step (ins, r) case = popj then r-popj-step (ins, r) case = set-local then r-set-local-step (ins, r) case = set-global then r-set-global-step (ins, r) case = test-nat-and-jump then r-test-nat-and-jump-step (ins, r) case = test-int-and-jump then r-test-int-and-jump-step (ins, r) case = test-bool-and-jump then r-test-bool-and-jump-step (ins, r) case = test-bitv-and-jump then r-test-bitv-and-jump-step (ins, r) case = no-op then r-no-op-step (ins, r) case = add-addr then r-add-addr-step (ins, r) case = sub-addr then r-sub-addr-step (ins, r) otherwise r-ins-step2 (ins, r) endcase

Definition: r-ins-step-clock2 (ins, r) = case on car (ins):

case = eq then r-eq-step-clock (ins, r) case = lt-addr then r-lt-addr-step-clock (ins, r) case = fetch then r-fetch-step-clock (ins, r) case = deposit then r-deposit-step-clock (ins, r) case = add-int then r-add-int-step-clock (ins, r) case = add-int-with-carry then r-add-int-with-carry-step-clock (ins, r) case = add1-int then r-add1-int-step-clock (ins, r) case = sub-int then r-sub-int-step-clock (ins, r) case = sub-int-with-carry then r-sub-int-with-carry-step-clock (ins, r) case = sub1-int then r-sub1-int-step-clock (ins, r) case = neg-int then r-neg-int-step-clock (ins, r) case = lt-int then r-lt-int-step-clock (ins, r) case = int-to-nat then r-int-to-nat-step-clock (ins, r) case = add-nat then r-add-nat-step-clock (ins, r) case = add-nat-with-carry then r-add-nat-with-carry-step-clock (ins, r) case = add1-nat then r-add1-nat-step-clock (ins, r) case = sub-nat then r-sub-nat-step-clock (ins, r) case = sub-nat-with-carry then r-sub-nat-with-carry-step-clock (ins, r) case = sub1-nat then r-sub1-nat-step-clock (ins, r) case = lt-nat then r-lt-nat-step-clock (ins, r) case = mult2-nat then r-mult2-nat-step-clock (ins, r) case = mult2-nat-with-carry-out then r-mult2-nat-with-carry-out-step-clock (ins, r) case = div2-nat then r-div2-nat-step-clock (ins, r) case = or-bitv then r-or-bitv-step-clock (ins, r) case = and-bitv then r-and-bitv-step-clock (ins, r) case = not-bitv then r-not-bitv-step-clock (ins, r) case = xor-bitv then r-xor-bitv-step-clock (ins, r) case = rsh-bitv then r-rsh-bitv-step-clock (ins, r) case = lsh-bitv then r-lsh-bitv-step-clock (ins, r) case = or-bool then r-or-bool-step-clock (ins, r) case = and-bool then r-and-bool-step-clock (ins, r) case = not-bool then r-not-bool-step-clock (ins, r) otherwise 0 endcase

Definition: r-ins-step-clock1 (ins, r) = case on car (ins):

case = call then r-call-step-clock (ins, r) case = ret then r-ret-step-clock (ins, r) case = locn then r-locn-step-clock (ins, r) case = push-constant then r-push-constant-step-clock (ins, r) case = push-local then r-push-local-step-clock (ins, r) case = push-global then r-push-global-step-clock (ins, r) case = push-ctrl-stk-free-size then r-push-ctrl-stk-free-size-step-clock (ins, r) case = push-temp-stk-free-size then r-push-temp-stk-free-size-step-clock (ins, r) case = push-temp-stk-index then r-push-temp-stk-index-step-clock (ins, r) case = jump-if-temp-stk-full then r-jump-if-temp-stk-full-step-clock (ins, r) case = jump-if-temp-stk-empty then r-jump-if-temp-stk-empty-step-clock (ins, r) case = pop then r-pop-step-clock (ins, r) case = pop* then r-pop*-step-clock (ins, r) case = popn then r-popn-step-clock (ins, r) case = pop-local then r-pop-local-step-clock (ins, r) case = pop-global then r-pop-global-step-clock (ins, r) case = pop-locn then r-pop-locn-step-clock (ins, r) case = pop-call then r-pop-call-step-clock (ins, r) case = fetch-temp-stk then r-fetch-temp-stk-step-clock (ins, r) case = deposit-temp-stk then r-deposit-temp-stk-step-clock (ins, r) case = jump then r-jump-step-clock (ins, r) case = jump-case then r-jump-case-step-clock (ins, r) case = pushj then r-pushj-step-clock (ins, r) case = popj then r-popj-step-clock (ins, r) case = set-local then r-set-local-step-clock (ins, r) case = set-global then r-set-global-step-clock (ins, r) case = test-nat-and-jump then r-test-nat-and-jump-step-clock (ins, r) case = test-int-and-jump then r-test-int-and-jump-step-clock (ins, r) case = test-bool-and-jump then r-test-bool-and-jump-step-clock (ins, r) case = test-bitv-and-jump then r-test-bitv-and-jump-step-clock (ins, r) case = no-op then r-no-op-step-clock (ins, r) case = add-addr then r-add-addr-step-clock (ins, r) case = sub-addr then r-sub-addr-step-clock (ins, r) otherwise r-ins-step-clock2 (ins, r) endcase

; We now prove these functions are equivalent to what we normally use:

Theorem: r-ins-step-is-r-ins-step1 r-ins-step (ins, r) = r-ins-step1 (ins, r)

Theorem: r-ins-step-clock-is-r-ins-step-clock1 r-ins-step-clock (ins, r) = r-ins-step-clock1 (ins, r)

Event: Disable r-ins-step.

Event: Disable r-ins-step-clock.

; Now we will prove that r-step preserves proper-r-statep.
; Consider (proper-r-statep (r-step r) load-addr).  The r-step will expand to ifs.
; We'll bring the ifs out of proper-r-statep with:

Theorem: proper-r-statep-if proper-r-statep (if a then b

else c endif, load-addr)

= if a then proper-r-statep (b, load-addr)

else proper-r-statep (c, load-addr) endif

; That will elevate the test a, which will be (r-ins-okp ins r) the first
; time and then particular instruction opcodes subsequently.  Under each
; particular assumption we'll have to prove (proper-r-statep b load-addr) where
; b will be the corresponding r-xxx-step.  Our just proved backchainer
; and our previously proved lemmas will hit each.  However, because we
; can't explore the full depth of r-ins-step, we will first do this for
; r-ins-step2 and then for r-step (which will expand into r-ins-step and
; hence into r-ins-step1, where it will then do the first half of the nest
; and then appeal to our r-ins-step2 work).

Event: Disable r-current-instruction.

Theorem: proper-r-statep-r-ins-step2 (proper-r-statep (r, load-addr) ∧ (r-psw (r) = 'run) ∧ r-ins-okp (r-current-instruction (r), r)) → proper-r-statep (r-ins-step2 (r-current-instruction (r), r), load-addr)

Event: Disable r-ins-step2.

Theorem: proper-r-statep-r-step proper-r-statep (r, load-addr) → proper-r-statep (r-step (r), load-addr)

; Note:  This was easier before I added Bill Young's requested 7 instructions.
; It was those 7 that put me beyond the depth of the stack!
; We repeat the exercise now, for one-way-correspondence.

; First we draw out the ifs.

Theorem: r->i-if r->i (if a then b

else c endif) = if a then r->i (b)

else r->i (c) endif

Theorem: i-if i (r,

if a then b else c endif, load-addr)

= if a then i (r, b, load-addr)

else i (r, c, load-addr) endif

Theorem: equal-if-if (if a then b else c endif = if a then d

else e endif) = if a then b = d

else c = e endif

; Note how clever the above strategy is.  Without this lemma, which extracts
; the branches of two isomorphic if nests simultaneously from the arms of
; the equal, we would cross multiply the tests.
; Then we arrange for the error and termination cases.

Theorem: i-0 i (i, 0, load-addr) = i

Theorem: r-halt-run (r-statep (r) ∧ (r-psw (r) = 'run)) → (r-halt (r, 'run) = r)

; Now we are really shooting for one-way-correspondence-r-i-step, below,
; but it has two occurrences of (r-step r) in it and I don't want to deal
; with them both at once.  So I'll first prove a mildly simplified version
; and then prove that if the (r-step r) is non-erroneous then the r-ins-okp
; below holds.

Theorem: one-way-correspondence-r-i-step2-simplified (proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ (r-psw (r) = 'run) ∧ r-ins-okp (r-current-instruction (r), r)) → (r->i (r-ins-step2 (r-current-instruction (r), r))

= i (r->i (r), r-ins-step-clock2 (r-current-instruction (r), r), load-addr))

Event: Disable r-ins-step-clock2.

Theorem: one-way-correspondence-r-i-step-simplified (proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ r-ins-okp (r-current-instruction (r), r)) → (r->i (r-step (r)) = i (r->i (r), r-step-clock (r), load-addr))

Theorem: r->i-r-halt (r-psw (r) = 'run) → (r->i (r-halt (r, 'halt)) = r->i (r))

Theorem: r-psw-r-halt r-psw (r-halt (r, psw)) = psw

; The double occurrence of r-step in the thm below makes its direct proof
; very explosive.  So I proved the simplified version above, from which this
; version is easy.

Theorem: one-way-correspondence-r-i-step (proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ (¬ errorp (r-psw (r-step (r))))) → (r->i (r-step (r)) = i (r->i (r), r-step-clock (r), load-addr))

Theorem: i-plus i (i, x + y, load-addr) = i (i (i, x, load-addr), y, load-addr)

Theorem: once-errorp-always-errorp-step (¬ errorp (r-psw (r-step (r)))) → (¬ errorp (r-psw (r)))

Theorem: once-errorp-always-errorp (¬ errorp (r-psw (r (r, n)))) → (¬ errorp (r-psw (r)))

Theorem: one-way-correspondence-r-i (proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ (¬ errorp (r-psw (r (r, n))))) → (r->i (r (r, n)) = i (r->i (r), clock (r, n), load-addr))

Theorem: proper-r-statep-r proper-r-statep (r, load-addr) → proper-r-statep (r (r, n), load-addr)

Theorem: all-r-usr-data-objectps-implies-all-i-usr-data-objectps (proper-r-statep (r, load-addr) ∧ all-r-usr-data-objectps (lst, r)) → all-i-usr-data-objectps (lst, r->i (r))

Theorem: proper-r-usr-data-segmentp-implies-proper-i-usr-data-segmentp (proper-r-statep (r, load-addr) ∧ proper-r-usr-data-segmentp (segment, r)) → proper-i-usr-data-segmentp (segment, r->i (r))

Theorem: proper-r-statep-implies-proper-i-user-data-segmentp proper-r-statep (r, load-addr) → proper-i-usr-data-segmentp (r-usr-data-segment (r), r->i (r))

; Book: p.events.  Finally, we define the p machine itself, the semantics
; of Piton.

Event: Set the status of all events. The status of each event is to be set as follows. Each ‘boot-strap’ satellite is to be returned to the initial condition. Each ‘add-shell’ satellite is to be enabled. enabled. Anything not otherwise mentioned is to be disabled. Name this event ‘close-data-base-4’.

; We now build p-r.events from its subbooks.

Definition: p-halt (p, psw) = p-state (p-pc (p),

p-ctrl-stk (p), p-temp-stk (p), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), psw)

Definition: rget (n, lst) = get ((length (lst) − n) − 1, lst)

Definition: rput (val, n, lst) = put (val, (length (lst) − n) − 1, lst)

Definition: push (x, stk) = cons (x, stk)

Definition: popn (n, x) = if n ≃ 0 then x

else popn (n − 1, cdr (x)) endif

Definition: top1 (stk) = top (pop (stk))

Definition: top2 (stk) = top (pop (pop (stk)))

Definition: all-find-labelp (lab-lst, lst) = if lab-lst ≃ nil then t

else find-labelp (car (lab-lst), lst) ∧ all-find-labelp (cdr (lab-lst), lst) endif

Definition: p-objectp (x, p) = (listp (x)

∧ (cddr (x) = nil) ∧ case on type (x): case = nat then small-naturalp (untag (x), p-word-size (p)) case = int then small-integerp (untag (x), p-word-size (p)) case = bitv then bit-vectorp (untag (x), p-word-size (p)) case = bool then booleanp (untag (x)) case = addr then adpp (untag (x), p-data-segment (p)) case = pc then pcpp (untag (x), p-prog-segment (p)) case = subr then definedp (untag (x), p-prog-segment (p)) otherwise f endcase)

Definition: p-objectp-type (type, x, p) = ((type (x) = type) ∧ p-objectp (x, p))

Definition: all-p-objectps (lst, p) = if lst ≃ nil then lst = nil

else p-objectp (car (lst), p) ∧ all-p-objectps (cdr (lst), p) endif

Definition: add1-p-pc (p) = add1-addr (p-pc (p))

Definition: p-current-program (p) = definition (area-name (p-pc (p)), p-prog-segment (p))

Definition: p-current-instruction (p) = unlabel (get (offset (p-pc (p)), program-body (p-current-program (p))))

Definition: p-frame (bindings, ret-pc) = list (bindings, ret-pc)

Definition: local-var-value (var, ctrl-stk) = definiens (var, bindings (top (ctrl-stk)))

Definition: set-local-var-value (val, var, ctrl-stk) = push (p-frame (put-value (val, var, bindings (top (ctrl-stk))),

ret-pc (top (ctrl-stk))), pop (ctrl-stk))

Definition: pair-formal-vars-with-actuals (formal-vars, temp-stk) = pairlist (formal-vars, rev (first-n (length (formal-vars), temp-stk)))

Definition: pair-temps-with-initial-values (temp-var-dcls) = if temp-var-dcls ≃ nil then nil

else cons (cons (caar (temp-var-dcls), cadar (temp-var-dcls)), pair-temps-with-initial-values (cdr (temp-var-dcls))) endif

Definition: make-p-call-frame (formal-vars, temp-stk, temp-var-dcls, ret-pc) = p-frame (append (pair-formal-vars-with-actuals (formal-vars, temp-stk),

pair-temps-with-initial-values (temp-var-dcls)), ret-pc)

Definition: p-call-okp (ins, p) = ((p-max-ctrl-stk-size (p)

≮ p-ctrl-stk-size (push (make-p-call-frame (formal-vars (definition (cadr (ins), p-prog-segment (p))), p-temp-stk (p), temp-var-dcls (definition (cadr (ins),

p-prog-segment (p))),

add1-addr (p-pc (p))),

p-ctrl-stk (p))))

∧ (length (p-temp-stk (p))

≮ length (formal-vars (definition (cadr (ins), p-prog-segment (p))))))

Definition: p-call-step (ins, p) = p-state (tag ('pc, cons (cadr (ins), 0)),

push (make-p-call-frame (formal-vars (definition (cadr (ins),

p-prog-segment (p))),

p-temp-stk (p),

temp-var-dcls (definition (cadr (ins),

p-prog-segment (p))),

add1-addr (p-pc (p))),

p-ctrl-stk (p)), popn (length (formal-vars (definition (cadr (ins),

p-prog-segment (p)))),

p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-ret-okp (ins, p) = t

Definition: p-ret-step (ins, p) = if listp (pop (p-ctrl-stk (p)))

then p-state (ret-pc (top (p-ctrl-stk (p))), pop (p-ctrl-stk (p)), p-temp-stk (p), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

else p-halt (p, 'halt) endif Definition: p-locn-okp (ins, p) = (p-objectp-type ('nat, local-var-value (cadr (ins), p-ctrl-stk (p)), p)

∧ (untag (local-var-value (cadr (ins), p-ctrl-stk (p))) < length (bindings (top (p-ctrl-stk (p))))) ∧ (length (p-temp-stk (p)) < p-max-temp-stk-size (p)))

Definition: p-locn-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p),

push (cdr (get (untag (local-var-value (cadr (ins), p-ctrl-stk (p))), bindings (top (p-ctrl-stk (p))))),

p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

          'run)

Definition: p-push-constant-okp (ins, p) = (length (p-temp-stk (p)) < p-max-temp-stk-size (p))

Definition: unabbreviate-constant (c, p) = if c = 'pc then add1-p-pc (p)

elseif c ≃ nil then pc (c, p-current-program (p))

else c endif

Definition: p-push-constant-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p),

push (unabbreviate-constant (cadr (ins), p), p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

          'run)

Definition: p-push-local-okp (ins, p) = (length (p-temp-stk (p)) < p-max-temp-stk-size (p))

Definition: p-push-local-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (local-var-value (cadr (ins), p-ctrl-stk (p)), p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-push-global-okp (ins, p) = (length (p-temp-stk (p)) < p-max-temp-stk-size (p))

Definition: p-push-global-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (fetch (tag ('addr, cons (cadr (ins), 0)), p-data-segment (p)),

p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-push-ctrl-stk-free-size-okp (ins, p) = (length (p-temp-stk (p)) < p-max-temp-stk-size (p))

Definition: p-push-ctrl-stk-free-size-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat,

p-max-ctrl-stk-size (p)

− p-ctrl-stk-size (p-ctrl-stk (p))), p-temp-stk (p)),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-push-temp-stk-free-size-okp (ins, p) = (length (p-temp-stk (p)) < p-max-temp-stk-size (p))

Definition: p-push-temp-stk-free-size-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat,

p-max-temp-stk-size (p) − length (p-temp-stk (p))), p-temp-stk (p)),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-push-temp-stk-index-okp (ins, p) = ((length (p-temp-stk (p)) < p-max-temp-stk-size (p))

∧ (cadr (ins) < length (p-temp-stk (p))))

Definition: p-push-temp-stk-index-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat, (length (p-temp-stk (p)) − cadr (ins)) − 1),

p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-jump-if-temp-stk-full-okp (ins, p) = t

Definition: p-jump-if-temp-stk-full-step (ins, p) = p-state (if length (p-temp-stk (p)) = p-max-temp-stk-size (p)

then pc (cadr (ins), p-current-program (p)) else add1-p-pc (p) endif, p-ctrl-stk (p), p-temp-stk (p), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-jump-if-temp-stk-empty-okp (ins, p) = t

Definition: p-jump-if-temp-stk-empty-step (ins, p) = p-state (if length (p-temp-stk (p)) ≃ 0

then pc (cadr (ins), p-current-program (p)) else add1-p-pc (p) endif, p-ctrl-stk (p), p-temp-stk (p), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-pop-okp (ins, p) = listp (p-temp-stk (p))

Definition: p-pop-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-pop*-okp (ins, p) = (length (p-temp-stk (p)) ≮ cadr (ins))

Definition: p-pop*-step (ins, p)

= p-state (add1-p-pc (p), p-ctrl-stk (p), popn (cadr (ins), p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-popn-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ (length (p-temp-stk (p)) ≮ (1 + untag (top (p-temp-stk (p))))))

Definition: p-popn-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), popn (untag (top (p-temp-stk (p))), pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-pop-local-okp (ins, p) = listp (p-temp-stk (p))

Definition: p-pop-local-step (ins, p) = p-state (add1-p-pc (p),

set-local-var-value (top (p-temp-stk (p)), cadr (ins), p-ctrl-stk (p)),

pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-pop-global-okp (ins, p) = listp (p-temp-stk (p))

Definition: p-pop-global-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p),

pop (p-temp-stk (p)), p-prog-segment (p), deposit (top (p-temp-stk (p)),

tag ('addr, cons (cadr (ins), 0)), p-data-segment (p)),

p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

          'run)

Definition: p-pop-locn-okp (ins, p) = (p-objectp-type ('nat, local-var-value (cadr (ins), p-ctrl-stk (p)), p)

∧ (untag (local-var-value (cadr (ins), p-ctrl-stk (p))) < length (bindings (top (p-ctrl-stk (p)))))

∧ listp (p-temp-stk (p)))

Definition: put-value-indirect (val, n, lst) = if listp (lst)

then if n ≃ 0 then cons (cons (caar (lst), val), cdr (lst))

else cons (car (lst), put-value-indirect (val, n − 1, cdr (lst))) endif else lst endif

Definition: set-local-var-indirect (val, index, ctrl-stk) = push (p-frame (put-value-indirect (val, index, bindings (top (ctrl-stk))),

ret-pc (top (ctrl-stk))), pop (ctrl-stk))

Definition: p-pop-locn-step (ins, p) = p-state (add1-p-pc (p),

set-local-var-indirect (top (p-temp-stk (p)),

untag (local-var-value (cadr (ins),

p-ctrl-stk (p))),

p-ctrl-stk (p)),

p-max-temp-stk-size (p),

p-word-size (p),

          'run)

pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), Definition: p-pop-call-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('subr, top (p-temp-stk (p)), p) ∧ p-call-okp (list ('call, untag (top (p-temp-stk (p)))),

p-state (p-pc (p), p-ctrl-stk (p), pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

                        'run)))

Definition: p-pop-call-step (ins, p) = p-call-step (list ('call, untag (top (p-temp-stk (p)))),

p-state (p-pc (p), p-ctrl-stk (p), pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

                    'run))

Definition: p-fetch-temp-stk-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p)

∧ (untag (top (p-temp-stk (p))) < length (p-temp-stk (p))))

Definition: p-fetch-temp-stk-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p),

push (rget (untag (top (p-temp-stk (p))), p-temp-stk (p)),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-deposit-temp-stk-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ (untag (top (p-temp-stk (p)))

< length (pop (pop (p-temp-stk (p))))))

Definition: p-deposit-temp-stk-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), rput (top1 (p-temp-stk (p)),

untag (top (p-temp-stk (p))), pop (pop (p-temp-stk (p)))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-jump-okp (ins, p) = t

Definition: p-jump-step (ins, p) = p-state (pc (cadr (ins), p-current-program (p)),

p-ctrl-stk (p), p-temp-stk (p), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-jump-case-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ (untag (top (p-temp-stk (p))) < length (cdr (ins))))

Definition: p-jump-case-step (ins, p) = p-state (pc (get (untag (top (p-temp-stk (p))), cdr (ins)),

p-current-program (p)), p-ctrl-stk (p), pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-pushj-okp (ins, p) = (length (p-temp-stk (p)) < p-max-temp-stk-size (p))

Definition: p-pushj-step (ins, p) = p-state (pc (cadr (ins), p-current-program (p)),

p-ctrl-stk (p), push (add1-p-pc (p), p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-popj-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('pc, top (p-temp-stk (p)), p) ∧ (area-name (top (p-temp-stk (p))) = area-name (p-pc (p))))

Definition: p-popj-step (ins, p) = p-state (top (p-temp-stk (p)),

p-ctrl-stk (p), pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), Definition: p-set-local-okp (ins, p) = listp (p-temp-stk (p))

Definition: p-set-local-step (ins, p) = p-state (add1-p-pc (p),

set-local-var-value (top (p-temp-stk (p)), cadr (ins), p-ctrl-stk (p)),

p-temp-stk (p), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-set-global-okp (ins, p) = listp (p-temp-stk (p))

Definition: p-set-global-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), p-temp-stk (p), p-prog-segment (p), deposit (top (p-temp-stk (p)),

tag ('addr, cons (cadr (ins), 0)), p-data-segment (p)),

p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-test-and-jump-okp (ins, type, test, p) = (listp (p-temp-stk (p)) ∧ p-objectp-type (type, top (p-temp-stk (p)), p))

Definition: p-test-and-jump-step (test, lab, p) = if test

then p-state (pc (lab, p-current-program (p)), p-ctrl-stk (p), pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

               'run)

else p-state (add1-p-pc (p), p-ctrl-stk (p), pop (p-temp-stk (p)), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), 'run) endif

Definition: p-test-nat-and-jump-okp (ins, p) = p-test-and-jump-okp (ins,

                      'nat,

p-test-natp (cadr (ins), untag (top (p-temp-stk (p)))), p)

Definition: p-test-nat-and-jump-step (ins, p) = p-test-and-jump-step (p-test-natp (cadr (ins), untag (top (p-temp-stk (p)))),

caddr (ins), p)

Definition: p-test-int-and-jump-okp (ins, p) = p-test-and-jump-okp (ins,

                      'int,

p-test-intp (cadr (ins), untag (top (p-temp-stk (p)))), p)

Definition: p-test-int-and-jump-step (ins, p) = p-test-and-jump-step (p-test-intp (cadr (ins), untag (top (p-temp-stk (p)))),

caddr (ins), p)

Definition: p-test-bool-and-jump-okp (ins, p)

= p-test-and-jump-okp (ins,

                      'bool,

p-test-boolp (cadr (ins), untag (top (p-temp-stk (p)))), p)

Definition: p-test-bool-and-jump-step (ins, p) = p-test-and-jump-step (p-test-boolp (cadr (ins), untag (top (p-temp-stk (p)))),

caddr (ins), p)

Definition: p-test-bitv-and-jump-okp (ins, p) = p-test-and-jump-okp (ins,

                      'bitv,

p-test-bitvp (cadr (ins), untag (top (p-temp-stk (p)))), p)

Definition: p-test-bitv-and-jump-step (ins, p) = p-test-and-jump-step (p-test-bitvp (cadr (ins), untag (top (p-temp-stk (p)))),

caddr (ins), p)

Definition: p-no-op-okp (ins, p) = t

Definition: p-no-op-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), p-temp-stk (p), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

          'run)

Definition: p-add-addr-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p)))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ p-objectp-type ('addr, top1 (p-temp-stk (p)), p) ∧ p-objectp-type ('addr, add-addr (top1 (p-temp-stk (p)),

untag (top (p-temp-stk (p)))),

p))

Definition: p-add-addr-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (add-addr (top1 (p-temp-stk (p)), untag (top (p-temp-stk (p)))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-sub-addr-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ p-objectp-type ('addr, top1 (p-temp-stk (p)), p) ∧ (offset (top1 (p-temp-stk (p))) ≮ untag (top (p-temp-stk (p)))))

Definition: p-sub-addr-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (sub-addr (top1 (p-temp-stk (p)), untag (top (p-temp-stk (p)))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-eq-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ (type (top (p-temp-stk (p))) = type (top1 (p-temp-stk (p)))))

Definition: p-eq-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (bool (untag (top1 (p-temp-stk (p)))

= untag (top (p-temp-stk (p)))), pop (pop (p-temp-stk (p)))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-lt-addr-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('addr, top (p-temp-stk (p)), p) ∧ p-objectp-type ('addr, top1 (p-temp-stk (p)), p) ∧ (area-name (top (p-temp-stk (p)))

= area-name (top1 (p-temp-stk (p)))))

Definition: p-lt-addr-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (bool (offset (top1 (p-temp-stk (p)))

< offset (top (p-temp-stk (p)))), pop (pop (p-temp-stk (p)))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-fetch-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('addr, top (p-temp-stk (p)), p))

Definition: p-fetch-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (fetch (top (p-temp-stk (p)), p-data-segment (p)),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-deposit-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('addr, top (p-temp-stk (p)), p))

Definition: p-deposit-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), pop (pop (p-temp-stk (p))), p-prog-segment (p), deposit (top1 (p-temp-stk (p)),

top (p-temp-stk (p)), p-data-segment (p)),

p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-add-int-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ p-objectp-type ('int, top1 (p-temp-stk (p)), p) ∧ small-integerp (iplus (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p)))), p-word-size (p)))

Definition: p-add-int-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('int,

iplus (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-add-int-with-carry-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ listp (pop (pop (p-temp-stk (p)))) ∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ p-objectp-type ('int, top1 (p-temp-stk (p)), p) ∧ p-objectp-type ('bool, top2 (p-temp-stk (p)), p))

Definition: p-add-int-with-carry-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('int,

fix-small-integer (iplus (bool-to-nat (untag (top2 (p-temp-stk (p)))),

iplus (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

p-word-size (p))),

push (bool (¬ small-integerp (iplus (bool-to-nat (untag (top2 (p-temp-stk (p)))),

iplus (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

p-word-size (p))),

pop (pop (pop (p-temp-stk (p)))))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-add1-int-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ small-integerp (iplus (1, untag (top (p-temp-stk (p)))),

p-word-size (p)))

Definition: p-add1-int-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('int, iplus (1, untag (top (p-temp-stk (p))))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-sub-int-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ p-objectp-type ('int, top1 (p-temp-stk (p)), p) ∧ small-integerp (idifference (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p)))),

p-word-size (p)))

Definition: p-sub-int-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('int,

idifference (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-sub-int-with-carry-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ listp (pop (pop (p-temp-stk (p)))) ∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ p-objectp-type ('int, top1 (p-temp-stk (p)), p)

∧ p-objectp-type ('bool, top2 (p-temp-stk (p)), p))

Definition: p-sub-int-with-carry-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('int,

fix-small-integer (idifference (untag (top1 (p-temp-stk (p))),

iplus (untag (top (p-temp-stk (p))),

bool-to-nat (untag (top2 (p-temp-stk (p)))))),

p-word-size (p))),

push (bool (¬ small-integerp (idifference (untag (top1 (p-temp-stk (p))),

iplus (untag (top (p-temp-stk (p))),

bool-to-nat (untag (top2 (p-temp-stk (p)))))),

p-word-size (p))),

pop (pop (pop (p-temp-stk (p)))))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-sub1-int-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ small-integerp (idifference (untag (top (p-temp-stk (p))), 1),

p-word-size (p)))

Definition: p-sub1-int-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('int, idifference (untag (top (p-temp-stk (p))), 1)),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-neg-int-okp (ins, p)

= (listp (p-temp-stk (p)) ∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ small-integerp (inegate (untag (top (p-temp-stk (p)))),

p-word-size (p)))

Definition: p-neg-int-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('int, inegate (untag (top (p-temp-stk (p))))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-lt-int-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ p-objectp-type ('int, top1 (p-temp-stk (p)), p))

Definition: p-lt-int-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (bool (ilessp (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-int-to-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('int, top (p-temp-stk (p)), p) ∧ (¬ negativep (untag (top (p-temp-stk (p))))))

Definition: p-int-to-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat, untag (top (p-temp-stk (p)))), pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-add-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ p-objectp-type ('nat, top1 (p-temp-stk (p)), p) ∧ small-naturalp (untag (top1 (p-temp-stk (p)))

+ untag (top (p-temp-stk (p))), p-word-size (p)))

Definition: p-add-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat,

untag (top1 (p-temp-stk (p))) + untag (top (p-temp-stk (p)))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-add-nat-with-carry-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ listp (pop (pop (p-temp-stk (p)))) ∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ p-objectp-type ('nat, top1 (p-temp-stk (p)), p) ∧ p-objectp-type ('bool, top2 (p-temp-stk (p)), p))

Definition: p-add-nat-with-carry-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat,

fix-small-natural (bool-to-nat (untag (top2 (p-temp-stk (p)))) + untag (top1 (p-temp-stk (p))) + untag (top (p-temp-stk (p))), p-word-size (p))),

push (bool (¬ small-naturalp (bool-to-nat (untag (top2 (p-temp-stk (p)))) + untag (top1 (p-temp-stk (p))) + untag (top (p-temp-stk (p))), p-word-size (p))),

pop (pop (pop (p-temp-stk (p)))))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-add1-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ small-naturalp (1 + untag (top (p-temp-stk (p))), p-word-size (p)))

Definition: p-add1-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat, 1 + untag (top (p-temp-stk (p)))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-sub-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('nat, top (p-temp-stk (p)), p)

∧ p-objectp-type ('nat, top1 (p-temp-stk (p)), p) ∧ (untag (top1 (p-temp-stk (p))) ≮ untag (top (p-temp-stk (p)))))

Definition: p-sub-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat,

untag (top1 (p-temp-stk (p))) − untag (top (p-temp-stk (p)))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-sub-nat-with-carry-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ listp (pop (pop (p-temp-stk (p)))) ∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ p-objectp-type ('nat, top1 (p-temp-stk (p)), p) ∧ p-objectp-type ('bool, top2 (p-temp-stk (p)), p))

Definition: p-sub-nat-with-carry-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat,

if untag (top1 (p-temp-stk (p)))

< (untag (top (p-temp-stk (p)))

+ bool-to-nat (untag (top2 (p-temp-stk (p))))) then exp (2, p-word-size (p))

− ((untag (top (p-temp-stk (p))) + bool-to-nat (untag (top2 (p-temp-stk (p))))) − untag (top1 (p-temp-stk (p))))

else untag (top1 (p-temp-stk (p)))

− (untag (top (p-temp-stk (p)))

+ bool-to-nat (untag (top2 (p-temp-stk (p))))) endif),

push (bool (untag (top1 (p-temp-stk (p)))

< (untag (top (p-temp-stk (p))) + bool-to-nat (untag (top2 (p-temp-stk (p)))))),

pop (pop (pop (p-temp-stk (p)))))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-sub1-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ (untag (top (p-temp-stk (p))) ≄ 0))

Definition: p-sub1-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat, untag (top (p-temp-stk (p))) − 1),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-lt-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ p-objectp-type ('nat, top1 (p-temp-stk (p)), p))

Definition: p-lt-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (bool (untag (top1 (p-temp-stk (p)))

< untag (top (p-temp-stk (p)))), pop (pop (p-temp-stk (p)))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-mult2-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ small-naturalp (2 ∗ untag (top (p-temp-stk (p))),

p-word-size (p)))

Definition: p-mult2-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat, 2 ∗ untag (top (p-temp-stk (p)))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-mult2-nat-with-carry-out-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ (length (p-temp-stk (p)) < p-max-temp-stk-size (p)))

Definition: p-mult2-nat-with-carry-out-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat,

fix-small-natural (2 ∗ untag (top (p-temp-stk (p))), p-word-size (p))), push (bool (¬ small-naturalp (2 ∗ untag (top (p-temp-stk (p))),

p-word-size (p))),

pop (p-temp-stk (p)))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-div2-nat-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('nat, top (p-temp-stk (p)), p) ∧ (length (p-temp-stk (p)) < p-max-temp-stk-size (p)))

Definition: p-div2-nat-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('nat, untag (top (p-temp-stk (p))) mod 2),

push (tag ('nat, untag (top (p-temp-stk (p))) ÷ 2),

pop (p-temp-stk (p)))),

p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-or-bitv-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('bitv, top (p-temp-stk (p)), p) ∧ p-objectp-type ('bitv, top1 (p-temp-stk (p)), p))

Definition: p-or-bitv-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bitv,

or-bitv (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-and-bitv-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('bitv, top (p-temp-stk (p)), p) ∧ p-objectp-type ('bitv, top1 (p-temp-stk (p)), p))

Definition: p-and-bitv-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bitv,

and-bitv (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-not-bitv-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('bitv, top (p-temp-stk (p)), p))

Definition: p-not-bitv-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bitv, not-bitv (untag (top (p-temp-stk (p))))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-xor-bitv-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('bitv, top (p-temp-stk (p)), p) ∧ p-objectp-type ('bitv, top1 (p-temp-stk (p)), p))

Definition: p-xor-bitv-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bitv,

xor-bitv (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-rsh-bitv-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('bitv, top (p-temp-stk (p)), p))

Definition: p-rsh-bitv-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bitv, rsh-bitv (untag (top (p-temp-stk (p))))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-lsh-bitv-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('bitv, top (p-temp-stk (p)), p))

Definition: p-lsh-bitv-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bitv, lsh-bitv (untag (top (p-temp-stk (p))))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-or-bool-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('bool, top (p-temp-stk (p)), p) ∧ p-objectp-type ('bool, top1 (p-temp-stk (p)), p))

Definition: p-or-bool-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bool,

or-bool (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-and-bool-okp (ins, p) = (listp (p-temp-stk (p))

∧ listp (pop (p-temp-stk (p))) ∧ p-objectp-type ('bool, top (p-temp-stk (p)), p) ∧ p-objectp-type ('bool, top1 (p-temp-stk (p)), p))

Definition: p-and-bool-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bool,

and-bool (untag (top1 (p-temp-stk (p))),

untag (top (p-temp-stk (p))))),

pop (pop (p-temp-stk (p)))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), Definition: p-not-bool-okp (ins, p) = (listp (p-temp-stk (p))

∧ p-objectp-type ('bool, top (p-temp-stk (p)), p))

Definition: p-not-bool-step (ins, p) = p-state (add1-p-pc (p),

p-ctrl-stk (p), push (tag ('bool, not-bool (untag (top (p-temp-stk (p))))),

pop (p-temp-stk (p))), p-prog-segment (p), p-data-segment (p), p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p),

'run)

Definition: p-ins-okp (ins, p) = case on car (ins):

case = call then p-call-okp (ins, p) case = ret then p-ret-okp (ins, p) case = locn then p-locn-okp (ins, p) case = push-constant then p-push-constant-okp (ins, p) case = push-local then p-push-local-okp (ins, p) case = push-global then p-push-global-okp (ins, p) case = push-ctrl-stk-free-size then p-push-ctrl-stk-free-size-okp (ins, p) case = push-temp-stk-free-size then p-push-temp-stk-free-size-okp (ins, p) case = push-temp-stk-index then p-push-temp-stk-index-okp (ins, p) case = jump-if-temp-stk-full then p-jump-if-temp-stk-full-okp (ins, p) case = jump-if-temp-stk-empty then p-jump-if-temp-stk-empty-okp (ins, p) case = pop then p-pop-okp (ins, p) case = pop* then p-pop*-okp (ins, p) case = popn then p-popn-okp (ins, p) case = pop-local then p-pop-local-okp (ins, p) case = pop-global then p-pop-global-okp (ins, p) case = pop-locn then p-pop-locn-okp (ins, p) case = pop-call then p-pop-call-okp (ins, p) case = fetch-temp-stk then p-fetch-temp-stk-okp (ins, p) case = deposit-temp-stk then p-deposit-temp-stk-okp (ins, p) case = jump then p-jump-okp (ins, p) case = jump-case then p-jump-case-okp (ins, p) case = pushj then p-pushj-okp (ins, p) case = popj then p-popj-okp (ins, p) case = set-local then p-set-local-okp (ins, p) case = set-global then p-set-global-okp (ins, p) case = test-nat-and-jump then p-test-nat-and-jump-okp (ins, p) case = test-int-and-jump then p-test-int-and-jump-okp (ins, p) case = test-bool-and-jump then p-test-bool-and-jump-okp (ins, p) case = test-bitv-and-jump then p-test-bitv-and-jump-okp (ins, p) case = no-op then p-no-op-okp (ins, p) case = add-addr then p-add-addr-okp (ins, p) case = sub-addr then p-sub-addr-okp (ins, p) case = eq then p-eq-okp (ins, p) case = lt-addr then p-lt-addr-okp (ins, p) case = fetch then p-fetch-okp (ins, p) case = deposit then p-deposit-okp (ins, p) case = add-int then p-add-int-okp (ins, p) case = add-int-with-carry then p-add-int-with-carry-okp (ins, p) case = add1-int then p-add1-int-okp (ins, p) case = sub-int then p-sub-int-okp (ins, p) case = sub-int-with-carry then p-sub-int-with-carry-okp (ins, p) case = sub1-int then p-sub1-int-okp (ins, p) case = neg-int then p-neg-int-okp (ins, p) case = lt-int then p-lt-int-okp (ins, p) case = int-to-nat then p-int-to-nat-okp (ins, p) case = add-nat then p-add-nat-okp (ins, p) case = add-nat-with-carry then p-add-nat-with-carry-okp (ins, p) case = add1-nat then p-add1-nat-okp (ins, p) case = sub-nat then p-sub-nat-okp (ins, p) case = sub-nat-with-carry then p-sub-nat-with-carry-okp (ins, p) case = sub1-nat then p-sub1-nat-okp (ins, p) case = lt-nat then p-lt-nat-okp (ins, p) case = mult2-nat then p-mult2-nat-okp (ins, p) case = mult2-nat-with-carry-out then p-mult2-nat-with-carry-out-okp (ins, p) case = div2-nat then p-div2-nat-okp (ins, p) case = or-bitv then p-or-bitv-okp (ins, p) case = and-bitv then p-and-bitv-okp (ins, p) case = not-bitv then p-not-bitv-okp (ins, p) case = xor-bitv then p-xor-bitv-okp (ins, p) case = rsh-bitv then p-rsh-bitv-okp (ins, p) case = lsh-bitv then p-lsh-bitv-okp (ins, p) case = or-bool then p-or-bool-okp (ins, p) case = and-bool then p-and-bool-okp (ins, p) case = not-bool then p-not-bool-okp (ins, p) otherwise f endcase

Definition: p-ins-step (ins, p) = case on car (ins):

case = call then p-call-step (ins, p) case = ret then p-ret-step (ins, p) case = locn then p-locn-step (ins, p) case = push-constant then p-push-constant-step (ins, p) case = push-local then p-push-local-step (ins, p) case = push-global then p-push-global-step (ins, p) case = push-ctrl-stk-free-size then p-push-ctrl-stk-free-size-step (ins, p) case = push-temp-stk-free-size then p-push-temp-stk-free-size-step (ins, p) case = push-temp-stk-index then p-push-temp-stk-index-step (ins, p) case = jump-if-temp-stk-full then p-jump-if-temp-stk-full-step (ins, p) case = jump-if-temp-stk-empty then p-jump-if-temp-stk-empty-step (ins, p) case = pop then p-pop-step (ins, p) case = pop* then p-pop*-step (ins, p) case = popn then p-popn-step (ins, p) case = pop-local then p-pop-local-step (ins, p) case = pop-global then p-pop-global-step (ins, p) case = pop-locn then p-pop-locn-step (ins, p) case = pop-call then p-pop-call-step (ins, p) case = fetch-temp-stk then p-fetch-temp-stk-step (ins, p) case = deposit-temp-stk then p-deposit-temp-stk-step (ins, p) case = jump then p-jump-step (ins, p) case = jump-case then p-jump-case-step (ins, p) case = pushj then p-pushj-step (ins, p) case = popj then p-popj-step (ins, p) case = set-local then p-set-local-step (ins, p) case = set-global then p-set-global-step (ins, p) case = test-nat-and-jump then p-test-nat-and-jump-step (ins, p) case = test-int-and-jump then p-test-int-and-jump-step (ins, p) case = test-bool-and-jump then p-test-bool-and-jump-step (ins, p) case = test-bitv-and-jump then p-test-bitv-and-jump-step (ins, p) case = no-op then p-no-op-step (ins, p) case = add-addr then p-add-addr-step (ins, p) case = sub-addr then p-sub-addr-step (ins, p) case = eq then p-eq-step (ins, p) case = lt-addr then p-lt-addr-step (ins, p) case = fetch then p-fetch-step (ins, p) case = deposit then p-deposit-step (ins, p) case = add-int then p-add-int-step (ins, p) case = add-int-with-carry then p-add-int-with-carry-step (ins, p) case = add1-int then p-add1-int-step (ins, p) case = sub-int then p-sub-int-step (ins, p) case = sub-int-with-carry then p-sub-int-with-carry-step (ins, p) case = sub1-int then p-sub1-int-step (ins, p) case = neg-int then p-neg-int-step (ins, p) case = lt-int then p-lt-int-step (ins, p) case = int-to-nat then p-int-to-nat-step (ins, p) case = add-nat then p-add-nat-step (ins, p) case = add-nat-with-carry then p-add-nat-with-carry-step (ins, p) case = add1-nat then p-add1-nat-step (ins, p) case = sub-nat then p-sub-nat-step (ins, p) case = sub-nat-with-carry then p-sub-nat-with-carry-step (ins, p) case = sub1-nat then p-sub1-nat-step (ins, p) case = lt-nat then p-lt-nat-step (ins, p) case = mult2-nat then p-mult2-nat-step (ins, p) case = mult2-nat-with-carry-out then p-mult2-nat-with-carry-out-step (ins, p) case = div2-nat then p-div2-nat-step (ins, p) case = or-bitv then p-or-bitv-step (ins, p) case = and-bitv then p-and-bitv-step (ins, p) case = not-bitv then p-not-bitv-step (ins, p) case = xor-bitv then p-xor-bitv-step (ins, p) case = rsh-bitv then p-rsh-bitv-step (ins, p) case = lsh-bitv then p-lsh-bitv-step (ins, p) case = or-bool then p-or-bool-step (ins, p) case = and-bool then p-and-bool-step (ins, p) case = not-bool then p-not-bool-step (ins, p) otherwise p-halt (p, 'run) endcase

Definition: p-step1 (ins, p) = if p-ins-okp (ins, p) then p-ins-step (ins, p)

else p-halt (p, x-y-error-msg ('p, car (ins))) endif

Definition: p-step (p) = if p-psw (p) = 'run then p-step1 (p-current-instruction (p), p)

else p endif

Definition: p (p, n) = if n ≃ 0 then p

else p (p-step (p), n − 1) endif

Definition: proper-p-call-instructionp (ins, name, p) = ((length (ins) = 2) ∧ definedp (cadr (ins), p-prog-segment (p)))

Definition: proper-p-ret-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-locn-instructionp (ins, name, p) = ((length (ins) = 2)

∧ (cadr (ins) ∈ local-vars (definition (name, p-prog-segment (p)))))

Definition: proper-p-push-constant-instructionp (ins, name, p) = ((length (ins) = 2)

∧ (p-objectp (cadr (ins), p) ∨ (cadr (ins) = 'pc) ∨ find-labelp (cadr (ins),

program-body (definition (name, p-prog-segment (p))))))

Definition: proper-p-push-local-instructionp (ins, name, p) = ((length (ins) = 2)

∧ (cadr (ins) ∈ local-vars (definition (name, p-prog-segment (p)))))

Definition: proper-p-push-global-instructionp (ins, name, p) = ((length (ins) = 2) ∧ definedp (cadr (ins), p-data-segment (p)))

Definition: proper-p-push-ctrl-stk-free-size-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-push-temp-stk-free-size-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-push-temp-stk-index-instructionp (ins, name, p) = ((length (ins) = 2) ∧ small-naturalp (cadr (ins), p-word-size (p)))

Definition: proper-p-jump-if-temp-stk-full-instructionp (ins, name, p) = ((length (ins) = 2)

∧ find-labelp (cadr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-jump-if-temp-stk-empty-instructionp (ins, name, p) = ((length (ins) = 2)

∧ find-labelp (cadr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-pop-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-pop*-instructionp (ins, name, p) = ((length (ins) = 2) ∧ small-naturalp (cadr (ins), p-word-size (p)))

Definition: proper-p-popn-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-pop-local-instructionp (ins, name, p) = ((length (ins) = 2)

∧ (cadr (ins) ∈ local-vars (definition (name, p-prog-segment (p)))))

Definition: proper-p-pop-global-instructionp (ins, name, p) = ((length (ins) = 2) ∧ definedp (cadr (ins), p-data-segment (p)))

Definition: proper-p-pop-locn-instructionp (ins, name, p) = ((length (ins) = 2)

∧ (cadr (ins) ∈ local-vars (definition (name, p-prog-segment (p)))))

Definition: proper-p-pop-call-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-fetch-temp-stk-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-deposit-temp-stk-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-jump-instructionp (ins, name, p) = ((length (ins) = 2)

∧ find-labelp (cadr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-jump-case-instructionp (ins, name, p) = (listp (cdr (ins))

∧ all-find-labelp (cdr (ins),

program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-pushj-instructionp (ins, name, p) = ((length (ins) = 2)

∧ find-labelp (cadr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-popj-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-set-local-instructionp (ins, name, p) = ((length (ins) = 2)

∧ (cadr (ins) ∈ local-vars (definition (name, p-prog-segment (p)))))

Definition: proper-p-set-global-instructionp (ins, name, p) = ((length (ins) = 2) ∧ definedp (cadr (ins), p-data-segment (p)))

Definition: proper-p-test-nat-and-jump-instructionp (ins, name, p) = ((length (ins) = 3)

∧ find-labelp (caddr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-test-int-and-jump-instructionp (ins, name, p) = ((length (ins) = 3)

∧ find-labelp (caddr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-test-bool-and-jump-instructionp (ins, name, p) = ((length (ins) = 3)

∧ find-labelp (caddr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-test-bitv-and-jump-instructionp (ins, name, p) = ((length (ins) = 3)

∧ find-labelp (caddr (ins), program-body (definition (name, p-prog-segment (p)))))

Definition: proper-p-no-op-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-add-addr-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-sub-addr-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-eq-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-lt-addr-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-fetch-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-deposit-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-add-int-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-add-int-with-carry-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-add1-int-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-sub-int-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-sub-int-with-carry-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-sub1-int-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-neg-int-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-lt-int-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-int-to-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-add-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-add-nat-with-carry-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-add1-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-sub-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-sub-nat-with-carry-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-sub1-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-lt-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-mult2-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-mult2-nat-with-carry-out-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-div2-nat-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-or-bitv-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-and-bitv-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-not-bitv-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-xor-bitv-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-rsh-bitv-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-lsh-bitv-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-or-bool-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-and-bool-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-not-bool-instructionp (ins, name, p) = (length (ins) = 1)

Definition: proper-p-instructionp (ins, name, p) = (properp (ins)

∧ case on car (ins): case = call then proper-p-call-instructionp (ins, name, p) case = ret then proper-p-ret-instructionp (ins, name, p) case = locn then proper-p-locn-instructionp (ins, name, p) case = push-constant then proper-p-push-constant-instructionp (ins, name, p) case = push-local then proper-p-push-local-instructionp (ins, name, p) case = push-global then proper-p-push-global-instructionp (ins, name, p) case = push-ctrl-stk-free-size then proper-p-push-ctrl-stk-free-size-instructionp (ins,

name, p)

case = push-temp-stk-free-size

then proper-p-push-temp-stk-free-size-instructionp (ins, name, p)

case = push-temp-stk-index

then proper-p-push-temp-stk-index-instructionp (ins, name, p) case = jump-if-temp-stk-full then proper-p-jump-if-temp-stk-full-instructionp (ins, name, p) case = jump-if-temp-stk-empty then proper-p-jump-if-temp-stk-empty-instructionp (ins, name, p)

case = pop then proper-p-pop-instructionp (ins, name, p) case = pop* then proper-p-pop*-instructionp (ins, name, p) case = popn then proper-p-popn-instructionp (ins, name, p) case = pop-local then proper-p-pop-local-instructionp (ins, name, p) case = pop-global then proper-p-pop-global-instructionp (ins, name, p) case = pop-locn then proper-p-pop-locn-instructionp (ins, name, p) case = pop-call then proper-p-pop-call-instructionp (ins, name, p) case = fetch-temp-stk then proper-p-fetch-temp-stk-instructionp (ins, name, p) case = deposit-temp-stk then proper-p-deposit-temp-stk-instructionp (ins, name, p) case = jump then proper-p-jump-instructionp (ins, name, p) case = jump-case then proper-p-jump-case-instructionp (ins, name, p) case = pushj then proper-p-pushj-instructionp (ins, name, p) case = popj then proper-p-popj-instructionp (ins, name, p) case = set-local then proper-p-set-local-instructionp (ins, name, p) case = set-global then proper-p-set-global-instructionp (ins, name, p) case = test-nat-and-jump then proper-p-test-nat-and-jump-instructionp (ins, name, p) case = test-int-and-jump then proper-p-test-int-and-jump-instructionp (ins, name, p) case = test-bool-and-jump then proper-p-test-bool-and-jump-instructionp (ins, name, p) case = test-bitv-and-jump then proper-p-test-bitv-and-jump-instructionp (ins, name, p) case = no-op then proper-p-no-op-instructionp (ins, name, p) case = add-addr then proper-p-add-addr-instructionp (ins, name, p) case = sub-addr then proper-p-sub-addr-instructionp (ins, name, p) case = eq then proper-p-eq-instructionp (ins, name, p) case = lt-addr then proper-p-lt-addr-instructionp (ins, name, p) case = fetch then proper-p-fetch-instructionp (ins, name, p) case = deposit then proper-p-deposit-instructionp (ins, name, p) case = add-int then proper-p-add-int-instructionp (ins, name, p) case = add-int-with-carry then proper-p-add-int-with-carry-instructionp (ins, name, p) case = add1-int then proper-p-add1-int-instructionp (ins, name, p) case = sub-int then proper-p-sub-int-instructionp (ins, name, p) case = sub-int-with-carry then proper-p-sub-int-with-carry-instructionp (ins, name, p) case = sub1-int then proper-p-sub1-int-instructionp (ins, name, p) case = neg-int then proper-p-neg-int-instructionp (ins, name, p) case = lt-int then proper-p-lt-int-instructionp (ins, name, p) case = int-to-nat then proper-p-int-to-nat-instructionp (ins, name, p) case = add-nat then proper-p-add-nat-instructionp (ins, name, p) case = add-nat-with-carry then proper-p-add-nat-with-carry-instructionp (ins, name, p) case = add1-nat then proper-p-add1-nat-instructionp (ins, name, p) case = sub-nat then proper-p-sub-nat-instructionp (ins, name, p) case = sub-nat-with-carry then proper-p-sub-nat-with-carry-instructionp (ins, name, p) case = sub1-nat then proper-p-sub1-nat-instructionp (ins, name, p) case = lt-nat then proper-p-lt-nat-instructionp (ins, name, p) case = mult2-nat then proper-p-mult2-nat-instructionp (ins, name, p) case = mult2-nat-with-carry-out then proper-p-mult2-nat-with-carry-out-instructionp (ins,

name, p)

case = div2-nat then proper-p-div2-nat-instructionp (ins, name, p) case = or-bitv then proper-p-or-bitv-instructionp (ins, name, p) case = and-bitv then proper-p-and-bitv-instructionp (ins, name, p) case = not-bitv then proper-p-not-bitv-instructionp (ins, name, p) case = xor-bitv then proper-p-xor-bitv-instructionp (ins, name, p) case = rsh-bitv then proper-p-rsh-bitv-instructionp (ins, name, p) case = lsh-bitv then proper-p-lsh-bitv-instructionp (ins, name, p) case = or-bool then proper-p-or-bool-instructionp (ins, name, p) case = and-bool then proper-p-and-bool-instructionp (ins, name, p) case = not-bool then proper-p-not-bool-instructionp (ins, name, p) otherwise f endcase)

Definition: proper-labeled-p-instructionsp (lst, name, p) = if lst ≃ nil then lst = nil

else legal-labelp (car (lst)) ∧ proper-p-instructionp (unlabel (car (lst)), name, p) ∧ proper-labeled-p-instructionsp (cdr (lst), name, p) endif

Definition: fall-off-proofp (lst) = (car (unlabel (get (length (lst) − 1, lst)))

∈ '(ret jump jump-case popj))

Definition: proper-p-program-bodyp (lst, name, p) = (listp (lst)

∧ proper-labeled-p-instructionsp (lst, name, p) ∧ fall-off-proofp (lst))

Definition: all-litatoms (lst) = if lst ≃ nil then lst = nil

else litatom (car (lst)) ∧ all-litatoms (cdr (lst)) endif

Definition: proper-p-temp-var-dclsp (temp-var-dcls, p) = if temp-var-dcls ≃ nil then t

else litatom (caar (temp-var-dcls))

∧ p-objectp (cadar (temp-var-dcls), p)

∧ proper-p-temp-var-dclsp (cdr (temp-var-dcls), p) endif

Definition: proper-p-programp (prog, p) = (litatom (name (prog))

∧ all-litatoms (formal-vars (prog))

∧ proper-p-temp-var-dclsp (temp-var-dcls (prog), p)

∧ proper-p-program-bodyp (program-body (prog), name (prog), p))

Definition: proper-p-prog-segmentp (segment, p) = if segment ≃ nil then segment = nil

else proper-p-programp (car (segment), p)

∧ proper-p-prog-segmentp (cdr (segment), p) endif

Definition: proper-p-alistp (alist, p) = if alist ≃ nil then alist = nil

else listp (car (alist))

∧ litatom (caar (alist)) ∧ p-objectp (cdar (alist), p) ∧ proper-p-alistp (cdr (alist), p) endif

Definition: proper-p-framep (frame, name, p) = (listp (frame)

∧ listp (cdr (frame)) ∧ (cddr (frame) = nil) ∧ proper-p-alistp (bindings (frame), p) ∧ (strip-cars (bindings (frame))

= local-vars (definition (name, p-prog-segment (p)))) ∧ p-objectp-type ('pc, ret-pc (frame), p))

Definition: proper-p-ctrl-stkp (ctrl-stk, name, p) = if ctrl-stk ≃ nil then ctrl-stk = nil else proper-p-framep (top (ctrl-stk), name, p)

∧ proper-p-ctrl-stkp (pop (ctrl-stk), area-name (ret-pc (top (ctrl-stk))),

p) endif

Definition: proper-p-temp-stkp (temp-stk, p) = if temp-stk ≃ nil then temp-stk = nil

else p-objectp (top (temp-stk), p)

∧ proper-p-temp-stkp (pop (temp-stk), p) endif

Definition: proper-p-area (area, p) = (litatom (car (area))

∧ listp (cdr (area)) ∧ all-p-objectps (cdr (area), p))

Definition: proper-p-data-segmentp (data-segment, p) = if data-segment ≃ nil then data-segment = nil

else proper-p-area (car (data-segment), p) ∧ (¬ definedp (caar (data-segment), cdr (data-segment))) ∧ proper-p-data-segmentp (cdr (data-segment), p) endif

Definition: proper-p-statep (p) = (p-statep (p)

∧ p-objectp-type ('pc, p-pc (p), p) ∧ listp (p-ctrl-stk (p)) ∧ proper-p-framep (top (p-ctrl-stk (p)), area-name (p-pc (p)), p) ∧ proper-p-ctrl-stkp (pop (p-ctrl-stk (p)),

area-name (ret-pc (top (p-ctrl-stk (p)))), p)

∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p))) ∧ proper-p-temp-stkp (p-temp-stk (p), p) ∧ (p-max-temp-stk-size (p) ≮ length (p-temp-stk (p))) ∧ proper-p-prog-segmentp (p-prog-segment (p), p) ∧ proper-p-data-segmentp (p-data-segment (p), p) ∧ (p-max-ctrl-stk-size (p) ∈ N) ∧ (p-max-temp-stk-size (p) ∈ N) ∧ (p-word-size (p) ∈ N) ∧ (p-max-ctrl-stk-size (p) < exp (2, p-word-size (p))) ∧ (p-max-temp-stk-size (p) < exp (2, p-word-size (p))) ∧ (0 < p-word-size (p)))

; Book: p-r.events.  In this section we prove that the p machine
; is implemented on the r machine.

Event: Disable unlabel. Event: Disable r-usr-data-typep. Event: Disable r-instructionp.

; I will disable type, tag and untag for sanity's sake,
; but prove the obvious relationships first.

Event: Enable type-tag. Event: Enable untag-tag. Theorem: equal-tags (tag (type, x) = tag (type, y)) = (x = y) Event: Enable cddr-tag. Event: Disable type. Event: Disable tag. Event: Disable untag.

; The function BOOLEANP is a killer because it
; causes everything to split.  I will disable it
; and prove what I need about it as necessary.

Event: Disable booleanp.

; Error messages are irrelevant as long as they are not 'run or 'halt.

Event: Enable not-equal-x-y-error-msg-run.

Event: Enable not-equal-x-y-error-msg-halt.

Event: Disable x-y-error-msg.

Event: Enable r-psw-r-halt.

Event: Disable r-halt.

; Now I arrange for r-objectp to open when we know the type:

Event: Enable r-objectp-opener.

Event: Disable r-objectp.

Event: Disable r-usr-data-typep.

; We repeat the same exercise for p-objectp:

Theorem: p-objectp-opener ((type (x) = 'nat) → (p-objectp (x, p)

= ((cddr (x) = nil)

∧ small-naturalp (untag (x), p-word-size (p)))))

∧ ((type (x) = 'int)

→ (p-objectp (x, p)

= ((cddr (x) = nil)

∧ small-integerp (untag (x), p-word-size (p)))))

∧ ((type (x) = 'bitv)

→ (p-objectp (x, p)

= ((cddr (x) = nil)

∧ bit-vectorp (untag (x), p-word-size (p)))))

∧ ((type (x) = 'bool)

→ (p-objectp (x, p)

= ((cddr (x) = nil) ∧ booleanp (untag (x)))))

∧ ((type (x) = 'addr) → (p-objectp (x, p)

= ((cddr (x) = nil)

∧ adpp (untag (x), p-data-segment (p)))))

∧ ((type (x) = 'pc)

→ (p-objectp (x, p)

= ((cddr (x) = nil)

∧ pcpp (untag (x), p-prog-segment (p)))))

∧ ((type (x) = 'subr)

→ (p-objectp (x, p)

= ((cddr (x) = nil)

∧ definedp (untag (x), p-prog-segment (p)))))

Event: Disable p-objectp. Event: Disable name. Event: Disable formal-vars. Event: Disable temp-var-dcls. Event: Disable program-body. Theorem: bindings-p-frame bindings (p-frame (alist, pc)) = alist Theorem: ret-pc-p-frame ret-pc (p-frame (alist, pc)) = pc Event: Disable bindings. Event: Disable ret-pc. Event: Disable p-frame. Event: Enable associativity-of-plus. Event: Enable commutativity-of-plus. Event: Enable plus-add1. Event: Enable commutativity2-of-plus.

; difference is used a lot in the stack pointer mappings and
; it is opened too often.  I want to control the expansion of
; difference carefully.

Event: Disable difference.

; The icompiler is involved in the characterization of loadablep
; but is actually irrelevant at this level.
; So we

Event: Disable icompile.

; to save the trouble of repeatedly considering expanding it.
; We need to get from (car (p-current-instruction p)) = 'no-op and
; (proper-p-statep p) the fact that
; (proper-p-no-op-instructionp (p-current-instruction p) name p).
; We will do it in two steps.  First we prove that proper-p-statep
; implies proper-p-instructionp for the current instruction.
; Then we'll arrange for proper-p-statep to expand and introduce
; the implied proper-p-instructionp too.

Event: Disable proper-p-instructionp.

Event: Disable legal-labelp.

Theorem: proper-labeled-p-instructionsp-implies-labelp-and-instructionp (proper-labeled-p-instructionsp (lst, name, p) ∧ (x ∈ lst)) → (legal-labelp (x) ∧ proper-p-instructionp (unlabel (x), name, p))

Theorem: proper-p-prog-segmentp-implies-proper-p-programp (proper-p-prog-segmentp (segment, p) ∧ (prog ∈ segment)) → proper-p-programp (prog, p)

Event: Enable member-assoc.

Event: Enable name-assoc.

Event: Enable member-get.

Theorem: proper-p-statep-implies-proper-p-instructionp (proper-p-prog-segmentp (p-prog-segment (p), p) ∧ definedp (car (untag (p-pc (p))), p-prog-segment (p)) ∧ (cdr (untag (p-pc (p)))

< length (program-body (assoc (car (untag (p-pc (p))),

p-prog-segment (p))))))

→ proper-p-instructionp (p-current-instruction (p), car (untag (p-pc (p))), p)

; Now I restructure proper-p-statep into two parts, those that
; have to do with arithmetic and those that do not.  The parts
; that do not are arithmetic, I confine to proper-p-statep1,
; which I keep closed and backchain into as needed.  The other
; parts I keep out in the open.  In addition, I throw in the
; proper-p-instructionp proved above, essentially forward
; chaining through the lemma.

Event: Disable p-loadablep.

Definition: proper-p-statep1 (p) = (p-statep (p)

∧ (type (p-pc (p)) = 'pc) ∧ listp (p-pc (p)) ∧ (cddr (p-pc (p)) = nil) ∧ listp (untag (p-pc (p))) ∧ definedp (car (untag (p-pc (p))), p-prog-segment (p)) ∧ listp (p-ctrl-stk (p)) ∧ listp (car (p-ctrl-stk (p))) ∧ listp (cdr (car (p-ctrl-stk (p)))) ∧ (cddr (car (p-ctrl-stk (p))) = nil) ∧ proper-p-alistp (bindings (car (p-ctrl-stk (p))), p) ∧ (strip-cars (bindings (car (p-ctrl-stk (p))))

= append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p))))))

∧ (type (ret-pc (car (p-ctrl-stk (p)))) = 'pc) ∧ listp (ret-pc (car (p-ctrl-stk (p)))) ∧ (cddr (ret-pc (car (p-ctrl-stk (p)))) = nil) ∧ listp (untag (ret-pc (car (p-ctrl-stk (p))))) ∧ definedp (car (untag (ret-pc (car (p-ctrl-stk (p))))),

p-prog-segment (p))

∧ proper-p-ctrl-stkp (cdr (p-ctrl-stk (p)), car (untag (ret-pc (car (p-ctrl-stk (p))))), p)

∧ proper-p-temp-stkp (p-temp-stk (p), p) ∧ proper-p-prog-segmentp (p-prog-segment (p), p) ∧ proper-p-data-segmentp (p-data-segment (p), p))

Theorem: proper-p-statep-restructuring proper-p-statep (p) = (proper-p-statep1 (p)

∧ (cdr (untag (p-pc (p))) ∈ N) ∧ (cdr (untag (p-pc (p)))

< length (program-body (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))

∧ (cdr (untag (ret-pc (car (p-ctrl-stk (p))))) ∈ N) ∧ (cdr (untag (ret-pc (car (p-ctrl-stk (p)))))

< length (program-body (assoc (car (untag (ret-pc (car (p-ctrl-stk (p))))),

p-prog-segment (p)))))

∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p))) ∧ (p-max-temp-stk-size (p) ≮ length (p-temp-stk (p))) ∧ (p-max-ctrl-stk-size (p) ∈ N) ∧ (p-max-temp-stk-size (p) ∈ N) ∧ (p-word-size (p) ∈ N) ∧ (p-max-ctrl-stk-size (p) < exp (2, p-word-size (p))) ∧ (p-max-temp-stk-size (p) < exp (2, p-word-size (p))) ∧ (0 < p-word-size (p)) ∧ proper-p-instructionp (p-current-instruction (p),

car (untag (p-pc (p))), p))

Theorem: proper-p-statep1-properties proper-p-statep1 (p) → (p-statep (p)

∧ (type (p-pc (p)) = 'pc) ∧ listp (p-pc (p)) ∧ (cddr (p-pc (p)) = nil) ∧ listp (untag (p-pc (p))) ∧ definedp (car (untag (p-pc (p))), p-prog-segment (p)) ∧ listp (p-ctrl-stk (p)) ∧ listp (car (p-ctrl-stk (p))) ∧ listp (cdr (car (p-ctrl-stk (p)))) ∧ (cddr (car (p-ctrl-stk (p))) = nil) ∧ proper-p-alistp (bindings (car (p-ctrl-stk (p))), p) ∧ (strip-cars (bindings (car (p-ctrl-stk (p))))

= append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p))))))

∧ (type (ret-pc (car (p-ctrl-stk (p)))) = 'pc) ∧ listp (ret-pc (car (p-ctrl-stk (p)))) ∧ (cddr (ret-pc (car (p-ctrl-stk (p)))) = nil) ∧ listp (untag (ret-pc (car (p-ctrl-stk (p))))) ∧ definedp (car (untag (ret-pc (car (p-ctrl-stk (p))))),

p-prog-segment (p))

∧ proper-p-ctrl-stkp (cdr (p-ctrl-stk (p)), car (untag (ret-pc (car (p-ctrl-stk (p))))), p)

∧ proper-p-temp-stkp (p-temp-stk (p), p) ∧ proper-p-prog-segmentp (p-prog-segment (p), p) ∧ proper-p-data-segmentp (p-data-segment (p), p))

Event: Disable proper-p-statep.

Event: Disable proper-p-statep1.

Event: Disable p-current-instruction.

; Now I provide a simple delayed opener for proper-p-instructionp:

Theorem: proper-p-instructionp-opener (car (ins) = pack (xxx)) → (proper-p-instructionp (ins, name, p)

= (properp (ins)

∧ case on car (ins): case = call then proper-p-call-instructionp (ins, name, p) case = ret then proper-p-ret-instructionp (ins, name, p) case = locn then proper-p-locn-instructionp (ins, name, p) case = push-constant then proper-p-push-constant-instructionp (ins, name, p) case = push-local then proper-p-push-local-instructionp (ins, name, p) case = push-global then proper-p-push-global-instructionp (ins, name, p) case = push-ctrl-stk-free-size then proper-p-push-ctrl-stk-free-size-instructionp (ins,

name, p)

case = push-temp-stk-free-size then proper-p-push-temp-stk-free-size-instructionp (ins,

name, p)

case = push-temp-stk-index then proper-p-push-temp-stk-index-instructionp (ins,

name, p)

case = jump-if-temp-stk-full then proper-p-jump-if-temp-stk-full-instructionp (ins,

name, p)

case = jump-if-temp-stk-empty then proper-p-jump-if-temp-stk-empty-instructionp (ins,

name, p)

case = pop then proper-p-pop-instructionp (ins, name, p) case = pop* then proper-p-pop*-instructionp (ins, name, p) case = popn then proper-p-popn-instructionp (ins, name, p) case = pop-local then proper-p-pop-local-instructionp (ins, name, p) case = pop-global then proper-p-pop-global-instructionp (ins, name, p) case = pop-locn then proper-p-pop-locn-instructionp (ins, name, p) case = pop-call then proper-p-pop-call-instructionp (ins, name, p) case = fetch-temp-stk then proper-p-fetch-temp-stk-instructionp (ins,

name, p)

case = deposit-temp-stk then proper-p-deposit-temp-stk-instructionp (ins,

name, p)

case = jump then proper-p-jump-instructionp (ins, name, p) case = jump-case then proper-p-jump-case-instructionp (ins, name, p) case = pushj then proper-p-pushj-instructionp (ins, name, p) case = popj then proper-p-popj-instructionp (ins, name, p) case = set-local then proper-p-set-local-instructionp (ins, name, p) case = set-global then proper-p-set-global-instructionp (ins, name, p) case = test-nat-and-jump then proper-p-test-nat-and-jump-instructionp (ins,

name, p)

case = test-int-and-jump then proper-p-test-int-and-jump-instructionp (ins,

name, p)

case = test-bool-and-jump then proper-p-test-bool-and-jump-instructionp (ins,

name, p)

case = test-bitv-and-jump then proper-p-test-bitv-and-jump-instructionp (ins,

name, p)

case = no-op then proper-p-no-op-instructionp (ins, name, p) case = add-addr then proper-p-add-addr-instructionp (ins, name, p) case = sub-addr then proper-p-sub-addr-instructionp (ins, name, p) case = eq then proper-p-eq-instructionp (ins, name, p) case = lt-addr then proper-p-lt-addr-instructionp (ins, name, p) case = fetch then proper-p-fetch-instructionp (ins, name, p) case = deposit then proper-p-deposit-instructionp (ins, name, p) case = add-int then proper-p-add-int-instructionp (ins, name, p) case = add-int-with-carry then proper-p-add-int-with-carry-instructionp (ins,

name,

p)

case = add1-int then proper-p-add1-int-instructionp (ins, name, p) case = sub-int then proper-p-sub-int-instructionp (ins, name, p) case = sub-int-with-carry then proper-p-sub-int-with-carry-instructionp (ins,

name, p)

case = sub1-int then proper-p-sub1-int-instructionp (ins, name, p) case = neg-int then proper-p-neg-int-instructionp (ins, name, p) case = lt-int then proper-p-lt-int-instructionp (ins, name, p) case = int-to-nat then proper-p-int-to-nat-instructionp (ins, name, p) case = add-nat then proper-p-add-nat-instructionp (ins, name, p) case = add-nat-with-carry then proper-p-add-nat-with-carry-instructionp (ins,

name, p)

case = add1-nat then proper-p-add1-nat-instructionp (ins, name, p) case = sub-nat then proper-p-sub-nat-instructionp (ins, name, p) case = sub-nat-with-carry then proper-p-sub-nat-with-carry-instructionp (ins,

name, p)

case = sub1-nat then proper-p-sub1-nat-instructionp (ins, name, p) case = lt-nat then proper-p-lt-nat-instructionp (ins, name, p) case = mult2-nat then proper-p-mult2-nat-instructionp (ins, name, p) case = mult2-nat-with-carry-out then proper-p-mult2-nat-with-carry-out-instructionp (ins,

name, p)

case = div2-nat then proper-p-div2-nat-instructionp (ins, name, p) case = or-bitv then proper-p-or-bitv-instructionp (ins, name, p) case = and-bitv then proper-p-and-bitv-instructionp (ins, name, p) case = not-bitv then proper-p-not-bitv-instructionp (ins, name, p) case = xor-bitv then proper-p-xor-bitv-instructionp (ins, name, p) case = rsh-bitv then proper-p-rsh-bitv-instructionp (ins, name, p) case = lsh-bitv then proper-p-lsh-bitv-instructionp (ins, name, p) case = or-bool then proper-p-or-bool-instructionp (ins, name, p) case = and-bool then proper-p-and-bool-instructionp (ins, name, p) case = not-bool then proper-p-not-bool-instructionp (ins, name, p) otherwise f endcase))

; The following lemma tells us that if the current instruction is
; not one of the fall-off barriers then it is possible to increment
; the pc.

Theorem: proper-p-statep-implies-add1-p-pcp ((car (p-current-instruction (p)) = pack (xxx)) ∧ proper-p-statep1 (p) ∧ (cdr (untag (p-pc (p)))

< length (program-body (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))

∧ (car (p-current-instruction (p))

∉ '(ret jump jump-case popj)))

→ (cdr (untag (p-pc (p)))

< (length (program-body (assoc (car (untag (p-pc (p))), p-prog-segment (p)))) − 1))

; We also know that the r-current-instruction of the mapped down state
; is the p-current-instruction.

Theorem: r-current-instruction-p->r r-current-instruction (p->r (p)) = p-current-instruction (p)

Event: Disable r-current-instruction.

; Henceforth, in my lemmas building up to the owc theorem, I will use
; (p-current-instruction p) even on the r side of the lemmas because the
; above theorem gives the equality I would otherwise need.  Furthermore,
; with the above theorem around, (r-current-instruction (p->r p)) would
; be Knuth-Bendixed away anyway.
; The major difficulty of this proof is in controlling the expansion
; of the sys-data-segment and tracking the isomorphism between the
; p and r level stacks -- that is ALL there is to this proof!
; We will keep p->r_sys-data-segment disabled because it generates
; a big list I don't like to see.
; We begin by showing what you get when you assoc for each of
; the 5 components of the sys-data-segment.

Theorem: assoc-cstk-p->r sys-data-segment assoc ('cstk,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))

= p->r ctrl-stk (ctrl-stk, max-ctrl-stk-size)

Theorem: assoc-tstk-p->r sys-data-segment assoc ('tstk,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))

= p->r temp-stk (temp-stk, max-temp-stk-size)

Theorem: assoc-full-ctrl-stk-addr-p->r sys-data-segment

 assoc ('full-ctrl-stk-addr,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))

 = list ('full-ctrl-stk-addr, tag ('sys-addr, '(cstk . 0)))

Theorem: assoc-full-temp-stk-addr-p->r sys-data-segment

 assoc ('full-temp-stk-addr,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))

 = list ('full-temp-stk-addr, tag ('sys-addr, '(tstk . 0)))

Theorem: assoc-empty-temp-stk-addr-p->r sys-data-segment

 assoc ('empty-temp-stk-addr,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))

 = list ('empty-temp-stk-addr,

tag ('sys-addr, cons ('tstk, max-temp-stk-size)))

; Next we establish that those we put into are defined:

Theorem: definedp-tstk-p->r sys-data-segment definedp ('tstk,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))

Theorem: definedp-cstk-p->r sys-data-segment definedp ('cstk,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))

; Next we establish the lengths of the mapped down cstk and tstk:

Theorem: length-strip-cdrs length (strip-cdrs (x)) = length (x)

Event: Enable length-append.

Theorem: length-p->r ctrl-stk1 length (p->r ctrl-stk1 (stk, max)) = p-ctrl-stk-size (stk)

Theorem: length-nat-0s length (nat-0s (n)) = fix (n)

Event: Enable lessp-difference=0.

Theorem: length-cdr-p->r ctrl-stk (max-ctrl-stk-size ≮ p-ctrl-stk-size (ctrl-stk)) → (length (cdr (p->r ctrl-stk (ctrl-stk, max-ctrl-stk-size)))

= (1 + max-ctrl-stk-size))

Theorem: length-cdr-p->r temp-stk (max-temp-stk-size ≮ length (temp-stk)) → (length (cdr (p->r temp-stk (temp-stk, max-temp-stk-size)))

= (1 + max-temp-stk-size))

; Now we show what happens when you access and change the mapped down stacks.
; My plan is this.  I will leave p->r_ctrl-stk and p->r_temp-stk disabled.
; I will explain how to get an "arbitrary" element out of both.
; I will explain how to put at an "arbitrary" location in p->r_ctrl-stk --
; by showing that the appropriate put-assoc-put combination on p->r_ctrl-stk
; is equal to a p->r_ctrl-stk of an appropriate put.  But I will not discuss
; how to put into p->r_temp-stk.  The problem has to do with popping the
; temp stack and the fact that we often pop several times and then put.
; It is not possible to say what the corresponding p->r_temp-stk would be
; because of the dead junk at the top.  This problem is dealt with by
; stk-equal and so we will address putting into the p->r_temp-stk when
; we deal with stk-equal.
; We start with accessing the temp-stk, which is the simplest operation.

Event: Enable unconditional-get-append.

Theorem: difference-difference-difference ((i ≮ j ) ∧ (i ≮ k)) → (((i − j ) − (i − k)) = (k − j ))

; The following theorem shows how to get at an "arbitrary"
; address in a mapped down stack, where by "arbitrary" I
; mean any address in the live part.

Theorem: get-cdr-p->r temp-stk ((max-temp-stk-size ≮ length (temp-stk)) ∧ (i < max-temp-stk-size) ∧ (i ≮ (max-temp-stk-size − length (temp-stk)))) → (get (i, cdr (p->r temp-stk (temp-stk, max-temp-stk-size)))

= get (i − (max-temp-stk-size − length (temp-stk)), temp-stk))

; Most often we will be getting at the top of the temp stk,
; which is i = (difference max-temp-stk-size (length temp-stk))

; (just look at p->r_tsp).  In that case, we will need:

Event: Enable difference-x-x.

; When we get at top1 i will be
;    (difference max-temp-stk-size (length (cdr temp-stk)))
; and the (difference max-temp-stk-size (length temp-stk))
; above will become
;    (difference max-temp-stk-size (add1 (length (cdr temp-stk))))
; which will expand to
;    (sub1 (difference max-temp-stk-size (length (cdr temp-stk))))
; by

Theorem: difference-add1{special} (x − (1 + y)) = ((x − y) − 1)

; So we will need:

Theorem: difference-x-sub1-x (x ≄ 0) → ((x − (x − 1)) = 1)

; Similarly for top2:

Theorem: difference-x-sub2-x ((x ≄ 0) ∧ ((x − 1) ≄ 0)) → ((x − ((x − 1) − 1)) = 2)

; We then eliminate the gets in these cases because the p machine
; uses top1 and top2, not get-1 and get-2:

Event: Enable get-0.

Theorem: get-1 get (1, lst) = cadr (lst)

Theorem: get-2 get (2, lst) = caddr (lst)

; Now I turn to the control stack.  Again, we need to be able to
; get and put into it.  However, we only entertain those operations
; on local variable positions of the top frame.

; We begin with get
; The key idea, of course, is that getting at a specified position
; in the strip-cdrs of an alist is the same as assoc.

Theorem: get-find-position-of-var (proper-p-alistp (alist, p) ∧ (var ∈ strip-cars (alist))) → (get (find-position-of-var (var, strip-cars (alist)),

append (strip-cdrs (alist), stk)) = cdr (assoc (var, alist)))

; Now we have to work a little to establish the correspondence between
; the list we find the position in and the list we assoc into.

Theorem: member-implies-lessp-find-position-of-var (x ∈ lst) → (find-position-of-var (x, lst) < length (lst))

Theorem: equal-strip-cars-implies-equal-lengths (strip-cars (x) = y) → (length (x) = length (y))

Event: Enable length-strip-cars.

Theorem: length-bindings proper-p-statep1 (p) → (length (bindings (car (p-ctrl-stk (p))))

= (length (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))))

+ length (temp-var-dcls (assoc (car (untag (p-pc (p))), p-prog-segment (p))))))

Theorem: difference-plus{special} ((x + y) − x) = fix (y)

Theorem: p->r ctrl-stk1-opener proper-p-statep1 (p) → (p->r ctrl-stk1 (p-ctrl-stk (p), p-max-ctrl-stk-size (p))

= append (p->r p-frame (top (p-ctrl-stk (p)), pop (p-ctrl-stk (p)), p-max-ctrl-stk-size (p)),

p->r ctrl-stk1 (pop (p-ctrl-stk (p)), p-max-ctrl-stk-size (p))))

; And here is the main lemma about getting at a local variable
; slot in the mapped down control stack:

Theorem: get-cdr-p->r ctrl-stk-1 (proper-p-statep1 (p) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p))) ∧ (var ∈ append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))))

→ (get ((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p)))

+ find-position-of-var (var,

append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))),

cdr (p->r ctrl-stk (p-ctrl-stk (p), p-max-ctrl-stk-size (p)))) = cdr (assoc (var, bindings (car (p-ctrl-stk (p))))))

; Now we turn to put.

Theorem: put-find-position-of-var (proper-p-alistp (alist, p) ∧ (var ∈ strip-cars (alist))) → (put (val,

find-position-of-var (var, strip-cars (alist)), append (strip-cdrs (alist), stk))

= append (strip-cdrs (put-assoc (val, var, alist)), stk))

Event: Enable equal-length-0.

Theorem: put-plus-append (i = length (a)) → (put (val, i + j , append (a, b)) = append (a, put (val, j , b)))

Theorem: length-put-assoc length (put-assoc (val, name, alist)) = length (alist)

Theorem: p-ctrl-stk-size-cons-p-frame-put-assoc listp (stk) → (p-ctrl-stk-size (cons (p-frame (put-assoc (val, var, bindings (car (stk))),

ret-pc (car (stk))), cdr (stk)))

= p-ctrl-stk-size (stk))

Event: Enable associativity-of-append.

Theorem: put-cdr-p->r ctrl-stk-1 (proper-p-statep1 (p) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p))) ∧ (var ∈ append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))))

→ (put (val, (p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p))) + find-position-of-var (var,

append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))),

cdr (p->r ctrl-stk (p-ctrl-stk (p), p-max-ctrl-stk-size (p)))) = cdr (p->r ctrl-stk (cons (p-frame (put-assoc (val,

var,

bindings (car (p-ctrl-stk (p)))),

ret-pc (car (p-ctrl-stk (p)))), cdr (p-ctrl-stk (p))),

p-max-ctrl-stk-size (p))))

; Recall that we are keeping p->r_sys-data-segment closed.  So we have
; to package up the put-assoc that the r machine does on its sys-data-segment:

Theorem: car-p->r ctrl-stk car (p->r ctrl-stk (temp-stk, max)) = 'cstk

Theorem: car-p->r temp-stk car (p->r temp-stk (temp-stk, max)) = 'tstk

Theorem: put-assoc-cstk-p->r sys-data-segment-local put-assoc (cdr (p->r ctrl-stk (ctrl-stk1 , max-ctrl-stk-size1 )),

         'cstk,

p->r sys-data-segment (ctrl-stk2 , max-ctrl-stk-size2 , temp-stk2 , max-temp-stk-size2 ))

= p->r sys-data-segment (ctrl-stk1 , max-ctrl-stk-size1 , temp-stk2 , max-temp-stk-size2 )

; Note:  The suffix "local" on the name above is present because we
; have a more elaborate version of this same idea later for call.
; Finally, we shut down the mappers:

Event: Disable p->r ctrl-stk.

Event: Disable p->r temp-stk.

Event: Disable p->r sys-data-segment.

; Now we address the stk-equal problem.  Since we have p->r_sys-data-segment
; disabled, we need theorems that tell us when one such application is
; stk-equal to another or to a put-assoc that changes on of the components.
; The following function is the standard induction hint for theorems about
; stk-equal that use a non-variable term for the stack pointer.  E.g.,
; if (stk-equal sp ...) could be proved by pop-to-empty-stkp induction
; on sp, then (stk-equal (tag 'sys-addr (cons 'cstk n)) ...) should be
; proved by (stk-equal-hint-1 n ...) induction on n.

Definition: stk-equal-hint-1 (n, max) = if (max − n) ≃ 0 then t

else stk-equal-hint-1 (1 + n, max) endif

; Because of the restrictions on the form of terms used as induction
; hints, we need a second form of this hint function.  (The problem has
; to do with the prohibition of non-variable terms in induction hint
; args, even for args in constant slots.)

Event: Enable difference-x-0.

Definition: stk-equal-hint-2 (n, ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size) = if ((length (cdr (assoc ('cstk,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))))

− n)− 1) ≃ 0 then t

else stk-equal-hint-2 (n + 1, ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size) endif

; By the way, normally in the theorems we have to prove formulas of the
; form (stk-equal sp segment1 segment2) have the following ancestry and:
; form.  The sp is some semi-explicit pointer like
; (tag 'sys-addr (cons 'cstk n)) as produced by p->r_csp.  Segment1 is
; a call of p->r_sys-data-segment on the result of stepping the p machine.
; Segment2 is the result of stepping the r machine on the original
; p->r_sys-data-segment.
; If the stack pointer of interest is in the cstk area, then it doesn't
; matter what happens to the tstk area at the r level.  The following theorem
; formalizes that for the case where the r-level does nothing, e.g., no-op.

Theorem: stk-equal-reflexive-cstk stk-equal (tag ('sys-addr, cons ('cstk, n)),

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk1 , max-temp-stk-size1 ),

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk2 , max-temp-stk-size2 ))

; The next theorem formalizes it (by reducing it to the no-op case) when the
; r-level just hits the tstk:

Theorem: assoc-put-assoc-1 (name1 ≠ name2 ) → (assoc (name1 , put-assoc (val, name2 , alist)) = assoc (name1 , alist))

Definition: stk-equal-hint-3 (n, segment) = if ((length (cdr (assoc ('cstk, segment))) − n) − 1) ≃ 0 then t

else stk-equal-hint-3 (n + 1, segment) endif

Theorem: stk-equal-cstk-put-assoc-tstk stk-equal (tag ('sys-addr, cons ('cstk, n)),

segment1 ,

put-assoc (area, 'tstk, segment2 ))

= stk-equal (tag ('sys-addr, cons ('cstk, n)), segment1 , segment2 )

; We now do the same thing for the case where the r-level machine doesn't
; change the cstk.  This is very common, of course.

Definition: stk-equal-hint-4 (n, ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size) = if ((length (cdr (assoc ('tstk,

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size))))

− n)− 1) ≃ 0 then t else stk-equal-hint-4 (n + 1,

ctrl-stk,

max-ctrl-stk-size,

temp-stk,

max-temp-stk-size) endif

Theorem: stk-equal-reflexive-tstk stk-equal (tag ('sys-addr, cons ('tstk, n)),

p->r sys-data-segment (ctrl-stk1 , max-ctrl-stk-size1 , temp-stk, max-temp-stk-size),

p->r sys-data-segment (ctrl-stk2 , max-ctrl-stk-size2 , temp-stk, max-temp-stk-size))

; This completely handles the stk-equal work for the cstk (except on
; CALL and RET, which we be done specially when they arise).  Now I
; turn to tstk.
; Consider the pattern of pushes and pops used by our instructions.
; For each we need to know that the high level operation corresponds to
; the low level one.  The patterns we use are
;   pattern     typical instruction
;  push            push-global

;  pop             pop-global
;  pop 2           deposit
;  pop 1 push 1    add1-nat
;  pop 2 push 1    add-addr
;  pop 3 push 2    add-nat-with-carry
;  pop 1 push 2    mult2-nat-with-carry-out
; Our approach to stk-equal questions of the form
; (stk-equal (tag 'sys-addr (cons 'tstk n))
;            (p->r_sys-data-segment ... p-level-temp-stk ...)
;            r-level-temp-stk)
; will be to reduce them to (equal p-level-temp-stk &), where & is the
; "live part" of the r-level-temp-stk.  We don't define the function
; live-part but rather just use the combination of cdr-n and all-but-last
; defined below.

Theorem: get-equal-car-cdr-n get (n, lst) = car (cdr-n (n, lst))

Theorem: cdr-n-nil ((n ≮ length (lst)) ∧ properp (lst)) → (cdr-n (n, lst)

= if fix (n) = length (lst) then nil else 0 endif)

Theorem: length-all-but-last length (all-but-last (x)) = (length (x) − 1)

Theorem: properp-all-but-last properp (all-but-last (x))

Theorem: stk-equal-is-equal-cdr-n-all-but-last-lemma1 (cdr-n (n, x) = cdr-n (n, y)) → ((cdr-n (n, cdr (x)) = cdr-n (n, cdr (y))) = t)

Theorem: stk-equal-is-equal-cdr-n-all-but-last-lemma2 ((n < (length (lst1 ) − 1)) ∧ (n ∈ N) ∧ (cdr-n (n, cdr (all-but-last (lst1 )))

= cdr-n (n, cdr (all-but-last (lst2 )))) ∧ (length (lst1 ) = length (lst2 )) ∧ (cdr-n (n, all-but-last (lst1 )) ≠ cdr-n (n, all-but-last (lst2 )))) → (car (cdr-n (n, lst1 )) ≠ car (cdr-n (n, lst2 )))

Theorem: stk-equal-is-equal-cdr-n-all-but-last-lemma3 ((n < (length (lst1 ) − 1)) ∧ (n ∈ N) ∧ (length (lst1 ) = length (lst2 )) ∧ (cdr-n (n, all-but-last (lst1 )) = cdr-n (n, all-but-last (lst2 )))) → ((car (cdr-n (n, lst1 )) = car (cdr-n (n, lst2 ))) = t)

Theorem: equal-sub1-difference-0 (((x − y) − 1) = 0) = (y ≮ (x − 1))

; This is the key theorem.  We do not, in general, want to eliminate
; stk-equal, so it is proved with lemma class nil.  We'll prove a
; certain instance of it later for use as a rewrite rule.
; Note that as proved below it applies as well to the cstk as to tstk.

Theorem: stk-equal-is-equal-cdr-n-all-but-last ((cdr (untag (sp)) ∈ N) ∧ (length (cdr (assoc (car (untag (sp)), segment1 )))

= length (cdr (assoc (car (untag (sp)), segment2 ))))) → (stk-equal (sp, segment1 , segment2 )

= (cdr-n (cdr (untag (sp)),

all-but-last (cdr (assoc (car (untag (sp)), segment1 )))) = cdr-n (cdr (untag (sp)),

all-but-last (cdr (assoc (car (untag (sp)), segment2 ))))))

Event: Disable equal-sub1-difference-0.

Event: Disable get-equal-car-cdr-n.

Event: Disable cdr-n-nil.

Event: Disable stk-equal-is-equal-cdr-n-all-but-last-lemma1.

Event: Disable stk-equal-is-equal-cdr-n-all-but-last-lemma2.

Event: Disable stk-equal-is-equal-cdr-n-all-but-last-lemma3.

Theorem: assoc-put-assoc-2 definedp (name, alist) → (assoc (name, put-assoc (val, name, alist)) = cons (name, val))

Theorem: all-but-last-append listp (b) → (all-but-last (append (a, b)) = append (a, all-but-last (b)))

Theorem: length-cdr-n length (cdr-n (n, lst)) = (length (lst) − n)

Event: Enable append-right-id.

Theorem: cdr-n-append{special} (n = length (a)) → (cdr-n (n, append (a, b)) = b)

; Here, finally, is the rewrite rule that reduce stk-equal
; questions on tstk to consideration of the "live part" of the
; r-level stack:

Theorem: stk-equal-tstk-p->r sys-data-segment (properp (temp-stk) ∧ (n = (max-temp-stk-size − length (temp-stk))) ∧ (max-temp-stk-size ≮ length (temp-stk)) ∧ ((1 + max-temp-stk-size) = length (cdr (assoc ('tstk, segment))))) → (stk-equal (tag ('sys-addr, cons ('tstk, n)),

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size),

segment)

= (temp-stk = cdr-n (max-temp-stk-size − length (temp-stk), all-but-last (cdr (assoc ('tstk, segment))))))

Event: Disable stk-equal.

Event: Disable empty-stkp.

; To use the theorem above we need to relieve the hypotheses.
; The typical form of instantiations for temp-stk in the lemma
; above is either (p-temp-stk p) or else some collection of
; conses and cdrs of it.  We need to know that it is proper.
; The first theorem below establishes that the initial temp
; stack is proper.

Theorem: proper-p-temp-stkp-implies-properp proper-p-temp-stkp (stk, p) → properp (stk)

Theorem: properp-p-temp-stkp proper-p-statep1 (p) → properp (p-temp-stk (p))

; And this one establishes that the cdr of it is proper.  This is
; what we'll need when we pop.

Theorem: properp-implies-properp-cdr (listp (x) ∧ properp (x)) → properp (cdr (x))

; When we push we'll cons onto the stack and that cons will be eaten
; by properp itself.
; The only other problematic hypothesis for the lemma above is that
; concerning the length of the new tstk area.  The typical instantiation
; of segment above will a put-assoc.  When we assoc for 'tstk in it we
; will get a (put val n previous-area), where n is some legal address in
; the previous tstk area.  We need to know the length of the resulting
; area.  It is, of course, unchanged:

Event: Enable length-put.

; That handles most of the problems I can anticipate on relieving the
; hyps.  Now we consider simplifying the rhs of the lemma under the
; typical instantiations of segment.  We are interested in cdr-n and
; all-but-last lemmas on the result of (assoc 'tstk segment).  As noted,
; the assoc will turn into a put under most instantiations of segment.
; In the case that it is a put, we will use the following lemma to
; drive the all-but-last through the put.  If there are multiple puts,
; this lemma will drive it all the way down.

Theorem: all-but-last-put (n < (length (lst) − 1)) → (all-but-last (put (val, n, lst)) = put (val, n, all-but-last (lst)))

; Eventually it will come to rest against the original tsk and we'll
; open it up:

Theorem: all-but-last-cdr-p->r temp-stk properp (temp-stk) → (all-but-last (cdr (p->r temp-stk (temp-stk, max-temp-stk-size)))

= append (nat-0s (max-temp-stk-size − length (temp-stk)), temp-stk))

; to remove the (NAT 0) at the end, kicking out an append
; which will let the PUTs start to resolve themselves.
; Now if the put is an simple push the following lemma will take care
; of it:

Theorem: nat-0s-opener-at-right-end nat-0s (n) = if n ≃ 0 then nil

else append (nat-0s (n − 1), list ('(nat 0))) endif

Theorem: nat-0s-opener-at-right-end-on-add1 nat-0s (1 + n) = append (nat-0s (n), list ('(nat 0)))

Theorem: put-append ((n = length (a)) ∧ listp (b)) → (put (val, n, append (a, b)) = append (a, cons (val, cdr (b))))

; Whew!  That was tough wasn't it?  Anyway, here is the key fact
; about a put that implements a push.

Theorem: put-append-1{special} ((n ≄ 0) ∧ (k = (n − 1))) → (put (val, k, append (nat-0s (n), lst)) = append (nat-0s (k), cons (val, lst)))

; The following is needed to simplify the cdr-n in the case where
; we have done a pop.

Theorem: cdr-n-cdr cdr-n (n, cdr (lst)) = cdr (cdr-n (n, lst))

; There are probably more facts about cdr-n than I have proved.  I will
; prove the rest as needed to get the owc proofs through.
; Now we begin considering the same-signature requirements of r-equal.

Theorem: same-signature-reflexive{special} ((max-ctrl-stk-size ≮ p-ctrl-stk-size (ctrl-stk1 )) ∧ (max-ctrl-stk-size ≮ p-ctrl-stk-size (ctrl-stk2 )) ∧ (max-temp-stk-size ≮ length (temp-stk1 )) ∧ (max-temp-stk-size ≮ length (temp-stk2 ))) → same-signature (p->r sys-data-segment (ctrl-stk1 , max-ctrl-stk-size, temp-stk1 , max-temp-stk-size),

p->r sys-data-segment (ctrl-stk2 , max-ctrl-stk-size, temp-stk2 , max-temp-stk-size))

Theorem: same-signature-put-assoc-1 (definedp (name, segment1 ) ∧ litatom (name) ∧ (length (val) = length (definiens (name, segment1 )))) → (same-signature (put-assoc (val, name, segment1 ), segment2 )

= same-signature (segment1 , segment2 ))

Theorem: same-signature-put-assoc-2 (definedp (name, segment2 ) ∧ litatom (name) ∧ (length (val) = length (definiens (name, segment2 )))) → (same-signature (segment1 , put-assoc (val, name, segment2 ))

= same-signature (segment1 , segment2 ))

Event: Disable same-signature.

; Now I want to disable get and put so that they are only manipulated by
; the lemmas we have proved.

Event: Disable get.

Event: Disable put.

; I have decided to do the owc proofs at this level a little differently.
; First I will prove that
; (p-xxx-okp p) -> (requal (p->r (p-xxx-step p)) (r-xxx-step (p->r p)))
; Then I will prove
; (p-xxx-okp p) -> (r-xxx-okp (p->r p)).
; Then I will put them together to get
; (p->xxx-okp p) -> (r-equal (p->r (p-xxx-step p)) (r-step (p->r p))).
; We now begin the owc proofs.  I have selected several theorems for my
; initial test section and will work on the lemma development to make the

; proofs of these work.  Then I'll turn it loose on all the others.
; CALL and RET are left for last.  I have made sure to include one theorem
; for each pattern of tstk use mentioned above, plus local variable
; pushing and popping.  I begin, as always, with no-op, the simplest.

Theorem: no-op-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'no-op) ∧ proper-p-statep (p) ∧ p-no-op-okp (p-current-instruction (p), p)) → r-equal (p->r (p-no-op-step (p-current-instruction (p), p)),

r-no-op-step (p-current-instruction (p), p->r (p)))

Theorem: push-global-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-global) ∧ proper-p-statep (p) ∧ p-push-global-okp (p-current-instruction (p), p)) → r-equal (p->r (p-push-global-step (p-current-instruction (p), p)),

r-push-global-step (p-current-instruction (p), p->r (p)))

Theorem: lessp-length-cdr length (x) ≮ length (cdr (x))

; To relieve the 2nd hypothesis of get-cdr-p->r_temp-stk, the one
; that says that i is less than max-temp-stk-size, we need to know,
; in the case of a simple pop, that:

Theorem: lessp-difference-x-y-x ((max ≮ length (temp-stk)) ∧ listp (temp-stk)) → ((max − length (temp-stk)) < max)

; Note:  The rule above uses max as a free-var, accidentally.  I
; don't know if this will prevent its use later...

Theorem: pop-global-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-global) ∧ proper-p-statep (p) ∧ p-pop-global-okp (p-current-instruction (p), p)) → r-equal (p->r (p-pop-global-step (p-current-instruction (p), p)),

r-pop-global-step (p-current-instruction (p), p->r (p)))

Theorem: push-local-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-local) ∧ proper-p-statep (p) ∧ p-push-local-okp (p-current-instruction (p), p)) → r-equal (p->r (p-push-local-step (p-current-instruction (p), p)),

r-push-local-step (p-current-instruction (p), p->r (p)))

Theorem: pop-local-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-local) ∧ proper-p-statep (p) ∧ p-pop-local-okp (p-current-instruction (p), p)) → r-equal (p->r (p-pop-local-step (p-current-instruction (p), p)),

r-pop-local-step (p-current-instruction (p), p->r (p)))

Theorem: difference-add1-x-x ((1 + x) − x) = 1

Theorem: cdr-n-append-pop2 ((n ≄ 0) ∧ ((n − 1) ≄ 0)) → (cdr-n (n, append (nat-0s ((n − 1) − 1), stk)) = cddr (stk))

Theorem: deposit-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit) ∧ proper-p-statep (p) ∧ p-deposit-okp (p-current-instruction (p), p)) → r-equal (p->r (p-deposit-step (p-current-instruction (p), p)),

r-deposit-step (p-current-instruction (p), p->r (p)))

; The following lemmas are needed because lessp opens up when it
; on (lessp (p-max-temp-stk-size p) (length (p-temp-stk p)))
; because length opens up.

Theorem: not-equal-p-max-temp-stk-size-0 (listp (p-temp-stk (p)) ∧ (p-max-temp-stk-size (p) ≮ length (p-temp-stk (p)))) → (p-max-temp-stk-size (p) ≠ 0)

Theorem: not-lessp-sub1-p-max-temp-stk-size (p-max-temp-stk-size (p) ≮ length (p-temp-stk (p))) → ((p-max-temp-stk-size (p) − 1) ≮ length (cdr (p-temp-stk (p))))

Theorem: add1-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-nat) ∧ proper-p-statep (p) ∧ p-add1-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-add1-nat-step (p-current-instruction (p), p)),

r-add1-nat-step (p-current-instruction (p), p->r (p)))

; The following lemma explains a push after two pops.

Theorem: put-append-2{special} ((n ≄ 0) ∧ listp (cdr (stk))) → (put (val, n, append (nat-0s (n − 1), stk))

= append (nat-0s (n − 1), cons (car (stk), cons (val, cddr (stk)))))

Theorem: cdr-n-append-2 (n ≄ 0) → (cdr-n (n, append (nat-0s (n − 1), stk)) = cdr (stk))

Theorem: add-addr-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-addr) ∧ proper-p-statep (p) ∧ p-add-addr-okp (p-current-instruction (p), p)) → r-equal (p->r (p-add-addr-step (p-current-instruction (p), p)),

r-add-addr-step (p-current-instruction (p), p->r (p)))

; Because add-nat-with-carry writes twice to the tstk, we need:

Event: Enable put-assoc-put-assoc.

; Both the p and the r machine use fix-small-natural and small-naturalp
; to operate on nats, so I will

Event: Disable fix-small-natural.

Event: Disable small-naturalp.

Event: Disable bool-to-nat.

Event: Disable bool.

; The following lemma explains a push after three pops.

Theorem: put-append-nat-0s-sub1-sub1 (((n − 1) ≄ 0) ∧ listp (cddr (stk))) → (put (val, n, append (nat-0s ((n − 1) − 1), stk))

= append (nat-0s ((n − 1) − 1), cons (car (stk), cons (cadr (stk), cons (val, cdddr (stk))))))

Theorem: add-nat-with-carry-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat-with-carry) ∧ proper-p-statep (p) ∧ p-add-nat-with-carry-okp (p-current-instruction (p), p)) → r-equal (p->r (p-add-nat-with-carry-step (p-current-instruction (p), p)),

r-add-nat-with-carry-step (p-current-instruction (p), p->r (p)))

; As above, length opens up on (cons val (cdr temp-stk)), and lessp
; opens on that and we have to accomodate them.

Theorem: not-equal-sub1-p-max-temp-stk-size-0 (listp (p-temp-stk (p)) ∧ (length (p-temp-stk (p)) < p-max-temp-stk-size (p))) → ((p-max-temp-stk-size (p) − 1) ≠ 0)

Theorem: not-lessp-sub1-sub1-p-max-temp-stk-size (length (p-temp-stk (p)) < p-max-temp-stk-size (p)) → ((((p-max-temp-stk-size (p) − 1) − 1) < length (cdr (p-temp-stk (p))))

= f)

Theorem: mult2-nat-with-carry-out-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat-with-carry-out) ∧ proper-p-statep (p) ∧ p-mult2-nat-with-carry-out-okp (p-current-instruction (p), p)) → r-equal (p->r (p-mult2-nat-with-carry-out-step (p-current-instruction (p),

p)),

r-mult2-nat-with-carry-out-step (p-current-instruction (p), p->r (p)))

Theorem: difference-sub1 ((x − 1) − y) = ((x − y) − 1)

Theorem: fetch-temp-stk-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch-temp-stk) ∧ proper-p-statep (p) ∧ p-fetch-temp-stk-okp (p-current-instruction (p), p)) → r-equal (p->r (p-fetch-temp-stk-step (p-current-instruction (p), p)),

r-fetch-temp-stk-step (p-current-instruction (p), p->r (p)))

Theorem: properp-put properp (lst) → properp (put (val, n, lst))

Theorem: cdr-n-put ((n ≮ k) ∧ (n < length (lst))) → (cdr-n (k, put (val, n, lst)) = put (val, n − k, cdr-n (k, lst)))

Theorem: deposit-temp-stk-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit-temp-stk) ∧ proper-p-statep (p) ∧ p-deposit-temp-stk-okp (p-current-instruction (p), p)) → r-equal (p->r (p-deposit-temp-stk-step (p-current-instruction (p), p)),

r-deposit-temp-stk-step (p-current-instruction (p), p->r (p)))

Event: Disable cdr-n-put.

Event: Disable difference-sub1.

; The pop* instruction shows a new twist:  popping many things off tstk.
; The p machine uses popn but we have a lot of machinery sitting around
; for cdr-n, which is an equivalent function:

Theorem: popn-is-cdr-n popn (n, lst) = cdr-n (n, lst)

; We now turn to stk-equal on the tstk. Recall
; stk-equal-tstk-p->r_sys-data-segment:  it has two variables of importance,
; temp-stk, the p-level version of the stack, and segment, the r-level
; sys-data-segment. In the call case, temp-stk will be a popn (now cdr-n)
; and segment is untouched.  If we can relieve the hyps of the lemma,
; we will have to prove that the popn is equal to a certain
; cdrn-all-but-last expression.

Theorem: properp-cdr-n (length (lst) ≮ n) → (properp (cdr-n (n, lst)) = properp (lst))

; That relieves the hyps.  The all-but-last disappears under
; the hands of our previous lemmas, taking the terminal '(NAT 0)
; with it.  We are left with proving the equivalence of two CDR-N
; expressions.  The key is getting the n in one of them into a
; normal form to allow cdr-n-plus-append, below, to apply.

Theorem: difference-x-difference ((len ≮ n) ∧ (max ≮ len)) → ((max − (len − n)) = (n + (max − len)))

Theorem: cdr-n-plus-append (i = length (a)) → (cdr-n (i + j , append (a, b)) = cdr-n (j , b))

Theorem: cdr-n-plus-append-commuted (i = length (a)) → (cdr-n (j + i, append (a, b)) = cdr-n (j , b))

Theorem: pop*-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop*) ∧ proper-p-statep (p) ∧ p-pop*-okp (p-current-instruction (p), p)) → r-equal (p->r (p-pop*-step (p-current-instruction (p), p)),

r-pop*-step (p-current-instruction (p), p->r (p)))

Theorem: length-cdr-cdr-n length (cdr (cdr-n (n, lst))) = (length (cdr (lst)) − n)

Theorem: properp-cdr-cdr-n (length (lst) ≮ (1 + n)) → (properp (cdr (cdr-n (n, lst))) = properp (lst))

Theorem: cdr-n-plus-sub1-append-commuted ((i ≄ 0) ∧ (j ∈ N) ∧ ((i − 1) = length (a))) → (cdr-n (j + i, append (a, b)) = cdr (cdr-n (j , b)))

Theorem: popn-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popn) ∧ proper-p-statep (p) ∧ p-popn-okp (p-current-instruction (p), p)) → r-equal (p->r (p-popn-step (p-current-instruction (p), p)),

r-popn-step (p-current-instruction (p), p->r (p)))

; This ends the test section.

Theorem: set-local-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-local) ∧ proper-p-statep (p) ∧ p-set-local-okp (p-current-instruction (p), p)) → r-equal (p->r (p-set-local-step (p-current-instruction (p), p)),

r-set-local-step (p-current-instruction (p), p->r (p)))

Theorem: set-global-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-global) ∧ proper-p-statep (p) ∧ p-set-global-okp (p-current-instruction (p), p)) → r-equal (p->r (p-set-global-step (p-current-instruction (p), p)),

r-set-global-step (p-current-instruction (p), p->r (p)))

Theorem: push-constant-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-constant) ∧ proper-p-statep (p) ∧ p-push-constant-okp (p-current-instruction (p), p)) → r-equal (p->r (p-push-constant-step (p-current-instruction (p), p)),

r-push-constant-step (p-current-instruction (p), p->r (p)))

Theorem: push-ctrl-stk-free-size-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-ctrl-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-ctrl-stk-free-size-okp (p-current-instruction (p), p)) → r-equal (p->r (p-push-ctrl-stk-free-size-step (p-current-instruction (p),

p)),

r-push-ctrl-stk-free-size-step (p-current-instruction (p), p->r (p)))

Theorem: push-temp-stk-free-size-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-temp-stk-free-size-okp (p-current-instruction (p), p)) → r-equal (p->r (p-push-temp-stk-free-size-step (p-current-instruction (p),

p)),

r-push-temp-stk-free-size-step (p-current-instruction (p), p->r (p)))

Theorem: push-temp-stk-index-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-index) ∧ proper-p-statep (p) ∧ p-push-temp-stk-index-okp (p-current-instruction (p), p)) → r-equal (p->r (p-push-temp-stk-index-step (p-current-instruction (p), p)),

r-push-temp-stk-index-step (p-current-instruction (p), p->r (p)))

Theorem: pop-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop) ∧ proper-p-statep (p) ∧ p-pop-okp (p-current-instruction (p), p)) → r-equal (p->r (p-pop-step (p-current-instruction (p), p)),

r-pop-step (p-current-instruction (p), p->r (p)))

Theorem: jump-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump) ∧ proper-p-statep (p) ∧ p-jump-okp (p-current-instruction (p), p)) → r-equal (p->r (p-jump-step (p-current-instruction (p), p)),

r-jump-step (p-current-instruction (p), p->r (p)))

Theorem: pushj-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pushj) ∧ proper-p-statep (p) ∧ p-pushj-okp (p-current-instruction (p), p)) → r-equal (p->r (p-pushj-step (p-current-instruction (p), p)),

r-pushj-step (p-current-instruction (p), p->r (p)))

Theorem: popj-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popj) ∧ proper-p-statep (p) ∧ p-popj-okp (p-current-instruction (p), p)) → r-equal (p->r (p-popj-step (p-current-instruction (p), p)),

r-popj-step (p-current-instruction (p), p->r (p)))

Theorem: sub-addr-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-addr) ∧ proper-p-statep (p) ∧ p-sub-addr-okp (p-current-instruction (p), p)) → r-equal (p->r (p-sub-addr-step (p-current-instruction (p), p)),

r-sub-addr-step (p-current-instruction (p), p->r (p)))

Theorem: eq-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'eq) ∧ proper-p-statep (p) ∧ p-eq-okp (p-current-instruction (p), p)) → r-equal (p->r (p-eq-step (p-current-instruction (p), p)),

r-eq-step (p-current-instruction (p), p->r (p)))

Theorem: lt-addr-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-addr) ∧ proper-p-statep (p) ∧ p-lt-addr-okp (p-current-instruction (p), p)) → r-equal (p->r (p-lt-addr-step (p-current-instruction (p), p)),

r-lt-addr-step (p-current-instruction (p), p->r (p)))

Theorem: fetch-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch) ∧ proper-p-statep (p) ∧ p-fetch-okp (p-current-instruction (p), p)) → r-equal (p->r (p-fetch-step (p-current-instruction (p), p)),

r-fetch-step (p-current-instruction (p), p->r (p)))

Event: Disable small-integerp.

Event: Disable iplus.

Event: Disable fix-small-integer.

Event: Disable idifference.

Event: Disable inegate.

Event: Disable ilessp.

Theorem: add-int-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int) ∧ proper-p-statep (p) ∧ p-add-int-okp (p-current-instruction (p), p))

→ r-equal (p->r (p-add-int-step (p-current-instruction (p), p)), r-add-int-step (p-current-instruction (p), p->r (p)))

Theorem: add-int-with-carry-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int-with-carry) ∧ proper-p-statep (p) ∧ p-add-int-with-carry-okp (p-current-instruction (p), p)) → r-equal (p->r (p-add-int-with-carry-step (p-current-instruction (p), p)),

r-add-int-with-carry-step (p-current-instruction (p), p->r (p)))

Theorem: add1-int-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-int) ∧ proper-p-statep (p) ∧ p-add1-int-okp (p-current-instruction (p), p)) → r-equal (p->r (p-add1-int-step (p-current-instruction (p), p)),

r-add1-int-step (p-current-instruction (p), p->r (p)))

Theorem: sub-int-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int) ∧ proper-p-statep (p) ∧ p-sub-int-okp (p-current-instruction (p), p)) → r-equal (p->r (p-sub-int-step (p-current-instruction (p), p)),

r-sub-int-step (p-current-instruction (p), p->r (p)))

Event: Enable commutativity-of-iplus.

Theorem: sub-int-with-carry-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int-with-carry) ∧ proper-p-statep (p) ∧ p-sub-int-with-carry-okp (p-current-instruction (p), p)) → r-equal (p->r (p-sub-int-with-carry-step (p-current-instruction (p), p)),

r-sub-int-with-carry-step (p-current-instruction (p), p->r (p)))

Theorem: sub1-int-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-int) ∧ proper-p-statep (p) ∧ p-sub1-int-okp (p-current-instruction (p), p)) → r-equal (p->r (p-sub1-int-step (p-current-instruction (p), p)),

r-sub1-int-step (p-current-instruction (p), p->r (p)))

Theorem: neg-int-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'neg-int) ∧ proper-p-statep (p) ∧ p-neg-int-okp (p-current-instruction (p), p)) → r-equal (p->r (p-neg-int-step (p-current-instruction (p), p)),

r-neg-int-step (p-current-instruction (p), p->r (p)))

Theorem: lt-int-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-int) ∧ proper-p-statep (p) ∧ p-lt-int-okp (p-current-instruction (p), p)) → r-equal (p->r (p-lt-int-step (p-current-instruction (p), p)),

r-lt-int-step (p-current-instruction (p), p->r (p)))

Theorem: int-to-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'int-to-nat) ∧ proper-p-statep (p) ∧ p-int-to-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-int-to-nat-step (p-current-instruction (p), p)),

r-int-to-nat-step (p-current-instruction (p), p->r (p)))

Theorem: add-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat) ∧ proper-p-statep (p) ∧ p-add-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-add-nat-step (p-current-instruction (p), p)),

r-add-nat-step (p-current-instruction (p), p->r (p)))

Theorem: sub-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat) ∧ proper-p-statep (p) ∧ p-sub-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-sub-nat-step (p-current-instruction (p), p)),

r-sub-nat-step (p-current-instruction (p), p->r (p)))

Theorem: sub-nat-with-carry-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat-with-carry) ∧ proper-p-statep (p) ∧ p-sub-nat-with-carry-okp (p-current-instruction (p), p))

→ r-equal (p->r (p-sub-nat-with-carry-step (p-current-instruction (p), p)), r-sub-nat-with-carry-step (p-current-instruction (p), p->r (p)))

Theorem: sub1-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-nat) ∧ proper-p-statep (p) ∧ p-sub1-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-sub1-nat-step (p-current-instruction (p), p)),

r-sub1-nat-step (p-current-instruction (p), p->r (p)))

Theorem: lt-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-nat) ∧ proper-p-statep (p) ∧ p-lt-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-lt-nat-step (p-current-instruction (p), p)),

r-lt-nat-step (p-current-instruction (p), p->r (p)))

Theorem: mult2-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat) ∧ proper-p-statep (p) ∧ p-mult2-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-mult2-nat-step (p-current-instruction (p), p)),

r-mult2-nat-step (p-current-instruction (p), p->r (p)))

Theorem: div2-nat-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'div2-nat) ∧ proper-p-statep (p) ∧ p-div2-nat-okp (p-current-instruction (p), p)) → r-equal (p->r (p-div2-nat-step (p-current-instruction (p), p)),

r-div2-nat-step (p-current-instruction (p), p->r (p)))

Theorem: or-bitv-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bitv) ∧ proper-p-statep (p) ∧ p-or-bitv-okp (p-current-instruction (p), p)) → r-equal (p->r (p-or-bitv-step (p-current-instruction (p), p)),

r-or-bitv-step (p-current-instruction (p), p->r (p)))

Theorem: and-bitv-one-way-correspondence-p-r ((p-psw (p) = 'run)

∧ (car (p-current-instruction (p)) = 'and-bitv) ∧ proper-p-statep (p) ∧ p-and-bitv-okp (p-current-instruction (p), p)) → r-equal (p->r (p-and-bitv-step (p-current-instruction (p), p)),

r-and-bitv-step (p-current-instruction (p), p->r (p)))

Theorem: not-bitv-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bitv) ∧ proper-p-statep (p) ∧ p-not-bitv-okp (p-current-instruction (p), p)) → r-equal (p->r (p-not-bitv-step (p-current-instruction (p), p)),

r-not-bitv-step (p-current-instruction (p), p->r (p)))

Theorem: xor-bitv-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'xor-bitv) ∧ proper-p-statep (p) ∧ p-xor-bitv-okp (p-current-instruction (p), p)) → r-equal (p->r (p-xor-bitv-step (p-current-instruction (p), p)),

r-xor-bitv-step (p-current-instruction (p), p->r (p)))

Theorem: rsh-bitv-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'rsh-bitv) ∧ proper-p-statep (p) ∧ p-rsh-bitv-okp (p-current-instruction (p), p)) → r-equal (p->r (p-rsh-bitv-step (p-current-instruction (p), p)),

r-rsh-bitv-step (p-current-instruction (p), p->r (p)))

Theorem: lsh-bitv-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lsh-bitv) ∧ proper-p-statep (p) ∧ p-lsh-bitv-okp (p-current-instruction (p), p)) → r-equal (p->r (p-lsh-bitv-step (p-current-instruction (p), p)),

r-lsh-bitv-step (p-current-instruction (p), p->r (p)))

Event: Disable and-bool.

Event: Disable or-bool.

Event: Disable not-bool.

Theorem: or-bool-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bool) ∧ proper-p-statep (p) ∧ p-or-bool-okp (p-current-instruction (p), p)) → r-equal (p->r (p-or-bool-step (p-current-instruction (p), p)),

r-or-bool-step (p-current-instruction (p), p->r (p)))

Theorem: and-bool-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bool) ∧ proper-p-statep (p) ∧ p-and-bool-okp (p-current-instruction (p), p)) → r-equal (p->r (p-and-bool-step (p-current-instruction (p), p)),

r-and-bool-step (p-current-instruction (p), p->r (p)))

Theorem: not-bool-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bool) ∧ proper-p-statep (p) ∧ p-not-bool-okp (p-current-instruction (p), p)) → r-equal (p->r (p-not-bool-step (p-current-instruction (p), p)),

r-not-bool-step (p-current-instruction (p), p->r (p)))

; In the next owc, we happen to compute a tstk stack pointer that
; is constant.  In particular, we generate (tag 'sys-addr (cons 'tstk n))
; for n = 0.  Thus, the tag computes and we get a constant that does
; not match a tag expression.  I therefore have to prove:

Theorem: stk-equal-reflexive-tstk-instance

stk-equal ('(sys-addr (tstk . 0)),

p->r sys-data-segment (ctrl-stk1 , max-ctrl-stk-size1 , temp-stk, max-temp-stk-size),

p->r sys-data-segment (ctrl-stk2 , max-ctrl-stk-size2 , temp-stk, max-temp-stk-size))

Theorem: jump-if-temp-stk-full-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-full) ∧ proper-p-statep (p)

∧ p-jump-if-temp-stk-full-okp (p-current-instruction (p), p)) → r-equal (p->r (p-jump-if-temp-stk-full-step (p-current-instruction (p), p)),

r-jump-if-temp-stk-full-step (p-current-instruction (p), p->r (p)))

; The following owc depends upon the definition of empty-stkp.  Recall
; that it has been disabled.  This is the only one so far that needs
; to know what it is.  Of course, the test made by the r-level
; jump-if-temp-stk-empty crucially depends on empty-stkp being
; consistently defined with the arithmetic done at the r-level.

Theorem: jump-if-temp-stk-empty-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-empty) ∧ proper-p-statep (p) ∧ p-jump-if-temp-stk-empty-okp (p-current-instruction (p), p)) → r-equal (p->r (p-jump-if-temp-stk-empty-step (p-current-instruction (p), p)),

r-jump-if-temp-stk-empty-step (p-current-instruction (p), p->r (p)))

; All of the test instructions at the r level use the same
; predicate the p level does to determine whether the test
; is satisfied.

Event: Disable p-test-natp.

Event: Disable p-test-intp.

Event: Disable p-test-bitvp.

Event: Disable p-test-boolp.

Theorem: test-nat-and-jump-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-nat-and-jump) ∧ proper-p-statep (p) ∧ p-test-nat-and-jump-okp (p-current-instruction (p), p)) → r-equal (p->r (p-test-nat-and-jump-step (p-current-instruction (p), p)),

r-test-nat-and-jump-step (p-current-instruction (p), p->r (p)))

Theorem: test-int-and-jump-one-way-correspondence-p-r ((p-psw (p) = 'run)

∧ (car (p-current-instruction (p)) = 'test-int-and-jump) ∧ proper-p-statep (p) ∧ p-test-int-and-jump-okp (p-current-instruction (p), p)) → r-equal (p->r (p-test-int-and-jump-step (p-current-instruction (p), p)),

r-test-int-and-jump-step (p-current-instruction (p), p->r (p)))

Theorem: test-bool-and-jump-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bool-and-jump) ∧ proper-p-statep (p) ∧ p-test-bool-and-jump-okp (p-current-instruction (p), p)) → r-equal (p->r (p-test-bool-and-jump-step (p-current-instruction (p), p)),

r-test-bool-and-jump-step (p-current-instruction (p), p->r (p)))

Theorem: test-bitv-and-jump-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bitv-and-jump) ∧ proper-p-statep (p) ∧ p-test-bitv-and-jump-okp (p-current-instruction (p), p)) → r-equal (p->r (p-test-bitv-and-jump-step (p-current-instruction (p), p)),

r-test-bitv-and-jump-step (p-current-instruction (p), p->r (p)))

Theorem: length-put-value-indirect length (put-value-indirect (val, n, alist)) = length (alist)

Theorem: put-is-put-value-indirect (i < length (alist)) → (put (val, i, append (strip-cdrs (alist), stk))

= append (strip-cdrs (put-value-indirect (val, i, alist)), stk))

Theorem: put-plus-append-commuted (i = length (a)) → (put (val, j + i, append (a, b)) = append (a, put (val, j , b)))

Theorem: put-cdr-p->r ctrl-stk-2 (proper-p-statep1 (p) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p))) ∧ (i < length (bindings (car (p-ctrl-stk (p)))))) → (put (val,

(p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p)))

+ i,

cdr (p->r ctrl-stk (p-ctrl-stk (p), p-max-ctrl-stk-size (p)))) = cdr (p->r ctrl-stk (cons (p-frame (put-value-indirect (val,

i,

bindings (car (p-ctrl-stk (p)))),

ret-pc (car (p-ctrl-stk (p)))), cdr (p-ctrl-stk (p))),

p-max-ctrl-stk-size (p))))

Event: Disable put-plus-append-commuted.

Theorem: p-ctrl-stk-size-put-value-indirect listp (ctrl-stk) → (p-ctrl-stk-size (cons (p-frame (put-value-indirect (val,

i,

bindings (car (ctrl-stk))),

ret-pc (car (ctrl-stk))), cdr (ctrl-stk)))

= p-ctrl-stk-size (ctrl-stk))

; The semantics of the pop-locn instruction, at the p level,
; introduces the term (cdr (p-ctrl-stk p)), which permits
; (p-ctrl-stk-size (p-ctrl-stk p)) to expand.  When that happens
; the lemma above (at least) is no longer applicable.  Perhaps
; the problem could be avoided by proving a bridged version of that
; single result.  But rather than do that, I will simply disable
; p-ctrl-stk-size in the owc proof.

Theorem: pop-locn-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-locn) ∧ proper-p-statep (p) ∧ p-pop-locn-okp (p-current-instruction (p), p)) → r-equal (p->r (p-pop-locn-step (p-current-instruction (p), p)),

r-pop-locn-step (p-current-instruction (p), p->r (p)))

Theorem: difference-plus-x-y-y ((x + y) − y) = fix (x)

Theorem: get-strip-cdrs get (i, strip-cdrs (alist)) = cdr (get (i, alist))

Theorem: get-non-numberp (i ∉ N) → (get (i, x) = car (x))

Theorem: get-cdr-p->r ctrl-stk-2 (proper-p-statep1 (p) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p))) ∧ (i < length (bindings (car (p-ctrl-stk (p))))))

→ (get ((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p))) + i, cdr (p->r ctrl-stk (p-ctrl-stk (p), p-max-ctrl-stk-size (p))))

= cdr (get (i, bindings (car (p-ctrl-stk (p))))))

Event: Disable get-non-numberp.

; I now need a more general version of get-find-position-of-var.
; This could be moved up to make the proof of the other version
; faster.

Theorem: get-find-position-of-var-generalized (var ∈ strip-cars (alist)) → (get (find-position-of-var (var, strip-cars (alist)), alist)

= assoc (var, alist))

Theorem: get-find-position-of-var-bindings (proper-p-statep1 (p) ∧ (var ∈ append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))))

→ (get (find-position-of-var (var,

append (formal-vars (assoc (car (untag (p-pc (p))),

p-prog-segment (p))),

strip-cars (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))),

bindings (car (p-ctrl-stk (p)))) = assoc (var, bindings (car (p-ctrl-stk (p)))))

Theorem: locn-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'locn) ∧ proper-p-statep (p) ∧ p-locn-okp (p-current-instruction (p), p)) → r-equal (p->r (p-locn-step (p-current-instruction (p), p)),

r-locn-step (p-current-instruction (p), p->r (p)))

Theorem: jump-case-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-case) ∧ proper-p-statep (p) ∧ p-jump-case-okp (p-current-instruction (p), p)) → r-equal (p->r (p-jump-case-step (p-current-instruction (p), p)),

r-jump-case-step (p-current-instruction (p), p->r (p)))

; We are headed into the CALL case.  I am going to keep
; p-ctrl-stk-size disabled and open it explicitly on the newly
; pushed stack.

Theorem: p-ctrl-stk-size-cons-p-frame p-ctrl-stk-size (cons (p-frame, stk)) = (p-frame-size (p-frame) + p-ctrl-stk-size (stk))

; Proceeding with the proof of the owc, I first address the equality
; of the two ctrl stack sizes.  It suffices to know.

Theorem: length-pairlist length (pairlist (a, b)) = length (a)

Theorem: length-pair-temps-with-initial-values length (pair-temps-with-initial-values (alist)) = length (alist)

; The following speeds things up slightly.

Event: Enable plus-0.

; Next we establish that the lengths of the final tstks are the same
; at both levels.  This follows from what we already have about popn
; being cdr-n and the length of cdr-n.
; Now we proceed to the stk-equal question on the cstk.  This is the
; crux of the call proof.  By allowing p->r_ctrl-stk to open we
; turn it into an append of nat-0s, etc., and enable our previously
; implemented lemmas converting puts to pushes to work.
; That explains the first two puts that the r machine does on call,
; one to push the ret-pc, the other to push the old cfp.
; Then r does a fetch-n to get the formals and a deposit-lst to push
; the formals and locals.  We deal with that now.
; We establish that the values the r machine fetches from its
; temp stk are the same as the values the p machine fetches.

Definition: fetch-n-p->r sys-data-segment-generalized-hint (n, i) = if n ≃ 0 then t

else fetch-n-p->r sys-data-segment-generalized-hint (n − 1, 1 + i) endif Theorem: cdr-n-append-1 (length (a) ≮ n) → (cdr-n (n, append (a, b)) = append (cdr-n (n, a), b))

Theorem: car-append{general} car (append (a, b)) = if listp (a) then car (a)

else car (b) endif

Event: Enable listp-cdr-n.

Theorem: fetch-n-p->r sys-data-segment-generalized (proper-p-statep1 (p) ∧ (i ∈ N) ∧ (length (cdr-n (i, p-temp-stk (p))) ≮ n)) → (fetch-n (n,

            tag ('sys-addr,

cons ('tstk,

i + (p-max-temp-stk-size (p)

− length (p-temp-stk (p))))),

p->r sys-data-segment (p-ctrl-stk (p), p-max-ctrl-stk-size (p), p-temp-stk (p), p-max-temp-stk-size (p)))

= first-n (n, cdr-n (i, p-temp-stk (p))))

Theorem: fetch-n-p->r sys-data-segment-call (proper-p-statep1 (p) ∧ (length (p-temp-stk (p)) ≮ n)) → (fetch-n (n,

            tag ('sys-addr,

cons ('tstk,

p-max-temp-stk-size (p) − length (p-temp-stk (p)))),

p->r sys-data-segment (p-ctrl-stk (p), p-max-ctrl-stk-size (p), p-temp-stk (p), p-max-temp-stk-size (p)))

= first-n (n, p-temp-stk (p)))

; So next the r machine does a deposit-lst on cstk.  Since deposit-lst
; operates on a segment, not just a single area, we have to give it
; a segment below.  The segment we give it is one obtained by doing
; a put-assoc to any other segment.  The value put by that put-assoc
; represents the cstk on which the deposits occur.  That cstk, in our
; application, happens to be the one on which the ret-pc and cfp were
; pushed.

Definition: deposit-lst-put-assoc-append-hint (n, lst, stk) = if lst ≃ nil then t

else deposit-lst-put-assoc-append-hint (n − 1, cdr (lst), cons (car (lst), stk)) endif

Theorem: deposit-lst-put-assoc-append (definedp ('cstk, segment) ∧ (n ≮ length (lst)) ∧ (n ∈ N)) → (deposit-lst (lst,

tag ('sys-addr, cons ('cstk, n − 1)),

put-assoc (append (nat-0s (n), stk), 'cstk, segment))

= put-assoc (append (nat-0s (n − length (lst)),

append (rev (lst), stk)),

                  'cstk,

segment))

; Note:  Each iteration we do a put.  We want our put-append-1 lemma to
; resolve it.  We don't want nat-0s expanding on us!
; To relieve the hypotheses we have to know the classic theorems:

Event: Enable length-first-n.

Event: Enable length-strip-cadrs.

; Having applied the lemma it remains to simplify the resulting rhs.  This
; requires more golden oldies:

Theorem: rev-rev properp (x) → (rev (rev (x)) = x)

Event: Enable properp-strip-cadrs.

Theorem: append-nil{special} append (nil, x) = x

; The rule above isn't crucial of course but it speeds things
; up a bit.
; Having simplified the rhs maximally, we observe that it is
; equivalent to using p->r_sys-data-segment on a newly pushed
; p-frame.

; Before we can prove that we have to know the following classic theorems:

Theorem: strip-cdrs-append strip-cdrs (append (a, b)) = append (strip-cdrs (a), strip-cdrs (b))

Theorem: strip-cdrs-pairlist ((length (a) = length (b)) ∧ properp (b)) → (strip-cdrs (pairlist (a, b)) = b)

Theorem: strip-cdrs-pair-temps-with-initial-values strip-cdrs (pair-temps-with-initial-values (alist)) = strip-cadrs (alist)

Theorem: difference-difference ((x − y) − z) = (x − (y + z))

Event: Enable properp-rev.

Event: Enable rev-append.

Event: Enable length-rev.

; Here then is the theorem that folds the PUT-ASSOC of the r-level
; cstk into a p->r_sys-data-segment.
; Note:  At one time I arranged this lemma to fold up into a
; p->r_ctrl-stk, with the intention of relying on
; put-assoc-cstk-p->r_sys-dat-segment-local to fold that
; up into the p->r_sys-data-segment.  That strategy did not
; work in the proof of the call owc because there I have
; p->r_ctrl-stk enabled and as soon as it was folded up
; it unfolded again.

Theorem: put-assoc-cstk-p->r sys-data-segment-call (((p-max-ctrl-stk-size (p) − 1) − 1) ≮ (p-ctrl-stk-size (p-ctrl-stk (p))

+ length (formal-vars (assoc (name, p-prog-segment (p)))) + length (temp-var-dcls (assoc (name, p-prog-segment (p))))))

→ (put-assoc (append (nat-0s ((((p-max-ctrl-stk-size (p)

− p-ctrl-stk-size (p-ctrl-stk (p)))− 1) − 1) − (length (formal-vars (assoc (name,

p-prog-segment (p))))

+ length (temp-var-dcls (assoc (name,

p-prog-segment (p)))))),

append (rev (first-n (length (formal-vars (assoc (name,

p-prog-segment (p)))),

p-temp-stk (p))),

append (strip-cadrs (temp-var-dcls (assoc (name,

p-prog-segment (p)))),

cons (tag ('sys-addr,

cons ('cstk, ((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (cdr (p-ctrl-stk (p))))− 1) − 1)),

cons (tag ('pc,

cons (car (untag (p-pc (p))),

1 + cdr (untag (p-pc (p))))),

append (p->r ctrl-stk1 (p-ctrl-stk (p),

p-max-ctrl-stk-size (p)),

                                                    '((nat 0)))))))),
              'cstk,

p->r sys-data-segment (ctrl-stk, p-max-ctrl-stk-size (p), temp-stk, max-temp-stk-size)) = p->r sys-data-segment (cons (p-frame (append (pairlist (formal-vars (assoc (name,

p-prog-segment (p))),

rev (first-n (length (formal-vars (assoc (name,

p-prog-segment (p)))),

p-temp-stk (p)))), pair-temps-with-initial-values (temp-var-dcls (assoc (name,

p-prog-segment (p))))),

tag ('pc,

cons (car (untag (p-pc (p))),

1 + cdr (untag (p-pc (p)))))),

p-ctrl-stk (p)), p-max-ctrl-stk-size (p), temp-stk, max-temp-stk-size))

Event: Disable difference-difference.

; The lemma above takes care of the stk-equal question for cstk, given
; reflexivity.

Theorem: call-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'call) ∧ proper-p-statep (p) ∧ p-call-okp (p-current-instruction (p), p)) → r-equal (p->r (p-call-step (p-current-instruction (p), p)),

r-call-step (p-current-instruction (p), p->r (p)))

; pop-call does an additional pop, which causes us a little trouble.
; The following three lemmas are necessary to let us relieve the hypotheses
; of the DEPOSIT-LST-PUT-ASSOC-APPEND lemma.

Theorem: not-equal-sub1-difference-p-max-ctrl-stk-size-etc (proper-p-statep1 (p) ∧ (((p-max-ctrl-stk-size (p) − 1) − 1)

≮ (p-ctrl-stk-size (p-ctrl-stk (p))

+ length (formal-vars (assoc (untag (car (p-temp-stk (p))),

p-prog-segment (p))))

+ length (temp-var-dcls (assoc (untag (car (p-temp-stk (p))),

p-prog-segment (p)))))))

→ (((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p))) − 1) ≠ 0)

Event: Enable length-fetch-n.

Theorem: not-lessp-sub1-sub1-difference-p-max-ctrl-stk-size-etc (proper-p-statep1 (p) ∧ (((p-max-ctrl-stk-size (p) − 1) − 1)

≮ (p-ctrl-stk-size (p-ctrl-stk (p))

+ length (formal-vars (assoc (untag (car (p-temp-stk (p))),

p-prog-segment (p))))

+ length (temp-var-dcls (assoc (untag (car (p-temp-stk (p))),

p-prog-segment (p)))))))

→ (((((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p))) − 1) − 1)

< (length (formal-vars (assoc (untag (car (p-temp-stk (p))),

p-prog-segment (p))))

+ length (temp-var-dcls (assoc (untag (car (p-temp-stk (p))),

p-prog-segment (p))))))

= f)

Theorem: fetch-n-p->r sys-data-segment-pop-call (proper-p-statep1 (p) ∧ (p-max-temp-stk-size (p) ≮ length (p-temp-stk (p)))

∧ (length (cdr (p-temp-stk (p))) ≮ n)) → (fetch-n (n,

            tag ('sys-addr,

cons ('tstk, p-max-temp-stk-size (p) − length (cdr (p-temp-stk (p))))),

p->r sys-data-segment (p-ctrl-stk (p), p-max-ctrl-stk-size (p), p-temp-stk (p), p-max-temp-stk-size (p)))

= first-n (n, cdr (p-temp-stk (p))))

Theorem: put-assoc-cstk-p->r sys-data-segment-pop-call (((p-max-ctrl-stk-size (p) − 1) − 1) ≮ (p-ctrl-stk-size (p-ctrl-stk (p))

+ length (formal-vars (assoc (name, p-prog-segment (p)))) + length (temp-var-dcls (assoc (name, p-prog-segment (p))))))

→ (put-assoc (append (nat-0s ((((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p))) − (length (formal-vars (assoc (name,

p-prog-segment (p))))

+ length (temp-var-dcls (assoc (name,

p-prog-segment (p))))))− 1) − 1),

append (rev (first-n (length (formal-vars (assoc (name,

p-prog-segment (p)))),

cdr (p-temp-stk (p)))), append (strip-cadrs (temp-var-dcls (assoc (name,

p-prog-segment (p)))),

cons (tag ('sys-addr,

cons ('cstk, ((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (cdr (p-ctrl-stk (p))))− 1) − 1)),

cons (tag ('pc,

cons (car (untag (p-pc (p))),

1 + cdr (untag (p-pc (p))))),

append (p->r ctrl-stk1 (p-ctrl-stk (p),

p-max-ctrl-stk-size (p)),

                                                    '((nat 0)))))))),
              'cstk,

p->r sys-data-segment (ctrl-stk, p-max-ctrl-stk-size (p), temp-stk, max-temp-stk-size)) = p->r sys-data-segment (cons (p-frame (append (pairlist (formal-vars (assoc (name,

p-prog-segment (p))),

rev (first-n (length (formal-vars (assoc (name,

p-prog-segment (p)))),

cdr (p-temp-stk (p))))), pair-temps-with-initial-values (temp-var-dcls (assoc (name,

p-prog-segment (p))))),

tag ('pc,

cons (car (untag (p-pc (p))),

1 + cdr (untag (p-pc (p)))))),

p-ctrl-stk (p)), p-max-ctrl-stk-size (p), temp-stk, max-temp-stk-size))

Theorem: cdr-n-plus-append-pop-call (len < max) → (cdr-n ((max − len) + n, append (nat-0s ((max − len) − 1), stk))

= cdr (cdr-n (n, stk)))

; pop-call has all the disable/enable hints of call; in addition,
; it disables nat-0s.  The problem is that because of the extra
; pop there is permission to expand nat-0s one more and lemmas
; fail to fire, it also enables difference-sub1 to let the extra
; pop come out where I expect it.

Theorem: pop-call-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-call) ∧ proper-p-statep (p) ∧ p-pop-call-okp (p-current-instruction (p), p)) → r-equal (p->r (p-pop-call-step (p-current-instruction (p), p)),

r-pop-call-step (p-current-instruction (p), p->r (p)))

; I am now headed for ret.  Because the ret command sometimes halts,
; and we're trying to prove r-equals of such states, we need to know
; what r-halt does.  I suppose I could have allowed it to expand.

Theorem: components-of-r-halt (r-pc (r-halt (r, psw)) = r-pc (r)) ∧ (r-cfp (r-halt (r, psw)) = r-cfp (r)) ∧ (r-csp (r-halt (r, psw)) = r-csp (r)) ∧ (r-tsp (r-halt (r, psw)) = r-tsp (r))

∧ (r-x (r-halt (r, psw)) = r-x (r)) ∧ (r-y (r-halt (r, psw)) = r-y (r)) ∧ (r-c-flg (r-halt (r, psw)) = r-c-flg (r)) ∧ (r-v-flg (r-halt (r, psw)) = r-v-flg (r)) ∧ (r-n-flg (r-halt (r, psw)) = r-n-flg (r)) ∧ (r-z-flg (r-halt (r, psw)) = r-z-flg (r)) ∧ (r-prog-segment (r-halt (r, psw)) = r-prog-segment (r)) ∧ (r-usr-data-segment (r-halt (r, psw)) = r-usr-data-segment (r)) ∧ (r-sys-data-segment (r-halt (r, psw)) = r-sys-data-segment (r)) ∧ (r-word-size (r-halt (r, psw)) = r-word-size (r))

; The p level machine cdrs the ctrl stack.  The r level, of course,
; doesn't, but it does set the csp and cfp by computation on the
; about-to-be popped top frame.  We need to know that the values
; it retrieves for ret-pc and the new cfp are the same as those the
; p machine uses.
; The values of cfp and ret-pc are fetched from an address based
; on the current cfp, which involves the size of the stack from
; before the top frame was pushed.  But the lemmas we have for
; explaining how to get from a stack are based on offsets from the
; the top of the stack, not negative offsets from somewhere in the
; middle.  The following lemma takes care of this by converting the
; previously computed cfp from a "somewhere in the middle" address
; to an offset from the current top.
; Warning:  The following lemma folds up p-ctrl-stk-size.  It must be not
; enabled unless that function is disabled.

Theorem: difference-p-ctrl-stk-size-folder (listp (p-ctrl-stk (p)) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p)))) → ((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (cdr (p-ctrl-stk (p))))

= (1 + ((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (p-ctrl-stk (p))) + length (bindings (top (p-ctrl-stk (p)))) + 1)))

; Note: The rather cruious ordering of the addends above makes it perfect
; fodder for get-append, provided the system doesn't rearrange the
; plus nests.  Note that the classic properties of plus are disabled
; in the next lemma.
; So here are the two lemmas that tell us the r machine fetches the same

; ret-pc and cfp that the p machine does.

Theorem: ret-pc-in-correct-position (listp (p-ctrl-stk (p)) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p)))) → (get ((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (cdr (p-ctrl-stk (p)))) − 1,

cdr (p->r ctrl-stk (p-ctrl-stk (p), p-max-ctrl-stk-size (p)))) = ret-pc (car (p-ctrl-stk (p))))

Theorem: cfp-in-correct-position (listp (p-ctrl-stk (p)) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p)))) → (get (((p-max-ctrl-stk-size (p) − p-ctrl-stk-size (cdr (p-ctrl-stk (p)))) − 1) − 1,

cdr (p->r ctrl-stk (p-ctrl-stk (p), p-max-ctrl-stk-size (p)))) = p->r cfp (cdr (p-ctrl-stk (p)), p-max-ctrl-stk-size (p)))

; And now we shut down the lemma that folds p-ctrl-stk-size.

Event: Disable difference-p-ctrl-stk-size-folder.

; The next pair of lemmas help deal with the arithmetic surrounding
; the hypothesis that the ctrl-stk has more than one frame on it.

Theorem: lessp-p-ctrl-stk-size listp (stk) → (0 < p-ctrl-stk-size (stk))

Theorem: zerop-difference-p-ctrl-stk-size (listp (p-ctrl-stk (p)) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p)))) → ((((((1 + p-max-ctrl-stk-size (p))

− ((p-max-ctrl-stk-size (p)

− p-ctrl-stk-size (cdr (p-ctrl-stk (p))))− 1))− 1) − 1) = 0) = (cdr (p-ctrl-stk (p)) ≃ nil))

; We now consider the crux of the matter, which is proving the
; stk-equality of the ctrl stks after the ret.  Recall that until
; now we have handled stk-equal questions in two different ways:
; For cstk we arranged for the r-level operation to fold itself into
; a mapped down image of the corresponding p level operation and then
; appealed simply to the reflexivity of stk-equal.  For tstk, on the
; other hand, we adopted the much more general strategy of showing

; the equality of the live part of the two stacks.  The stk-equal
; question on tstk was converted to an equality question on cdr-n
; and all-but-last by the lemma stk-equal-tstk-p->r_sys-data-segment.
; To handle ret we will adopt the tstk strategy for cstk.
; We prove a cstk version of stk-equal-tstk-p->r_sys-data-segment.
; If you look below you will see it.  It is necessary to know
; what cdr-n and all-but-last do on p->r_ctrl-stk.

Event: Enable properp-append.

Theorem: properp-p->r ctrl-stk1 properp (p->r ctrl-stk1 (ctrl-stk, max-ctrl-stk-size))

Theorem: all-but-last-cdr-p->r ctrl-stk all-but-last (cdr (p->r ctrl-stk (ctrl-stk, max-ctrl-stk-size))) = append (nat-0s (max-ctrl-stk-size − p-ctrl-stk-size (ctrl-stk)),

p->r ctrl-stk1 (ctrl-stk, max-ctrl-stk-size))

; Here then is the lemma.  The hints were formed by analogy with
; the hints for the tstk version.

Theorem: stk-equal-cstk-p->r sys-data-segment (properp (ctrl-stk) ∧ (n = (max-ctrl-stk-size − p-ctrl-stk-size (ctrl-stk))) ∧ (max-ctrl-stk-size ≮ p-ctrl-stk-size (ctrl-stk)) ∧ ((1 + max-ctrl-stk-size) = length (cdr (assoc ('cstk, segment))))) → (stk-equal (tag ('sys-addr, cons ('cstk, n)),

p->r sys-data-segment (ctrl-stk, max-ctrl-stk-size, temp-stk, max-temp-stk-size),

segment)

= (p->r ctrl-stk1 (ctrl-stk, max-ctrl-stk-size)

= cdr-n (max-ctrl-stk-size − p-ctrl-stk-size (ctrl-stk), all-but-last (cdr (assoc ('cstk, segment))))))

; To apply the lemma we to be able to relieve the hypothesis that
; the new ctrl-stk produced by the p machine is proper.

Theorem: proper-p-ctrl-stkp-implies-properp proper-p-ctrl-stkp (ctrl-stk, name, p) → properp (ctrl-stk)

Theorem: properp-p-ctrl-stkp proper-p-statep1 (p) → properp (cdr (p-ctrl-stk (p)))

; Once we've done that we rewrite the stk-equal to the cdr-n of
; the all-but-last of the mapped down stack.  The all-but-last
; theorem above takes care of that function.  The following cdr-n
; lemma shows that the cdr-n is exactly enough to pop off the
; top frame.

Theorem: difference-plus-plus-plus-cancellation ((x + (y + (z + n))) − n) = (y + (z + x))

; The odd reordering of the addends above makes the result perfect
; fodder for cdr-n-plus-append.

Theorem: cdr-n-append-ret ((max = (2 + length (part1 ) + length (part2 ) + length (tail))) ∧ (len = length (tail))) → (cdr-n (max − len, append (part1 , append (part2 , cons (e1 , cons (e2 , tail)))))

= tail)

; And that is that.

Theorem: ret-one-way-correspondence-p-r ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'ret) ∧ proper-p-statep (p) ∧ p-ret-okp (p-current-instruction (p), p)) → r-equal (p->r (p-ret-step (p-current-instruction (p), p)),

r-ret-step (p-current-instruction (p), p->r (p)))

; We now attack the invariance of proper-p-statep.  The proof is
; as you would expect, by consideration of each of the cases.
; We first prove a beautiful theorem.  Suppose p is a proper p state
; and p' is derived from p, having certain components in common with it
; (e.g., the program segment).  Then the question "is p' proper?"
; can be reduced the some questions about its components and p.
; That may sound like just opening up proper-p-statep, but it's not.
; Opening up would reduce the question to some questions about its
; components and p'.  The nice thing about reducing it to p is that
; we will generally have many hypotheses about things being

; proper p objects.
; The amount of work we have to do to prove this lemma is an indication
; of how much it saves us, over merely opening up proper-p-statep.

; Whenever I have a same-signature as a hyp of a rule with concl
; lhs = rhs the same-signature will determine the direction of
; the rule.  In particular, (same-signature segment1 segment2)
; in a hyp means I will rewrite segment1 terms to segment2 terms.

Event: Enable same-signature-segment-length.

Theorem: same-signature-implies-equal-p-loadablep same-signature (new-data-segment, p-data-segment (p)) → (p-loadablep (p-state (new-pc,

new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw),

load-addr) = p-loadablep (p, load-addr))

Theorem: same-signature-implies-equal-lengths same-signature (segment1 , segment2 ) → (length (cdr (assoc (name, segment1 )))

= length (cdr (assoc (name, segment2 ))))

Theorem: same-signature-implies-equal-definedp same-signature (segment1 , segment2 ) → (definedp (name, segment1 ) = definedp (name, segment2 ))

Theorem: same-signature-implies-equal-p-objectp same-signature (new-data-segment, p-data-segment (p)) → (p-objectp (x,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= p-objectp (x, p))

Theorem: same-signature-implies-equal-all-p-objectps same-signature (new-data-segment, p-data-segment (p)) → (all-p-objectps (lst,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= all-p-objectps (lst, p))

Theorem: same-signature-implies-equal-proper-p-alistp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-alistp (alist,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-alistp (alist, p))

Theorem: same-signature-implies-equal-proper-p-framep same-signature (new-data-segment, p-data-segment (p)) → (proper-p-framep (frame,

name, p-state (new-pc,

new-ctrl-stk,

new-temp-stk,

p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-framep (frame, name, p))

Event: Disable proper-p-framep.

Theorem: same-signature-implies-equal-proper-p-ctrl-stkp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-ctrl-stkp (stk,

name, p-state (new-pc,

new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-ctrl-stkp (stk, name, p))

Theorem: same-signature-implies-equal-proper-p-temp-stkp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-temp-stkp (stk,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-temp-stkp (stk, p))

Theorem: same-signature-implies-equal-proper-p-temp-var-dclsp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-temp-var-dclsp (lst,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-temp-var-dclsp (lst, p))

Theorem: same-signature-implies-equal-proper-p-instructionp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-instructionp (ins,

name, p-state (new-pc,

new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-instructionp (ins, name, p))

Theorem: same-signature-implies-equal-proper-labeled-p-instructionsp same-signature (new-data-segment, p-data-segment (p)) → (proper-labeled-p-instructionsp (lst,

name, p-state (new-pc,

new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-labeled-p-instructionsp (lst, name, p))

Theorem: same-signature-implies-equal-proper-p-program-bodyp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-program-bodyp (lst,

name, p-state (new-pc,

new-ctrl-stk,

new-temp-stk,

p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-program-bodyp (lst, name, p))

Event: Disable proper-p-program-bodyp.

Theorem: same-signature-implies-equal-proper-p-programp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-programp (prog,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-programp (prog, p))

Event: Disable proper-p-programp.

Theorem: same-signature-implies-equal-proper-p-prog-segmentp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-prog-segmentp (lst,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-prog-segmentp (lst, p))

Theorem: same-signature-implies-equal-proper-p-data-segmentp same-signature (new-data-segment, p-data-segment (p)) → (proper-p-data-segmentp (lst,

p-state (new-pc, new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= proper-p-data-segmentp (lst, p))

; We are about to prove the theorem that is our main tool for
; the invariance proofs.  However, there is one major trick ahead.
; Here is a typical step theorem we will have to prove:
;(prove-lemma xxx-preserves-proper-p-statep (rewrite)
; (implies (and (equal (p-psw p) 'run)
;               (equal (car (p-current-instruction p))
;                      'xxx)
;               (proper-p-statep p)
;               (p-xxx-okp (p-current-instruction p) p))
;          (proper-p-statep
;           (p-xxx-step (p-current-instruction p) p))))
; Recall proper-p-state-restructuring.  It is an unconditional
; rewrite that replaces the hypothesized (proper-p-statep p)
; by a conjunction of (proper-p-statep1 p) and some linear
; conditions and a gratuitous but extremely useful
; (proper-p-instructionp (p-current-instruction p) p).
; We depend on that restructuring to let us access many of the
; lemmas already proved.
; However, that same restructuring will hit our concluding
; (proper-p-statep (p-xxx-step ...)) and force us to prove
; different things than we wish.  We are going to avoid this by
; a silly syntactic trick.  The step theorems we prove will
; be of the form:
;(prove-lemma xxx-preserves-proper-p-statep (rewrite)
; (implies (and (equal (p-psw p) 'run)
;               (proper-p-statep p)
;               (p-xxx-okp (p-current-instruction p) p))
;          (ur-proper-p-statep
;           (p-xxx-step (p-current-instruction p) p))))
; where ur-proper-p-statep is in fact proper-p-statep but
; is disabled.

Definition: ur-proper-p-statep (p) = proper-p-statep (p)

; The lemma towards which we have been working, namely the
; lemma that rewrites (proper-p-statep p') to a conjunction
; of facts about p, will actually rewrite (ur-proper-p-statep p'):

Theorem: ur-proper-p-statep-p-state (proper-p-statep (p) ∧ same-signature (new-data-segment, p-data-segment (p))) → (ur-proper-p-statep (p-state (new-pc,

new-ctrl-stk, new-temp-stk, p-prog-segment (p), new-data-segment, p-max-ctrl-stk-size (p), p-max-temp-stk-size (p), p-word-size (p), new-psw))

= (p-objectp-type ('pc, new-pc, p) ∧ listp (new-ctrl-stk) ∧ proper-p-framep (top (new-ctrl-stk), area-name (new-pc), p) ∧ proper-p-ctrl-stkp (pop (new-ctrl-stk),

area-name (ret-pc (top (new-ctrl-stk))), p)

∧ (p-max-ctrl-stk-size (p)

≮ p-ctrl-stk-size (new-ctrl-stk)) ∧ proper-p-temp-stkp (new-temp-stk, p) ∧ (p-max-temp-stk-size (p) ≮ length (new-temp-stk)) ∧ proper-p-data-segmentp (new-data-segment, p)))

Event: Disable ur-proper-p-statep.

; When we are all done we will reveal that ur-proper-p-statep
; is proper-p-statep and get the invariance theorem.
; To apply the main lemma above we need to establish the
; same-signature hypothesis.  We will prove the necessary
; lemmas as needed.  For the no-op case it is:

Event: Enable same-signature-reflexive.

; We also have to be able to establish (proper-p-statep p)
; in a context in which it has been restructured.  This is
; a new problem -- in our previous proofs we always went after
; (proper-p-statep1 p) or explicit inequalities.  Anyway, to
; get (proper-p-statep p) it is sufficient to know:

Theorem: listp-p-current-instruction (car (p-current-instruction (p)) = pack (xxx)) → listp (p-current-instruction (p))

Event: Enable proper-p-framep.

Theorem: no-op-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'no-op) ∧ proper-p-statep (p) ∧ p-no-op-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-no-op-step (p-current-instruction (p), p))

; To prove push-global we need to know that the object pushed is
; a p-objectp.  The object pushed is fetched from the data segment.
; So we have to prove the general fact that anything fetched from
; the data segment is a p-objectp.  This, of course, will be used
; in many of the subsequent proofs.

Theorem: all-p-objectps-implies-p-objectp (all-p-objectps (lst, p) ∧ (x ∈ lst)) → p-objectp (x, p)

Theorem: proper-p-data-segmentp-implies-all-p-objectps (proper-p-data-segmentp (segment, p) ∧ definedp (name, segment)) → all-p-objectps (cdr (assoc (name, segment)), p)

Theorem: p-objectp-get-p-data-segment (proper-p-data-segmentp (segment, p) ∧ definedp (name, segment) ∧ (n < length (cdr (assoc (name, segment))))) → p-objectp (get (n, cdr (assoc (name, segment))), p)

; To access global vars we use a naked car of the global data
; area, knowing that it is a listp -- i.e., there is not
; legal address check.  In addition, we don't get via the
; function get and so the lemma above is not quite what
; we need.  We take care of these details here.

Theorem: definedp-p-data-segment-implies-listp-generalized (proper-p-data-segmentp (segment, p) ∧ definedp (name, segment)) → listp (cdr (assoc (name, segment)))

Theorem: definedp-p-data-segment-implies-listp (proper-p-statep1 (p) ∧ definedp (name, p-data-segment (p))) → listp (cdr (assoc (name, p-data-segment (p))))

Theorem: p-objectp-cadr-assoc-p-data-segment (proper-p-statep1 (p) ∧ definedp (name, p-data-segment (p))) → p-objectp (car (cdr (assoc (name, p-data-segment (p)))), p)

; So that sets us up for:

Theorem: push-global-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-global) ∧ proper-p-statep (p) ∧ p-push-global-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-push-global-step (p-current-instruction (p), p))

; To do pop-global we need first to relieve the hypotheses on our
; ur-proper-p-statep-p-state lemma, namely the same-signature
; hypothesis on the data segment.  The new data segment in
; question is obtained by put-assoc and put.  So we prove:

Theorem: same-signature-put-assoc-generalized (proper-p-data-segmentp (segment, p) ∧ definedp (name, segment) ∧ (length (val) = length (cdr (assoc (name, segment))))) → same-signature (put-assoc (val, name, segment), segment)

; The proper-p-data-segmentp hyp above is necessary only to assure us that
; the alist does not have any nlistp members, so a less sophisticated
; (and state free) predicate could have been used.  But since I had this
; one I used it.  Unfortunately, it introduces a free variable, p, so
; I eliminate it and make it a rewrite rule by choosing the only
; instantiation I ever need:

Theorem: same-signature-put-assoc{special} (proper-p-statep1 (p) ∧ definedp (name, p-data-segment (p)) ∧ (length (val) = length (cdr (assoc (name, p-data-segment (p)))))) → same-signature (put-assoc (val, name, p-data-segment (p)),

p-data-segment (p))

; Since pop-global pops the temp stack, we have to prove that the new
; one is proper:

Theorem: proper-p-temp-stk-cdr (listp (stk) ∧ proper-p-temp-stkp (stk, p)) → proper-p-temp-stkp (cdr (stk), p)

; We wouldn't need the theorem above if proper-p-statep were opened in the
; hypothesis because the (proper-p-temp-stkp (p-temp-stk p) p) would open
; given our interest in (cdr (p-temp-stk p)).
; Finally, since pop-global does a put into the data segment, we need to
; to prove that proper-p-data-segmentp is preserved by the put-assoc and
; put.

Theorem: all-p-objectps-put (p-objectp (val, p) ∧ (n < length (lst)) ∧ all-p-objectps (lst, p)) → all-p-objectps (put (val, n, lst), p)

Event: Enable definedp-put-assoc.

Theorem: proper-p-data-segmentp-put-assoc (proper-p-data-segmentp (segment, p) ∧ definedp (name, segment) ∧ listp (lst) ∧ all-p-objectps (lst, p)) → proper-p-data-segmentp (put-assoc (lst, name, segment), p)

; The lemma above does the job, but note that we need to know that
; the thing we put into the data area is a p-objectp.  What is that
; thing?  It's the top of the temp stack.  So we need to prove:

Theorem: p-objectp-top-p-temp-stk (proper-p-temp-stkp (temp-stk, p) ∧ listp (temp-stk)) → p-objectp (car (temp-stk), p)

; We also get the similar results for top1 and top2:

Theorem: p-objectp-top1-p-temp-stk (proper-p-temp-stkp (temp-stk, p) ∧ listp (cdr (temp-stk))) → p-objectp (cadr (temp-stk), p)

Theorem: p-objectp-top2-p-temp-stk (proper-p-temp-stkp (temp-stk, p) ∧ listp (cddr (temp-stk))) → p-objectp (caddr (temp-stk), p)

; For CALL I will need a more general lemma about the first-n
; of the temp-stk, but I'll wait till I see the need.
; The provision of the three lemmas above interacts in a detrimental
; way with something else in our proofs.  Consider p-deposit-okp,
; for example.  It requires that the top of the temp-stk by a
; p-objectp of type 'addr.  When we assume that -okp we have been
; getting the p-objectp in our assumptions and the p-objectp has then
; been opening up to reveal important things like that the car of the
; object is definedp in the data-segment or, in the case of the arithmetic
; instructions, the object is a numberp.  But with the provision of the
; three p-objectp lemmas above, whenever we hypothesis that something on
; the stack is a p-objectp of a given type the hypothesis is rewritten
; simply to the fact that it is of the right type -- because the p-objectp
; is obvious by the thing merely being on the stack.  This in fact
; suggests an improvement we could make in the defns of all the -okp
; fns:  don't check p-objectp of things on the stack, just check their
; types.  I'll save that for another day.
; Meanwhile, we have a problem:  lots of rules have definedp and numberp
; hyps that will no longer be relieved because the three lemmas above
; have simplified away the p-objectps that used to open up.  What to do?
; I am taking a really simple way out, exploiting the fact that all the
; -okp fns that check for the type of an object do so with
; p-objectp-type.  I will disable it after proving the rule below, which
; not only expands p-objectp-type but also the resulting p-objectp.
; This trick just slips the p-objectp past the three lemmas above.

Theorem: p-objectp-type-opener (p-objectp-type ('nat, x, p) = ((type (x) = 'nat)

∧ (cddr (x) = nil)

∧ small-naturalp (untag (x), p-word-size (p)))) ∧ (p-objectp-type ('int, x, p)

= ((type (x) = 'int) ∧ (cddr (x) = nil) ∧ small-integerp (untag (x), p-word-size (p))))

∧ (p-objectp-type ('bitv, x, p)

= ((type (x) = 'bitv) ∧ (cddr (x) = nil) ∧ bit-vectorp (untag (x), p-word-size (p))))

∧ (p-objectp-type ('bool, x, p)

= ((type (x) = 'bool) ∧ (cddr (x) = nil) ∧ booleanp (untag (x))))

∧ (p-objectp-type ('addr, x, p)

= ((type (x) = 'addr) ∧ (cddr (x) = nil) ∧ adpp (untag (x), p-data-segment (p))))

∧ (p-objectp-type ('pc, x, p)

= ((type (x) = 'pc) ∧ (cddr (x) = nil) ∧ pcpp (untag (x), p-prog-segment (p))))

∧ (p-objectp-type ('subr, x, p)

= ((type (x) = 'subr) ∧ (cddr (x) = nil) ∧ definedp (untag (x), p-prog-segment (p))))

Event: Disable p-objectp-type.

; Confession:  I feel a little dirty for this.  If I ever remove
; the p-objectp tests in the -okp predicates, this will return to
; bite me.  By the way, this problem first arose when I did
; the deposit preservation lemma below.  I put the solution up
; here to keep it in proximity with the lemmas that caused the
; trouble.

Theorem: pop-global-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-global) ∧ proper-p-statep (p) ∧ p-pop-global-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-pop-global-step (p-current-instruction (p), p))

; We need similar machinery to do local variable manipulation.
; In particular, we need to know that any var value extracted
; from the top frame of the ctrl stack is a p-objectp and that
; depositing any p-objectp there leaves the stack proper.
; Here's extraction:

Theorem: p-objectp-cdr-assoc-proper-p-alistp (proper-p-alistp (alist, p) ∧ (var ∈ strip-cars (alist))) → p-objectp (cdr (assoc (var, alist)), p)

; So we get:

Theorem: push-local-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-local) ∧ proper-p-statep (p) ∧ p-push-local-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-push-local-step (p-current-instruction (p), p))

; And now we deal with depositing.  The p machine puts a
; new frame on the stack, replacing the old one.  We need
; to prove that the new frame is proper.  There are many
; parts.  The new frame is built with P-FRAME and the
; "shape" requirements follow immediately from its defn:

Theorem: p-frame-properties listp (cdr (p-frame (alist, ret-pc))) ∧ (cddr (p-frame (alist, ret-pc)) = nil)

; The requirement that the new bindings be a proper-p-alistp
; is established by:

Theorem: proper-p-alistp-put-assoc (proper-p-alistp (alist, p) ∧ (var ∈ strip-cars (alist)) ∧ p-objectp (val, p)) → proper-p-alistp (put-assoc (val, var, alist), p)

; The requirement that the strip-cars of the bindings be
; the local-vars of the current subroutine follows from the
; observation that the strip-cars of the new bindings is the
; same as for the old:

Theorem: strip-cars-put-assoc strip-cars (put-assoc (val, var, alist)) = strip-cars (alist)

; That completes the proof that the new frame is proper.  We
; also have to prove that the new ctrl stack isn't too big.
; This follows immediately from the fact that the new stack is

; the same size as the old, but that simple observation doesn't
; help us unless we disable some arithmetic stuff, because the
; sizes are computed and cause some linear arithmetic splits.
; Rather than disable I'll just handle the splits.  It suffices
; to know:

Theorem: not-equal-p-ctrl-stk-size-1 proper-p-statep1 (p) → ((p-ctrl-stk-size (p-ctrl-stk (p)) − 1) ≠ 0)

; That completes the entire pop-local exercise.

Theorem: pop-local-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-local) ∧ proper-p-statep (p) ∧ p-pop-local-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-pop-local-step (p-current-instruction (p), p))

Theorem: deposit-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit) ∧ proper-p-statep (p) ∧ p-deposit-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-deposit-step (p-current-instruction (p), p))

Theorem: add1-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-nat) ∧ proper-p-statep (p) ∧ p-add1-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-add1-nat-step (p-current-instruction (p), p))

Theorem: add-addr-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-addr) ∧ proper-p-statep (p) ∧ p-add-addr-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-add-addr-step (p-current-instruction (p), p))

; I still need some facts about lessp length and cdr!
; I hope this will take care of it:

Theorem: not-lessp-length-cdr-backchainer (max ≮ length (lst)) → ((max < length (cdr (lst))) = f)

; For add-nat-with-carry we need to prove that our computed
; result is a p-objectp.  It suffices to know:

Theorem: small-naturalp-fix-small-natural small-naturalp (fix-small-natural (i, n), n)

; These kind of lemmas will be required each time we shift to
; consideration of a new data type.

Theorem: add-nat-with-carry-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat-with-carry) ∧ proper-p-statep (p) ∧ p-add-nat-with-carry-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-add-nat-with-carry-step (p-current-instruction (p),

p))

Theorem: mult2-nat-with-carry-out-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat-with-carry-out) ∧ proper-p-statep (p) ∧ p-mult2-nat-with-carry-out-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-mult2-nat-with-carry-out-step (p-current-instruction (p),

p))

Theorem: p-objectp-get-temp-stk (proper-p-temp-stkp (temp-stk, p) ∧ (n < length (temp-stk))) → p-objectp (get (n, temp-stk), p)

Theorem: fetch-temp-stk-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch-temp-stk) ∧ proper-p-statep (p) ∧ p-fetch-temp-stk-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-fetch-temp-stk-step (p-current-instruction (p), p))

Theorem: proper-p-temp-stkp-put (proper-p-temp-stkp (temp-stk, p) ∧ p-objectp (val, p) ∧ (n < length (temp-stk))) → proper-p-temp-stkp (put (val, n, temp-stk), p)

Theorem: deposit-temp-stk-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit-temp-stk) ∧ proper-p-statep (p) ∧ p-deposit-temp-stk-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-deposit-temp-stk-step (p-current-instruction (p), p))

; For POP* we clearly need:

Theorem: proper-p-temp-stkp-cdr-n (proper-p-temp-stkp (stk, p) ∧ (length (stk) ≮ n)) → proper-p-temp-stkp (cdr-n (n, stk), p)

Theorem: pop*-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop*) ∧ proper-p-statep (p) ∧ p-pop*-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-pop*-step (p-current-instruction (p), p))

Theorem: popn-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popn) ∧ proper-p-statep (p) ∧ p-popn-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-popn-step (p-current-instruction (p), p))

; For what it's worth, this concludes the so-called "test section"
; of instructions identified as interesting in the case of the
; one-way-correspondence proof.

Theorem: set-local-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-local) ∧ proper-p-statep (p) ∧ p-set-local-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-set-local-step (p-current-instruction (p), p))

Theorem: set-global-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-global) ∧ proper-p-statep (p) ∧ p-set-global-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-set-global-step (p-current-instruction (p), p))

; To get push-constant we have to know that the case analysis done
; to unabbreviate the constant is the same as that done in the
; syntax check, proper-p-push-constant-instructionp.  It suffices
; to know:

Theorem: nlistp-implies-not-p-objectp (x ≃ nil) → (p-objectp (x, p) = f)

Theorem: labels-are-nlistp-generalized (proper-labeled-p-instructionsp (body, name, p) ∧ listp (lab)) → (¬ find-labelp (lab, body))

Theorem: proper-p-prog-segmentp-implies-proper-labled-p-instructionsp (proper-p-prog-segmentp (segment, p) ∧ definedp (name, segment)) → proper-labeled-p-instructionsp (program-body (assoc (name, segment)),

name, p)

Theorem: labels-are-nlistp (proper-p-statep1 (p) ∧ definedp (name, p-prog-segment (p)) ∧ listp (lab)) → (¬ find-labelp (lab, program-body (assoc (name, p-prog-segment (p)))))

; The following is needed to prove that when a "label" is pushed
; the object is a p-objectp.

Theorem: lessp-find-label find-labelp (lab, lst) → (find-label (lab, lst) < length (lst))

Theorem: push-constant-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-constant) ∧ proper-p-statep (p) ∧ p-push-constant-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-push-constant-step (p-current-instruction (p), p))

; To get push-ctrl-stk-free-size we need to know that the number
; pushed is a small-naturalp.  Despite its name the lemma below
; actually shows that any number less than p-max-ctrl-stk-size is
; ok.

Theorem: proper-p-statep-implies-small-naturalp-p-max-ctrl-stk-size (p-max-ctrl-stk-size (p) < exp (2, p-word-size (p))) → small-naturalp (p-max-ctrl-stk-size (p) − n, p-word-size (p))

Theorem: push-ctrl-stk-free-size-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-ctrl-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-ctrl-stk-free-size-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-push-ctrl-stk-free-size-step (p-current-instruction (p),

p))

; We prove an analogous lemma for p-max-temp-stk-size:

Theorem: proper-p-statep-implies-small-naturalp-p-max-temp-stk-size (p-max-temp-stk-size (p) < exp (2, p-word-size (p))) → small-naturalp (p-max-temp-stk-size (p) − n, p-word-size (p))

Theorem: push-temp-stk-free-size-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-temp-stk-free-size-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-push-temp-stk-free-size-step (p-current-instruction (p),

p))

; And we prove the analogous lemma for the index pushed by push-temp-stk-index.

Theorem: proper-p-statep-implies-small-naturalp-length-p-temp-stk ((p-max-temp-stk-size (p) < exp (2, p-word-size (p))) ∧ (length (p-temp-stk (p)) < p-max-temp-stk-size (p))) → small-naturalp ((length (p-temp-stk (p)) − n) − 1, p-word-size (p))

Theorem: push-temp-stk-index-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-index) ∧ proper-p-statep (p) ∧ p-push-temp-stk-index-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-push-temp-stk-index-step (p-current-instruction (p),

p))

Theorem: pop-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop) ∧ proper-p-statep (p) ∧ p-pop-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-pop-step (p-current-instruction (p), p))

Theorem: jump-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump) ∧ proper-p-statep (p) ∧ p-jump-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-jump-step (p-current-instruction (p), p))

Theorem: pushj-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pushj) ∧ proper-p-statep (p) ∧ p-pushj-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-pushj-step (p-current-instruction (p), p))

Theorem: popj-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popj) ∧ proper-p-statep (p) ∧ p-popj-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-popj-step (p-current-instruction (p), p))

Theorem: sub-addr-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-addr) ∧ proper-p-statep (p) ∧ p-sub-addr-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-sub-addr-step (p-current-instruction (p), p))

; Since bool is disabled we need:

Theorem: p-objectp-bool p-objectp (bool (x), p)

Theorem: eq-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'eq) ∧ proper-p-statep (p) ∧ p-eq-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-eq-step (p-current-instruction (p), p))

Theorem: lt-addr-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-addr) ∧ proper-p-statep (p) ∧ p-lt-addr-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-lt-addr-step (p-current-instruction (p), p))

Theorem: fetch-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch) ∧ proper-p-statep (p) ∧ p-fetch-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-fetch-step (p-current-instruction (p), p))

Theorem: add-int-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int) ∧ proper-p-statep (p) ∧ p-add-int-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-add-int-step (p-current-instruction (p), p))

Event: Enable small-integerp-fix-small-integer-plus-case.

Theorem: add-int-with-carry-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int-with-carry) ∧ proper-p-statep (p) ∧ p-add-int-with-carry-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-add-int-with-carry-step (p-current-instruction (p),

p))

Theorem: add1-int-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-int) ∧ proper-p-statep (p) ∧ p-add1-int-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-add1-int-step (p-current-instruction (p), p))

Theorem: sub-int-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int) ∧ proper-p-statep (p) ∧ p-sub-int-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-sub-int-step (p-current-instruction (p), p))

Event: Enable small-integerp-fix-small-integer-difference-case.

Theorem: sub-int-with-carry-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int-with-carry) ∧ proper-p-statep (p)

∧ p-sub-int-with-carry-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-sub-int-with-carry-step (p-current-instruction (p),

p))

Theorem: sub1-int-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-int) ∧ proper-p-statep (p) ∧ p-sub1-int-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-sub1-int-step (p-current-instruction (p), p))

Theorem: neg-int-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'neg-int) ∧ proper-p-statep (p) ∧ p-neg-int-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-neg-int-step (p-current-instruction (p), p))

Theorem: lt-int-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-int) ∧ proper-p-statep (p) ∧ p-lt-int-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-lt-int-step (p-current-instruction (p), p))

; For int-to-nat conversion we clearly need:

Theorem: small-integerp-implies-small-naturalp (small-integerp (x, word-size) ∧ (¬ negativep (x))) → small-naturalp (x, word-size)

Theorem: int-to-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'int-to-nat) ∧ proper-p-statep (p) ∧ p-int-to-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-int-to-nat-step (p-current-instruction (p), p))

Theorem: add-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat) ∧ proper-p-statep (p) ∧ p-add-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-add-nat-step (p-current-instruction (p), p))

Theorem: small-naturalp-difference small-naturalp (x, word-size) → small-naturalp (x − y, word-size)

Theorem: sub-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat) ∧ proper-p-statep (p) ∧ p-sub-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-sub-nat-step (p-current-instruction (p), p))

; sub-nat-with-carry flag returns one of two different
; differences depending on the args.  We have to show that
; both are small-naturalps.  The first is handled by
; small-natural-difference above.
; The second is:

Theorem: small-naturalp-difference-exp-x (x ≄ 0) → small-naturalp (exp (2, word-size) − x, word-size)

Theorem: sub-nat-with-carry-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat-with-carry) ∧ proper-p-statep (p) ∧ p-sub-nat-with-carry-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-sub-nat-with-carry-step (p-current-instruction (p),

p))

Theorem: small-naturalp-sub1 small-naturalp (x, word-size) → small-naturalp (x − 1, word-size)

Theorem: sub1-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-nat) ∧ proper-p-statep (p) ∧ p-sub1-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-sub1-nat-step (p-current-instruction (p), p))

Theorem: lt-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-nat) ∧ proper-p-statep (p) ∧ p-lt-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-lt-nat-step (p-current-instruction (p), p))

Theorem: mult2-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat) ∧ proper-p-statep (p) ∧ p-mult2-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-mult2-nat-step (p-current-instruction (p), p))

; For div2-nat we must establish that the results are small-naturalps.

Theorem: not-lessp-remainder x ≮ (x mod y)

Event: Enable not-lessp-quotient.

Theorem: small-naturalp-remainder small-naturalp (x, word-size) → small-naturalp (x mod 2, word-size)

Theorem: small-naturalp-quotient small-naturalp (x, word-size) → small-naturalp (x ÷ 2, word-size)

Theorem: div2-nat-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'div2-nat) ∧ proper-p-statep (p) ∧ p-div2-nat-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-div2-nat-step (p-current-instruction (p), p))

; We must show that each bit vector operation yields a bit vector:

Theorem: bit-vectorp-or-bitv (bit-vectorp (x, word-size) ∧ bit-vectorp (y, word-size)) → bit-vectorp (or-bitv (x, y), word-size)

Theorem: bit-vectorp-and-bitv (bit-vectorp (x, word-size) ∧ bit-vectorp (y, word-size)) → bit-vectorp (and-bitv (x, y), word-size)

Theorem: bit-vectorp-xor-bitv (bit-vectorp (x, word-size) ∧ bit-vectorp (y, word-size)) → bit-vectorp (xor-bitv (x, y), word-size)

Theorem: bit-vectorp-not-bitv bit-vectorp (x, word-size) → bit-vectorp (not-bitv (x), word-size)

; It surprised me to see that we need, yet again, the fact that our
; machine has a non-zero word-size.

Theorem: bit-vectorp-rsh-bitv (bit-vectorp (x, word-size) ∧ (word-size ≄ 0)) → bit-vectorp (rsh-bitv (x), word-size)

Event: Disable rsh-bitv.

Theorem: bit-vectorp-lsh-bitv (bit-vectorp (x, word-size) ∧ (word-size ≄ 0)) → bit-vectorp (lsh-bitv (x), word-size)

Event: Disable lsh-bitv.

; To use the latter two rules we need:

Theorem: p-loadablep-implies-not-zerop-p-word-size p-loadablep (p, load-addr) → ((p-word-size (p) ∈ N) ∧ (p-word-size (p) ≠ 0))

Theorem: or-bitv-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bitv) ∧ proper-p-statep (p) ∧ p-or-bitv-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-or-bitv-step (p-current-instruction (p), p))

Theorem: and-bitv-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bitv) ∧ proper-p-statep (p) ∧ p-and-bitv-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-and-bitv-step (p-current-instruction (p), p))

Theorem: not-bitv-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bitv) ∧ proper-p-statep (p) ∧ p-not-bitv-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-not-bitv-step (p-current-instruction (p), p))

Theorem: xor-bitv-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'xor-bitv) ∧ proper-p-statep (p) ∧ p-xor-bitv-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-xor-bitv-step (p-current-instruction (p), p))

Theorem: rsh-bitv-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'rsh-bitv) ∧ proper-p-statep (p) ∧ p-rsh-bitv-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-rsh-bitv-step (p-current-instruction (p), p))

Theorem: lsh-bitv-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lsh-bitv) ∧ proper-p-statep (p) ∧ p-lsh-bitv-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-lsh-bitv-step (p-current-instruction (p), p))

; And we must do the analogous thing for the boolean type and its
; operators.

Theorem: booleanp-or-bool (booleanp (x) ∧ booleanp (y)) → booleanp (or-bool (x, y))

Theorem: booleanp-and-bool (booleanp (x) ∧ booleanp (y)) → booleanp (and-bool (x, y))

Theorem: booleanp-not-bool booleanp (x) → booleanp (not-bool (x))

Theorem: or-bool-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bool) ∧ proper-p-statep (p) ∧ p-or-bool-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-or-bool-step (p-current-instruction (p), p))

Theorem: and-bool-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bool) ∧ proper-p-statep (p) ∧ p-and-bool-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-and-bool-step (p-current-instruction (p), p))

Theorem: not-bool-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bool) ∧ proper-p-statep (p) ∧ p-not-bool-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-not-bool-step (p-current-instruction (p), p))

Theorem: jump-if-temp-stk-full-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-full) ∧ proper-p-statep (p) ∧ p-jump-if-temp-stk-full-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-jump-if-temp-stk-full-step (p-current-instruction (p),

p))

Theorem: jump-if-temp-stk-empty-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-empty) ∧ proper-p-statep (p) ∧ p-jump-if-temp-stk-empty-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-jump-if-temp-stk-empty-step (p-current-instruction (p),

p))

Theorem: test-nat-and-jump-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-nat-and-jump) ∧ proper-p-statep (p) ∧ p-test-nat-and-jump-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-test-nat-and-jump-step (p-current-instruction (p),

p))

Theorem: test-int-and-jump-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-int-and-jump) ∧ proper-p-statep (p) ∧ p-test-int-and-jump-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-test-int-and-jump-step (p-current-instruction (p),

p))

Theorem: test-bool-and-jump-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bool-and-jump) ∧ proper-p-statep (p) ∧ p-test-bool-and-jump-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-test-bool-and-jump-step (p-current-instruction (p),

p))

Theorem: test-bitv-and-jump-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bitv-and-jump) ∧ proper-p-statep (p) ∧ p-test-bitv-and-jump-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-test-bitv-and-jump-step (p-current-instruction (p),

p))

; Since pop-locn uses put-value-indirect to modify the control
; stack, we must know:

Theorem: proper-p-alistp-put-value-indirect (proper-p-alistp (alist, p) ∧ (n < length (alist)) ∧ p-objectp (val, p)) → proper-p-alistp (put-value-indirect (val, n, alist), p)

Theorem: strip-cars-put-value-indirect strip-cars (put-value-indirect (val, n, alist)) = strip-cars (alist)

; Note:  below we prevent p-ctrl-stk-size from expanding -- either
; via its defn or the -cons-p-frame lemma proved during the call
; owc work.  This allows the lemma we proved during pop-locn
; owc to normalize the ctrl-stk-size of the new stack.

Theorem: pop-locn-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-locn) ∧ proper-p-statep (p) ∧ p-pop-locn-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-pop-locn-step (p-current-instruction (p), p))

Theorem: p-objectp-cdr-get-proper-p-alistp (proper-p-alistp (alist, p) ∧ (n < length (alist))) → p-objectp (cdr (get (n, alist)), p)

Theorem: locn-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'locn) ∧ proper-p-statep (p) ∧ p-locn-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-locn-step (p-current-instruction (p), p))

; The legality of the pc computed by a jump-case depends on the
; all-find-labelp check:

Theorem: all-find-labelp-implies-find-labelp-get (all-find-labelp (lst, body) ∧ (n < length (lst))) → find-labelp (get (n, lst), body)

Theorem: jump-case-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-case) ∧ proper-p-statep (p) ∧ p-jump-case-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-jump-case-step (p-current-instruction (p), p))

; So now we begin call.
; First we establish that the body of the called subroutine is a listp.

Theorem: listp-program-body-generalized{special} (proper-p-prog-segmentp (segment, p) ∧ definedp (name, segment)) → listp (program-body (assoc (name, segment)))

Theorem: listp-program-body{special} (proper-p-statep1 (p) ∧ definedp (name, p-prog-segment (p))) → listp (program-body (assoc (name, p-prog-segment (p))))

; Next we have to know that the bindings in the new frame is proper.
; We take it in steps.  First, we divide it into the section of formals
; and the section of locals:

Theorem: proper-p-alistp-append properp (a) → (proper-p-alistp (append (a, b), p)

= (proper-p-alistp (a, p) ∧ proper-p-alistp (b, p)))

; In the application in question, a above is a call of pairlist.  It is
; properp:
; A lemma properp-pairlist exists in fm9001.events, but it did not
; originally.  We accommodate this change by introducing the "my-"
; prefix below.

Theorem: my-properp-pairlist properp (pairlist (a, b))

; So after the rule is applied, we have to prove two proper-p-alistps.
; The first is for the pairlist of the formals to the actuals.
; The second is for the initialization of the temp vars.
; The first is handled by:

Theorem: proper-p-alistp-pairlist (all-litatoms (formals) ∧ all-p-objectps (actuals, p) ∧ (length (formals) = length (actuals))) → proper-p-alistp (pairlist (formals, actuals), p)

; where the hypotheses above are relieved as follows.  The all-litatoms
; of the formals is derived from proper-p-prog-segmentp:

Theorem: all-litatoms-formal-vars-generalized (proper-p-prog-segmentp (segment, p) ∧ definedp (name, segment)) → all-litatoms (formal-vars (assoc (name, segment)))

Theorem: all-litatoms-formal-vars (proper-p-prog-segmentp (p-prog-segment (p), p) ∧ definedp (name, p-prog-segment (p))) → all-litatoms (formal-vars (assoc (name, p-prog-segment (p))))

; The all-p-objectps of the actuals is a little more interesting.  The
; actuals in question are the reverse of the first-n elements of temp-stk.
; We eliminate the reverse with:

Theorem: all-p-objectps-append properp (a) → (all-p-objectps (append (a, b), p)

= (all-p-objectps (a, p) ∧ all-p-objectps (b, p)))

Theorem: all-p-objectps-rev properp (lst) → (all-p-objectps (rev (lst), p) = all-p-objectps (lst, p))

; where we know:

Theorem: properp-first-n properp (first-n (n, lst))

; Then we get that the first-n elements of the temp stack are p-objects
; by:

Theorem: all-p-objectps-first-n (proper-p-temp-stkp (temp-stk, p) ∧ (length (temp-stk) ≮ n)) → all-p-objectps (first-n (n, temp-stk), p)

; The third hypothesis of the pairlist lemma above is that the lengths of
; the formals and actuals are the same.  That follows from what we've
; already proved.
; Now we move to the second proper-p-alistp task, namely, for the
; initialization of the temp vars.  That is handled by:

Theorem: proper-p-prog-segmentp-implies-proper-p-temp-var-dclsp (proper-p-prog-segmentp (segment, p) ∧ definedp (name, segment)) → proper-p-temp-var-dclsp (temp-var-dcls (assoc (name, segment)), p)

Theorem: proper-p-alistp-pair-temps-with-initial-values proper-p-temp-var-dclsp (var-dcls, p) → proper-p-alistp (pair-temps-with-initial-values (var-dcls), p)

; That takes care of the proper-p-alistp of the new bindings.
; Next we have to prove that the strip-cars of the new bindings
; is correct.  We start by distributing the strip-cars over the
; append

Theorem: strip-cars-append strip-cars (append (a, b)) = append (strip-cars (a), strip-cars (b))

; Of course, a and b are as discussed above.  So for the a side we need:

Theorem: strip-cars-pairlist properp (formals) → (strip-cars (pairlist (formals, actuals)) = formals)

; where we know

Theorem: all-litatoms-implies-properp all-litatoms (lst) → properp (lst)

; and we've already set up the machinery to show that the formals are
; all-litatoms.
; For the b side, its

Theorem: strip-cars-pair-temps-with-initial-values strip-cars (pair-temps-with-initial-values (lst)) = strip-cars (lst)

; That completes the work for the strip-cars.
; The next part of the proper-p-statep check is that the temp-stk
; is proper.  We did the work for that with POP*.
; And that is all we need for call.

Theorem: call-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'call) ∧ proper-p-statep (p) ∧ p-call-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-call-step (p-current-instruction (p), p))

; Note:  The hints above are identical to those for the call owc
; proof.  The entire list of preservation lemmas was generated
; mechanically, hints and all, from the owc list.
; The call work also takes care of pop-call.

Theorem: pop-call-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-call) ∧ proper-p-statep (p) ∧ p-pop-call-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-pop-call-step (p-current-instruction (p), p))

; The ret case splits into two parts:  a top level ret or a ret inside
; a subroutine.  In both cases the problem is to prove proper-p-framep
; of the newly exposed frame.  If we leave proper-p-framep enabled,
; the proof of the top-level return is trivial because the newly exposed
; frame IS the frame described by proper-p-statep1, where proper-p-framep
; is opened up.  But the proof of the interior return becomes complicated
; because proper-p-framep expands after we pop the stack.  We therefore

; disable proper-p-framep in our proof and first prove:
; In the lemma below we need a little more than proper-p-statep1,
; because the arithmetic part of proper-p-statep was not put into
; proper-p-statep1.

Theorem: proper-p-statep1-implies-proper-p-framep (proper-p-statep1 (p) ∧ (cdr (untag (ret-pc (car (p-ctrl-stk (p))))) ∈ N) ∧ (cdr (untag (ret-pc (car (p-ctrl-stk (p)))))

< length (program-body (assoc (car (untag (ret-pc (car (p-ctrl-stk (p))))),

p-prog-segment (p))))))

→ proper-p-framep (car (p-ctrl-stk (p)), car (untag (p-pc (p))), p)

; In the case of an interior return, it suffices to open up
; proper-p-ctrl-stkp to see that the newly exposed frame is ok
; and that the rest of the stack is proper.  But proper-p-ctrl-stkp
; is hidden in proper-p-statep1.  So I prove two backchaining
; lemmas:

Theorem: proper-p-ctrl-stkp-implies-proper-p-framep (proper-p-ctrl-stkp (cdr (p-ctrl-stk (p)),

car (untag (ret-pc (car (p-ctrl-stk (p))))), p)

∧ listp (cdr (p-ctrl-stk (p)))) → proper-p-framep (cadr (p-ctrl-stk (p)),

car (untag (ret-pc (car (p-ctrl-stk (p))))), p)

Theorem: proper-p-ctrl-stkp-implies-proper-p-ctrl-stkp (proper-p-ctrl-stkp (cdr (p-ctrl-stk (p)),

car (untag (ret-pc (car (p-ctrl-stk (p))))), p)

∧ listp (cdr (p-ctrl-stk (p)))) → proper-p-ctrl-stkp (cddr (p-ctrl-stk (p)),

car (untag (ret-pc (cadr (p-ctrl-stk (p))))), p)

Theorem: ret-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'ret) ∧ proper-p-statep (p) ∧ p-ret-okp (p-current-instruction (p), p)) → ur-proper-p-statep (p-ret-step (p-current-instruction (p), p))

; I had forgotten to handle the lemmas of the form:
; (p-xxx-okp p) -> (r-xxx-okp (p->r p)).
; So I'll do them now.  Once I tried doing them up
; there, where I had their -step correspondents, but
; I found there were several useful rules developed during
; the proper-p-state preservation lemmas.

Theorem: p-no-op-okp-implies-r-no-op-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'no-op) ∧ proper-p-statep (p) ∧ p-no-op-okp (p-current-instruction (p), p)) → r-no-op-okp (p-current-instruction (p), p->r (p))

Theorem: p-push-global-okp-implies-r-push-global-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-global) ∧ proper-p-statep (p) ∧ p-push-global-okp (p-current-instruction (p), p)) → r-push-global-okp (p-current-instruction (p), p->r (p))

Event: Enable empty-stkp.

; We need to know that every p-objectp is an r-usr-data-objectp

Theorem: p-objectp-is-r-usr-data-typep p-objectp (x, p) → r-usr-data-typep (type (x))

; The lemma above isn't very useful as a rule because of the free
; var.  We take care of that for the instance we need right now:

Theorem: r-usr-data-typep-top (proper-p-statep1 (p) ∧ listp (p-temp-stk (p))) → r-usr-data-typep (type (car (p-temp-stk (p))))

Theorem: r-usr-data-typep-top1 (proper-p-statep1 (p) ∧ listp (cdr (p-temp-stk (p)))) → r-usr-data-typep (type (cadr (p-temp-stk (p))))

Theorem: r-usr-data-typep-top2 (proper-p-statep1 (p) ∧ listp (cddr (p-temp-stk (p)))) → r-usr-data-typep (type (caddr (p-temp-stk (p))))

; That was the easy part, about the type tag.  Now we do the
; nitty-gritty part.

Theorem: p-objectp-implies-r-objectp (p-objectp (x, p) ∧ same-signature (r-usr-data-segment, p-data-segment (p))) → r-objectp (x,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, p-prog-segment (p), r-usr-data-segment, r-sys-data-segment, p-word-size (p), r-psw))

Theorem: p-pop-global-okp-implies-r-pop-global-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-global) ∧ proper-p-statep (p) ∧ p-pop-global-okp (p-current-instruction (p), p)) → r-pop-global-okp (p-current-instruction (p), p->r (p))

; To get the transition for push-local we need to know a little more
; about the size of the control stack -- recall that r-push-local-okp
; checks that several incremented stack pointers are non-empty-stkp.
; The idea is to show that the position from which we are fetching
; -- which is computed by looking up the posiition of the the var -- is not
; at the (NAT 0) marking the end of the stack.

Theorem: lessp-length-bindings listp (ctrl-stk) → (length (bindings (top (ctrl-stk))) < p-ctrl-stk-size (ctrl-stk))

Theorem: lessp-length-bindings-p-ctrl-stk proper-p-statep1 (p) → ((length (formal-vars (assoc (car (untag (p-pc (p))), p-prog-segment (p))))

+ length (temp-var-dcls (assoc (car (untag (p-pc (p))),

p-prog-segment (p)))))

< p-ctrl-stk-size (p-ctrl-stk (p)))

Theorem: p-push-local-okp-implies-r-push-local-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-local) ∧ proper-p-statep (p) ∧ p-push-local-okp (p-current-instruction (p), p)) → r-push-local-okp (p-current-instruction (p), p->r (p))

Theorem: p-pop-local-okp-implies-r-pop-local-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-local) ∧ proper-p-statep (p) ∧ p-pop-local-okp (p-current-instruction (p), p)) → r-pop-local-okp (p-current-instruction (p), p->r (p))

Theorem: p-deposit-okp-implies-r-deposit-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit) ∧ proper-p-statep (p) ∧ p-deposit-okp (p-current-instruction (p), p)) → r-deposit-okp (p-current-instruction (p), p->r (p))

Theorem: p-add1-nat-okp-implies-r-add1-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-nat) ∧ proper-p-statep (p) ∧ p-add1-nat-okp (p-current-instruction (p), p)) → r-add1-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-add-addr-okp-implies-r-add-addr-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-addr) ∧ proper-p-statep (p) ∧ p-add-addr-okp (p-current-instruction (p), p)) → r-add-addr-okp (p-current-instruction (p), p->r (p))

Theorem: p-add-nat-with-carry-okp-implies-r-add-nat-with-carry-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat-with-carry)

∧ proper-p-statep (p) ∧ p-add-nat-with-carry-okp (p-current-instruction (p), p)) → r-add-nat-with-carry-okp (p-current-instruction (p), p->r (p))

Theorem: p-mult2-nat-with-carry-out-okp-implies-r-mult2-nat-with-carry-out-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat-with-carry-out) ∧ proper-p-statep (p) ∧ p-mult2-nat-with-carry-out-okp (p-current-instruction (p), p)) → r-mult2-nat-with-carry-out-okp (p-current-instruction (p), p->r (p))

Theorem: p-fetch-temp-stk-okp-implies-r-fetch-temp-stk-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch-temp-stk) ∧ proper-p-statep (p) ∧ p-fetch-temp-stk-okp (p-current-instruction (p), p)) → r-fetch-temp-stk-okp (p-current-instruction (p), p->r (p))

Theorem: p-deposit-temp-stk-okp-implies-r-deposit-temp-stk-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit-temp-stk) ∧ proper-p-statep (p) ∧ p-deposit-temp-stk-okp (p-current-instruction (p), p)) → r-deposit-temp-stk-okp (p-current-instruction (p), p->r (p))

; To prove the next one we need to know that small-naturalp, as
; checked in proper-p-pop*-instructionp, implies numberp, as
; checked in r-pop*-okp.  We just enable small-naturalp

Theorem: p-pop*-okp-implies-r-pop*-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop*) ∧ proper-p-statep (p) ∧ p-pop*-okp (p-current-instruction (p), p)) → r-pop*-okp (p-current-instruction (p), p->r (p))

Theorem: p-popn-okp-implies-r-popn-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popn) ∧ proper-p-statep (p) ∧ p-popn-okp (p-current-instruction (p), p)) → r-popn-okp (p-current-instruction (p), p->r (p))

Theorem: p-set-local-okp-implies-r-set-local-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-local) ∧ proper-p-statep (p) ∧ p-set-local-okp (p-current-instruction (p), p)) → r-set-local-okp (p-current-instruction (p), p->r (p))

Theorem: p-set-global-okp-implies-r-set-global-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-global) ∧ proper-p-statep (p) ∧ p-set-global-okp (p-current-instruction (p), p)) → r-set-global-okp (p-current-instruction (p), p->r (p))

Theorem: p-push-constant-okp-implies-r-push-constant-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-constant) ∧ proper-p-statep (p) ∧ p-push-constant-okp (p-current-instruction (p), p)) → r-push-constant-okp (p-current-instruction (p), p->r (p))

Theorem: p-push-ctrl-stk-free-size-okp-implies-r-push-ctrl-stk-free-size-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-ctrl-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-ctrl-stk-free-size-okp (p-current-instruction (p), p)) → r-push-ctrl-stk-free-size-okp (p-current-instruction (p), p->r (p))

Theorem: p-push-temp-stk-free-size-okp-implies-r-push-temp-stk-free-size-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-temp-stk-free-size-okp (p-current-instruction (p), p)) → r-push-temp-stk-free-size-okp (p-current-instruction (p), p->r (p))

; Again, we enable small-naturalp to get the numberp check at the r-level.

Theorem: p-push-temp-stk-index-okp-implies-r-push-temp-stk-index-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-index) ∧ proper-p-statep (p) ∧ p-push-temp-stk-index-okp (p-current-instruction (p), p)) → r-push-temp-stk-index-okp (p-current-instruction (p), p->r (p))

Theorem: p-pop-okp-implies-r-pop-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop) ∧ proper-p-statep (p) ∧ p-pop-okp (p-current-instruction (p), p)) → r-pop-okp (p-current-instruction (p), p->r (p))

Theorem: p-jump-okp-implies-r-jump-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump) ∧ proper-p-statep (p) ∧ p-jump-okp (p-current-instruction (p), p)) → r-jump-okp (p-current-instruction (p), p->r (p))

Theorem: p-pushj-okp-implies-r-pushj-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pushj) ∧ proper-p-statep (p) ∧ p-pushj-okp (p-current-instruction (p), p)) → r-pushj-okp (p-current-instruction (p), p->r (p))

Theorem: p-popj-okp-implies-r-popj-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popj) ∧ proper-p-statep (p) ∧ p-popj-okp (p-current-instruction (p), p)) → r-popj-okp (p-current-instruction (p), p->r (p))

Theorem: p-sub-addr-okp-implies-r-sub-addr-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-addr) ∧ proper-p-statep (p) ∧ p-sub-addr-okp (p-current-instruction (p), p)) → r-sub-addr-okp (p-current-instruction (p), p->r (p))

Theorem: p-eq-okp-implies-r-eq-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'eq) ∧ proper-p-statep (p) ∧ p-eq-okp (p-current-instruction (p), p)) → r-eq-okp (p-current-instruction (p), p->r (p))

Theorem: p-lt-addr-okp-implies-r-lt-addr-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-addr) ∧ proper-p-statep (p) ∧ p-lt-addr-okp (p-current-instruction (p), p)) → r-lt-addr-okp (p-current-instruction (p), p->r (p))

Theorem: p-fetch-okp-implies-r-fetch-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch) ∧ proper-p-statep (p) ∧ p-fetch-okp (p-current-instruction (p), p)) → r-fetch-okp (p-current-instruction (p), p->r (p))

Theorem: p-add-int-okp-implies-r-add-int-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int) ∧ proper-p-statep (p) ∧ p-add-int-okp (p-current-instruction (p), p)) → r-add-int-okp (p-current-instruction (p), p->r (p))

Theorem: p-add-int-with-carry-okp-implies-r-add-int-with-carry-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int-with-carry) ∧ proper-p-statep (p) ∧ p-add-int-with-carry-okp (p-current-instruction (p), p)) → r-add-int-with-carry-okp (p-current-instruction (p), p->r (p))

Theorem: p-add1-int-okp-implies-r-add1-int-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-int) ∧ proper-p-statep (p) ∧ p-add1-int-okp (p-current-instruction (p), p)) → r-add1-int-okp (p-current-instruction (p), p->r (p))

Theorem: p-sub-int-okp-implies-r-sub-int-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int) ∧ proper-p-statep (p) ∧ p-sub-int-okp (p-current-instruction (p), p)) → r-sub-int-okp (p-current-instruction (p), p->r (p))

Theorem: p-sub-int-with-carry-okp-implies-r-sub-int-with-carry-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int-with-carry) ∧ proper-p-statep (p) ∧ p-sub-int-with-carry-okp (p-current-instruction (p), p)) → r-sub-int-with-carry-okp (p-current-instruction (p), p->r (p))

Theorem: p-sub1-int-okp-implies-r-sub1-int-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-int)

∧ proper-p-statep (p) ∧ p-sub1-int-okp (p-current-instruction (p), p)) → r-sub1-int-okp (p-current-instruction (p), p->r (p))

Theorem: p-neg-int-okp-implies-r-neg-int-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'neg-int) ∧ proper-p-statep (p) ∧ p-neg-int-okp (p-current-instruction (p), p)) → r-neg-int-okp (p-current-instruction (p), p->r (p))

Theorem: p-lt-int-okp-implies-r-lt-int-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-int) ∧ proper-p-statep (p) ∧ p-lt-int-okp (p-current-instruction (p), p)) → r-lt-int-okp (p-current-instruction (p), p->r (p))

Theorem: p-int-to-nat-okp-implies-r-int-to-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'int-to-nat) ∧ proper-p-statep (p) ∧ p-int-to-nat-okp (p-current-instruction (p), p)) → r-int-to-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-add-nat-okp-implies-r-add-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat) ∧ proper-p-statep (p) ∧ p-add-nat-okp (p-current-instruction (p), p)) → r-add-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-sub-nat-okp-implies-r-sub-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat) ∧ proper-p-statep (p) ∧ p-sub-nat-okp (p-current-instruction (p), p)) → r-sub-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-sub-nat-with-carry-okp-implies-r-sub-nat-with-carry-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat-with-carry) ∧ proper-p-statep (p) ∧ p-sub-nat-with-carry-okp (p-current-instruction (p), p)) → r-sub-nat-with-carry-okp (p-current-instruction (p), p->r (p))

Theorem: p-sub1-nat-okp-implies-r-sub1-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-nat) ∧ proper-p-statep (p) ∧ p-sub1-nat-okp (p-current-instruction (p), p)) → r-sub1-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-lt-nat-okp-implies-r-lt-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-nat) ∧ proper-p-statep (p) ∧ p-lt-nat-okp (p-current-instruction (p), p)) → r-lt-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-mult2-nat-okp-implies-r-mult2-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat) ∧ proper-p-statep (p) ∧ p-mult2-nat-okp (p-current-instruction (p), p)) → r-mult2-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-div2-nat-okp-implies-r-div2-nat-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'div2-nat) ∧ proper-p-statep (p) ∧ p-div2-nat-okp (p-current-instruction (p), p)) → r-div2-nat-okp (p-current-instruction (p), p->r (p))

Theorem: p-or-bitv-okp-implies-r-or-bitv-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bitv) ∧ proper-p-statep (p) ∧ p-or-bitv-okp (p-current-instruction (p), p)) → r-or-bitv-okp (p-current-instruction (p), p->r (p))

Theorem: p-and-bitv-okp-implies-r-and-bitv-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bitv) ∧ proper-p-statep (p) ∧ p-and-bitv-okp (p-current-instruction (p), p)) → r-and-bitv-okp (p-current-instruction (p), p->r (p))

Theorem: p-not-bitv-okp-implies-r-not-bitv-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bitv)

∧ proper-p-statep (p) ∧ p-not-bitv-okp (p-current-instruction (p), p)) → r-not-bitv-okp (p-current-instruction (p), p->r (p))

Theorem: p-xor-bitv-okp-implies-r-xor-bitv-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'xor-bitv) ∧ proper-p-statep (p) ∧ p-xor-bitv-okp (p-current-instruction (p), p)) → r-xor-bitv-okp (p-current-instruction (p), p->r (p))

Theorem: p-rsh-bitv-okp-implies-r-rsh-bitv-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'rsh-bitv) ∧ proper-p-statep (p) ∧ p-rsh-bitv-okp (p-current-instruction (p), p)) → r-rsh-bitv-okp (p-current-instruction (p), p->r (p))

Theorem: p-lsh-bitv-okp-implies-r-lsh-bitv-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lsh-bitv) ∧ proper-p-statep (p) ∧ p-lsh-bitv-okp (p-current-instruction (p), p)) → r-lsh-bitv-okp (p-current-instruction (p), p->r (p))

Theorem: p-or-bool-okp-implies-r-or-bool-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bool) ∧ proper-p-statep (p) ∧ p-or-bool-okp (p-current-instruction (p), p)) → r-or-bool-okp (p-current-instruction (p), p->r (p))

Theorem: p-and-bool-okp-implies-r-and-bool-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bool) ∧ proper-p-statep (p) ∧ p-and-bool-okp (p-current-instruction (p), p)) → r-and-bool-okp (p-current-instruction (p), p->r (p))

Theorem: p-not-bool-okp-implies-r-not-bool-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bool) ∧ proper-p-statep (p) ∧ p-not-bool-okp (p-current-instruction (p), p)) → r-not-bool-okp (p-current-instruction (p), p->r (p))

Theorem: p-jump-if-temp-stk-full-okp-implies-r-jump-if-temp-stk-full-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-full) ∧ proper-p-statep (p) ∧ p-jump-if-temp-stk-full-okp (p-current-instruction (p), p)) → r-jump-if-temp-stk-full-okp (p-current-instruction (p), p->r (p))

Theorem: p-jump-if-temp-stk-empty-okp-implies-r-jump-if-temp-stk-empty-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-empty) ∧ proper-p-statep (p) ∧ p-jump-if-temp-stk-empty-okp (p-current-instruction (p), p)) → r-jump-if-temp-stk-empty-okp (p-current-instruction (p), p->r (p))

Theorem: p-test-nat-and-jump-okp-implies-r-test-nat-and-jump-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-nat-and-jump) ∧ proper-p-statep (p) ∧ p-test-nat-and-jump-okp (p-current-instruction (p), p)) → r-test-nat-and-jump-okp (p-current-instruction (p), p->r (p))

Theorem: p-test-int-and-jump-okp-implies-r-test-int-and-jump-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-int-and-jump) ∧ proper-p-statep (p) ∧ p-test-int-and-jump-okp (p-current-instruction (p), p)) → r-test-int-and-jump-okp (p-current-instruction (p), p->r (p))

Theorem: p-test-bool-and-jump-okp-implies-r-test-bool-and-jump-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bool-and-jump) ∧ proper-p-statep (p) ∧ p-test-bool-and-jump-okp (p-current-instruction (p), p)) → r-test-bool-and-jump-okp (p-current-instruction (p), p->r (p))

Theorem: p-test-bitv-and-jump-okp-implies-r-test-bitv-and-jump-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bitv-and-jump) ∧ proper-p-statep (p) ∧ p-test-bitv-and-jump-okp (p-current-instruction (p), p)) → r-test-bitv-and-jump-okp (p-current-instruction (p), p->r (p))

Theorem: p-pop-locn-okp-implies-r-pop-locn-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-locn)

∧ proper-p-statep (p) ∧ p-pop-locn-okp (p-current-instruction (p), p)) → r-pop-locn-okp (p-current-instruction (p), p->r (p))

Theorem: p-locn-okp-implies-r-locn-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'locn) ∧ proper-p-statep (p) ∧ p-locn-okp (p-current-instruction (p), p)) → r-locn-okp (p-current-instruction (p), p->r (p))

Theorem: p-jump-case-okp-implies-r-jump-case-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-case) ∧ proper-p-statep (p) ∧ p-jump-case-okp (p-current-instruction (p), p)) → r-jump-case-okp (p-current-instruction (p), p->r (p))

Theorem: proper-p-temp-var-dclsp-implies-all-p-objectps proper-p-temp-var-dclsp (temp-var-dcls, p) → all-p-objectps (strip-cadrs (temp-var-dcls), p)

Theorem: all-p-objectps-implies-all-r-objectps (all-p-objectps (lst, p) ∧ same-signature (r-usr-data-segment, p-data-segment (p))) → all-r-objectps (lst,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, p-prog-segment (p), r-usr-data-segment, r-sys-data-segment, p-word-size (p), r-psw))

Theorem: p-call-okp-implies-r-call-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'call)

∧ proper-p-statep (p) ∧ p-call-okp (p-current-instruction (p), p)) → r-call-okp (p-current-instruction (p), p->r (p))

Theorem: p-pop-call-okp-implies-r-pop-call-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-call) ∧ proper-p-statep (p) ∧ p-pop-call-okp (p-current-instruction (p), p)) → r-pop-call-okp (p-current-instruction (p), p->r (p))

Theorem: p-ret-okp-implies-r-ret-okp ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'ret) ∧ proper-p-statep (p) ∧ p-ret-okp (p-current-instruction (p), p)) → r-ret-okp (p-current-instruction (p), p->r (p))

; We now turn to the preservation of r-equal.  Our basic strategy is to
; disable r-equal after proving rewrite rules that let us convert
; terms involving r2 to terms involving r1 under the hyp that r2 is
; r-equal to r1.  Then we will force open the r-equal in the conclusion
; of our theorems by an r-equal-r-state lemma below.  We begin with
; the very basic r-equal properties:

Theorem: r-equal-properties r-equal (r2 , r1 ) → (r-statep (r2 )

∧ r-statep (r1 ) ∧ (r-pc (r2 ) = r-pc (r1 )) ∧ (r-cfp (r2 ) = r-cfp (r1 )) ∧ (r-csp (r2 ) = r-csp (r1 )) ∧ (r-tsp (r2 ) = r-tsp (r1 )) ∧ (r-prog-segment (r2 ) = r-prog-segment (r1 )) ∧ (r-usr-data-segment (r2 ) = r-usr-data-segment (r1 )) ∧ stk-equal (r-csp (r1 ),

r-sys-data-segment (r2 ), r-sys-data-segment (r1 ))

∧ stk-equal (r-tsp (r1 ), r-sys-data-segment (r2 ), r-sys-data-segment (r1 ))

∧ same-signature (r-sys-data-segment (r2 ), r-sys-data-segment (r1 )) ∧ (r-word-size (r2 ) = r-word-size (r1 )) ∧ (r-psw (r2 ) = r-psw (r1 )))

Theorem: r-equal-r-state r-equal (r-state (r-pc2 ,

r-cfp2 , r-csp2 , r-tsp2 , r-x2 , r-y2 , r-c-flg2 , r-v-flg2 , r-n-flg2 , r-z-flg2 , r-prog-segment, r-usr-data-segment2 , r-sys-data-segment2 , r-word-size, r-psw),

r-state (r-pc1 , r-cfp1 , r-csp1 , r-tsp1 , r-x1 , r-y1 , r-c-flg1 , r-v-flg1 , r-n-flg1 , r-z-flg1 , r-prog-segment, r-usr-data-segment1 , r-sys-data-segment1 , r-word-size, r-psw))

= ((r-pc2 = r-pc1 ) ∧ (r-cfp2 = r-cfp1 ) ∧ (r-csp2 = r-csp1 ) ∧ (r-tsp2 = r-tsp1 ) ∧ (r-usr-data-segment2 = r-usr-data-segment1 ) ∧ stk-equal (r-csp1 , r-sys-data-segment2 , r-sys-data-segment1 ) ∧ stk-equal (r-tsp1 , r-sys-data-segment2 , r-sys-data-segment1 ) ∧ same-signature (r-sys-data-segment2 , r-sys-data-segment1 ))

Event: Disable r-equal.

Theorem: r-equal-implies-equal-r-current-instruction r-equal (r2 , r1 )

→ (r-current-instruction (r2 ) = r-current-instruction (r1 ))

; We adopt the same policy for handling proper-r-statep that we adopted
; at the r-i level:

Event: Enable proper-r-statep-properties.

; Note: Unfortunately, the above remark is wrong, as I discovered much
; later below where I have to prove
; proper-r-statep-properties{augmented}.  The two statements of
; proper-r-statep-properties (in r-i.events and p-r.events) are NOT
; the same!
; Having proved that, we will

Event: Disable proper-r-statep.

Theorem: r-equal-implies-equal-add1-r-pcp r-equal (r2 , r1 ) → (add1-r-pcp (r2 ) = add1-r-pcp (r1 ))

Event: Disable add1-r-pcp.

; We need to enable empty-stkp.  The reason is that the r-equal in our
; hypothesis tells us that the tstk, say, in both r1 and r2 are stk-equal,
; but that implies the equality of the live parts only down to the empty-stk.
; It does not assure us that both stacks have the '(NAT 0) at the bottom.
; But all of our tests just insure that when we get at n in the stack,
; n is less than the length of the stack.  We now need to know that it is
; less than sub1 the length of the stack, so we're within the range checked
; by the stk-equal.  That assurance is given only by the empty-stkp.

Event: Enable empty-stkp.

Theorem: r-equal-implies-equal-r-no-op-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'no-op) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-no-op-okp (r-current-instruction (r1 ), r2 )

= r-no-op-okp (r-current-instruction (r1 ), r1 ))

Theorem: no-op-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'no-op) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-no-op-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-no-op-step (r-current-instruction (r1 ), r2 ),

r-no-op-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-push-global-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-global) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-push-global-okp (r-current-instruction (r1 ), r2 )

= r-push-global-okp (r-current-instruction (r1 ), r1 ))

; The following lemma is the key to obtaining the stk-equal on the cstk
; in cases where the cstk is not being modified.

Theorem: stk-equal-cstk-put-assoc-tstk2 (car (untag (csp)) = 'cstk) → (stk-equal (csp,

put-assoc (val2 , 'tstk, segment2 ), put-assoc (val1 , 'tstk, segment1 ))

= stk-equal (csp, segment2 , segment1 ))

; And now we turn to the key lemma for the stk-equal on the tstk.
; The lemma, stk-equal-put-assoc-push, below, is general enough to apply
; to the cstk as well, if it is being pushed.

Theorem: get-put{special} ((k ∈ N) ∧ (n ∈ N) ∧ (n < length (lst))) → (get (k, put (val, n, lst))

= if k = n then val else get (k, lst) endif)

; The following lemma is the inductive part of the main theorem,
; named stk-equal-put-assoc-push, below.  The form of the main
; theorem is discussed there.

Theorem: stk-equal-put-assoc-above-top ((name = car (untag (sp))) ∧ definedp (name, segment1 ) ∧ definedp (name, segment2 ) ∧ (cdr (untag (sp)) ∈ N) ∧ (n ∈ N) ∧ (n < cdr (untag (sp))) ∧ (length (area1 ) = length (cdr (assoc (name, segment1 )))) ∧ (length (area2 ) = length (cdr (assoc (name, segment2 )))) ∧ (n < (length (area1 ) − 1)) ∧ (n < (length (area2 ) − 1))) → (stk-equal (sp,

put-assoc (put (val, n, area2 ), name, segment2 ), put-assoc (put (val, n, area1 ), name, segment1 ))

= stk-equal (sp, put-assoc (area2 , name, segment2 ), put-assoc (area1 , name, segment1 )))

Theorem: equal-sub1-difference (0 = ((max − n) − 1)) = (n ≮ (max − 1))

; This is the main theorem for dealing with stk-equality on two
; stacks that have been pushed.  The lemma says, roughly, that if
; you are interested in stack equality from sp on down, and you
; just deposited equal things at sp, then pop and omit the deposits.
; But the lemma is more general that that suggests.  Consider
; the use of area1 and area2.  My first version of the lemma
; used (cdr (assoc name segmenti)) for areai.
; That limited the utility of the lemma to cases in which
; only one thing is pushed.  This version permits areai to be another
; put.  Observe that on the rhs of the lemma I omite the puts but I
; keep the put-assocs because I have to put the areai's into the
; segments.

Theorem: stk-equal-put-assoc-push (listp (untag (sp)) ∧ (name = car (untag (sp))) ∧ definedp (name, segment1 ) ∧ definedp (name, segment2 ) ∧ (n = cdr (untag (sp))) ∧ (n ∈ N) ∧ (length (area1 ) = length (cdr (assoc (name, segment1 )))) ∧ (length (area2 ) = length (cdr (assoc (name, segment2 ))))

∧ (¬ empty-stkp (tag ('sys-addr, cons (name, n)), segment1 )) ∧ (¬ empty-stkp (tag ('sys-addr, cons (name, n)), segment2 ))) → (stk-equal (sp,

put-assoc (put (val, n, area2 ), name, segment2 ), put-assoc (put (val, n, area1 ), name, segment1 ))

= stk-equal (pop-stk (sp), put-assoc (area2 , name, segment2 ), put-assoc (area1 , name, segment1 )))

; Eventually, when all the puts are exhausted we will be putting
; the original area into the segment and the following rule will
; collapse it:

Theorem: put-assoc-cdr-assoc listp (assoc (name, segment)) → (put-assoc (cdr (assoc (name, segment)), name, segment) = segment)

; However, to get the hypothesis above we need:

Theorem: proper-r-statep-implies-tstkp proper-r-statep (r, load-addr) → (cdr (untag (r-tsp (r)))

< length (cdr (assoc ('tstk, r-sys-data-segment (r)))))

Theorem: listp-assoc-tstk proper-r-statep (r, load-addr) → listp (assoc ('tstk, r-sys-data-segment (r)))

; Finally, in the main theorem above we sometimes have to prove a
; non-empty-stkp of a pushed stack, which follows from the non-emptiness
; of the unpushed stack:

Theorem: not-empty-stkp-push{special} (¬ empty-stkp (tag ('sys-addr, cons (name, n)), segment)) → (¬ empty-stkp (tag ('sys-addr, cons (name, n − 1)), segment))

; The next lemma establishes that if we have a stk-equal at n
; we have it at all greater n.  This means that if we pop several
; things off the stack and then push one, the lemma above will take
; care of the push and the lemma below will take care of the pops.

Theorem: stk-equal-extends-upwards-base-case ((n ≮ (length (cdr (assoc (name, segment2 ))) − 1)) ∧ (n ∈ N) ∧ (k ∈ N) ∧ (k ≮ n)) → stk-equal (tag ('sys-addr, cons (name, k)), segment2 , segment1 )

Definition: stk-equal-hint-5 (n, name, segment) = if ((length (cdr (assoc (name, segment))) − n) − 1) ≃ 0 then t

else stk-equal-hint-5 (n + 1, name, segment) endif

; The next lemma is really the key result.  However, as stated it is
; not useful as a rewrite rule because it has the free-var segment1
; picked up by the stk-equal but in our applications the stk-equal is
; enclosed inside the r-equal we keep disabled.  This pattern will be
; repeated many times in the lemma development here.

Theorem: stk-equal-extends-upwards ((n ∈ N) ∧ (k ∈ N) ∧ stk-equal (tag ('sys-addr, cons (name, n)), segment2 , segment1 ) ∧ (k ≮ n)) → stk-equal (tag ('sys-addr, cons (name, k)), segment2 , segment1 )

Event: Disable stk-equal-extends-upwards-base-case.

Theorem: proper-r-statep-implies-tag-untag ((type (x) = 'sys-addr) ∧ listp (untag (x)) ∧ (car (untag (x)) = 'tstk) ∧ (cddr (x) = nil)) → (tag ('sys-addr, cons ('tstk, cdr (untag (x)))) = x)

; When this proper-r-statep-properties was proved in r-i.events it had some
; adp-name and other fns "closed".  But when it was proved in p-r.events I
; had expanded those names.  I did not notice this when I concatenated the two
; event lists and removed "duplicates"  -- i.e., I mistook the second occurrence
; of the name proper-r-statep-properties as a duplicate of the first when in fact
; the formulas were different by virtue of these non-rec fn expansions.  So here
; I prove the expanded conjuncts.

Theorem: proper-r-statep-properties{augmented} proper-r-statep (r, load-addr) → (definedp (car (untag (r-pc (r))), r-prog-segment (r))

∧ (cdr (untag (r-pc (r))) ∈ N) ∧ (cdr (untag (r-pc (r)))

< length (program-body (assoc (car (untag (r-pc (r))),

r-prog-segment (r)))))

∧ (car (untag (r-cfp (r))) = 'cstk) ∧ (cdr (untag (r-cfp (r))) ∈ N) ∧ (cdr (untag (r-cfp (r)))

< length (cdr (assoc ('cstk, r-sys-data-segment (r))))) ∧ (car (untag (r-csp (r))) = 'cstk) ∧ (cdr (untag (r-csp (r))) ∈ N) ∧ (cdr (untag (r-csp (r)))

< length (cdr (assoc ('cstk, r-sys-data-segment (r))))) ∧ (car (untag (r-tsp (r))) = 'tstk) ∧ (cdr (untag (r-tsp (r))) ∈ N) ∧ (cdr (untag (r-tsp (r)))

< length (cdr (assoc ('tstk, r-sys-data-segment (r))))) ∧ definedp ('full-ctrl-stk-addr, r-sys-data-segment (r)) ∧ definedp ('full-temp-stk-addr, r-sys-data-segment (r)) ∧ definedp ('empty-temp-stk-addr, r-sys-data-segment (r)))

Theorem: r-equal-implies-stk-equal-extends-upwards-tstk (r-equal (r2 , r1 ) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ (k ∈ N) ∧ (k ≮ cdr (untag (r-tsp (r1 ))))) → stk-equal (tag ('sys-addr, cons ('tstk, k)),

r-sys-data-segment (r2 ), r-sys-data-segment (r1 ))

; So now we can do

Theorem: push-global-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-global) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-push-global-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-push-global-step (r-current-instruction (r1 ), r2 ),

r-push-global-step (r-current-instruction (r1 ), r1 ))

; We will keep empty-stkp disabled to cut down on the arithmetic
; used.  Of course, we need:

Theorem: r-equal-implies-equal-length r-equal (r2 , r1 ) → (length (cdr (assoc (name, r-sys-data-segment (r2 ))))

= length (cdr (assoc (name, r-sys-data-segment (r1 )))))

Theorem: r-equal-implies-equal-empty-stkp r-equal (r2 , r1 ) → (empty-stkp (sp, r-sys-data-segment (r2 ))

= empty-stkp (sp, r-sys-data-segment (r1 )))

; The next two lemmas establish that when we get from the active
; region of either the cstk or the tstk of two r-equal states
; we get the same result.  The key fact is the lemma immediately
; below, which is then instantiated for each stack and lifted up
; to r-equal.

Theorem: stk-equal-implies-equal-get (stk-equal (sp, segment2 , segment1 ) ∧ (k ∈ N) ∧ (cdr (untag (sp)) ∈ N) ∧ (k ≮ cdr (untag (sp))) ∧ (k < (length (cdr (assoc (car (untag (sp)), segment2 ))) − 1))) → (get (k, cdr (assoc (car (untag (sp)), segment2 )))

= get (k, cdr (assoc (car (untag (sp)), segment1 ))))

; The instantiated versions of the lemma above requires that we know
; the stack pointer at which we are getting is non-empty.

Theorem: r-equal-implies-equal-get-tstk (r-equal (r2 , r1 ) ∧ proper-r-statep (r1 , load-addr) ∧ (k ∈ N) ∧ (¬ empty-stkp (tag ('sys-addr, cons ('tstk, k)),

r-sys-data-segment (r1 )))

∧ (k ≮ cdr (untag (r-tsp (r1 ))))) → (get (k, cdr (assoc ('tstk, r-sys-data-segment (r2 ))))

= get (k, cdr (assoc ('tstk, r-sys-data-segment (r1 )))))

; We don't actually need the cstk version just yet, but I have proved
; it because when we get to local vars we will need it.

Theorem: r-equal-implies-equal-get-cstk (r-equal (r2 , r1 ) ∧ proper-r-statep (r1 , load-addr) ∧ (k ∈ N) ∧ (¬ empty-stkp (tag ('sys-addr, cons ('cstk, k)),

r-sys-data-segment (r1 )))

∧ (k ≮ cdr (untag (r-csp (r1 ))))) → (get (k, cdr (assoc ('cstk, r-sys-data-segment (r2 ))))

= get (k, cdr (assoc ('cstk, r-sys-data-segment (r1 )))))

; We now disable empty-stkp.  We will undoubtedly have to prove some
; lemmas to establish the non-empty-stkp hypotheses above.

Event: Disable empty-stkp.

; In the case where we are getting from r-tsp we need:

; We need that the r-objects of one state are those of the other.

Theorem: r-equal-implies-equal-r-objectp r-equal (r2 , r1 ) → (r-objectp (x, r2 ) = r-objectp (x, r1 ))

; We also get the rule for r-objectp-type and disable that function
; because here we do not need to know what it means, just that if
; it is true for r2 it is true for r1.

Theorem: r-equal-implies-equal-r-objectp-type r-equal (r2 , r1 ) → (r-objectp-type (type, x, r2 ) = r-objectp-type (type, x, r1 ))

Event: Disable r-objectp-type.

; And we'll get the rule for r-usr-data-objectp too.

Theorem: r-equal-implies-equal-r-usr-data-objectp r-equal (r2 , r1 ) → (r-usr-data-objectp (x, r2 ) = r-usr-data-objectp (x, r1 ))

Event: Disable r-usr-data-objectp.

; Now we can also handle:

Theorem: r-equal-implies-equal-r-pop-global-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-global) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-pop-global-okp (r-current-instruction (r1 ), r2 )

= r-pop-global-okp (r-current-instruction (r1 ), r1 ))

Theorem: pop-global-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-global) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-pop-global-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-pop-global-step (r-current-instruction (r1 ), r2 ),

r-pop-global-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-push-local-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-local) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-push-local-okp (r-current-instruction (r1 ), r2 )

= r-push-local-okp (r-current-instruction (r1 ), r1 ))

; To prove a stk-equal after a push we have to be able to establish
; the non-empty-stkp hypothesis for the pushed stack.  That follows
; from:

Theorem: proper-r-statep-implies-non-empty-stkp-push (proper-r-statep (r, load-addr) ∧ (free-stk-size (r-tsp (r)) ≄ 0)) → (¬ empty-stkp (tag ('sys-addr,

cons ('tstk, cdr (untag (r-tsp (r))) − 1)), r-sys-data-segment (r)))

Theorem: push-local-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-local)

∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-push-local-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-push-local-step (r-current-instruction (r1 ), r2 ),

r-push-local-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-pop-local-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-local) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-pop-local-okp (r-current-instruction (r1 ), r2 )

= r-pop-local-okp (r-current-instruction (r1 ), r1 ))

; That we could get to here without further work is not too surprising
; considering the nature of the instructions we've learned to handle.
; That we stopped here is also not surprising: we haven't explained
; how to handle stk-equal on the cstk (except in the rare case of
; pushes onto the cstk).  What we need is the lemma that says if two
; cstks are stk-equal and you put the same thing at the same place in
; both then they are still stk-equal.  This is sort of like the
; stk-equal-put-assoc-push lemma above except (a) we don't require
; that the put be a push and because of that (b) we don't require that
; the stk-equal start its scan at the location of the push.  This
; operation, of sticking something into the middle of a stack, is of
; course only performed on the cstk; never on the tstk.

Theorem: stk-equal-put-assoc-insertion (listp (untag (sp)) ∧ stk-equal (sp, segment2 , segment1 ) ∧ (name = car (untag (sp))) ∧ definedp (name, segment2 ) ∧ definedp (name, segment1 ) ∧ (cdr (untag (sp)) ∈ N) ∧ (n ∈ N) ∧ (n ≮ cdr (untag (sp))) ∧ (¬ empty-stkp (tag ('sys-addr, cons (name, n)), segment2 )) ∧ (¬ empty-stkp (tag ('sys-addr, cons (name, n)), segment1 )) ∧ listp (assoc (name, segment1 )) ∧ listp (assoc (name, segment2 ))) → stk-equal (sp,

put-assoc (put (val, n, cdr (assoc (name, segment2 ))), name, segment2 ),

put-assoc (put (val, n, cdr (assoc (name, segment1 ))), name, segment1 ))

; The hypotheses above about (listp (assoc name segmenti)) will
; be relieved in our applications by:

Theorem: proper-r-statep-implies-cstkp proper-r-statep (r, load-addr) → (cdr (untag (r-csp (r)))

< length (cdr (assoc ('cstk, r-sys-data-segment (r)))))

Theorem: listp-assoc-cstk proper-r-statep (r, load-addr) → listp (assoc ('cstk, r-sys-data-segment (r)))

; The following rule is the dual of its namesake: it establishes a
; stk-equal on the tstk when the cstk has been changed.

Theorem: stk-equal-tstk-put-assoc-cstk2 (car (untag (tsp)) = 'tstk) → (stk-equal (tsp,

put-assoc (val2 , 'cstk, segment2 ), put-assoc (val1 , 'cstk, segment1 ))

= stk-equal (tsp, segment2 , segment1 ))

; The following lemma is needed to relieve the hypothesis that we are
; putting into a legal position.  This would not be necessary if we
; had empty-stkp enabled.

Theorem: empty-stkp-backchainer (¬ empty-stkp (tag (xxx, cons (name, k)), segment)) → ((k < length (cdr (assoc (name, segment)))) = t)

Theorem: pop-local-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-local) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-pop-local-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-pop-local-step (r-current-instruction (r1 ), r2 ),

r-pop-local-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-deposit-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'deposit) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-deposit-okp (r-current-instruction (r1 ), r2 )

= r-deposit-okp (r-current-instruction (r1 ), r1 ))

Theorem: deposit-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'deposit) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-deposit-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-deposit-step (r-current-instruction (r1 ), r2 ),

r-deposit-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-add1-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add1-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-add1-nat-okp (r-current-instruction (r1 ), r2 )

= r-add1-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: add1-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add1-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-add1-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-add1-nat-step (r-current-instruction (r1 ), r2 ),

r-add1-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-add-addr-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-addr) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-add-addr-okp (r-current-instruction (r1 ), r2 )

= r-add-addr-okp (r-current-instruction (r1 ), r1 ))

Theorem: add-addr-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-addr) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-add-addr-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-add-addr-step (r-current-instruction (r1 ), r2 ),

r-add-addr-step (r-current-instruction (r1 ), r1 ))

; The following lemma is a good example of the value of tuning
; the disable/enable strategy.  In an environment just like
; the current one except with empty-stkp enabled and the
; necessary rule that (sub1 (sub1 (difference x y))) = 0
; iff y is not lessp x-2, the following theorem took 67 seconds
; to prove and 118 seconds for io.  It now takes 3.8 to prove
; and .1 for io.  The reason is that when empty-stkp opens
; and is converted to an inequality, the linear arithmetic
; package repeatedly splits on various zerop possibilities.

Theorem: r-equal-implies-equal-r-add-nat-with-carry-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-nat-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-add-nat-with-carry-okp (r-current-instruction (r1 ), r2 )

= r-add-nat-with-carry-okp (r-current-instruction (r1 ), r1 ))

Theorem: add-nat-with-carry-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-nat-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-add-nat-with-carry-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-add-nat-with-carry-step (r-current-instruction (r1 ), r2 ),

r-add-nat-with-carry-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-mult2-nat-with-carry-out-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 ))

    = 'mult2-nat-with-carry-out)

∧ proper-r-statep (r1 , load-addr)

∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-mult2-nat-with-carry-out-okp (r-current-instruction (r1 ), r2 )

= r-mult2-nat-with-carry-out-okp (r-current-instruction (r1 ), r1 ))

Theorem: mult2-nat-with-carry-out-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 ))

    = 'mult2-nat-with-carry-out)

∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-mult2-nat-with-carry-out-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-mult2-nat-with-carry-out-step (r-current-instruction (r1 ), r2 ),

r-mult2-nat-with-carry-out-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-fetch-temp-stk-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'fetch-temp-stk) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-fetch-temp-stk-okp (r-current-instruction (r1 ), r2 )

= r-fetch-temp-stk-okp (r-current-instruction (r1 ), r1 ))

; To relieve the hypothesis of R-EQUAL-IMPLIES-EQUAL-GET-TSTK we need:

Theorem: not-empty-stkp-temp-stk-index (n < (length (cdr (assoc ('tstk, r-sys-data-segment (r)))) − 1)) → (¬ empty-stkp (tag ('sys-addr,

cons ('tstk,

((length (cdr (assoc ('tstk,

r-sys-data-segment (r)))) − 1)

− n)− 1)),

r-sys-data-segment (r)))

Theorem: fetch-temp-stk-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'fetch-temp-stk) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-fetch-temp-stk-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-fetch-temp-stk-step (r-current-instruction (r1 ), r2 ),

r-fetch-temp-stk-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-deposit-temp-stk-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'deposit-temp-stk) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-deposit-temp-stk-okp (r-current-instruction (r1 ), r2 )

= r-deposit-temp-stk-okp (r-current-instruction (r1 ), r1 ))

Theorem: deposit-temp-stk-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'deposit-temp-stk) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-deposit-temp-stk-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-deposit-temp-stk-step (r-current-instruction (r1 ), r2 ),

r-deposit-temp-stk-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-pop*-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop*) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-pop*-okp (r-current-instruction (r1 ), r2 )

= r-pop*-okp (r-current-instruction (r1 ), r1 ))

Theorem: pop*-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop*) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-pop*-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-pop*-step (r-current-instruction (r1 ), r2 ),

r-pop*-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-popn-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'popn) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-popn-okp (r-current-instruction (r1 ), r2 )

= r-popn-okp (r-current-instruction (r1 ), r1 ))

Theorem: popn-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'popn) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-popn-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-popn-step (r-current-instruction (r1 ), r2 ),

r-popn-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-set-local-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'set-local) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-set-local-okp (r-current-instruction (r1 ), r2 )

= r-set-local-okp (r-current-instruction (r1 ), r1 ))

Theorem: set-local-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'set-local) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-set-local-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-set-local-step (r-current-instruction (r1 ), r2 ),

r-set-local-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-set-global-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'set-global) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-set-global-okp (r-current-instruction (r1 ), r2 )

= r-set-global-okp (r-current-instruction (r1 ), r1 ))

Theorem: set-global-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'set-global) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-set-global-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 ))

→ r-equal (r-set-global-step (r-current-instruction (r1 ), r2 ), r-set-global-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-push-constant-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-constant) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-push-constant-okp (r-current-instruction (r1 ), r2 )

= r-push-constant-okp (r-current-instruction (r1 ), r1 ))

Theorem: push-constant-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-constant) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-push-constant-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-push-constant-step (r-current-instruction (r1 ), r2 ),

r-push-constant-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-push-ctrl-stk-free-size-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-ctrl-stk-free-size) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-push-ctrl-stk-free-size-okp (r-current-instruction (r1 ), r2 )

= r-push-ctrl-stk-free-size-okp (r-current-instruction (r1 ), r1 ))

Theorem: push-ctrl-stk-free-size-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-ctrl-stk-free-size) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-push-ctrl-stk-free-size-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-push-ctrl-stk-free-size-step (r-current-instruction (r1 ), r2 ),

r-push-ctrl-stk-free-size-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-push-temp-stk-free-size-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-temp-stk-free-size) ∧ proper-r-statep (r1 , load-addr)

∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-push-temp-stk-free-size-okp (r-current-instruction (r1 ), r2 )

= r-push-temp-stk-free-size-okp (r-current-instruction (r1 ), r1 ))

Theorem: push-temp-stk-free-size-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-temp-stk-free-size) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-push-temp-stk-free-size-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-push-temp-stk-free-size-step (r-current-instruction (r1 ), r2 ),

r-push-temp-stk-free-size-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-push-temp-stk-index-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-temp-stk-index) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-push-temp-stk-index-okp (r-current-instruction (r1 ), r2 )

= r-push-temp-stk-index-okp (r-current-instruction (r1 ), r1 ))

Theorem: push-temp-stk-index-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'push-temp-stk-index) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-push-temp-stk-index-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-push-temp-stk-index-step (r-current-instruction (r1 ), r2 ),

r-push-temp-stk-index-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-pop-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-pop-okp (r-current-instruction (r1 ), r2 )

= r-pop-okp (r-current-instruction (r1 ), r1 ))

Theorem: pop-preserves-r-equal ((r-psw (r1 ) = 'run)

∧ (car (r-current-instruction (r1 )) = 'pop) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-pop-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-pop-step (r-current-instruction (r1 ), r2 ),

r-pop-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-jump-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-jump-okp (r-current-instruction (r1 ), r2 )

= r-jump-okp (r-current-instruction (r1 ), r1 ))

Theorem: jump-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-jump-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-jump-step (r-current-instruction (r1 ), r2 ),

r-jump-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-pushj-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pushj) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-pushj-okp (r-current-instruction (r1 ), r2 )

= r-pushj-okp (r-current-instruction (r1 ), r1 ))

Theorem: pushj-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pushj) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-pushj-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-pushj-step (r-current-instruction (r1 ), r2 ),

r-pushj-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-popj-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'popj) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-popj-okp (r-current-instruction (r1 ), r2 )

= r-popj-okp (r-current-instruction (r1 ), r1 ))

Theorem: popj-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'popj) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-popj-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-popj-step (r-current-instruction (r1 ), r2 ),

r-popj-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-sub-addr-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-addr) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-sub-addr-okp (r-current-instruction (r1 ), r2 )

= r-sub-addr-okp (r-current-instruction (r1 ), r1 ))

Theorem: sub-addr-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-addr) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-sub-addr-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-sub-addr-step (r-current-instruction (r1 ), r2 ),

r-sub-addr-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-eq-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'eq) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-eq-okp (r-current-instruction (r1 ), r2 )

= r-eq-okp (r-current-instruction (r1 ), r1 ))

Theorem: eq-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'eq) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-eq-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-eq-step (r-current-instruction (r1 ), r2 ),

r-eq-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-lt-addr-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lt-addr) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-lt-addr-okp (r-current-instruction (r1 ), r2 )

= r-lt-addr-okp (r-current-instruction (r1 ), r1 ))

Theorem: lt-addr-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lt-addr) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-lt-addr-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-lt-addr-step (r-current-instruction (r1 ), r2 ),

r-lt-addr-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-fetch-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'fetch) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-fetch-okp (r-current-instruction (r1 ), r2 )

= r-fetch-okp (r-current-instruction (r1 ), r1 ))

Theorem: fetch-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'fetch) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-fetch-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 ))

→ r-equal (r-fetch-step (r-current-instruction (r1 ), r2 ), r-fetch-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-add-int-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-add-int-okp (r-current-instruction (r1 ), r2 )

= r-add-int-okp (r-current-instruction (r1 ), r1 ))

Theorem: add-int-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-add-int-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-add-int-step (r-current-instruction (r1 ), r2 ),

r-add-int-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-add-int-with-carry-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-int-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-add-int-with-carry-okp (r-current-instruction (r1 ), r2 )

= r-add-int-with-carry-okp (r-current-instruction (r1 ), r1 ))

Theorem: add-int-with-carry-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-int-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-add-int-with-carry-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-add-int-with-carry-step (r-current-instruction (r1 ), r2 ),

r-add-int-with-carry-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-add1-int-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add1-int) ∧ proper-r-statep (r1 , load-addr)

∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-add1-int-okp (r-current-instruction (r1 ), r2 )

= r-add1-int-okp (r-current-instruction (r1 ), r1 ))

Theorem: add1-int-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add1-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-add1-int-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-add1-int-step (r-current-instruction (r1 ), r2 ),

r-add1-int-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-sub-int-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-sub-int-okp (r-current-instruction (r1 ), r2 )

= r-sub-int-okp (r-current-instruction (r1 ), r1 ))

Theorem: sub-int-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-sub-int-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-sub-int-step (r-current-instruction (r1 ), r2 ),

r-sub-int-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-sub-int-with-carry-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-int-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-sub-int-with-carry-okp (r-current-instruction (r1 ), r2 )

= r-sub-int-with-carry-okp (r-current-instruction (r1 ), r1 ))

Theorem: sub-int-with-carry-preserves-r-equal ((r-psw (r1 ) = 'run)

∧ (car (r-current-instruction (r1 )) = 'sub-int-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-sub-int-with-carry-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-sub-int-with-carry-step (r-current-instruction (r1 ), r2 ),

r-sub-int-with-carry-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-sub1-int-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub1-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-sub1-int-okp (r-current-instruction (r1 ), r2 )

= r-sub1-int-okp (r-current-instruction (r1 ), r1 ))

Theorem: sub1-int-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub1-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-sub1-int-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-sub1-int-step (r-current-instruction (r1 ), r2 ),

r-sub1-int-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-neg-int-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'neg-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-neg-int-okp (r-current-instruction (r1 ), r2 )

= r-neg-int-okp (r-current-instruction (r1 ), r1 ))

Theorem: neg-int-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'neg-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-neg-int-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-neg-int-step (r-current-instruction (r1 ), r2 ),

r-neg-int-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-lt-int-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lt-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-lt-int-okp (r-current-instruction (r1 ), r2 )

= r-lt-int-okp (r-current-instruction (r1 ), r1 ))

Theorem: lt-int-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lt-int) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-lt-int-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-lt-int-step (r-current-instruction (r1 ), r2 ),

r-lt-int-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-int-to-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'int-to-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-int-to-nat-okp (r-current-instruction (r1 ), r2 )

= r-int-to-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: int-to-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'int-to-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-int-to-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-int-to-nat-step (r-current-instruction (r1 ), r2 ),

r-int-to-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-add-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-add-nat-okp (r-current-instruction (r1 ), r2 )

= r-add-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: add-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'add-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-add-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-add-nat-step (r-current-instruction (r1 ), r2 ),

r-add-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-sub-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-sub-nat-okp (r-current-instruction (r1 ), r2 )

= r-sub-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: sub-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-sub-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-sub-nat-step (r-current-instruction (r1 ), r2 ),

r-sub-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-sub-nat-with-carry-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-nat-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-sub-nat-with-carry-okp (r-current-instruction (r1 ), r2 )

= r-sub-nat-with-carry-okp (r-current-instruction (r1 ), r1 ))

Theorem: sub-nat-with-carry-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub-nat-with-carry) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-sub-nat-with-carry-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 ))

→ r-equal (r-sub-nat-with-carry-step (r-current-instruction (r1 ), r2 ), r-sub-nat-with-carry-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-sub1-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub1-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-sub1-nat-okp (r-current-instruction (r1 ), r2 )

= r-sub1-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: sub1-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'sub1-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-sub1-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-sub1-nat-step (r-current-instruction (r1 ), r2 ),

r-sub1-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-lt-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lt-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-lt-nat-okp (r-current-instruction (r1 ), r2 )

= r-lt-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: lt-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lt-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-lt-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-lt-nat-step (r-current-instruction (r1 ), r2 ),

r-lt-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-mult2-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'mult2-nat) ∧ proper-r-statep (r1 , load-addr)

∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-mult2-nat-okp (r-current-instruction (r1 ), r2 )

= r-mult2-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: mult2-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'mult2-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-mult2-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-mult2-nat-step (r-current-instruction (r1 ), r2 ),

r-mult2-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-div2-nat-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'div2-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-div2-nat-okp (r-current-instruction (r1 ), r2 )

= r-div2-nat-okp (r-current-instruction (r1 ), r1 ))

Theorem: div2-nat-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'div2-nat) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-div2-nat-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-div2-nat-step (r-current-instruction (r1 ), r2 ),

r-div2-nat-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-or-bitv-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'or-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-or-bitv-okp (r-current-instruction (r1 ), r2 )

= r-or-bitv-okp (r-current-instruction (r1 ), r1 ))

Theorem: or-bitv-preserves-r-equal ((r-psw (r1 ) = 'run)

∧ (car (r-current-instruction (r1 )) = 'or-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-or-bitv-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-or-bitv-step (r-current-instruction (r1 ), r2 ),

r-or-bitv-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-and-bitv-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'and-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-and-bitv-okp (r-current-instruction (r1 ), r2 )

= r-and-bitv-okp (r-current-instruction (r1 ), r1 ))

Theorem: and-bitv-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'and-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-and-bitv-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-and-bitv-step (r-current-instruction (r1 ), r2 ),

r-and-bitv-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-not-bitv-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'not-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-not-bitv-okp (r-current-instruction (r1 ), r2 )

= r-not-bitv-okp (r-current-instruction (r1 ), r1 ))

Theorem: not-bitv-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'not-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-not-bitv-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-not-bitv-step (r-current-instruction (r1 ), r2 ),

r-not-bitv-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-xor-bitv-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'xor-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-xor-bitv-okp (r-current-instruction (r1 ), r2 )

= r-xor-bitv-okp (r-current-instruction (r1 ), r1 ))

Theorem: xor-bitv-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'xor-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-xor-bitv-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-xor-bitv-step (r-current-instruction (r1 ), r2 ),

r-xor-bitv-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-rsh-bitv-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'rsh-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-rsh-bitv-okp (r-current-instruction (r1 ), r2 )

= r-rsh-bitv-okp (r-current-instruction (r1 ), r1 ))

Theorem: rsh-bitv-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'rsh-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-rsh-bitv-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-rsh-bitv-step (r-current-instruction (r1 ), r2 ),

r-rsh-bitv-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-lsh-bitv-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lsh-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-lsh-bitv-okp (r-current-instruction (r1 ), r2 )

= r-lsh-bitv-okp (r-current-instruction (r1 ), r1 ))

Theorem: lsh-bitv-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'lsh-bitv) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-lsh-bitv-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-lsh-bitv-step (r-current-instruction (r1 ), r2 ),

r-lsh-bitv-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-or-bool-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'or-bool) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-or-bool-okp (r-current-instruction (r1 ), r2 )

= r-or-bool-okp (r-current-instruction (r1 ), r1 ))

Theorem: or-bool-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'or-bool) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-or-bool-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-or-bool-step (r-current-instruction (r1 ), r2 ),

r-or-bool-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-and-bool-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'and-bool) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-and-bool-okp (r-current-instruction (r1 ), r2 )

= r-and-bool-okp (r-current-instruction (r1 ), r1 ))

Theorem: and-bool-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'and-bool) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-and-bool-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 ))

→ r-equal (r-and-bool-step (r-current-instruction (r1 ), r2 ), r-and-bool-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-not-bool-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'not-bool) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-not-bool-okp (r-current-instruction (r1 ), r2 )

= r-not-bool-okp (r-current-instruction (r1 ), r1 ))

Theorem: not-bool-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'not-bool) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-not-bool-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-not-bool-step (r-current-instruction (r1 ), r2 ),

r-not-bool-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-jump-if-temp-stk-full-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump-if-temp-stk-full) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-jump-if-temp-stk-full-okp (r-current-instruction (r1 ), r2 )

= r-jump-if-temp-stk-full-okp (r-current-instruction (r1 ), r1 ))

Theorem: jump-if-temp-stk-full-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump-if-temp-stk-full) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-jump-if-temp-stk-full-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-jump-if-temp-stk-full-step (r-current-instruction (r1 ), r2 ),

r-jump-if-temp-stk-full-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-jump-if-temp-stk-empty-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump-if-temp-stk-empty) ∧ proper-r-statep (r1 , load-addr)

∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-jump-if-temp-stk-empty-okp (r-current-instruction (r1 ), r2 )

= r-jump-if-temp-stk-empty-okp (r-current-instruction (r1 ), r1 ))

Theorem: jump-if-temp-stk-empty-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump-if-temp-stk-empty) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-jump-if-temp-stk-empty-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-jump-if-temp-stk-empty-step (r-current-instruction (r1 ), r2 ),

r-jump-if-temp-stk-empty-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-test-nat-and-jump-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'test-nat-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-test-nat-and-jump-okp (r-current-instruction (r1 ), r2 )

= r-test-nat-and-jump-okp (r-current-instruction (r1 ), r1 ))

Theorem: test-nat-and-jump-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'test-nat-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-test-nat-and-jump-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-test-nat-and-jump-step (r-current-instruction (r1 ), r2 ),

r-test-nat-and-jump-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-test-int-and-jump-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'test-int-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-test-int-and-jump-okp (r-current-instruction (r1 ), r2 )

= r-test-int-and-jump-okp (r-current-instruction (r1 ), r1 ))

Theorem: test-int-and-jump-preserves-r-equal ((r-psw (r1 ) = 'run)

∧ (car (r-current-instruction (r1 )) = 'test-int-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-test-int-and-jump-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-test-int-and-jump-step (r-current-instruction (r1 ), r2 ),

r-test-int-and-jump-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-test-bool-and-jump-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'test-bool-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-test-bool-and-jump-okp (r-current-instruction (r1 ), r2 )

= r-test-bool-and-jump-okp (r-current-instruction (r1 ), r1 ))

Theorem: test-bool-and-jump-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'test-bool-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-test-bool-and-jump-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-test-bool-and-jump-step (r-current-instruction (r1 ), r2 ),

r-test-bool-and-jump-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-test-bitv-and-jump-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'test-bitv-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-test-bitv-and-jump-okp (r-current-instruction (r1 ), r2 )

= r-test-bitv-and-jump-okp (r-current-instruction (r1 ), r1 ))

Theorem: test-bitv-and-jump-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'test-bitv-and-jump) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-test-bitv-and-jump-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-test-bitv-and-jump-step (r-current-instruction (r1 ), r2 ),

r-test-bitv-and-jump-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-pop-locn-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-locn) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-pop-locn-okp (r-current-instruction (r1 ), r2 )

= r-pop-locn-okp (r-current-instruction (r1 ), r1 ))

Theorem: pop-locn-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-locn) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-pop-locn-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-pop-locn-step (r-current-instruction (r1 ), r2 ),

r-pop-locn-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-locn-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'locn) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-locn-okp (r-current-instruction (r1 ), r2 )

= r-locn-okp (r-current-instruction (r1 ), r1 ))

Theorem: locn-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'locn) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-locn-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-locn-step (r-current-instruction (r1 ), r2 ),

r-locn-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-jump-case-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump-case) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-jump-case-okp (r-current-instruction (r1 ), r2 )

= r-jump-case-okp (r-current-instruction (r1 ), r1 ))

Theorem: jump-case-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'jump-case) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-jump-case-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-jump-case-step (r-current-instruction (r1 ), r2 ),

r-jump-case-step (r-current-instruction (r1 ), r1 ))

; To do call, we need:

Theorem: r-equal-implies-equal-all-r-objectps r-equal (r2 , r1 ) → (all-r-objectps (lst, r2 ) = all-r-objectps (lst, r1 ))

Theorem: r-equal-implies-equal-r-call-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'call) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-call-okp (r-current-instruction (r1 ), r2 )

= r-call-okp (r-current-instruction (r1 ), r1 ))

; Now we start working on call-step itself:
; There are two main problems.  The first is that the machine fetches the
; same actuals from each of the two states.  This is a generalization of
; r-equal-implies-equal-get-tstk.

Definition: stk-equal-fetch-n-hint (n, sp, segment2 ) = if n ≃ 0 then t

elseif (length (cdr (assoc (car (untag (sp)), segment2 ))) − 1)

< cdr (untag (sp)) then t else stk-equal-fetch-n-hint (n − 1, pop-stk (sp), segment2 ) endif

Theorem: stk-equal-implies-equal-fetch-n (listp (untag (sp)) ∧ stk-equal (sp, segment2 , segment1 ) ∧ (stk-length (sp, segment2 ) ≮ n)) → (fetch-n (n, sp, segment2 ) = fetch-n (n, sp, segment1 ))

Theorem: r-equal-implies-equal-fetch-n-call (r-equal (r2 , r1 ) ∧ listp (untag (r-tsp (r1 ))) ∧ (stk-length (r-tsp (r1 ), r-sys-data-segment (r1 )) ≮ n)) → (fetch-n (n, r-tsp (r1 ), r-sys-data-segment (r2 ))

= fetch-n (n, r-tsp (r1 ), r-sys-data-segment (r1 )))

; The second problem is proving that deposit-lst produces stk-equal
; stacks.
; There may be an easier way to do this, but I don't see it.  My
; plan is to replace deposit-lst by deposit-lst1, which runs down
; the list in the reverse order and does the put-assocs on the outside
; of its recursion.  This function, which we prove equivalent to
; deposit-lst, is easier for stk-equal to handle because each time
; it recurses it kicks out a put-assoc for the stk-equal to eat.

Definition: deposit-lst1 (lst, name, n, segment) = if lst ≃ nil then segment

else put-assoc (put (car (lst), n, cdr (assoc (name,

deposit-lst1 (cdr (lst), name, 1 + n, segment)))),

name,

segment) endif

; To prove deposit-lst is deposit-lst1 we need to make explicit the
; relation with append because the main theorem involves reverse:

Theorem: deposit-lst1-append (n ∈ N) → (deposit-lst1 (append (a, list (x)), name, n, segment)

= deposit-lst1 (a, name, n, put-assoc (put (x,

n + length (a),

cdr (assoc (name, segment))), name, segment)))

Theorem: plus-difference{special} (x ≮ y) → ((y + (x − y)) = fix (x))

; So here is the equivalence of the two versions of deposit-lst.

Theorem: deposit-lst-equal-deposit-lst1 ((cdr (untag (sp)) ∈ N) ∧ (cdr (untag (sp)) ≮ (length (lst) − 1))) → (deposit-lst (lst, sp, segment)

= deposit-lst1 (rev (lst), car (untag (sp)), cdr (untag (sp)) − (length (lst) − 1), segment))

; Now I am headed for the theorem that says that if you have
; two stk-equal segments then the result of doing deposit-lst is
; stk-equal.  In the proof deposit-lst will be replaced, as above,
; by deposit-lst1, and then I will use arithmetic, including

Event: Enable difference-elim.

Event: Enable difference-elim-rewrite.

; and

Theorem: difference-sub1-plus-etc ((v ∈ N) ∧ listp (lst)) → ((((v + length (lst)) − 1) − (length (lst) − 1)) = v)

; to reduce the stk-equal-deposit-lst-generalized theorem to an instance of
; stk-equal-deposit-lst1, below.  By the way, the order of the
; actuals, whether reversed or not, is unimportant here; i.e., the
; reverse introduced above is now simply generalized away.
; The proof of stk-equal-deposit-lst1 relies on stk-equal-put-assoc-push
; to eat each put-assoc kicked out by deposit-lst1.  We need to relieve
; the hypotheses of the -push lemma:

Theorem: length-cdr-assoc-deposit-lst1 (definedp (name, segment) ∧ (length (cdr (assoc (name, segment))) ≮ (n + length (lst)))) → (length (cdr (assoc (name, deposit-lst1 (lst, name, n, segment))))

= length (cdr (assoc (name, segment))))

; In the main theorem to which we are heading, we have tag, type, and
; untag enabled.  We therefore need to state this lemma in terms of list
; rather than tag, and enable the accessors.  We explain below.

Theorem: room-to-deposit-lst-implies-not-empty-stkp ((n + length (cdr (lst))) < (length (cdr (assoc (name, segment1 ))) − 1)) → (¬ empty-stkp (list ('sys-addr, cons (name, n)), segment1 ))

; After we relieve the hyps we need to simplify the rhs.  Recall that
; the rhs of the stk-equal-put-assoc-push lemma says that you continue
; the stk-equal at the next higher position after put-associng the
; name with the list into which you did the put.  In our case, the
; list into which we did the put is obtained by associng for
; the name in the result of the continued deposit-lst1.  In any case,
; the identity we need is this:

Theorem: stk-equal-put-assoc-cdr-assoc ((n ∈ N) ∧ definedp (name, old-segment1 ) ∧ definedp (name, old-segment2 )) → (stk-equal (list (sys-addr, cons (name, n)),

put-assoc (cdr (assoc (name, segment1 )), name, old-segment1 ), put-assoc (cdr (assoc (name, segment2 )), name, old-segment2 ))

= stk-equal (list (sys-addr, cons (name, n)), segment1 , segment2 ))

; This is the key result for stk-equal and deposit-lst1.  The lemma is
; a little unusual in having sys-addr as a variable.  Most of the time
; we've used the constant 'sys-addr.  The reason we used a variable
; this time is just that in the lemma we are headed for,
; stk-equal-deposit-lst-generalized, we don't bother to say that
; sp-init is a sys-addr address.

Theorem: stk-equal-deposit-lst1 ((n ∈ N) ∧ definedp (name, segment2 ) ∧ ((n + length (lst)) < length (cdr (assoc (name, segment2 )))) ∧ definedp (name, segment1 ) ∧ ((n + length (lst)) < length (cdr (assoc (name, segment1 )))) ∧ ((n + length (lst)) ≮ length (lst)) ∧ stk-equal (list (sys-addr, cons (name, n + length (lst))),

segment2 , segment1 ))

→ stk-equal (list (sys-addr, cons (name, n)), deposit-lst1 (lst, name, n, segment2 ), deposit-lst1 (lst, name, n, segment1 ))

; Here is the main theorem about stk-equal and deposit-lst.  As noted, the
; proof involves an elim to get rid of the difference introduced when we
; trade deposit-lst for deposit-lst1.  That elim also introduces conses for
; sp-init, below, and so we need to enable type and untag so they compute on
; conses.  That is why the lemma development above used list instead of tag
; everywhere.  The lemma is of lemma class nil because we need to instantiate
; it later to derive the actual rewrite rule we need.

Theorem: stk-equal-deposit-lst-generalized ((cddr (sp-init) = nil) ∧ addressp (sp-init, segment2 ) ∧ addressp (sp-init, segment1 ) ∧ (free-stk-size (sp-init) ≮ length (lst)) ∧ stk-equal (sp-init, segment2 , segment1 )) → stk-equal (push-stk-n (length (lst), sp-init),

deposit-lst (lst, push-stk (sp-init), segment2 ), deposit-lst (lst, push-stk (sp-init), segment1 ))

; We now disable the things we introduced just for this proof.

Event: Disable deposit-lst-equal-deposit-lst1.

Event: Disable difference-elim.

Event: Disable difference-sub1-plus-etc.

Event: Disable room-to-deposit-lst-implies-not-empty-stkp.

Theorem: stk-equal-deposit-lst ((n-final = (n-init − length (lst))) ∧ definedp ('cstk, segment2 ) ∧ definedp ('cstk, segment1 ) ∧ (n-init ∈ N) ∧ (n-init ≮ length (lst)) ∧ (n-init < length (cdr (assoc ('cstk, segment2 )))) ∧ (n-init < length (cdr (assoc ('cstk, segment1 )))) ∧ stk-equal (tag ('sys-addr, cons ('cstk, n-init)), segment2 , segment1 )) → stk-equal (tag ('sys-addr, cons ('cstk, n-final)),

deposit-lst (lst, tag ('sys-addr, cons ('cstk, n-init − 1)),

segment2 ),

deposit-lst (lst, tag ('sys-addr, cons ('cstk, n-init − 1)), segment1 ))

; Returning now to the consideration of call itself and the stk-equality
; on the new cstks, the theorem above reduces (actually backchains) the
; problem to one of the stk-equality after the first pushes of the old fp
; and ret-pc.  The following lemma establishes that the stack on which
; we're pushing is non-empty and allows the famous stk-equal-put-assoc-push
; to handle those two pushes:

Theorem: not-empty-stkp-push-csp (proper-r-statep (r, load-addr) ∧ (n < cdr (untag (r-csp (r))))) → (¬ empty-stkp (tag ('sys-addr, cons ('cstk, n)),

r-sys-data-segment (r)))

; We are finally left with the stk-equality of the two cstks below the
; new frame.  That is given to us, except that we have torn the csp
; apart with all the stuff above and need to put it back together:

Theorem: proper-r-statep-implies-tag-untag-cstk ((type (x) = 'sys-addr) ∧ (car (untag (x)) = 'cstk) ∧ (cddr (x) = nil)) → (tag ('sys-addr, cons ('cstk, cdr (untag (x)))) = x)

; This completes the argument that the new cstks are stk-equal.
; We now turn to the stk-equality of the new tstks.
; The only observation we need to make is that the deposit-lst on the
; cstk does not affect the question of stk-equality on the tstk.  Then
; the knowledge that stk-equal extends upwards will handle things for
; us.
; The strategy is the same as before: replace deposit-lst with
; deposit-lst1 and appeal to the simple theorem about deposit-lst1:

Theorem: stk-equal-tstk-deposit-lst1-cstk stk-equal (tag ('sys-addr, cons ('tstk, n)),

deposit-lst1 (lst, 'cstk, k, segment2 ), deposit-lst1 (lst, 'cstk, k, segment1 ))

= stk-equal (tag ('sys-addr, cons ('tstk, n)), segment2 , segment1 )

; So here is the result we needed for the stk-equality on the tstk:

Theorem: stk-equal-tstk-deposit-lst-cstk ((car (untag (csp)) = 'cstk) ∧ (cdr (untag (csp)) ∈ N) ∧ (cdr (untag (csp)) ≮ (length (lst) − 1))) → (stk-equal (tag ('sys-addr, cons ('tstk, n)),

deposit-lst (lst, csp, segment2 ), deposit-lst (lst, csp, segment1 ))

= stk-equal (tag ('sys-addr, cons ('tstk, n)), segment2 , segment1 ))

; The last thing we have to handle is the same-signature of the new
; sys-data-segments.  We use deposit-lst1 again.

Theorem: same-signature-deposit-lst1 (litatom (name) ∧ definedp (name, segment1 ) ∧ definedp (name, segment2 ) ∧ (length (cdr (assoc (name, segment1 ))) ≮ (n + length (lst))) ∧ (length (cdr (assoc (name, segment2 ))) ≮ (n + length (lst)))) → (same-signature (deposit-lst1 (lst, name, n, segment2 ),

deposit-lst1 (lst, name, n, segment1 ))

= same-signature (segment2 , segment1 ))

Theorem: same-signature-deposit-lst{special} (litatom (car (untag (csp))) ∧ definedp (car (untag (csp)), segment1 ) ∧ definedp (car (untag (csp)), segment2 ) ∧ (cdr (untag (csp)) ∈ N) ∧ (cdr (untag (csp)) ≮ (length (lst) − 1)) ∧ (cdr (untag (csp)) < length (cdr (assoc (car (untag (csp)), segment1 )))) ∧ (cdr (untag (csp)) < length (cdr (assoc (car (untag (csp)), segment2 ))))) → (same-signature (deposit-lst (lst, csp, segment2 ),

deposit-lst (lst, csp, segment1 ))

= same-signature (segment2 , segment1 ))

; And that completes the r-equal work for call!

Theorem: call-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'call) ∧ proper-r-statep (r1 , load-addr)

∧ proper-r-statep (r2 , load-addr) ∧ r-call-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-call-step (r-current-instruction (r1 ), r2 ),

r-call-step (r-current-instruction (r1 ), r1 ))

; In order to reduce the pop-call case to call, we need to
; explain that the fake state created by pop-call does not
; affect the tests we make:

Theorem: r-objectp-on-pop-call-state ((r-prog-segment (r) = r-prog-segment) ∧ (r-usr-data-segment (r) = r-usr-data-segment) ∧ (r-word-size (r) = r-word-size)) → (r-objectp (x,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, r-prog-segment, r-usr-data-segment, r-sys-data-segment (r), r-word-size, r-psw))

= r-objectp (x, r))

Theorem: all-r-objectps-on-pop-call-state ((r-prog-segment (r) = r-prog-segment) ∧ (r-usr-data-segment (r) = r-usr-data-segment) ∧ (r-word-size (r) = r-word-size)) → (all-r-objectps (lst,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, r-prog-segment, r-usr-data-segment, r-sys-data-segment (r), r-word-size, r-psw))

= all-r-objectps (lst, r))

Theorem: add1-r-pcp-on-pop-call-state ((r-prog-segment (r) = r-prog-segment) ∧ (r-pc (r) = r-pc)) → (add1-r-pcp (r-state (r-pc,

r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, r-prog-segment, r-usr-data-segment, r-sys-data-segment (r), r-word-size, r-psw))

= add1-r-pcp (r))

Theorem: r-equal-implies-equal-r-pop-call-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-call) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-pop-call-okp (r-current-instruction (r1 ), r2 )

= r-pop-call-okp (r-current-instruction (r1 ), r1 ))

; Recall the lemma r-equal-implies-equal-fetch-n-call.  It rewrites
; (fetch-n n (r-tsp r1) (r-sys-data-segment r2)).  That will not
; do for pop-call because instead of (r-tsp r1) we are interested
; in (pop-stk (r-tsp r1)), with the pop-stk expanded.  So we
; prove a slightly different version:
; The proper-r-statep hypothesis added below is necessary to

; insure that (tag 'sys-addr (cons 'tstk (cdr (untag (r-tsp r1)))))
; is in fact (r-tsp r1).

Theorem: r-equal-implies-equal-fetch-n-pop-call (r-equal (r2 , r1 ) ∧ proper-r-statep (r1 , load-addr) ∧ listp (untag (r-tsp (r1 ))) ∧ (stk-length (tag ('sys-addr, cons ('tstk, 1 + cdr (untag (r-tsp (r1 ))))),

r-sys-data-segment (r1 ))

≮ n)) → (fetch-n (n,

tag ('sys-addr, cons ('tstk, 1 + cdr (untag (r-tsp (r1 ))))), r-sys-data-segment (r2 ))

= fetch-n (n,

              tag ('sys-addr,

cons ('tstk, 1 + cdr (untag (r-tsp (r1 ))))), r-sys-data-segment (r1 )))

Theorem: pop-call-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'pop-call) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-pop-call-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-pop-call-step (r-current-instruction (r1 ), r2 ),

r-pop-call-step (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-ret-okp ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'ret) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-ret-okp (r-current-instruction (r1 ), r2 )

= r-ret-okp (r-current-instruction (r1 ), r1 ))

; Needless to say, on ret we need to know that the stk-equality
; on the cstk extends upwards too.  Previously we had proved it
; only for the tstk.

Theorem: r-equal-implies-stk-equal-extends-upwards-cstk (r-equal (r2 , r1 )

∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ (k ∈ N) ∧ (k ≮ cdr (untag (r-csp (r1 ))))) → stk-equal (tag ('sys-addr, cons ('cstk, k)),

r-sys-data-segment (r2 ), r-sys-data-segment (r1 ))

; And we need to know about r-halt:

Theorem: r-equal-implies-r-equal-r-halt r-equal (r2 , r1 ) → r-equal (r-halt (r2 , r-psw), r-halt (r1 , r-psw))

Theorem: ret-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ (car (r-current-instruction (r1 )) = 'ret) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-ret-okp (r-current-instruction (r1 ), r2 ) ∧ r-equal (r2 , r1 )) → r-equal (r-ret-step (r-current-instruction (r1 ), r2 ),

r-ret-step (r-current-instruction (r1 ), r1 ))

; We also have to prove that p-loadablep is preserved by p-step.
; We do it in the expected way, beginning with the individual
; instruction steppers.

Theorem: no-op-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'no-op) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-no-op-okp (p-current-instruction (p), p)) → p-loadablep (p-no-op-step (p-current-instruction (p), p), load-addr)

Theorem: push-global-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-global) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-push-global-okp (p-current-instruction (p), p)) → p-loadablep (p-push-global-step (p-current-instruction (p), p), load-addr)

Theorem: pop-global-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-global) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-pop-global-okp (p-current-instruction (p), p)) → p-loadablep (p-pop-global-step (p-current-instruction (p), p), load-addr)

Theorem: push-local-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-local) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-push-local-okp (p-current-instruction (p), p)) → p-loadablep (p-push-local-step (p-current-instruction (p), p), load-addr)

Theorem: pop-local-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-local) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-pop-local-okp (p-current-instruction (p), p)) → p-loadablep (p-pop-local-step (p-current-instruction (p), p), load-addr)

Theorem: deposit-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-deposit-okp (p-current-instruction (p), p)) → p-loadablep (p-deposit-step (p-current-instruction (p), p), load-addr)

Theorem: add1-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-add1-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-add1-nat-step (p-current-instruction (p), p), load-addr)

Theorem: add-addr-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-addr) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr)

∧ p-add-addr-okp (p-current-instruction (p), p)) → p-loadablep (p-add-addr-step (p-current-instruction (p), p), load-addr)

Theorem: add-nat-with-carry-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat-with-carry) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-add-nat-with-carry-okp (p-current-instruction (p), p)) → p-loadablep (p-add-nat-with-carry-step (p-current-instruction (p), p),

load-addr)

Theorem: mult2-nat-with-carry-out-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat-with-carry-out) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-mult2-nat-with-carry-out-okp (p-current-instruction (p), p)) → p-loadablep (p-mult2-nat-with-carry-out-step (p-current-instruction (p),

p),

load-addr)

Theorem: fetch-temp-stk-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch-temp-stk) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-fetch-temp-stk-okp (p-current-instruction (p), p)) → p-loadablep (p-fetch-temp-stk-step (p-current-instruction (p), p),

load-addr)

Theorem: deposit-temp-stk-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit-temp-stk) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-deposit-temp-stk-okp (p-current-instruction (p), p)) → p-loadablep (p-deposit-temp-stk-step (p-current-instruction (p), p),

load-addr)

Theorem: pop*-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop*) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr)

∧ p-pop*-okp (p-current-instruction (p), p)) → p-loadablep (p-pop*-step (p-current-instruction (p), p), load-addr)

Theorem: popn-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popn) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-popn-okp (p-current-instruction (p), p)) → p-loadablep (p-popn-step (p-current-instruction (p), p), load-addr)

Theorem: set-local-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-local) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-set-local-okp (p-current-instruction (p), p)) → p-loadablep (p-set-local-step (p-current-instruction (p), p), load-addr)

Theorem: set-global-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-global) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-set-global-okp (p-current-instruction (p), p)) → p-loadablep (p-set-global-step (p-current-instruction (p), p), load-addr)

Theorem: push-constant-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-constant) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-push-constant-okp (p-current-instruction (p), p)) → p-loadablep (p-push-constant-step (p-current-instruction (p), p),

load-addr)

Theorem: push-ctrl-stk-free-size-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-ctrl-stk-free-size) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-push-ctrl-stk-free-size-okp (p-current-instruction (p), p)) → p-loadablep (p-push-ctrl-stk-free-size-step (p-current-instruction (p), p),

load-addr)

Theorem: push-temp-stk-free-size-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-free-size) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-push-temp-stk-free-size-okp (p-current-instruction (p), p)) → p-loadablep (p-push-temp-stk-free-size-step (p-current-instruction (p), p),

load-addr)

Theorem: push-temp-stk-index-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-index) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-push-temp-stk-index-okp (p-current-instruction (p), p)) → p-loadablep (p-push-temp-stk-index-step (p-current-instruction (p), p),

load-addr)

Theorem: pop-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-pop-okp (p-current-instruction (p), p)) → p-loadablep (p-pop-step (p-current-instruction (p), p), load-addr)

Theorem: jump-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-jump-okp (p-current-instruction (p), p)) → p-loadablep (p-jump-step (p-current-instruction (p), p), load-addr)

Theorem: pushj-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pushj) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-pushj-okp (p-current-instruction (p), p)) → p-loadablep (p-pushj-step (p-current-instruction (p), p), load-addr)

Theorem: popj-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popj)

∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-popj-okp (p-current-instruction (p), p)) → p-loadablep (p-popj-step (p-current-instruction (p), p), load-addr)

Theorem: sub-addr-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-addr) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-sub-addr-okp (p-current-instruction (p), p)) → p-loadablep (p-sub-addr-step (p-current-instruction (p), p), load-addr)

Theorem: eq-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'eq) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-eq-okp (p-current-instruction (p), p)) → p-loadablep (p-eq-step (p-current-instruction (p), p), load-addr)

Theorem: lt-addr-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-addr) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-lt-addr-okp (p-current-instruction (p), p)) → p-loadablep (p-lt-addr-step (p-current-instruction (p), p), load-addr)

Theorem: fetch-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-fetch-okp (p-current-instruction (p), p)) → p-loadablep (p-fetch-step (p-current-instruction (p), p), load-addr)

Theorem: add-int-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-add-int-okp (p-current-instruction (p), p)) → p-loadablep (p-add-int-step (p-current-instruction (p), p), load-addr)

Theorem: add-int-with-carry-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int-with-carry) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-add-int-with-carry-okp (p-current-instruction (p), p)) → p-loadablep (p-add-int-with-carry-step (p-current-instruction (p), p),

load-addr)

Theorem: add1-int-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-int) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-add1-int-okp (p-current-instruction (p), p)) → p-loadablep (p-add1-int-step (p-current-instruction (p), p), load-addr)

Theorem: sub-int-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-sub-int-okp (p-current-instruction (p), p)) → p-loadablep (p-sub-int-step (p-current-instruction (p), p), load-addr)

Theorem: sub-int-with-carry-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int-with-carry) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-sub-int-with-carry-okp (p-current-instruction (p), p)) → p-loadablep (p-sub-int-with-carry-step (p-current-instruction (p), p),

load-addr)

Theorem: sub1-int-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-int) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-sub1-int-okp (p-current-instruction (p), p)) → p-loadablep (p-sub1-int-step (p-current-instruction (p), p), load-addr)

Theorem: neg-int-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'neg-int)

∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-neg-int-okp (p-current-instruction (p), p)) → p-loadablep (p-neg-int-step (p-current-instruction (p), p), load-addr)

Theorem: lt-int-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-int) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-lt-int-okp (p-current-instruction (p), p)) → p-loadablep (p-lt-int-step (p-current-instruction (p), p), load-addr)

Theorem: int-to-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'int-to-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-int-to-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-int-to-nat-step (p-current-instruction (p), p), load-addr)

Theorem: add-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-add-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-add-nat-step (p-current-instruction (p), p), load-addr)

Theorem: sub-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-sub-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-sub-nat-step (p-current-instruction (p), p), load-addr)

Theorem: sub-nat-with-carry-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat-with-carry) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-sub-nat-with-carry-okp (p-current-instruction (p), p)) → p-loadablep (p-sub-nat-with-carry-step (p-current-instruction (p), p),

load-addr)

Theorem: sub1-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-sub1-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-sub1-nat-step (p-current-instruction (p), p), load-addr)

Theorem: lt-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-lt-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-lt-nat-step (p-current-instruction (p), p), load-addr)

Theorem: mult2-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-mult2-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-mult2-nat-step (p-current-instruction (p), p), load-addr)

Theorem: div2-nat-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'div2-nat) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-div2-nat-okp (p-current-instruction (p), p)) → p-loadablep (p-div2-nat-step (p-current-instruction (p), p), load-addr)

Theorem: or-bitv-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bitv) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-or-bitv-okp (p-current-instruction (p), p)) → p-loadablep (p-or-bitv-step (p-current-instruction (p), p), load-addr)

Theorem: and-bitv-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bitv) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr)

∧ p-and-bitv-okp (p-current-instruction (p), p)) → p-loadablep (p-and-bitv-step (p-current-instruction (p), p), load-addr)

Theorem: not-bitv-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bitv) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-not-bitv-okp (p-current-instruction (p), p)) → p-loadablep (p-not-bitv-step (p-current-instruction (p), p), load-addr)

Theorem: xor-bitv-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'xor-bitv) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-xor-bitv-okp (p-current-instruction (p), p)) → p-loadablep (p-xor-bitv-step (p-current-instruction (p), p), load-addr)

Theorem: rsh-bitv-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'rsh-bitv) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-rsh-bitv-okp (p-current-instruction (p), p)) → p-loadablep (p-rsh-bitv-step (p-current-instruction (p), p), load-addr)

Theorem: lsh-bitv-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lsh-bitv) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-lsh-bitv-okp (p-current-instruction (p), p)) → p-loadablep (p-lsh-bitv-step (p-current-instruction (p), p), load-addr)

Theorem: or-bool-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bool) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-or-bool-okp (p-current-instruction (p), p)) → p-loadablep (p-or-bool-step (p-current-instruction (p), p), load-addr)

Theorem: and-bool-preserves-p-loadablep ((p-psw (p) = 'run)

∧ (car (p-current-instruction (p)) = 'and-bool) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-and-bool-okp (p-current-instruction (p), p)) → p-loadablep (p-and-bool-step (p-current-instruction (p), p), load-addr)

Theorem: not-bool-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bool) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-not-bool-okp (p-current-instruction (p), p)) → p-loadablep (p-not-bool-step (p-current-instruction (p), p), load-addr)

Theorem: jump-if-temp-stk-full-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-full) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-jump-if-temp-stk-full-okp (p-current-instruction (p), p)) → p-loadablep (p-jump-if-temp-stk-full-step (p-current-instruction (p), p),

load-addr)

Theorem: jump-if-temp-stk-empty-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-empty) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-jump-if-temp-stk-empty-okp (p-current-instruction (p), p)) → p-loadablep (p-jump-if-temp-stk-empty-step (p-current-instruction (p), p),

load-addr)

Theorem: test-nat-and-jump-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-nat-and-jump) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-test-nat-and-jump-okp (p-current-instruction (p), p)) → p-loadablep (p-test-nat-and-jump-step (p-current-instruction (p), p),

load-addr)

Theorem: test-int-and-jump-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-int-and-jump) ∧ proper-p-statep (p)

∧ p-loadablep (p, load-addr) ∧ p-test-int-and-jump-okp (p-current-instruction (p), p)) → p-loadablep (p-test-int-and-jump-step (p-current-instruction (p), p),

load-addr)

Theorem: test-bool-and-jump-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bool-and-jump) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-test-bool-and-jump-okp (p-current-instruction (p), p)) → p-loadablep (p-test-bool-and-jump-step (p-current-instruction (p), p),

load-addr)

Theorem: test-bitv-and-jump-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bitv-and-jump) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-test-bitv-and-jump-okp (p-current-instruction (p), p)) → p-loadablep (p-test-bitv-and-jump-step (p-current-instruction (p), p),

load-addr)

Theorem: pop-locn-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-locn) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-pop-locn-okp (p-current-instruction (p), p)) → p-loadablep (p-pop-locn-step (p-current-instruction (p), p), load-addr)

Theorem: locn-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'locn) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-locn-okp (p-current-instruction (p), p)) → p-loadablep (p-locn-step (p-current-instruction (p), p), load-addr)

Theorem: jump-case-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-case) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-jump-case-okp (p-current-instruction (p), p)) → p-loadablep (p-jump-case-step (p-current-instruction (p), p), load-addr)

Theorem: call-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'call) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-call-okp (p-current-instruction (p), p)) → p-loadablep (p-call-step (p-current-instruction (p), p), load-addr)

Theorem: pop-call-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-call) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-pop-call-okp (p-current-instruction (p), p)) → p-loadablep (p-pop-call-step (p-current-instruction (p), p), load-addr)

Theorem: ret-preserves-p-loadablep ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'ret) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ p-ret-okp (p-current-instruction (p), p)) → p-loadablep (p-ret-step (p-current-instruction (p), p), load-addr)

; We now turn our attention to putting all these lemmas together to
; get the p-step and r-step versions of each.

Event: Disable p-call-okp.

Event: Disable p-call-step.

Event: Disable p-ret-okp.

Event: Disable p-ret-step.

Event: Disable p-locn-okp.

Event: Disable p-locn-step.

Event: Disable p-push-constant-okp.

Event: Disable p-push-constant-step. Event: Disable p-push-local-okp. Event: Disable p-push-local-step. Event: Disable p-push-global-okp. Event: Disable p-push-global-step. Event: Disable p-push-ctrl-stk-free-size-okp. Event: Disable p-push-ctrl-stk-free-size-step. Event: Disable p-push-temp-stk-free-size-okp. Event: Disable p-push-temp-stk-free-size-step. Event: Disable p-push-temp-stk-index-okp. Event: Disable p-push-temp-stk-index-step. Event: Disable p-jump-if-temp-stk-full-okp. Event: Disable p-jump-if-temp-stk-full-step. Event: Disable p-jump-if-temp-stk-empty-okp. Event: Disable p-jump-if-temp-stk-empty-step. Event: Disable p-pop-okp. Event: Disable p-pop-step. Event: Disable p-pop*-okp.

Event: Disable p-pop*-step. Event: Disable p-popn-okp. Event: Disable p-popn-step. Event: Disable p-pop-local-okp. Event: Disable p-pop-local-step. Event: Disable p-pop-global-okp. Event: Disable p-pop-global-step. Event: Disable p-pop-locn-okp. Event: Disable p-pop-locn-step. Event: Disable p-pop-call-okp. Event: Disable p-pop-call-step. Event: Disable p-fetch-temp-stk-okp. Event: Disable p-fetch-temp-stk-step. Event: Disable p-deposit-temp-stk-okp. Event: Disable p-deposit-temp-stk-step. Event: Disable p-jump-okp. Event: Disable p-jump-step. Event: Disable p-jump-case-okp.

Event: Disable p-jump-case-step. Event: Disable p-pushj-okp. Event: Disable p-pushj-step. Event: Disable p-popj-okp. Event: Disable p-popj-step. Event: Disable p-set-local-okp. Event: Disable p-set-local-step. Event: Disable p-set-global-okp. Event: Disable p-set-global-step. Event: Disable p-test-nat-and-jump-okp. Event: Disable p-test-nat-and-jump-step. Event: Disable p-test-int-and-jump-okp. Event: Disable p-test-int-and-jump-step. Event: Disable p-test-bool-and-jump-okp. Event: Disable p-test-bool-and-jump-step. Event: Disable p-test-bitv-and-jump-okp. Event: Disable p-test-bitv-and-jump-step. Event: Disable p-no-op-okp.

Event: Disable p-no-op-step. Event: Disable p-add-addr-okp. Event: Disable p-add-addr-step. Event: Disable p-sub-addr-okp. Event: Disable p-sub-addr-step. Event: Disable p-eq-okp. Event: Disable p-eq-step. Event: Disable p-lt-addr-okp. Event: Disable p-lt-addr-step. Event: Disable p-fetch-okp. Event: Disable p-fetch-step. Event: Disable p-deposit-okp. Event: Disable p-deposit-step. Event: Disable p-add-int-okp. Event: Disable p-add-int-step. Event: Disable p-add-int-with-carry-okp. Event: Disable p-add-int-with-carry-step. Event: Disable p-add1-int-okp.

Event: Disable p-add1-int-step. Event: Disable p-sub-int-okp. Event: Disable p-sub-int-step. Event: Disable p-sub-int-with-carry-okp. Event: Disable p-sub-int-with-carry-step. Event: Disable p-sub1-int-okp. Event: Disable p-sub1-int-step. Event: Disable p-neg-int-okp. Event: Disable p-neg-int-step. Event: Disable p-lt-int-okp. Event: Disable p-lt-int-step. Event: Disable p-int-to-nat-okp. Event: Disable p-int-to-nat-step. Event: Disable p-add-nat-okp. Event: Disable p-add-nat-step. Event: Disable p-add-nat-with-carry-okp. Event: Disable p-add-nat-with-carry-step. Event: Disable p-add1-nat-okp.

Event: Disable p-add1-nat-step. Event: Disable p-sub-nat-okp. Event: Disable p-sub-nat-step. Event: Disable p-sub-nat-with-carry-okp. Event: Disable p-sub-nat-with-carry-step. Event: Disable p-sub1-nat-okp. Event: Disable p-sub1-nat-step. Event: Disable p-lt-nat-okp. Event: Disable p-lt-nat-step. Event: Disable p-mult2-nat-okp. Event: Disable p-mult2-nat-step. Event: Disable p-mult2-nat-with-carry-out-okp. Event: Disable p-mult2-nat-with-carry-out-step. Event: Disable p-div2-nat-okp. Event: Disable p-div2-nat-step. Event: Disable p-or-bitv-okp. Event: Disable p-or-bitv-step. Event: Disable p-and-bitv-okp.

Event: Disable p-and-bitv-step. Event: Disable p-not-bitv-okp. Event: Disable p-not-bitv-step. Event: Disable p-xor-bitv-okp. Event: Disable p-xor-bitv-step. Event: Disable p-rsh-bitv-okp. Event: Disable p-rsh-bitv-step. Event: Disable p-lsh-bitv-okp. Event: Disable p-lsh-bitv-step. Event: Disable p-or-bool-okp. Event: Disable p-or-bool-step. Event: Disable p-and-bool-okp. Event: Disable p-and-bool-step. Event: Disable p-not-bool-okp. Event: Disable p-not-bool-step. Event: Disable r-call-okp. Event: Disable r-call-step. Event: Disable r-ret-okp.

Event: Disable r-ret-step. Event: Disable r-locn-okp. Event: Disable r-locn-step. Event: Disable r-push-constant-okp. Event: Disable r-push-constant-step. Event: Disable r-push-local-okp. Event: Disable r-push-local-step. Event: Disable r-push-global-okp. Event: Disable r-push-global-step. Event: Disable r-push-ctrl-stk-free-size-okp. Event: Disable r-push-ctrl-stk-free-size-step. Event: Disable r-push-temp-stk-free-size-okp. Event: Disable r-push-temp-stk-free-size-step. Event: Disable r-push-temp-stk-index-okp. Event: Disable r-push-temp-stk-index-step. Event: Disable r-jump-if-temp-stk-full-okp. Event: Disable r-jump-if-temp-stk-full-step. Event: Disable r-jump-if-temp-stk-empty-okp.

Event: Disable r-jump-if-temp-stk-empty-step. Event: Disable r-pop-okp. Event: Disable r-pop-step. Event: Disable r-pop*-okp. Event: Disable r-pop*-step. Event: Disable r-popn-okp. Event: Disable r-popn-step. Event: Disable r-pop-local-okp. Event: Disable r-pop-local-step. Event: Disable r-pop-global-okp. Event: Disable r-pop-global-step. Event: Disable r-pop-locn-okp. Event: Disable r-pop-locn-step. Event: Disable r-pop-call-okp. Event: Disable r-pop-call-step. Event: Disable r-fetch-temp-stk-okp. Event: Disable r-fetch-temp-stk-step. Event: Disable r-deposit-temp-stk-okp.

Event: Disable r-deposit-temp-stk-step. Event: Disable r-jump-okp. Event: Disable r-jump-step. Event: Disable r-jump-case-okp. Event: Disable r-jump-case-step. Event: Disable r-pushj-okp. Event: Disable r-pushj-step. Event: Disable r-popj-okp. Event: Disable r-popj-step. Event: Disable r-set-local-okp. Event: Disable r-set-local-step. Event: Disable r-set-global-okp. Event: Disable r-set-global-step. Event: Disable r-test-nat-and-jump-okp. Event: Disable r-test-nat-and-jump-step. Event: Disable r-test-int-and-jump-okp. Event: Disable r-test-int-and-jump-step. Event: Disable r-test-bool-and-jump-okp.

Event: Disable r-test-bool-and-jump-step. Event: Disable r-test-bitv-and-jump-okp. Event: Disable r-test-bitv-and-jump-step. Event: Disable r-no-op-okp. Event: Disable r-no-op-step. Event: Disable r-add-addr-okp. Event: Disable r-add-addr-step. Event: Disable r-sub-addr-okp. Event: Disable r-sub-addr-step. Event: Disable r-eq-okp. Event: Disable r-eq-step. Event: Disable r-lt-addr-okp. Event: Disable r-lt-addr-step. Event: Disable r-fetch-okp. Event: Disable r-fetch-step. Event: Disable r-deposit-okp. Event: Disable r-deposit-step. Event: Disable r-add-int-okp.

Event: Disable r-add-int-step. Event: Disable r-add-int-with-carry-okp. Event: Disable r-add-int-with-carry-step. Event: Disable r-add1-int-okp. Event: Disable r-add1-int-step. Event: Disable r-sub-int-okp. Event: Disable r-sub-int-step. Event: Disable r-sub-int-with-carry-okp. Event: Disable r-sub-int-with-carry-step. Event: Disable r-sub1-int-okp. Event: Disable r-sub1-int-step. Event: Disable r-neg-int-okp. Event: Disable r-neg-int-step. Event: Disable r-lt-int-okp. Event: Disable r-lt-int-step. Event: Disable r-int-to-nat-okp. Event: Disable r-int-to-nat-step. Event: Disable r-add-nat-okp.

Event: Disable r-add-nat-step. Event: Disable r-add-nat-with-carry-okp. Event: Disable r-add-nat-with-carry-step. Event: Disable r-add1-nat-okp. Event: Disable r-add1-nat-step. Event: Disable r-sub-nat-okp. Event: Disable r-sub-nat-step. Event: Disable r-sub-nat-with-carry-okp. Event: Disable r-sub-nat-with-carry-step. Event: Disable r-sub1-nat-okp. Event: Disable r-sub1-nat-step. Event: Disable r-lt-nat-okp. Event: Disable r-lt-nat-step. Event: Disable r-mult2-nat-okp. Event: Disable r-mult2-nat-step. Event: Disable r-mult2-nat-with-carry-out-okp. Event: Disable r-mult2-nat-with-carry-out-step. Event: Disable r-div2-nat-okp.

Event: Disable r-div2-nat-step. Event: Disable r-or-bitv-okp. Event: Disable r-or-bitv-step. Event: Disable r-and-bitv-okp. Event: Disable r-and-bitv-step. Event: Disable r-not-bitv-okp. Event: Disable r-not-bitv-step. Event: Disable r-xor-bitv-okp. Event: Disable r-xor-bitv-step. Event: Disable r-rsh-bitv-okp. Event: Disable r-rsh-bitv-step. Event: Disable r-lsh-bitv-okp. Event: Disable r-lsh-bitv-step. Event: Disable r-or-bool-okp. Event: Disable r-or-bool-step. Event: Disable r-and-bool-okp. Event: Disable r-and-bool-step. Event: Disable r-not-bool-okp.

Event: Disable r-not-bool-step.

; Our plan for putting everything together requires -- as every plan must
; I think -- enough Lisp stack space for the rewriter to completely explore
; the if-nest in r-ins-step and the other "big switch" functions.
; Unfortunately that is not the case.  So we artificially partition our
; functions into two nearly equal halves and deal with each half separately.

Definition: r-ins-okp2 (ins, r) = case on car (ins):

case = eq then r-eq-okp (ins, r) case = lt-addr then r-lt-addr-okp (ins, r) case = fetch then r-fetch-okp (ins, r) case = deposit then r-deposit-okp (ins, r) case = add-int then r-add-int-okp (ins, r) case = add-int-with-carry then r-add-int-with-carry-okp (ins, r) case = add1-int then r-add1-int-okp (ins, r) case = sub-int then r-sub-int-okp (ins, r) case = sub-int-with-carry then r-sub-int-with-carry-okp (ins, r) case = sub1-int then r-sub1-int-okp (ins, r) case = neg-int then r-neg-int-okp (ins, r) case = lt-int then r-lt-int-okp (ins, r) case = int-to-nat then r-int-to-nat-okp (ins, r) case = add-nat then r-add-nat-okp (ins, r) case = add-nat-with-carry then r-add-nat-with-carry-okp (ins, r) case = add1-nat then r-add1-nat-okp (ins, r) case = sub-nat then r-sub-nat-okp (ins, r) case = sub-nat-with-carry then r-sub-nat-with-carry-okp (ins, r) case = sub1-nat then r-sub1-nat-okp (ins, r) case = lt-nat then r-lt-nat-okp (ins, r) case = mult2-nat then r-mult2-nat-okp (ins, r) case = mult2-nat-with-carry-out then r-mult2-nat-with-carry-out-okp (ins, r) case = div2-nat then r-div2-nat-okp (ins, r) case = or-bitv then r-or-bitv-okp (ins, r) case = and-bitv then r-and-bitv-okp (ins, r) case = not-bitv then r-not-bitv-okp (ins, r) case = xor-bitv then r-xor-bitv-okp (ins, r) case = rsh-bitv then r-rsh-bitv-okp (ins, r) case = lsh-bitv then r-lsh-bitv-okp (ins, r) case = or-bool then r-or-bool-okp (ins, r) case = and-bool then r-and-bool-okp (ins, r) case = not-bool then r-not-bool-okp (ins, r) otherwise f endcase

Definition: r-ins-okp1 (ins, r) = case on car (ins):

case = call then r-call-okp (ins, r) case = ret then r-ret-okp (ins, r) case = locn then r-locn-okp (ins, r) case = push-constant then r-push-constant-okp (ins, r) case = push-local then r-push-local-okp (ins, r) case = push-global then r-push-global-okp (ins, r) case = push-ctrl-stk-free-size then r-push-ctrl-stk-free-size-okp (ins, r) case = push-temp-stk-free-size then r-push-temp-stk-free-size-okp (ins, r) case = push-temp-stk-index then r-push-temp-stk-index-okp (ins, r) case = jump-if-temp-stk-full then r-jump-if-temp-stk-full-okp (ins, r) case = jump-if-temp-stk-empty then r-jump-if-temp-stk-empty-okp (ins, r) case = pop then r-pop-okp (ins, r) case = pop* then r-pop*-okp (ins, r) case = popn then r-popn-okp (ins, r) case = pop-local then r-pop-local-okp (ins, r) case = pop-global then r-pop-global-okp (ins, r) case = pop-locn then r-pop-locn-okp (ins, r) case = pop-call then r-pop-call-okp (ins, r) case = fetch-temp-stk then r-fetch-temp-stk-okp (ins, r) case = deposit-temp-stk then r-deposit-temp-stk-okp (ins, r) case = jump then r-jump-okp (ins, r) case = jump-case then r-jump-case-okp (ins, r) case = pushj then r-pushj-okp (ins, r) case = popj then r-popj-okp (ins, r) case = set-local then r-set-local-okp (ins, r) case = set-global then r-set-global-okp (ins, r) case = test-nat-and-jump then r-test-nat-and-jump-okp (ins, r) case = test-int-and-jump then r-test-int-and-jump-okp (ins, r) case = test-bool-and-jump then r-test-bool-and-jump-okp (ins, r) case = test-bitv-and-jump then r-test-bitv-and-jump-okp (ins, r) case = no-op then r-no-op-okp (ins, r) case = add-addr then r-add-addr-okp (ins, r) case = sub-addr then r-sub-addr-okp (ins, r) otherwise r-ins-okp2 (ins, r) endcase

Theorem: r-ins-okp-is-r-ins-okp1 r-ins-okp (ins, r) = r-ins-okp1 (ins, r)

Event: Disable r-ins-okp.

Event: Disable r-ins-okp-is-r-ins-okp1.

; We repeat the exercise for r-ins-step.

Event: Enable r-ins-step-is-r-ins-step1.

Event: Disable r-ins-step.

Event: Disable r-ins-step-is-r-ins-step1.

Definition: p-ins-okp2 (ins, p) = case on car (ins):

case = eq then p-eq-okp (ins, p) case = lt-addr then p-lt-addr-okp (ins, p) case = fetch then p-fetch-okp (ins, p) case = deposit then p-deposit-okp (ins, p) case = add-int then p-add-int-okp (ins, p) case = add-int-with-carry then p-add-int-with-carry-okp (ins, p) case = add1-int then p-add1-int-okp (ins, p) case = sub-int then p-sub-int-okp (ins, p) case = sub-int-with-carry then p-sub-int-with-carry-okp (ins, p) case = sub1-int then p-sub1-int-okp (ins, p) case = neg-int then p-neg-int-okp (ins, p) case = lt-int then p-lt-int-okp (ins, p) case = int-to-nat then p-int-to-nat-okp (ins, p) case = add-nat then p-add-nat-okp (ins, p) case = add-nat-with-carry then p-add-nat-with-carry-okp (ins, p) case = add1-nat then p-add1-nat-okp (ins, p) case = sub-nat then p-sub-nat-okp (ins, p) case = sub-nat-with-carry then p-sub-nat-with-carry-okp (ins, p) case = sub1-nat then p-sub1-nat-okp (ins, p) case = lt-nat then p-lt-nat-okp (ins, p) case = mult2-nat then p-mult2-nat-okp (ins, p) case = mult2-nat-with-carry-out then p-mult2-nat-with-carry-out-okp (ins, p) case = div2-nat then p-div2-nat-okp (ins, p) case = or-bitv then p-or-bitv-okp (ins, p) case = and-bitv then p-and-bitv-okp (ins, p) case = not-bitv then p-not-bitv-okp (ins, p) case = xor-bitv then p-xor-bitv-okp (ins, p) case = rsh-bitv then p-rsh-bitv-okp (ins, p) case = lsh-bitv then p-lsh-bitv-okp (ins, p) case = or-bool then p-or-bool-okp (ins, p) case = and-bool then p-and-bool-okp (ins, p) case = not-bool then p-not-bool-okp (ins, p) otherwise f endcase

Definition: p-ins-okp1 (ins, p) = case on car (ins):

case = call then p-call-okp (ins, p) case = ret then p-ret-okp (ins, p) case = locn then p-locn-okp (ins, p) case = push-constant then p-push-constant-okp (ins, p) case = push-local then p-push-local-okp (ins, p) case = push-global then p-push-global-okp (ins, p) case = push-ctrl-stk-free-size then p-push-ctrl-stk-free-size-okp (ins, p) case = push-temp-stk-free-size then p-push-temp-stk-free-size-okp (ins, p) case = push-temp-stk-index then p-push-temp-stk-index-okp (ins, p) case = jump-if-temp-stk-full then p-jump-if-temp-stk-full-okp (ins, p) case = jump-if-temp-stk-empty then p-jump-if-temp-stk-empty-okp (ins, p) case = pop then p-pop-okp (ins, p) case = pop* then p-pop*-okp (ins, p) case = popn then p-popn-okp (ins, p) case = pop-local then p-pop-local-okp (ins, p) case = pop-global then p-pop-global-okp (ins, p) case = pop-locn then p-pop-locn-okp (ins, p) case = pop-call then p-pop-call-okp (ins, p) case = fetch-temp-stk then p-fetch-temp-stk-okp (ins, p) case = deposit-temp-stk then p-deposit-temp-stk-okp (ins, p) case = jump then p-jump-okp (ins, p) case = jump-case then p-jump-case-okp (ins, p) case = pushj then p-pushj-okp (ins, p) case = popj then p-popj-okp (ins, p) case = set-local then p-set-local-okp (ins, p) case = set-global then p-set-global-okp (ins, p) case = test-nat-and-jump then p-test-nat-and-jump-okp (ins, p) case = test-int-and-jump then p-test-int-and-jump-okp (ins, p) case = test-bool-and-jump then p-test-bool-and-jump-okp (ins, p) case = test-bitv-and-jump then p-test-bitv-and-jump-okp (ins, p) case = no-op then p-no-op-okp (ins, p) case = add-addr then p-add-addr-okp (ins, p) case = sub-addr then p-sub-addr-okp (ins, p) otherwise p-ins-okp2 (ins, p) endcase

Theorem: p-ins-okp-is-p-ins-okp1 p-ins-okp (ins, p) = p-ins-okp1 (ins, p)

Event: Disable p-ins-okp.

Event: Disable p-ins-okp-is-p-ins-okp1.

Definition: p-ins-step2 (ins, p) = case on car (ins):

case = eq then p-eq-step (ins, p) case = lt-addr then p-lt-addr-step (ins, p) case = fetch then p-fetch-step (ins, p) case = deposit then p-deposit-step (ins, p) case = add-int then p-add-int-step (ins, p) case = add-int-with-carry then p-add-int-with-carry-step (ins, p) case = add1-int then p-add1-int-step (ins, p) case = sub-int then p-sub-int-step (ins, p) case = sub-int-with-carry then p-sub-int-with-carry-step (ins, p) case = sub1-int then p-sub1-int-step (ins, p) case = neg-int then p-neg-int-step (ins, p) case = lt-int then p-lt-int-step (ins, p) case = int-to-nat then p-int-to-nat-step (ins, p) case = add-nat then p-add-nat-step (ins, p) case = add-nat-with-carry then p-add-nat-with-carry-step (ins, p) case = add1-nat then p-add1-nat-step (ins, p) case = sub-nat then p-sub-nat-step (ins, p) case = sub-nat-with-carry then p-sub-nat-with-carry-step (ins, p) case = sub1-nat then p-sub1-nat-step (ins, p) case = lt-nat then p-lt-nat-step (ins, p) case = mult2-nat then p-mult2-nat-step (ins, p) case = mult2-nat-with-carry-out then p-mult2-nat-with-carry-out-step (ins, p) case = div2-nat then p-div2-nat-step (ins, p) case = or-bitv then p-or-bitv-step (ins, p) case = and-bitv then p-and-bitv-step (ins, p) case = not-bitv then p-not-bitv-step (ins, p) case = xor-bitv then p-xor-bitv-step (ins, p) case = rsh-bitv then p-rsh-bitv-step (ins, p) case = lsh-bitv then p-lsh-bitv-step (ins, p) case = or-bool then p-or-bool-step (ins, p) case = and-bool then p-and-bool-step (ins, p) case = not-bool then p-not-bool-step (ins, p) otherwise p-halt (p, 'run) endcase

Definition: p-ins-step1 (ins, p) = case on car (ins):

case = call then p-call-step (ins, p) case = ret then p-ret-step (ins, p) case = locn then p-locn-step (ins, p) case = push-constant then p-push-constant-step (ins, p) case = push-local then p-push-local-step (ins, p) case = push-global then p-push-global-step (ins, p) case = push-ctrl-stk-free-size then p-push-ctrl-stk-free-size-step (ins, p) case = push-temp-stk-free-size then p-push-temp-stk-free-size-step (ins, p) case = push-temp-stk-index then p-push-temp-stk-index-step (ins, p) case = jump-if-temp-stk-full then p-jump-if-temp-stk-full-step (ins, p) case = jump-if-temp-stk-empty then p-jump-if-temp-stk-empty-step (ins, p) case = pop then p-pop-step (ins, p) case = pop* then p-pop*-step (ins, p) case = popn then p-popn-step (ins, p) case = pop-local then p-pop-local-step (ins, p) case = pop-global then p-pop-global-step (ins, p) case = pop-locn then p-pop-locn-step (ins, p) case = pop-call then p-pop-call-step (ins, p) case = fetch-temp-stk then p-fetch-temp-stk-step (ins, p) case = deposit-temp-stk then p-deposit-temp-stk-step (ins, p) case = jump then p-jump-step (ins, p) case = jump-case then p-jump-case-step (ins, p) case = pushj then p-pushj-step (ins, p) case = popj then p-popj-step (ins, p) case = set-local then p-set-local-step (ins, p) case = set-global then p-set-global-step (ins, p) case = test-nat-and-jump then p-test-nat-and-jump-step (ins, p) case = test-int-and-jump then p-test-int-and-jump-step (ins, p) case = test-bool-and-jump then p-test-bool-and-jump-step (ins, p) case = test-bitv-and-jump then p-test-bitv-and-jump-step (ins, p) case = no-op then p-no-op-step (ins, p) case = add-addr then p-add-addr-step (ins, p) case = sub-addr then p-sub-addr-step (ins, p) otherwise p-ins-step2 (ins, p) endcase

Theorem: p-ins-step-is-p-ins-step1 p-ins-step (ins, p) = p-ins-step1 (ins, p)

Event: Disable p-ins-step.

Event: Disable p-ins-step-is-p-ins-step1.

; We disable p-ins-okp because the main owc theorem involves p-ins-okp
; and p-ins-step, and opening either is sufficient to drive the case
; analysis.  If both open, then we get cross-multiplied cases and
; there is a lot of silly propositional work to do.  So we arbitrarily
; choose to keep p-ins-okp disabled.  Now we could choose to rewrite
; it to p-xxx-okp when the car of ins is 'xxx, analogously to what we
; did for r-ins-okp above.  But the proof of the owc should be faster
; if we do this: keep p-ins-okp disabled and show that p-xxx-okp holds
; if the car of ins is 'xxx.  The reason is that when we fire the
; xxx-one-way-correspondence-p-r lemma we will want to get p-xxx-okp
; and we'll be governed by a p-ins-okp and a hyp about car ins.  But
; the hyp about car ins won't have been raised all the way to the top
; and so won't yet be available to tell the p-ins-okp which way to go.
; This is the same strategy used for r-ins-okp in the r-i level proof.

Theorem: p-ins-okp2-backchainer p-ins-okp2 (ins, p) → (((car (ins) = 'eq) → p-eq-okp (ins, p))

∧ ((car (ins) = 'lt-addr) → p-lt-addr-okp (ins, p)) ∧ ((car (ins) = 'fetch) → p-fetch-okp (ins, p)) ∧ ((car (ins) = 'deposit) → p-deposit-okp (ins, p))

∧ ((car (ins) = 'add-int) → p-add-int-okp (ins, p))

∧ ((car (ins) = 'add-int-with-carry)

→ p-add-int-with-carry-okp (ins, p)) ∧ ((car (ins) = 'add1-int) → p-add1-int-okp (ins, p)) ∧ ((car (ins) = 'sub-int) → p-sub-int-okp (ins, p))

∧ ((car (ins) = 'sub-int-with-carry)

→ p-sub-int-with-carry-okp (ins, p)) ∧ ((car (ins) = 'sub1-int) → p-sub1-int-okp (ins, p)) ∧ ((car (ins) = 'neg-int) → p-neg-int-okp (ins, p)) ∧ ((car (ins) = 'lt-int) → p-lt-int-okp (ins, p)) ∧ ((car (ins) = 'int-to-nat) → p-int-to-nat-okp (ins, p)) ∧ ((car (ins) = 'add-nat) → p-add-nat-okp (ins, p))

∧ ((car (ins) = 'add-nat-with-carry)

→ p-add-nat-with-carry-okp (ins, p)) ∧ ((car (ins) = 'add1-nat) → p-add1-nat-okp (ins, p)) ∧ ((car (ins) = 'sub-nat) → p-sub-nat-okp (ins, p))

∧ ((car (ins) = 'sub-nat-with-carry)

→ p-sub-nat-with-carry-okp (ins, p)) ∧ ((car (ins) = 'sub1-nat) → p-sub1-nat-okp (ins, p)) ∧ ((car (ins) = 'lt-nat) → p-lt-nat-okp (ins, p)) ∧ ((car (ins) = 'mult2-nat) → p-mult2-nat-okp (ins, p))

∧ ((car (ins) = 'mult2-nat-with-carry-out)

→ p-mult2-nat-with-carry-out-okp (ins, p)) ∧ ((car (ins) = 'div2-nat) → p-div2-nat-okp (ins, p)) ∧ ((car (ins) = 'or-bitv) → p-or-bitv-okp (ins, p)) ∧ ((car (ins) = 'and-bitv) → p-and-bitv-okp (ins, p)) ∧ ((car (ins) = 'not-bitv) → p-not-bitv-okp (ins, p)) ∧ ((car (ins) = 'xor-bitv) → p-xor-bitv-okp (ins, p)) ∧ ((car (ins) = 'rsh-bitv) → p-rsh-bitv-okp (ins, p)) ∧ ((car (ins) = 'lsh-bitv) → p-lsh-bitv-okp (ins, p)) ∧ ((car (ins) = 'or-bool) → p-or-bool-okp (ins, p)) ∧ ((car (ins) = 'and-bool) → p-and-bool-okp (ins, p)) ∧ ((car (ins) = 'not-bool) → p-not-bool-okp (ins, p)))

Event: Disable p-ins-okp2.

Theorem: p-ins-okp-backchainer p-ins-okp (ins, p) → (((car (ins) = 'call) → p-call-okp (ins, p))

∧ ((car (ins) = 'ret) → p-ret-okp (ins, p)) ∧ ((car (ins) = 'locn) → p-locn-okp (ins, p))

∧ ((car (ins) = 'push-constant)

→ p-push-constant-okp (ins, p)) ∧ ((car (ins) = 'push-local) → p-push-local-okp (ins, p))

∧ ((car (ins) = 'push-global) → p-push-global-okp (ins, p))

∧ ((car (ins) = 'push-ctrl-stk-free-size)

→ p-push-ctrl-stk-free-size-okp (ins, p))

∧ ((car (ins) = 'push-temp-stk-free-size)

→ p-push-temp-stk-free-size-okp (ins, p))

∧ ((car (ins) = 'push-temp-stk-index)

→ p-push-temp-stk-index-okp (ins, p))

∧ ((car (ins) = 'jump-if-temp-stk-full)

→ p-jump-if-temp-stk-full-okp (ins, p))

∧ ((car (ins) = 'jump-if-temp-stk-empty)

→ p-jump-if-temp-stk-empty-okp (ins, p)) ∧ ((car (ins) = 'pop) → p-pop-okp (ins, p)) ∧ ((car (ins) = 'pop*) → p-pop*-okp (ins, p)) ∧ ((car (ins) = 'popn) → p-popn-okp (ins, p)) ∧ ((car (ins) = 'pop-local) → p-pop-local-okp (ins, p)) ∧ ((car (ins) = 'pop-global) → p-pop-global-okp (ins, p)) ∧ ((car (ins) = 'pop-locn) → p-pop-locn-okp (ins, p)) ∧ ((car (ins) = 'pop-call) → p-pop-call-okp (ins, p))

∧ ((car (ins) = 'fetch-temp-stk)

→ p-fetch-temp-stk-okp (ins, p))

∧ ((car (ins) = 'deposit-temp-stk)

→ p-deposit-temp-stk-okp (ins, p)) ∧ ((car (ins) = 'jump) → p-jump-okp (ins, p)) ∧ ((car (ins) = 'jump-case) → p-jump-case-okp (ins, p)) ∧ ((car (ins) = 'pushj) → p-pushj-okp (ins, p)) ∧ ((car (ins) = 'popj) → p-popj-okp (ins, p)) ∧ ((car (ins) = 'set-local) → p-set-local-okp (ins, p)) ∧ ((car (ins) = 'set-global) → p-set-global-okp (ins, p))

∧ ((car (ins) = 'test-nat-and-jump)

→ p-test-nat-and-jump-okp (ins, p))

∧ ((car (ins) = 'test-int-and-jump)

→ p-test-int-and-jump-okp (ins, p))

∧ ((car (ins) = 'test-bool-and-jump)

→ p-test-bool-and-jump-okp (ins, p))

∧ ((car (ins) = 'test-bitv-and-jump)

→ p-test-bitv-and-jump-okp (ins, p)) ∧ ((car (ins) = 'no-op) → p-no-op-okp (ins, p)) ∧ ((car (ins) = 'add-addr) → p-add-addr-okp (ins, p)) ∧ ((car (ins) = 'sub-addr) → p-sub-addr-okp (ins, p)))

; The only problem with these backchainers is that we don't know that the
; above cases are exhaustive.  That is, suppose the current instruction
; is none of the above.  Then p-ins-okp is false.  We need to know that.
; The most natural expression of this fact is that if the instruction

; is not call and not ret and, etc., then p-ins-okp is false.  But that
; is an inefficient way to hang it, because every time we see p-ins-okp
; we'll try to show the instruction is none of the above and most of the time
; it will be one of the ones listed half-way through the list.  So we'll
; hang it on one of the instructions!  It reads: if p-ins-okp is true
; and the instruction is not call, not ret, etc., then the instruction
; is 'not-bool, except we split it into two lemmas.

Theorem: p-ins-okp-exhausted (p-ins-okp (ins, p) ∧ (car (ins) ≠ 'call) ∧ (car (ins) ≠ 'ret) ∧ (car (ins) ≠ 'locn)

∧ (car (ins) ≠ 'push-constant)

∧ (car (ins) ≠ 'push-local)

∧ (car (ins) ≠ 'push-global)
∧ (car (ins) ≠ 'push-ctrl-stk-free-size)
∧ (car (ins) ≠ 'push-temp-stk-free-size)
∧ (car (ins) ≠ 'push-temp-stk-index)
∧ (car (ins) ≠ 'jump-if-temp-stk-full)
∧ (car (ins) ≠ 'jump-if-temp-stk-empty)

∧ (car (ins) ≠ 'pop) ∧ (car (ins) ≠ 'pop*) ∧ (car (ins) ≠ 'popn) ∧ (car (ins) ≠ 'pop-local) ∧ (car (ins) ≠ 'pop-global) ∧ (car (ins) ≠ 'pop-locn) ∧ (car (ins) ≠ 'pop-call)

∧ (car (ins) ≠ 'fetch-temp-stk)
∧ (car (ins) ≠ 'deposit-temp-stk)

∧ (car (ins) ≠ 'jump) ∧ (car (ins) ≠ 'jump-case) ∧ (car (ins) ≠ 'pushj) ∧ (car (ins) ≠ 'popj) ∧ (car (ins) ≠ 'set-local) ∧ (car (ins) ≠ 'set-global)

∧ (car (ins) ≠ 'test-nat-and-jump)
∧ (car (ins) ≠ 'test-int-and-jump)
∧ (car (ins) ≠ 'test-bool-and-jump)
∧ (car (ins) ≠ 'test-bitv-and-jump)

∧ (car (ins) ≠ 'no-op) ∧ (car (ins) ≠ 'add-addr) ∧ (car (ins) ≠ 'sub-addr))

→ p-ins-okp2 (ins, p)

Theorem: p-ins-okp2-exhausted (p-ins-okp2 (ins, p) ∧ (car (ins) ≠ 'eq) ∧ (car (ins) ≠ 'lt-addr) ∧ (car (ins) ≠ 'fetch) ∧ (car (ins) ≠ 'deposit) ∧ (car (ins) ≠ 'add-int)

∧ (car (ins) ≠ 'add-int-with-carry)

∧ (car (ins) ≠ 'add1-int) ∧ (car (ins) ≠ 'sub-int)

∧ (car (ins) ≠ 'sub-int-with-carry)

∧ (car (ins) ≠ 'sub1-int) ∧ (car (ins) ≠ 'neg-int) ∧ (car (ins) ≠ 'lt-int) ∧ (car (ins) ≠ 'int-to-nat) ∧ (car (ins) ≠ 'add-nat)

∧ (car (ins) ≠ 'add-nat-with-carry)

∧ (car (ins) ≠ 'add1-nat) ∧ (car (ins) ≠ 'sub-nat)

∧ (car (ins) ≠ 'sub-nat-with-carry)

∧ (car (ins) ≠ 'sub1-nat) ∧ (car (ins) ≠ 'lt-nat) ∧ (car (ins) ≠ 'mult2-nat)

∧ (car (ins) ≠ 'mult2-nat-with-carry-out)

∧ (car (ins) ≠ 'div2-nat) ∧ (car (ins) ≠ 'or-bitv) ∧ (car (ins) ≠ 'and-bitv) ∧ (car (ins) ≠ 'not-bitv) ∧ (car (ins) ≠ 'xor-bitv) ∧ (car (ins) ≠ 'rsh-bitv) ∧ (car (ins) ≠ 'lsh-bitv) ∧ (car (ins) ≠ 'or-bool) ∧ (car (ins) ≠ 'and-bool)) → ((car (ins) = 'not-bool) = t)

; We will package the owc lemmas for each instruction into two lemmas
; about p-ins-okp v. r-ins-okp and p-ins-step v. r-ins-step.  Then we will
; put those together to get a p-step v. r-step lemma.
; Look at p-ins-okp-implies-r-ins-okp below.  We will let the r-ins-okp
; drive the case analysis, by enabling it during the proof.  It will
; open into an if, carrying the (p->r p) down into the maw of each of

; the n r-xxx-okps, each  governed by a hyp on the car of the current
; instruction.  When (r-xxx-okp (p-current-instruction p) (p->r p)) is
; formed, it will fire the p-xxx-okp-implies-r-xxx-okp lemma.  That will
; back chain to p-xxx-okp, under the hyp about the current instruction
; being 'xxx, and that will backchain into p-ins-okp by the lemma above.
; Every single case will be proved by appeal to one of our lemmas and
; all that will be left is proving that the case analysis done by r-ins-okp
; exhausts p-ins-okp.  But we already have that.  So one rewrite will
; prove the theorem.
; Of course, we want the following disabled:

Event: Disable p->r.

Event: Disable proper-p-statep-restructuring.

; And we need to split the proof into two manageable sized steps.

Theorem: p-r-ins-okp2 ((p-psw (p) = 'run) ∧ proper-p-statep (p) ∧ p-ins-okp2 (p-current-instruction (p), p)) → r-ins-okp2 (p-current-instruction (p), p->r (p))

Theorem: p-r-ins-okp ((p-psw (p) = 'run) ∧ proper-p-statep (p) ∧ p-ins-okp (p-current-instruction (p), p)) → r-ins-okp (p-current-instruction (p), p->r (p))

; Now we move on to the p v. r ins-step case.
; Now consider p-r-ins-step-owc below.  We will let both the p-ins-step
; and the r-ins-step expand.  They both go to ghastly if expressions.
; With the following lemma we will bring the p-ins-step's ifs out of p->r:

Theorem: p->r-if p->r (if a then b

else c endif) = if a then p->r (b)

else p->r (c) endif

; So now the r-equal has two if nests as its args.  If we let the theorem
; prover handle things it would cross multiply them.  But there is a simpler
; way because the two nests have identical tests in the same order.  So
; we can use:

Theorem: r-equal-if r-equal (if op then r1

else r2 endif, if op then r3 else r4 endif)

= if op then r-equal (r1 , r3 )

else r-equal (r2 , r4 ) endif

; Since r2 and r4 are themselves ifs, this will just drive on down.  At the
; bottom we will need:

Theorem: stk-equal-reflexive stk-equal (sp, segment, segment)

Theorem: r-equal-reflexive r-statep (r) → r-equal (r, r)

; Each of the branches of this new if will be an r-equality between
; (p->r (p-xxx-step ...)) and (r-xxx-step ... (p->r p)), governed by
; the hyp that the instruction is 'xxx.  That will fire our individual
; one way correspondence lemmas and backchain to (p-xxx-okp ...), which
; we'll get, as above, from the p-ins-okp.
; So once again, under these rules, the following theorem rewrites to
; T in one pass:

Theorem: p-r-ins-step2-owc ((p-psw (p) = 'run) ∧ proper-p-statep (p) ∧ p-ins-okp2 (p-current-instruction (p), p)) → r-equal (p->r (p-ins-step2 (p-current-instruction (p), p)),

r-ins-step2 (p-current-instruction (p), p->r (p)))

Event: Disable p-ins-step2.

Event: Disable r-ins-step2.

Theorem: p-r-ins-step-owc ((p-psw (p) = 'run) ∧ proper-p-statep (p) ∧ p-ins-okp (p-current-instruction (p), p)) → r-equal (p->r (p-ins-step (p-current-instruction (p), p)),

r-ins-step (p-current-instruction (p), p->r (p)))

; We now package the p-r-ins-okp and p-r-ins-step pair into p-r-step:
; We need to know a few things about the psw to get through r-step properly.

Theorem: r-psw-p->r r-psw (p->r (p)) = p-psw (p)

Theorem: step-one-way-correspondence-p-r (proper-p-statep (p) ∧ (¬ errorp (p-psw (p-step (p))))) → r-equal (p->r (p-step (p)), r-step (p->r (p)))

; So that completes the packaging of the owc lemmas.  Now we move on to
; the packaging of the proper-p-statep preservation lemmas.
; Recall that we proved the lemmas about ur-proper-p-statep.  So we
; take it in two steps.  First we gather all the lemmas into a single
; stepper concluding with ur-proper-p-statep.  Then we expose the true
; identity of ur-proper-p-statep.  As above, we deal first with p-ins-step.
; The strategy is to let p-ins-step open, bring the ifs through
; ur-proper-p-statep, and then hit each branch with the preservation
; lemma for the governing case.

Theorem: ur-proper-p-statep-if ur-proper-p-statep (if a then b

else c endif)

= if a then ur-proper-p-statep (b)

else ur-proper-p-statep (c) endif

Theorem: p-ins-step2-preserves-ur-proper-p-statep ((p-psw (p) = 'run) ∧ p-ins-okp2 (p-current-instruction (p), p) ∧ proper-p-statep (p)) → ur-proper-p-statep (p-ins-step2 (p-current-instruction (p), p))

Theorem: p-ins-step-preserves-ur-proper-p-statep ((p-psw (p) = 'run) ∧ p-ins-okp (p-current-instruction (p), p) ∧ proper-p-statep (p)) → ur-proper-p-statep (p-ins-step (p-current-instruction (p), p))

; Now we show the true identity of ur-proper-p-statep.

Theorem: p-ins-step-preserves-proper-p-statep ((p-psw (p) = 'run) ∧ p-ins-okp (p-current-instruction (p), p) ∧ proper-p-statep (p)) → proper-p-statep (p-ins-step (p-current-instruction (p), p))

; And now we package it up to the p-step level:

Theorem: p-step-preserves-proper-p-statep (proper-p-statep (p) ∧ (¬ errorp (p-psw (p-step (p))))) → proper-p-statep (p-step (p))

; And that completes the packaging of the proper-p-statep preservation.
; Finally, we prove the preservation of r-equality by r-step.
; This whole exercise would be simpler if we did two things.
; (1) in all of the lemmas of the form r-equal-implies-equal-r-xxx-okp
; replace the concluding (equal lhs rhs) with (equal (equal lhs rhs) t).
; (2) in all of the lemmas r-xxx-step-preserves-r-equal, replace
; the (r-xxx-okp ... r2) hyp by (r-xxx-okp ... r1).  Then my
; concern about r-equal-reflexivity can be forgotten.  !!! except
; in the r-step lemma below -- the r-ins-okp lemma below must still
; be (equal lhs rhs) and so reflexivity must be disabled when
; I use that lemma.

; We need a backchainer for r-ins-okp analogous to that used for p-ins-okp
; above:

Theorem: r-ins-okp2-backchainer r-ins-okp2 (ins, r) → (((car (ins) = 'eq) → r-eq-okp (ins, r))

∧ ((car (ins) = 'lt-addr) → r-lt-addr-okp (ins, r)) ∧ ((car (ins) = 'fetch) → r-fetch-okp (ins, r))

∧ ((car (ins) = 'deposit) → r-deposit-okp (ins, r)) ∧ ((car (ins) = 'add-int) → r-add-int-okp (ins, r))

∧ ((car (ins) = 'add-int-with-carry)

→ r-add-int-with-carry-okp (ins, r)) ∧ ((car (ins) = 'add1-int) → r-add1-int-okp (ins, r)) ∧ ((car (ins) = 'sub-int) → r-sub-int-okp (ins, r))

∧ ((car (ins) = 'sub-int-with-carry)

→ r-sub-int-with-carry-okp (ins, r)) ∧ ((car (ins) = 'sub1-int) → r-sub1-int-okp (ins, r)) ∧ ((car (ins) = 'neg-int) → r-neg-int-okp (ins, r)) ∧ ((car (ins) = 'lt-int) → r-lt-int-okp (ins, r)) ∧ ((car (ins) = 'int-to-nat) → r-int-to-nat-okp (ins, r)) ∧ ((car (ins) = 'add-nat) → r-add-nat-okp (ins, r))

∧ ((car (ins) = 'add-nat-with-carry)

→ r-add-nat-with-carry-okp (ins, r)) ∧ ((car (ins) = 'add1-nat) → r-add1-nat-okp (ins, r)) ∧ ((car (ins) = 'sub-nat) → r-sub-nat-okp (ins, r))

∧ ((car (ins) = 'sub-nat-with-carry)

→ r-sub-nat-with-carry-okp (ins, r)) ∧ ((car (ins) = 'sub1-nat) → r-sub1-nat-okp (ins, r)) ∧ ((car (ins) = 'lt-nat) → r-lt-nat-okp (ins, r)) ∧ ((car (ins) = 'mult2-nat) → r-mult2-nat-okp (ins, r))

∧ ((car (ins) = 'mult2-nat-with-carry-out)

→ r-mult2-nat-with-carry-out-okp (ins, r)) ∧ ((car (ins) = 'div2-nat) → r-div2-nat-okp (ins, r)) ∧ ((car (ins) = 'or-bitv) → r-or-bitv-okp (ins, r)) ∧ ((car (ins) = 'and-bitv) → r-and-bitv-okp (ins, r)) ∧ ((car (ins) = 'not-bitv) → r-not-bitv-okp (ins, r)) ∧ ((car (ins) = 'xor-bitv) → r-xor-bitv-okp (ins, r)) ∧ ((car (ins) = 'rsh-bitv) → r-rsh-bitv-okp (ins, r)) ∧ ((car (ins) = 'lsh-bitv) → r-lsh-bitv-okp (ins, r)) ∧ ((car (ins) = 'or-bool) → r-or-bool-okp (ins, r)) ∧ ((car (ins) = 'and-bool) → r-and-bool-okp (ins, r)) ∧ ((car (ins) = 'not-bool) → r-not-bool-okp (ins, r)))

Event: Disable r-ins-okp2.

Event: Enable r-ins-okp-backchainer.

Theorem: r-ins-okp-exhausted (r-ins-okp (ins, r) ∧ (car (ins) ≠ 'call) ∧ (car (ins) ≠ 'ret)

∧ (car (ins) ≠ 'locn)

∧ (car (ins) ≠ 'push-constant)

∧ (car (ins) ≠ 'push-local)

∧ (car (ins) ≠ 'push-global)
∧ (car (ins) ≠ 'push-ctrl-stk-free-size)
∧ (car (ins) ≠ 'push-temp-stk-free-size)
∧ (car (ins) ≠ 'push-temp-stk-index)
∧ (car (ins) ≠ 'jump-if-temp-stk-full)
∧ (car (ins) ≠ 'jump-if-temp-stk-empty)

∧ (car (ins) ≠ 'pop) ∧ (car (ins) ≠ 'pop*) ∧ (car (ins) ≠ 'popn) ∧ (car (ins) ≠ 'pop-local) ∧ (car (ins) ≠ 'pop-global) ∧ (car (ins) ≠ 'pop-locn) ∧ (car (ins) ≠ 'pop-call)

∧ (car (ins) ≠ 'fetch-temp-stk)
∧ (car (ins) ≠ 'deposit-temp-stk)

∧ (car (ins) ≠ 'jump) ∧ (car (ins) ≠ 'jump-case) ∧ (car (ins) ≠ 'pushj) ∧ (car (ins) ≠ 'popj) ∧ (car (ins) ≠ 'set-local) ∧ (car (ins) ≠ 'set-global)

∧ (car (ins) ≠ 'test-nat-and-jump)
∧ (car (ins) ≠ 'test-int-and-jump)
∧ (car (ins) ≠ 'test-bool-and-jump)
∧ (car (ins) ≠ 'test-bitv-and-jump)

∧ (car (ins) ≠ 'no-op) ∧ (car (ins) ≠ 'add-addr) ∧ (car (ins) ≠ 'sub-addr)) → r-ins-okp2 (ins, r)

; Now we'll prove that r-equal implies r-ins-okp is indifferent to
; which state it gets.
; The plan is to let r-ins-okp expand into ifs on both sides of the
; equal and then take them out with:

Theorem: equal-if (if a then r1 else r2 endif = if a then r3

else r4 endif) = if a then r1 = r3

else r2 = r4 endif

; The proof requires some care.  If you leave r-equal-reflexive enabled
; we infinitely rewrite (r-xxx-okp ins r1) to (r-xxx-okp ins r1)
; because we know r1 is r-equal to itself.

Theorem: r-equal-implies-equal-r-ins-okp2 ((r-psw (r1 ) = 'run) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-ins-okp2 (r-current-instruction (r1 ), r2 )

= r-ins-okp2 (r-current-instruction (r1 ), r1 ))

Theorem: r-equal-implies-equal-r-ins-okp ((r-psw (r1 ) = 'run) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → (r-ins-okp (r-current-instruction (r1 ), r2 )

= r-ins-okp (r-current-instruction (r1 ), r1 ))

; Now we do the r-ins-step.
; We'll let r-ins-step open on both sides of the r-equal.  The r-equal-if
; lemma will drive the r-equal through the matching if-nests and we'll
; appeal to our previously proved preservation lemmas.

Theorem: r-ins-step2-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-ins-okp2 (r-current-instruction (r1 ), r1 ) ∧ r-equal (r2 , r1 )) → r-equal (r-ins-step2 (r-current-instruction (r1 ), r2 ),

r-ins-step2 (r-current-instruction (r1 ), r1 ))

Theorem: r-ins-step-preserves-r-equal ((r-psw (r1 ) = 'run) ∧ proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr)

∧ r-ins-okp (r-current-instruction (r1 ), r1 ) ∧ r-equal (r2 , r1 )) → r-equal (r-ins-step (r-current-instruction (r1 ), r2 ),

r-ins-step (r-current-instruction (r1 ), r1 ))

Theorem: r-step-preserves-r-equal (proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → r-equal (r-step (r2 ), r-step (r1 ))

; Now we package up the p-loadablep results into a p-step.
; The approach is exactly the same as used above.

Theorem: p-loadablep-if p-loadablep (if a then b

else c endif, load-addr)

= if a then p-loadablep (b, load-addr)

else p-loadablep (c, load-addr) endif

Theorem: p-ins-step2-preserves-p-loadablep ((p-psw (p) = 'run) ∧ p-ins-okp2 (p-current-instruction (p), p) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr)) → p-loadablep (p-ins-step2 (p-current-instruction (p), p), load-addr)

Theorem: p-ins-step-preserves-p-loadablep ((p-psw (p) = 'run) ∧ p-ins-okp (p-current-instruction (p), p) ∧ proper-p-statep (p) ∧ p-loadablep (p, load-addr)) → p-loadablep (p-ins-step (p-current-instruction (p), p), load-addr)

Theorem: p-step-preserves-p-loadablep (proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ (¬ errorp (p-psw (p-step (p))))) → p-loadablep (p-step (p), load-addr)

;  Now we grab an event from the r-i proofs:
#|

(include-book r-i-book "r-i" t nil)
;  The following status expression has the effect of enabling only
;  proper-r-statep-r-step among all the other things brought in by
;  the above inclusion.  It also disables r-step.
(status r-i-book-status
        (set-difference
         (union (@ *e* p-step-preserves-p-loadablep)
                '(proper-r-statep-r-step))
         '(r-step)))
|#

Event: Enable proper-r-statep-r-step.

Event: Disable r-step.

Theorem: r-preserves-r-equal (proper-r-statep (r1 , load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r1 )) → r-equal (r (r2 , n), r (r1 , n))

Theorem: transitivity-of-same-signature (same-signature (segment1 , segment2 ) ∧ same-signature (segment2 , segment3 )) → same-signature (segment1 , segment3 )

Theorem: transitivity-of-stk-equal (stk-equal (sp, segment1 , segment2 ) ∧ stk-equal (sp, segment2 , segment3 ) ∧ (length (cdr (assoc (car (untag (sp)), segment2 )))

= length (cdr (assoc (car (untag (sp)), segment1 )))) ∧ (length (cdr (assoc (car (untag (sp)), segment3 )))

= length (cdr (assoc (car (untag (sp)), segment1 ))))) → stk-equal (sp, segment1 , segment3 )

Theorem: transitivity-of-r-equal (r-equal (r1 , r2 ) ∧ r-equal (r2 , r3 )) → r-equal (r1 , r3 )

; We are now headed toward the proof that proper-p-statep maps down via
; p->r to a proper-r-statep.

; Proper temp-var-dcls at the p level implies the corresponding thing
; at the r level:

Theorem: proper-p-temp-var-dclsp-implies-r-temp-var-dclsp proper-p-temp-var-dclsp (lst, p) → r-temp-var-dclsp (lst)

; The surprisingly hard result is that proper programs at the p level
; implies proper programs at the r level.  We start with two
; observations: anything occuring as a label in a properly labeled
; list of instructions is a litatom; and to be a proper instruction at
; the p level means (among many other things) that the car is a piton
; opcode and push-constants satisfy the
; proper-p-push-constant-instructionp predicate.

Theorem: proper-labeled-p-instructionsp-implies-litatom-labels (proper-labeled-p-instructionsp (lst, name, p) ∧ find-labelp (lab, lst)) → litatom (lab)

Event: Disable proper-p-call-instructionp.

Event: Disable proper-p-ret-instructionp.

Event: Disable proper-p-locn-instructionp.

Event: Disable proper-p-push-constant-instructionp.

Event: Disable proper-p-push-local-instructionp.

Event: Disable proper-p-push-global-instructionp.

Event: Disable proper-p-push-ctrl-stk-free-size-instructionp.

Event: Disable proper-p-push-temp-stk-free-size-instructionp.

Event: Disable proper-p-push-temp-stk-index-instructionp.

Event: Disable proper-p-jump-if-temp-stk-full-instructionp.

Event: Disable proper-p-jump-if-temp-stk-empty-instructionp. Event: Disable proper-p-pop-instructionp. Event: Disable proper-p-pop*-instructionp. Event: Disable proper-p-popn-instructionp. Event: Disable proper-p-pop-local-instructionp. Event: Disable proper-p-pop-global-instructionp. Event: Disable proper-p-pop-locn-instructionp. Event: Disable proper-p-pop-call-instructionp. Event: Disable proper-p-fetch-temp-stk-instructionp. Event: Disable proper-p-deposit-temp-stk-instructionp. Event: Disable proper-p-jump-instructionp. Event: Disable proper-p-jump-case-instructionp. Event: Disable proper-p-pushj-instructionp. Event: Disable proper-p-popj-instructionp. Event: Disable proper-p-set-local-instructionp. Event: Disable proper-p-set-global-instructionp. Event: Disable proper-p-test-nat-and-jump-instructionp. Event: Disable proper-p-test-int-and-jump-instructionp.

Event: Disable proper-p-test-bool-and-jump-instructionp. Event: Disable proper-p-test-bitv-and-jump-instructionp. Event: Disable proper-p-no-op-instructionp. Event: Disable proper-p-add-addr-instructionp. Event: Disable proper-p-sub-addr-instructionp. Event: Disable proper-p-eq-instructionp. Event: Disable proper-p-lt-addr-instructionp. Event: Disable proper-p-fetch-instructionp. Event: Disable proper-p-deposit-instructionp. Event: Disable proper-p-add-int-instructionp. Event: Disable proper-p-add-int-with-carry-instructionp. Event: Disable proper-p-add1-int-instructionp. Event: Disable proper-p-sub-int-instructionp. Event: Disable proper-p-sub-int-with-carry-instructionp. Event: Disable proper-p-sub1-int-instructionp. Event: Disable proper-p-neg-int-instructionp. Event: Disable proper-p-lt-int-instructionp. Event: Disable proper-p-int-to-nat-instructionp.

Event: Disable proper-p-add-nat-instructionp. Event: Disable proper-p-add-nat-with-carry-instructionp. Event: Disable proper-p-add1-nat-instructionp. Event: Disable proper-p-sub-nat-instructionp. Event: Disable proper-p-sub-nat-with-carry-instructionp. Event: Disable proper-p-sub1-nat-instructionp. Event: Disable proper-p-lt-nat-instructionp. Event: Disable proper-p-mult2-nat-instructionp. Event: Disable proper-p-mult2-nat-with-carry-out-instructionp. Event: Disable proper-p-div2-nat-instructionp. Event: Disable proper-p-or-bitv-instructionp. Event: Disable proper-p-and-bitv-instructionp. Event: Disable proper-p-not-bitv-instructionp. Event: Disable proper-p-xor-bitv-instructionp. Event: Disable proper-p-rsh-bitv-instructionp. Event: Disable proper-p-lsh-bitv-instructionp. Event: Disable proper-p-or-bool-instructionp. Event: Disable proper-p-and-bool-instructionp.

Event: Disable proper-p-not-bool-instructionp.

; We split proper-p-instructionp into two parts, as usual with our
; big switches.

Definition: proper-p-instructionp2 (ins, name, p) = case on car (ins):

case = eq then proper-p-eq-instructionp (ins, name, p) case = lt-addr then proper-p-lt-addr-instructionp (ins, name, p) case = fetch then proper-p-fetch-instructionp (ins, name, p) case = deposit then proper-p-deposit-instructionp (ins, name, p) case = add-int then proper-p-add-int-instructionp (ins, name, p) case = add-int-with-carry then proper-p-add-int-with-carry-instructionp (ins, name, p) case = add1-int then proper-p-add1-int-instructionp (ins, name, p) case = sub-int then proper-p-sub-int-instructionp (ins, name, p) case = sub-int-with-carry then proper-p-sub-int-with-carry-instructionp (ins, name, p) case = sub1-int then proper-p-sub1-int-instructionp (ins, name, p) case = neg-int then proper-p-neg-int-instructionp (ins, name, p) case = lt-int then proper-p-lt-int-instructionp (ins, name, p) case = int-to-nat then proper-p-int-to-nat-instructionp (ins, name, p) case = add-nat then proper-p-add-nat-instructionp (ins, name, p) case = add-nat-with-carry then proper-p-add-nat-with-carry-instructionp (ins, name, p) case = add1-nat then proper-p-add1-nat-instructionp (ins, name, p) case = sub-nat then proper-p-sub-nat-instructionp (ins, name, p) case = sub-nat-with-carry then proper-p-sub-nat-with-carry-instructionp (ins, name, p) case = sub1-nat then proper-p-sub1-nat-instructionp (ins, name, p) case = lt-nat then proper-p-lt-nat-instructionp (ins, name, p) case = mult2-nat then proper-p-mult2-nat-instructionp (ins, name, p) case = mult2-nat-with-carry-out then proper-p-mult2-nat-with-carry-out-instructionp (ins, name, p) case = div2-nat then proper-p-div2-nat-instructionp (ins, name, p) case = or-bitv then proper-p-or-bitv-instructionp (ins, name, p) case = and-bitv then proper-p-and-bitv-instructionp (ins, name, p) case = not-bitv then proper-p-not-bitv-instructionp (ins, name, p) case = xor-bitv then proper-p-xor-bitv-instructionp (ins, name, p) case = rsh-bitv then proper-p-rsh-bitv-instructionp (ins, name, p) case = lsh-bitv then proper-p-lsh-bitv-instructionp (ins, name, p) case = or-bool then proper-p-or-bool-instructionp (ins, name, p) case = and-bool then proper-p-and-bool-instructionp (ins, name, p) case = not-bool then proper-p-not-bool-instructionp (ins, name, p) otherwise f endcase

Definition: proper-p-instructionp1 (ins, name, p) = (properp (ins)

∧ case on car (ins): case = call then proper-p-call-instructionp (ins, name, p) case = ret then proper-p-ret-instructionp (ins, name, p) case = locn then proper-p-locn-instructionp (ins, name, p) case = push-constant then proper-p-push-constant-instructionp (ins, name, p) case = push-local then proper-p-push-local-instructionp (ins, name, p) case = push-global then proper-p-push-global-instructionp (ins, name, p) case = push-ctrl-stk-free-size then proper-p-push-ctrl-stk-free-size-instructionp (ins,

name, p)

case = push-temp-stk-free-size then proper-p-push-temp-stk-free-size-instructionp (ins,

name, p)

case = push-temp-stk-index then proper-p-push-temp-stk-index-instructionp (ins, name, p) case = jump-if-temp-stk-full then proper-p-jump-if-temp-stk-full-instructionp (ins, name, p) case = jump-if-temp-stk-empty then proper-p-jump-if-temp-stk-empty-instructionp (ins,

name, p)

case = pop then proper-p-pop-instructionp (ins, name, p) case = pop* then proper-p-pop*-instructionp (ins, name, p) case = popn then proper-p-popn-instructionp (ins, name, p) case = pop-local then proper-p-pop-local-instructionp (ins, name, p) case = pop-global then proper-p-pop-global-instructionp (ins, name, p) case = pop-locn then proper-p-pop-locn-instructionp (ins, name, p) case = pop-call then proper-p-pop-call-instructionp (ins, name, p) case = fetch-temp-stk then proper-p-fetch-temp-stk-instructionp (ins, name, p) case = deposit-temp-stk then proper-p-deposit-temp-stk-instructionp (ins, name, p) case = jump then proper-p-jump-instructionp (ins, name, p) case = jump-case then proper-p-jump-case-instructionp (ins, name, p) case = pushj then proper-p-pushj-instructionp (ins, name, p) case = popj then proper-p-popj-instructionp (ins, name, p) case = set-local then proper-p-set-local-instructionp (ins, name, p) case = set-global then proper-p-set-global-instructionp (ins, name, p) case = test-nat-and-jump then proper-p-test-nat-and-jump-instructionp (ins, name, p) case = test-int-and-jump then proper-p-test-int-and-jump-instructionp (ins, name, p) case = test-bool-and-jump then proper-p-test-bool-and-jump-instructionp (ins, name, p) case = test-bitv-and-jump then proper-p-test-bitv-and-jump-instructionp (ins, name, p) case = no-op then proper-p-no-op-instructionp (ins, name, p) case = add-addr then proper-p-add-addr-instructionp (ins, name, p) case = sub-addr then proper-p-sub-addr-instructionp (ins, name, p) otherwise proper-p-instructionp2 (ins, name, p) endcase)

Theorem: proper-p-instructionp-is-proper-p-instructionp1 proper-p-instructionp (ins, name, p) = proper-p-instructionp1 (ins, name, p)

Event: Disable proper-p-instructionp-is-proper-p-instructionp1.

; The following theorem is the proper-p-instructionp2 analogoue of the
; next theorem, except that piton-opcodes has been expanded since
; I am using this as a rewrite rule.

Theorem: proper-p-instructionp2-implies-member-piton-opcodes proper-p-instructionp2 (ins, name, p) → ((car (ins)

∈ '(call ret locn push-constant push-local
   push-global push-ctrl-stk-free-size
   push-temp-stk-free-size push-temp-stk-index
   jump-if-temp-stk-full jump-if-temp-stk-empty
   pop pop* popn pop-local pop-global pop-locn
   pop-call fetch-temp-stk deposit-temp-stk jump
   jump-case pushj popj set-local set-global
   test-nat-and-jump test-int-and-jump
   test-bool-and-jump test-bitv-and-jump no-op
   add-addr sub-addr eq lt-addr fetch deposit

            add-int add-int-with-carry add1-int sub-int
            sub-int-with-carry sub1-int neg-int lt-int
            int-to-nat add-nat add-nat-with-carry add1-nat
            sub-nat sub-nat-with-carry sub1-nat lt-nat
            mult2-nat mult2-nat-with-carry-out div2-nat
            or-bitv and-bitv not-bitv xor-bitv rsh-bitv
            lsh-bitv or-bool and-bool not-bool))
     ∧ ((car (ins) = 'push-constant)

→ proper-p-push-constant-instructionp (ins, name, p)))

Event: Disable proper-p-instructionp2.

Theorem: proper-p-instructionp-implies-member-piton-opcodes proper-p-instructionp (ins, name, p) → ((car (ins) ∈ piton-opcodes)

     ∧ ((car (ins) = 'push-constant)

→ proper-p-push-constant-instructionp (ins, name, p)))

; The push-constant predicate checks that the constant is (possibly)
; a p-object.  The r level makes sure it is not a fake dl.  We need
; to know p-objects aren't dls:

Theorem: p-objectp-implies-not-dl p-objectp (x, p) → (car (x) ≠ 'dl)

; Any program defined within a proper-p-prog-segmentp has a properly
; labelled body:

Theorem: proper-p-prog-segmentp-contains-proper-labeled-p-instructionsp (definedp (name, segment) ∧ proper-p-prog-segmentp (segment, p)) → proper-labeled-p-instructionsp (program-body (assoc (name, segment)),

name, p)

; So, if you have a proper list of instructions at the p level then
; it is proper at the r level, provided the name is defined within
; a proper-p-prog-segmentp.

Theorem: proper-p-instructionp-implies-r-instructionp (proper-p-instructionp (ins, name, p) ∧ definedp (name, p-prog-segment (p)) ∧ proper-p-prog-segmentp (p-prog-segment (p), p)) → r-instructionp (ins)

; Consequently, a properly labelled sequence of instructions at the p
; level is a proper sequence at the r level -- this is just an induction
; applying the lemma above.

Theorem: proper-labeled-p-instructionsp-implies-r-program-bodyp (proper-labeled-p-instructionsp (lst, name, p) ∧ definedp (name, p-prog-segment (p)) ∧ proper-p-prog-segmentp (p-prog-segment (p), p)) → r-program-bodyp (lst)

; So a proper p prog-segment is a proper r prog-segment.  But it is
; pretty tricky to state a general enough lemma.  The trouble is that we
; need to induct on the segment while holding the state and its prog-segment
; fixed.  We need the auxiliary concept that every name in one segment
; is defined in the state's:

Definition: all-names-definedp (segment1 , segment2 ) = if segment1 ≃ nil then t

else definedp (name (car (segment1 )), segment2 ) ∧ all-names-definedp (cdr (segment1 ), segment2 ) endif

; Now we can state the essence of the theorem:

Theorem: proper-p-prog-segmentp-implies-r-prog-segmentp-generalized (proper-p-prog-segmentp (segment, p) ∧ all-names-definedp (segment, p-prog-segment (p)) ∧ proper-p-prog-segmentp (p-prog-segment (p), p)) → r-prog-segmentp (segment)

; But of course,

Theorem: all-names-definedp-cdr all-names-definedp (x, cdr (y)) → all-names-definedp (x, y)

Theorem: all-names-definedp-reflexive all-names-definedp (segment, segment)

; And so we can instantiate the lemma above,
; proper-p-prog-segmentp-implies-r-prog-segmentp-generalized, with
; segment replaced by (p-prog-segment p) and collapse the hyps to get:

Theorem: proper-p-prog-segmentp-implies-r-prog-segmentp proper-p-prog-segmentp (p-prog-segment (p), p) → r-prog-segmentp (p-prog-segment (p))

; Whew!  The delicacy of that proof really surprised me.
; So, now we move on the next part of the proper-r-statep predicate,
; the consideration of the usr-data-segment.
; The core of course is just showing that p-objects are
; r-usr-data-objects.  Then we lift it up through several layers
; of recursion.

Theorem: p-objectp-implies-r-usr-data-typep p-objectp (x, p) → r-usr-data-typep (type (x))

Theorem: p-objectp-implies-r-usr-data-objectp (p-objectp (x, p) ∧ same-signature (r-usr-data-segment, p-data-segment (p))) → r-usr-data-objectp (x,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, p-prog-segment (p), r-usr-data-segment, r-sys-data-segment, p-word-size (p), r-psw))

Theorem: all-p-objectps-implies-all-r-usr-data-objectps (all-p-objectps (lst, p) ∧ same-signature (r-usr-data-segment, p-data-segment (p))) → all-r-usr-data-objectps (lst,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, p-prog-segment (p), r-usr-data-segment, r-sys-data-segment, p-word-size (p), r-psw))

Theorem: proper-p-data-segmentp-implies-proper-r-usr-data-segmentp (proper-p-data-segmentp (segment, p) ∧ same-signature (r-usr-data-segment, p-data-segment (p))) → proper-r-usr-data-segmentp (segment,

r-state (r-pc, r-cfp, r-csp, r-tsp, r-x, r-y, r-c-flg, r-v-flg, r-n-flg, r-z-flg, p-prog-segment (p), r-usr-data-segment, r-sys-data-segment, p-word-size (p), r-psw))

; That completes the data segment work.  Finally, we consider the question
; of loadability.
; The need for the second and third hypotheses surprised me. The size
; of the mapped down stacks is as expected only if the p level stacks
; are sufficiently small.

Theorem: p-loadablep-implies-r-loadablep (p-loadablep (p, load-addr) ∧ (p-max-ctrl-stk-size (p) ≮ p-ctrl-stk-size (p-ctrl-stk (p))) ∧ (p-max-temp-stk-size (p) ≮ length (p-temp-stk (p)))) → ((load-addr

+ segment-length (p-data-segment (p))

+ segment-length (icompile (p-prog-segment (p)))

+ segment-length (p->r sys-data-segment (p-ctrl-stk (p), p-max-ctrl-stk-size (p), p-temp-stk (p), p-max-temp-stk-size (p))))

< exp (2, p-word-size (p)))

; So, here we are at what we wanted:  proper states map
; down from p to r.

Theorem: proper-p-statep-implies-proper-r-statep (proper-p-statep (p) ∧ p-loadablep (p, load-addr)) → proper-r-statep (p->r (p), load-addr)

; So we can now complete the p-r level proof by just observing the
; usual things about the treatment of errors.

Theorem: once-errorp-always-errorp-step{special} (¬ errorp (p-psw (p-step (p)))) → (¬ errorp (p-psw (p)))

Theorem: once-errorp-always-errorp{special} (¬ errorp (p-psw (p (p, n)))) → (¬ errorp (p-psw (p)))

; The following lemma wasn't necessary until I added load-addr.  Its
; only purpose is to solve a free-var problem in r-preserves-r-equal.
; Essentially it is just that lemma except we've gone ahead and
; backchained up to (p-loadablep p load-addr) so that the
; instantiation of load-addr can be found in
; one-way-correspondence-p-r immediately below.

Theorem: r-preserves-r-equal-bridge (proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ proper-r-statep (r2 , load-addr) ∧ r-equal (r2 , r-step (p->r (p)))) → r-equal (r (r2 , n), r (r-step (p->r (p)), n))

Theorem: one-way-correspondence-p-r (proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ (¬ errorp (p-psw (p (p, n))))) → r-equal (p->r (p (p, n)), r (p->r (p), n))

Theorem: p-preserves-proper-p-statep (proper-p-statep (p) ∧ (¬ errorp (p-psw (p (p, n))))) → proper-p-statep (p (p, n))

; Book: prim.events (sort of).  This section contains an informal
; sketch of how all of the foregoing are put together into the final
; result.
; In the FM8502 script this informal sketch was followed by its
; formalization: we were virtually done at this point.  This section
; began as prim.events which just imported the names enabled below,
; proved a few little helpers, and then combined the results to get
; the map from P down to FM8502.  But when we tried to do that for
; FM9001 we learned that to get the map up from FM9001 to M we needed
; a constraint on the link tables having to do with the size of the
; physical memory.  (In the first effort to move Piton to FM9001 we
; proved the map down and just left the map up for this section,
; thinking it would be simple.  When we discovered the problem, we
; defined the constraint (PLAUSIBLE-DATA-LINK-TABLEP) in the section
; on m to FM9001 and we proved that it was sufficient to get the map
; up, but we did not show that the plausibility condition was
; satisfied.  We left that for here because its satisfaction is tied
; up with the notion of same-signature, which was not available at the
; time we defined plausibility.)
; So this section of the script begins the final assault on the proof
; but then has a long "digression" were we show how to get the
; plausibility condition.

Event: Set the status of all events. The status of each event is to be set as follows. Each ‘boot-strap’ satellite is to be returned to the initial condition. Each ‘add-shell’ satellite is to be enabled. Each ‘*1* function’ is to be enabled. disabled. Anything not otherwise mentioned is to be disabled. Name this event ‘close-data-base-5’.

Event: Enable theory (proper-p-statep-implies-proper-r-statep proper-r-statep-implies-proper-i-user-data-segmentp proper-r-statep-r proper-r-statep-r-step properr-statep-implies-i-state-okp-r-¿i display-fm9001-data-segment-m-¿fm9001 displaym-data-segment-inverts-i-¿m i-link-tables-i i-state-okp-i-ins-step)proper-p-statep-implies-proper-r-statep, proper-r-statep-implies-proper-i-user-data-segmentp, properr-statep-r, proper-r-statep-r-step, proper-r-statep-implies-i-state-okp-r->i, displayfm9001-data-segment-m->fm9001, display-m-data-segment-inverts-i->m, i-link-tables-i, i-state-okp-i-ins-step.

Theorem: fm9001-m-owc proper-m-statep (m) → (fm9001 (m->fm9001 (m), n) = m->fm9001 (m (m, n)))

Theorem: i-m-owc ((load-addr ∈ N) ∧ (i-psw (i (i, n, load-addr)) = 'run) ∧ (i-word-size (i) = 32)) → (m (i->m (i, boot-lst, load-addr), n)

= i->m (i (i, n, load-addr), boot-lst, load-addr))

; (This one was oriented the other way.)

Theorem: r-i-owc (proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ (¬ errorp (r-psw (r (r, n))))) → (i (r->i (r), clock (r, n), load-addr) = r->i (r (r, n)))

; (This one was oriented the other way.)

Theorem: p-r-owc-corrolary (proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ (¬ errorp (p-psw (p (p, n))))) → ((r-psw (r (p->r (p), n)) = p-psw (p (p, n)))

∧ (r-usr-data-segment (r (p->r (p), n)) = p-data-segment (p (p, n))))

; (This one was packaged up with R-EQUAL and now we are just interested
; in the equality of the psw and data segment components.)
; The three owc theorems have hypotheses about word-size, proper states,
; and psws.  The proper states hyps are all obtainable from the
; proper-p-statep in the top goal and the previously noted theorem
; that proper-p-statep implies proper-r-statep of p->r and the corresponding
; relation down to the i-level by r->i.  However, the lemma that we
; can get from proper r states to proper i states is not a REWRITE
; rule and so we package it up now:

Theorem: proper-r-statep-implies-i-state-okp-r->i-rewrite (proper-r-statep (r, load-addr) ∧ (¬ errorp (r-psw (r)))) → i-state-okp (r->i (r), load-addr)

; The main theorem contains the hypothesis that the word size at the p-level
; is 32.  But our i-m-owc requires that the word size at the i level be 32.
; Clearly we need to know that the word size is the same all the way down:

Theorem: i-word-size-r->i i-word-size (r->i (r)) = r-word-size (r)

Theorem: r-word-size-p->r r-word-size (p->r (p)) = p-word-size (p)

; Similarly, the main theorem gives us that the final p-psw is not an errorp.
; But the i-m-owc requires that the final i-psw is 'run.  The corrollary to
; the p-r-owc gives us that the r-psw is not an error.  So it suffices to
; observe

Theorem: i-psw-r->i (¬ errorp (r-psw (r))) → (i-psw (r->i (r)) = 'run)

; That completes the preliminaries.  We will use the three owcs without
; further attention to their hyps.  We now give the proof of the top goal.
; Note:  The following comments are from the FM8502 proof.  But all of this
; still holds except that we now have one more mapping function, M->FM9001,
; after i->m.
; Consider the display-m-data-segment expression in the top goal:
; (display-m-data-segment (fm8502 (i->m (r->i (p->r p0)) boot-lst load-addr) ...) ...)
; By the equivalence of m and fm8502, this becomes
; (display-m-data-segment (m (i->m (r->i (p->r p0)) boot-lst load-addr) ...) ...).
; Then, by i-m-owc, the i->m is brought outside the m to produce:
; (display-m-data-segment (i->m (i (r->i (p->r p0)) n load-addr) boot-lst load-addr) ...).
; Then, by r-i-owc, the r->i is brought outside the i:
; (display-m-data-segment (i->m (r->i (r (p->r p0) n)) boot-lst load-addr)
;                         (type-specification (p-data-segment (p p0 n)))
;                         (link-tables p0 load-addr))

; In addition, link-tables expands and we get:
; (display-m-data-segment (i->m (r->i (r (p->r p0) n)) boot-lst load-addr)
;                         (type-specification (p-data-segment (p p0 n)))
;                         (i-link-tables (r->i (p->r p0)) load-addr))
; We wish that would match the left-hand side of the conclusion of
; display-m-data-segment-inverts-i->m, said conclusion being:
; (equal (display-m-data-segment (i->m i boot-lst load-addr)
;                                (type-specification (i-usr-data-segment i))
;                                (i-link-tables i load-addr))
;        (i-usr-data-segment i)))
; But it does not because of the second and third args.
; We therefore build a bridged version of the lemma noted above.  It
; is:

Theorem: display-m-data-segment-inverts-i->m-bridge ((load-addr ∈ N) ∧ proper-i-usr-data-segmentp (i-usr-data-segment (i), i) ∧ i-state-okp (i, load-addr) ∧ (type-spec = type-specification (i-usr-data-segment (i))) ∧ (link-tables = i-link-tables (i, load-addr))) → (display-m-data-segment (i->m (i, boot-lst, load-addr),

type-spec, link-tables)

= i-usr-data-segment (i))

; Suppose we could relieve the four hyps.   Then the top goal would reduce
; to:
;  (equal (i-usr-data-segment (r->i (r (p->r p0) n)))
;         (p-data-segment (p p0 n))).
; But we know

Theorem: i-usr-data-segment-r->i i-usr-data-segment (r->i (r)) = r-usr-data-segment (r)

; So the top goal becomes:

;  (equal (r-usr-data-segment (r (p->r p0) n))
;         (p-data-segment (p p0 n))).
; which t by the corrollary of p-r-owc.
; So it only remains to relieve the hypotheses of the bridged display lemma
; above.  There are four:
; Hyp1. (proper-i-usr-data-segmentp (i-usr-data-segment i) i)
; Hyp2. (i-state-okp i load-addr)
; Hyp3. (equal type-spec (type-specification (i-usr-data-segment i)))
; Hyp4. (equal link-tables (i-link-tables i load-addr)))
; where i           is   (r->i (r (p->r p0) n))
;       type-spec   is   (type-specification (p-data-segment (p p0 n)))
;       link-tables is   (i-link-tables (r->i (p->r p0)) load-addr)
; We deal with them in turn.
; Hyp1.  The fully instantiated first hypothesis is:
;   (proper-i-usr-data-segmentp (i-usr-data-segment (r->i (r (p->r p0) n)))
;                               (r->i (r (p->r p0) n)))
; If we apply the previous rule for simplifying the i-usr-data-segment of
; r->i, we would get:
;   (proper-i-usr-data-segmentp (r-usr-data-segment (r (p->r p0) n))
;                               (r->i (r (p->r p0) n)))
; This would immediately match the imported theorem
; proper-r-statep-implies-proper-i-user-data-segmentp
; and we would only have to establish that (r (p->r p0) n) was a
; proper-r-statep.  This follows from the fact that p->r is a
; proper-r-statep (since p0 is a proper-p-statep) and r preserves
; proper-r-statep.  [Note:  we could have relied on p preserving
; proper-p-statep, but then we'd need to express the r term above
; as (p->r (p p0 n)).]
; But this simple argument doesn't work because of the presence of
; the p-r-owc corrollary.  In particular, (r-usr-data-segment (r (p->r p0) n))
; rewrites to (p-data-segment (p p0 n)) by the corrollary and we no
; longer get the match on proper-r-statep-implies-proper-i-user-data-segmentp.

; So we prove a bridged version of that rule:

Theorem: proper-r-statep-implies-proper-i-user-data-segmentp-bridge (proper-r-statep (r, load-addr) ∧ (segment = r-usr-data-segment (r))) → proper-i-usr-data-segmentp (segment, r->i (r))

; That completes hyp1.
; Hyp2.  (i-state-okp (r->i (r (p->r p0) n)) load-addr) follows from the fact that
; r->i produces okp i states from proper r states.
; Hyp3.  The third hypothesis to prove is that the equivalence of
;    (type-specification (p-data-segment (p p0 n)))
; and
;    (type-specification (i-usr-data-segment (r->i (r (p->r p0 n))))).
; The first is what occurs in the top goal; the second is what our lemma
; expects.  But the previously noted fact about the i-usr-data-segment
; of r->i reduces the second to:
;    (type-specification (r-usr-data-segment (r (p->r p0 n))))
; And the corrollary of p-r-owc reduces that to the first.
; Hyp4.  The last hypothesis is the equivalence of
;    (i-link-tables (r->i (p->r p0)) load-addr)
; and
;    (i-link-tables (r->i (r (p->r p0) n)) load-addr).
; Observe that what we are asked to show is that execution on the r machine
; preserves the i-link-tables (computed from mapped down r states).  But
; we know that the i machine preserves link tables.  And we know, from
; r-i-owc, that any mapped down r computation can be seen as an i computation
; on the mapped down states.  So the above requirement follows.  Here is
; a formal rendering of it:

Theorem: i-link-tables-r->i ((load-addr ∈ N) ∧ (r-word-size (r0 ) = 32) ∧ proper-r-statep (r0 , load-addr) ∧ (¬ errorp (r-psw (r (r0 , n))))) → (i-link-tables (r->i (r (r0 , n)), load-addr)

= i-link-tables (r->i (r0 ), load-addr))

; That completes the proof of FM8501 Piton.  We have to define the
; witness function, FM8502-CLOCK, but that is easy:

Definition: fm9001-clock (p, n) = clock (p->r (p), n)

; Note:  In the FM8502 script we were in fact done!  Here we simply
; put top-goal.  But no longer.  We must relieve the plausibility
; constraint.
; Book: plausibility.  We now depart from the FM8502 proof and begin
; to work on deriving the plausibility condition from the fact that
; the initial p state is proper.  We ultimately have to establish that
; the intermediate machines preserve the word size of the state as
; well as the signatures of the program and data segments.

Theorem: bvp-listp-append bvp-listp (a) → (bvp-listp (append (a, b)) = bvp-listp (b))

Theorem: bvp-listp-link-area bvp-listp (link-area (lst, link-tables, 32))

Theorem: bvp-listp-link-segment bvp-listp (link-segment (lst, link-tables, 32))

Theorem: bvp-listp-boot-code bvp-listp (boot-code (boot-lst, n, 32))

Theorem: proper-m-statep-i->m ((i-word-size (i) = 32) ∧ i-loadablep (i, load-addr)) → proper-m-statep (i->m (i, boot-lst, load-addr))

Theorem: i-loadable-r->i proper-r-statep (r, load-addr) → i-loadablep (r->i (r), load-addr)

; I need to show that r preserves the word-size.  It surprises me that I haven't
; proved this at every level.  I apparently haven't proved this at any level!

Theorem: r-word-size-r-step1 r-word-size (r-step1 (ins, r)) = r-word-size (r)

Theorem: r-word-size-r-step r-word-size (r-step (r)) = r-word-size (r)

Theorem: r-word-size-r r-word-size (r (r, n)) = r-word-size (r)

; I have confirmed that if we add the following PLAUSIBLE-TYPE-
; SPEC-AND-LINK-TABLESP instance as an axiom, we can prove top-goal.
; So the entire problem reduces to that described below.  Everything
; between here and the proof of consolidated-plausibility-argument was
; created over a 3 day period (Oct 9-11, 1991) in order to establish
; the plausibility hypothesis necessary to apply DISPLAY-FM9001-
; DATA-SEGMENT-M->FM9001.  That hypothesis is:
; (PLAUSIBLE-DATA-LINK-TABLEP
;         (TYPE-SPECIFICATION (P-DATA-SEGMENT (P P0 N)))
;         (LENGTH (M-MEM (I->M (R->I (R (P->R P0) N)) boot-lst LOAD-ADDR)))
;         (USR-DATA-LINKS (I-LINK-TABLES (R->I (P->R P0)) LOAD-ADDR)))
; under the assumptions
; (NOT (ERRORP (P-PSW (P P0 N))))
; (EQUAL (P-WORD-SIZE P0) 32)
; (P-LOADABLEP P0 LOAD-ADDR)
; (PROPER-P-STATEP P0)
; Plausibility insures that, for each area in the type-spec, the base address of
; the area plus the length of the area must be less than or equal to the length of
; the memory.
; We start by noting

Theorem: same-signature-plausible-data-link-tablep (same-signature (seg1 , seg2 ) ∧ plausible-data-link-tablep (type-specification (seg1 ), n, table)) → plausible-data-link-tablep (type-specification (seg2 ), n, table)

Theorem: same-signature-reflexive-1 same-signature (segment, segment)

Theorem: proper-p-data-segmentp-proper-alistp proper-p-data-segmentp (x, p) → proper-alistp (x)

Theorem: proper-alistp-p-data-segment proper-p-statep (p) → proper-alistp (p-data-segment (p))

; Our next goal is to prove that the p machine does not change the
; signature of the data segment.  Most instructions don't change
; the data segment at all and the corresponding lemma can be proved
; without using most of the hypotheses provided.  But we make all of the
; lemmas of the same form simply so we can use an Emacs macro to
; create them all.  Had these proofs been done at the appropriate
; stage in the proof of the p-r, we would not need to give the hints.

Theorem: same-signature-p-ins-step-call ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'call) ∧ proper-p-statep (p) ∧ p-call-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-call-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-ret ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'ret) ∧ proper-p-statep (p) ∧ p-ret-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-ret-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-locn ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'locn) ∧ proper-p-statep (p) ∧ p-locn-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-locn-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-push-constant ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-constant) ∧ proper-p-statep (p) ∧ p-push-constant-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-push-constant-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-push-local ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-local) ∧ proper-p-statep (p) ∧ p-push-local-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-push-local-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-push-global ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-global) ∧ proper-p-statep (p) ∧ p-push-global-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-push-global-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-push-ctrl-stk-free-size ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-ctrl-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-ctrl-stk-free-size-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-push-ctrl-stk-free-size-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-push-temp-stk-free-size ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-free-size) ∧ proper-p-statep (p) ∧ p-push-temp-stk-free-size-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-push-temp-stk-free-size-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-push-temp-stk-index ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'push-temp-stk-index) ∧ proper-p-statep (p) ∧ p-push-temp-stk-index-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-push-temp-stk-index-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-jump-if-temp-stk-full ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-full) ∧ proper-p-statep (p) ∧ p-jump-if-temp-stk-full-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-jump-if-temp-stk-full-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-jump-if-temp-stk-empty ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-if-temp-stk-empty) ∧ proper-p-statep (p) ∧ p-jump-if-temp-stk-empty-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-jump-if-temp-stk-empty-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-pop ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop) ∧ proper-p-statep (p) ∧ p-pop-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-pop-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-pop* ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop*) ∧ proper-p-statep (p) ∧ p-pop*-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-pop*-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-popn ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popn) ∧ proper-p-statep (p) ∧ p-popn-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-popn-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-pop-local ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-local)

∧ proper-p-statep (p) ∧ p-pop-local-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-pop-local-step (p-current-instruction (p), p)))

; So here is the first occasion on which we need to investigate the hyps to
; get the proof.  An important fact here is that since the state is proper
; the programs are all proper so that the pop-global instruction we are
; executing references a legal area name in the data section.  If it did not
; the resulting deposit would change the signature!  Similarly, we must know that
; the length of the area is sufficient.  We have to enable the rules that were
; freely available during the p-r correspondence work.

Theorem: same-signature-p-ins-step-pop-global ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-global) ∧ proper-p-statep (p) ∧ p-pop-global-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-pop-global-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-pop-locn ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-locn) ∧ proper-p-statep (p) ∧ p-pop-locn-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-pop-locn-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-pop-call ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pop-call) ∧ proper-p-statep (p) ∧ p-pop-call-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-pop-call-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-fetch-temp-stk ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch-temp-stk)

∧ proper-p-statep (p) ∧ p-fetch-temp-stk-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-fetch-temp-stk-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-deposit-temp-stk ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit-temp-stk) ∧ proper-p-statep (p) ∧ p-deposit-temp-stk-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-deposit-temp-stk-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-jump ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump) ∧ proper-p-statep (p) ∧ p-jump-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-jump-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-jump-case ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'jump-case) ∧ proper-p-statep (p) ∧ p-jump-case-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-jump-case-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-pushj ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'pushj) ∧ proper-p-statep (p) ∧ p-pushj-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-pushj-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-popj ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'popj) ∧ proper-p-statep (p) ∧ p-popj-okp (p-current-instruction (p), p))

→ same-signature (p-data-segment (p), p-data-segment (p-popj-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-set-local ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-local) ∧ proper-p-statep (p) ∧ p-set-local-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-set-local-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-set-global ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'set-global) ∧ proper-p-statep (p) ∧ p-set-global-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-set-global-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-test-nat-and-jump ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-nat-and-jump) ∧ proper-p-statep (p) ∧ p-test-nat-and-jump-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-test-nat-and-jump-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-test-int-and-jump ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-int-and-jump) ∧ proper-p-statep (p) ∧ p-test-int-and-jump-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-test-int-and-jump-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-test-bool-and-jump ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bool-and-jump) ∧ proper-p-statep (p) ∧ p-test-bool-and-jump-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p), p-data-segment (p-test-bool-and-jump-step (p-current-instruction (p),

p)))

Theorem: same-signature-p-ins-step-test-bitv-and-jump ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'test-bitv-and-jump) ∧ proper-p-statep (p) ∧ p-test-bitv-and-jump-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-test-bitv-and-jump-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-no-op ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'no-op) ∧ proper-p-statep (p) ∧ p-no-op-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-no-op-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-add-addr ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-addr) ∧ proper-p-statep (p) ∧ p-add-addr-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-add-addr-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-sub-addr ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-addr) ∧ proper-p-statep (p) ∧ p-sub-addr-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-sub-addr-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-eq ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'eq) ∧ proper-p-statep (p) ∧ p-eq-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-eq-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-lt-addr ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-addr) ∧ proper-p-statep (p) ∧ p-lt-addr-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-lt-addr-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-fetch ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'fetch) ∧ proper-p-statep (p) ∧ p-fetch-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-fetch-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-deposit ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'deposit) ∧ proper-p-statep (p) ∧ p-deposit-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-deposit-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-add-int ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int) ∧ proper-p-statep (p) ∧ p-add-int-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-add-int-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-add-int-with-carry ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-int-with-carry) ∧ proper-p-statep (p) ∧ p-add-int-with-carry-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-add-int-with-carry-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-add1-int ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-int) ∧ proper-p-statep (p) ∧ p-add1-int-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-add1-int-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-sub-int ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int) ∧ proper-p-statep (p) ∧ p-sub-int-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-sub-int-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-sub-int-with-carry ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-int-with-carry) ∧ proper-p-statep (p) ∧ p-sub-int-with-carry-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-sub-int-with-carry-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-sub1-int ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-int) ∧ proper-p-statep (p) ∧ p-sub1-int-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-sub1-int-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-neg-int ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'neg-int) ∧ proper-p-statep (p) ∧ p-neg-int-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-neg-int-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-lt-int ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-int) ∧ proper-p-statep (p) ∧ p-lt-int-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-lt-int-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-int-to-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'int-to-nat) ∧ proper-p-statep (p) ∧ p-int-to-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-int-to-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-add-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat) ∧ proper-p-statep (p) ∧ p-add-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-add-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-add-nat-with-carry ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add-nat-with-carry) ∧ proper-p-statep (p) ∧ p-add-nat-with-carry-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-add-nat-with-carry-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-add1-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'add1-nat) ∧ proper-p-statep (p) ∧ p-add1-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-add1-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-sub-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat) ∧ proper-p-statep (p) ∧ p-sub-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-sub-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-sub-nat-with-carry ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub-nat-with-carry) ∧ proper-p-statep (p) ∧ p-sub-nat-with-carry-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-sub-nat-with-carry-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-sub1-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'sub1-nat) ∧ proper-p-statep (p) ∧ p-sub1-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-sub1-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-lt-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lt-nat) ∧ proper-p-statep (p) ∧ p-lt-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-lt-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-mult2-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat) ∧ proper-p-statep (p) ∧ p-mult2-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-mult2-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-mult2-nat-with-carry-out ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'mult2-nat-with-carry-out) ∧ proper-p-statep (p) ∧ p-mult2-nat-with-carry-out-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-mult2-nat-with-carry-out-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-div2-nat ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'div2-nat) ∧ proper-p-statep (p) ∧ p-div2-nat-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-div2-nat-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-or-bitv ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bitv) ∧ proper-p-statep (p) ∧ p-or-bitv-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-or-bitv-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-and-bitv ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bitv) ∧ proper-p-statep (p) ∧ p-and-bitv-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-and-bitv-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-not-bitv ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bitv) ∧ proper-p-statep (p) ∧ p-not-bitv-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-not-bitv-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-xor-bitv ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'xor-bitv) ∧ proper-p-statep (p) ∧ p-xor-bitv-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-xor-bitv-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-rsh-bitv ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'rsh-bitv) ∧ proper-p-statep (p) ∧ p-rsh-bitv-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-rsh-bitv-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-lsh-bitv ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'lsh-bitv) ∧ proper-p-statep (p) ∧ p-lsh-bitv-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-lsh-bitv-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-or-bool ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'or-bool) ∧ proper-p-statep (p) ∧ p-or-bool-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-or-bool-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-and-bool ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'and-bool) ∧ proper-p-statep (p) ∧ p-and-bool-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-and-bool-step (p-current-instruction (p), p)))

Theorem: same-signature-p-ins-step-not-bool ((p-psw (p) = 'run) ∧ (car (p-current-instruction (p)) = 'not-bool) ∧ proper-p-statep (p) ∧ p-not-bool-okp (p-current-instruction (p), p)) → same-signature (p-data-segment (p),

p-data-segment (p-not-bool-step (p-current-instruction (p), p)))

; We now put these all together.

Theorem: same-signature-p-ins-step ((p-psw (p) = 'run) ∧ p-ins-okp (p-current-instruction (p), p) ∧ proper-p-statep (p)) → same-signature (p-data-segment (p),

p-data-segment (p-ins-step (p-current-instruction (p), p)))

Theorem: same-signature-p-step proper-p-statep (p) → same-signature (p-data-segment (p), p-data-segment (p-step (p)))

Theorem: same-signature-p-transitivity-lemma ((n ∈ N) ∧ (n ≠ 0) ∧ same-signature (p-data-segment (p-step (p)),

p-data-segment (p (p-step (p), n − 1)))

∧ proper-p-statep (p) ∧ (¬ errorp (p-psw (p (p-step (p), n − 1))))) → same-signature (p-data-segment (p), p-data-segment (p (p-step (p), n − 1)))

Theorem: same-signature-p (proper-p-statep (p) ∧ (¬ errorp (p-psw (p (p, n))))) → same-signature (p-data-segment (p), p-data-segment (p (p, n)))

; What we wish to prove is:
; (PLAUSIBLE-DATA-LINK-TABLEP
;   (TYPE-SPECIFICATION (P-DATA-SEGMENT (P P0 N)))
;   (LENGTH (M-MEM (I->M (R->I (R (P->R P0) N)) boot-lst LOAD-ADDR)))
;   (USR-DATA-LINKS (I-LINK-TABLES (R->I (P->R P0)) LOAD-ADDR)))
; By instantiating same-signature-plausible-data-link-tablep with
; (seg1 (p-data-segment p0))
; (seg2 (p-data-segment (p p0 n)))
; and applealing to same-signature-p, we can backchain from our goal to

; (PLAUSIBLE-DATA-LINK-TABLEP
;   (TYPE-SPECIFICATION (P-DATA-SEGMENT P0))
;   (LENGTH (M-MEM (I->M (R->I (R (P->R P0) N)) boot-lst LOAD-ADDR)))
;   (USR-DATA-LINKS (I-LINK-TABLES (R->I (P->R P0)) LOAD-ADDR)))
; Next I need to show that
; (length (m-mem (i->m (r->i (r pr n)) boot-lst load-addr)))
;  = (length (m-mem (i->m (r->i pr) boot-lst load-addr))).
; This follows from the fact that the r-prog-segment is unchanged by r and the
; signatures of both the usr-data-segment and sys-data-segment are unchanged.
; So now we undertake those proofs. (!)

Theorem: same-signature-r-ins-step-call ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'call) ∧ proper-r-statep (r, load-addr) ∧ r-call-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-call-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-call-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-call-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-ret ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'ret) ∧ proper-r-statep (r, load-addr) ∧ r-ret-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-ret-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-ret-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-ret-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-locn ((r-psw (r) = 'run)

∧ (car (r-current-instruction (r)) = 'locn) ∧ proper-r-statep (r, load-addr) ∧ r-locn-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-locn-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-locn-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-locn-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-push-constant ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-constant) ∧ proper-r-statep (r, load-addr) ∧ r-push-constant-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-push-constant-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-push-constant-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-push-constant-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-push-local ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-local) ∧ proper-r-statep (r, load-addr) ∧ r-push-local-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-push-local-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-push-local-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-push-local-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-push-global ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-global) ∧ proper-r-statep (r, load-addr) ∧ r-push-global-okp (r-current-instruction (r), r))

→ ((r-prog-segment (r-push-global-step (r-current-instruction (r), r)) = r-prog-segment (r)) ∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-push-global-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-push-global-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-push-ctrl-stk-free-size ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-ctrl-stk-free-size) ∧ proper-r-statep (r, load-addr) ∧ r-push-ctrl-stk-free-size-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-push-ctrl-stk-free-size-step (r-current-instruction (r),

r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-push-ctrl-stk-free-size-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-push-ctrl-stk-free-size-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-push-temp-stk-free-size ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-temp-stk-free-size) ∧ proper-r-statep (r, load-addr) ∧ r-push-temp-stk-free-size-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-push-temp-stk-free-size-step (r-current-instruction (r),

r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-push-temp-stk-free-size-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-push-temp-stk-free-size-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-push-temp-stk-index ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'push-temp-stk-index) ∧ proper-r-statep (r, load-addr) ∧ r-push-temp-stk-index-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-push-temp-stk-index-step (r-current-instruction (r),

r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-push-temp-stk-index-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-push-temp-stk-index-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-jump-if-temp-stk-full ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump-if-temp-stk-full) ∧ proper-r-statep (r, load-addr) ∧ r-jump-if-temp-stk-full-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-jump-if-temp-stk-full-step (r-current-instruction (r),

r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-jump-if-temp-stk-full-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-jump-if-temp-stk-full-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-jump-if-temp-stk-empty ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump-if-temp-stk-empty) ∧ proper-r-statep (r, load-addr) ∧ r-jump-if-temp-stk-empty-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-jump-if-temp-stk-empty-step (r-current-instruction (r),

r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-jump-if-temp-stk-empty-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-jump-if-temp-stk-empty-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-pop ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop) ∧ proper-r-statep (r, load-addr) ∧ r-pop-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-pop-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-pop-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-pop-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-pop* ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop*) ∧ proper-r-statep (r, load-addr) ∧ r-pop*-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-pop*-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-pop*-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-pop*-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-popn ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'popn) ∧ proper-r-statep (r, load-addr) ∧ r-popn-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-popn-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-popn-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-popn-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-pop-local ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-local) ∧ proper-r-statep (r, load-addr) ∧ r-pop-local-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-pop-local-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r), r-usr-data-segment (r-pop-local-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-pop-local-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-pop-global ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-global) ∧ proper-r-statep (r, load-addr) ∧ r-pop-global-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-pop-global-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-pop-global-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-pop-global-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-pop-locn ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-locn) ∧ proper-r-statep (r, load-addr) ∧ r-pop-locn-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-pop-locn-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-pop-locn-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-pop-locn-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-pop-call ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pop-call) ∧ proper-r-statep (r, load-addr) ∧ r-pop-call-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-pop-call-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-pop-call-step (r-current-instruction (r),

r)))

r))))

∧ same-signature (r-sys-data-segment (r), r-sys-data-segment (r-pop-call-step (r-current-instruction (r), Theorem: same-signature-r-ins-step-fetch-temp-stk ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'fetch-temp-stk) ∧ proper-r-statep (r, load-addr) ∧ r-fetch-temp-stk-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-fetch-temp-stk-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-fetch-temp-stk-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-fetch-temp-stk-step (r-current-instruction (r), r))))

; I am having trouble getting same-signature-r-ins-step-DEPOSIT-TEMP-STK
; so I am proving a lemma just for it.  I'm sure there is one like this
; somewhere already here.  I am embarassed to confess that the following
; dumb helper is also beyond the abilities of the unassisted prover in its
; current disabled state!  I suppose I could find lemmas to make this go
; through too, but I'll just push it through by induction!

Theorem: same-signature-r-ins-step-deposit-temp-stk-lemma-helper (n ≄ 0) → ((((n − 1) − 1) − untag) < n)

Theorem: same-signature-r-ins-step-deposit-temp-stk-lemma proper-r-statep (r, load-addr) → ((if (length (cdr (assoc ('tstk, r-sys-data-segment (r)))) − 1) = 0

then 0

else ((length (cdr (assoc ('tstk, r-sys-data-segment (r)))) − 1) − 1) − untag (fetch (r-tsp (r), r-sys-data-segment (r))) endif

< length (cdr (assoc ('tstk, r-sys-data-segment (r)))))

= t)

Theorem: same-signature-r-ins-step-deposit-temp-stk ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'deposit-temp-stk) ∧ proper-r-statep (r, load-addr) ∧ r-deposit-temp-stk-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-deposit-temp-stk-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r), r-usr-data-segment (r-deposit-temp-stk-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-deposit-temp-stk-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-jump ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump) ∧ proper-r-statep (r, load-addr) ∧ r-jump-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-jump-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-jump-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-jump-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-jump-case ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'jump-case) ∧ proper-r-statep (r, load-addr) ∧ r-jump-case-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-jump-case-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-jump-case-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-jump-case-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-pushj ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'pushj) ∧ proper-r-statep (r, load-addr) ∧ r-pushj-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-pushj-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-pushj-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r), r-sys-data-segment (r-pushj-step (r-current-instruction (r), Theorem: same-signature-r-ins-step-popj ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'popj) ∧ proper-r-statep (r, load-addr) ∧ r-popj-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-popj-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-popj-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-popj-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-set-local ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'set-local) ∧ proper-r-statep (r, load-addr) ∧ r-set-local-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-set-local-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-set-local-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-set-local-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-set-global ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'set-global) ∧ proper-r-statep (r, load-addr) ∧ r-set-global-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-set-global-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-set-global-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-set-global-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-test-nat-and-jump ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-nat-and-jump) ∧ proper-r-statep (r, load-addr) ∧ r-test-nat-and-jump-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-test-nat-and-jump-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-test-nat-and-jump-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-test-nat-and-jump-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-test-int-and-jump ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-int-and-jump) ∧ proper-r-statep (r, load-addr) ∧ r-test-int-and-jump-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-test-int-and-jump-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-test-int-and-jump-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-test-int-and-jump-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-test-bool-and-jump ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-bool-and-jump) ∧ proper-r-statep (r, load-addr) ∧ r-test-bool-and-jump-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-test-bool-and-jump-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-test-bool-and-jump-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-test-bool-and-jump-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-test-bitv-and-jump ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'test-bitv-and-jump) ∧ proper-r-statep (r, load-addr)

∧ r-test-bitv-and-jump-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-test-bitv-and-jump-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-test-bitv-and-jump-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-test-bitv-and-jump-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-no-op ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'no-op) ∧ proper-r-statep (r, load-addr) ∧ r-no-op-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-no-op-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-no-op-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-no-op-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-add-addr ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-addr) ∧ proper-r-statep (r, load-addr) ∧ r-add-addr-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-add-addr-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-add-addr-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-add-addr-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-sub-addr ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-addr) ∧ proper-r-statep (r, load-addr) ∧ r-sub-addr-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-sub-addr-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-sub-addr-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-sub-addr-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-eq ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'eq) ∧ proper-r-statep (r, load-addr) ∧ r-eq-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-eq-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-eq-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-eq-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-lt-addr ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'lt-addr) ∧ proper-r-statep (r, load-addr) ∧ r-lt-addr-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-lt-addr-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-lt-addr-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-lt-addr-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-fetch ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'fetch) ∧ proper-r-statep (r, load-addr) ∧ r-fetch-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-fetch-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-fetch-step (r-current-instruction (r), r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-fetch-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-deposit ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'deposit) ∧ proper-r-statep (r, load-addr) ∧ r-deposit-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-deposit-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-deposit-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-deposit-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-add-int ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-int) ∧ proper-r-statep (r, load-addr) ∧ r-add-int-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-add-int-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-add-int-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-add-int-step (r-current-instruction (r), r))))

Theorem: definedp-deposit-adp definedp (name, deposit-adp (val, adp, segment)) = definedp (name, segment)

; We need a special lemma here because add-int-with-carry pushes two things.
; As usual, there is undoubtedly a set of lemmas already available for this
; if I only wanted to understand every detail of the old proofs.

Theorem: adpp-add-adp-hack (proper-r-statep (r, load-addr) ∧ ((1 + adp-offset (untag (r-tsp (r))))

< ((length (cdr (assoc ('tstk, r-sys-data-segment (r)))) − 1) − 1))) → adpp (add-adp (untag (r-tsp (r)), 2), r-sys-data-segment (r))

Theorem: same-signature-r-ins-step-add-int-with-carry ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-int-with-carry) ∧ proper-r-statep (r, load-addr) ∧ r-add-int-with-carry-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-add-int-with-carry-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-add-int-with-carry-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-add-int-with-carry-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-add1-int ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add1-int) ∧ proper-r-statep (r, load-addr) ∧ r-add1-int-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-add1-int-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-add1-int-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-add1-int-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-sub-int ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-int) ∧ proper-r-statep (r, load-addr) ∧ r-sub-int-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-sub-int-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-sub-int-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-sub-int-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-sub-int-with-carry ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-int-with-carry)

∧ proper-r-statep (r, load-addr) ∧ r-sub-int-with-carry-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-sub-int-with-carry-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-sub-int-with-carry-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-sub-int-with-carry-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-sub1-int ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub1-int) ∧ proper-r-statep (r, load-addr) ∧ r-sub1-int-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-sub1-int-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-sub1-int-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-sub1-int-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-neg-int ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'neg-int) ∧ proper-r-statep (r, load-addr) ∧ r-neg-int-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-neg-int-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-neg-int-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-neg-int-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-lt-int ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'lt-int) ∧ proper-r-statep (r, load-addr) ∧ r-lt-int-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-lt-int-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-lt-int-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-lt-int-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-int-to-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'int-to-nat) ∧ proper-r-statep (r, load-addr) ∧ r-int-to-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-int-to-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-int-to-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-int-to-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-add-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-nat) ∧ proper-r-statep (r, load-addr) ∧ r-add-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-add-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-add-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-add-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-add-nat-with-carry ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add-nat-with-carry) ∧ proper-r-statep (r, load-addr) ∧ r-add-nat-with-carry-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-add-nat-with-carry-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r), r-usr-data-segment (r-add-nat-with-carry-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-add-nat-with-carry-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-add1-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'add1-nat) ∧ proper-r-statep (r, load-addr) ∧ r-add1-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-add1-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-add1-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-add1-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-sub-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-nat) ∧ proper-r-statep (r, load-addr) ∧ r-sub-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-sub-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-sub-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-sub-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-sub-nat-with-carry ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub-nat-with-carry) ∧ proper-r-statep (r, load-addr) ∧ r-sub-nat-with-carry-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-sub-nat-with-carry-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-sub-nat-with-carry-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r), r-sys-data-segment (r-sub-nat-with-carry-step (r-current-instruction (r), Theorem: same-signature-r-ins-step-sub1-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'sub1-nat) ∧ proper-r-statep (r, load-addr) ∧ r-sub1-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-sub1-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-sub1-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-sub1-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-lt-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'lt-nat) ∧ proper-r-statep (r, load-addr) ∧ r-lt-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-lt-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-lt-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-lt-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-mult2-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'mult2-nat) ∧ proper-r-statep (r, load-addr) ∧ r-mult2-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-mult2-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-mult2-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-mult2-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-mult2-nat-with-carry-out ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'mult2-nat-with-carry-out) ∧ proper-r-statep (r, load-addr) ∧ r-mult2-nat-with-carry-out-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-mult2-nat-with-carry-out-step (r-current-instruction (r),

r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-mult2-nat-with-carry-out-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-mult2-nat-with-carry-out-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-div2-nat ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'div2-nat) ∧ proper-r-statep (r, load-addr) ∧ r-div2-nat-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-div2-nat-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-div2-nat-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-div2-nat-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-or-bitv ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'or-bitv) ∧ proper-r-statep (r, load-addr) ∧ r-or-bitv-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-or-bitv-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-or-bitv-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-or-bitv-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-and-bitv ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'and-bitv)

∧ proper-r-statep (r, load-addr) ∧ r-and-bitv-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-and-bitv-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-and-bitv-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-and-bitv-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-not-bitv ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'not-bitv) ∧ proper-r-statep (r, load-addr) ∧ r-not-bitv-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-not-bitv-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-not-bitv-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-not-bitv-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-xor-bitv ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'xor-bitv) ∧ proper-r-statep (r, load-addr) ∧ r-xor-bitv-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-xor-bitv-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-xor-bitv-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-xor-bitv-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-rsh-bitv ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'rsh-bitv) ∧ proper-r-statep (r, load-addr) ∧ r-rsh-bitv-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-rsh-bitv-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-rsh-bitv-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-rsh-bitv-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-lsh-bitv ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'lsh-bitv) ∧ proper-r-statep (r, load-addr) ∧ r-lsh-bitv-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-lsh-bitv-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-lsh-bitv-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-lsh-bitv-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-or-bool ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'or-bool) ∧ proper-r-statep (r, load-addr) ∧ r-or-bool-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-or-bool-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-or-bool-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-or-bool-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-and-bool ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'and-bool) ∧ proper-r-statep (r, load-addr) ∧ r-and-bool-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-and-bool-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r), r-usr-data-segment (r-and-bool-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-and-bool-step (r-current-instruction (r), r))))

Theorem: same-signature-r-ins-step-not-bool ((r-psw (r) = 'run) ∧ (car (r-current-instruction (r)) = 'not-bool) ∧ proper-r-statep (r, load-addr) ∧ r-not-bool-okp (r-current-instruction (r), r)) → ((r-prog-segment (r-not-bool-step (r-current-instruction (r), r))

= r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-not-bool-step (r-current-instruction (r),

r)))

∧ same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-not-bool-step (r-current-instruction (r), r))))

; Now we put these all together.  We'll do each segment individually
; because the case splitting is pretty bad here:

Theorem: same-signature-r-prog-segment-r-ins-step ((r-psw (r) = 'run) ∧ r-ins-okp (r-current-instruction (r), r) ∧ proper-r-statep (r, load-addr)) → (r-prog-segment (r-ins-step (r-current-instruction (r), r))

= r-prog-segment (r))

Theorem: same-signature-r-usr-data-segment-r-ins-step ((r-psw (r) = 'run) ∧ r-ins-okp (r-current-instruction (r), r) ∧ proper-r-statep (r, load-addr)) → same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-ins-step (r-current-instruction (r), r)))

Theorem: same-signature-r-sys-data-segment-r-ins-step ((r-psw (r) = 'run) ∧ r-ins-okp (r-current-instruction (r), r) ∧ proper-r-statep (r, load-addr)) → same-signature (r-sys-data-segment (r),

r-sys-data-segment (r-ins-step (r-current-instruction (r), r)))

Theorem: same-signature-r-step proper-r-statep (r, load-addr) → ((r-prog-segment (r-step (r)) = r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r-step (r)))

∧ same-signature (r-sys-data-segment (r), r-sys-data-segment (r-step (r))))

Theorem: same-signature-r-transitivity-lemma1 ((n ∈ N) ∧ (n ≠ 0) ∧ same-signature (r-usr-data-segment (r-step (r)),

r-usr-data-segment (r (r-step (r), n − 1)))

∧ proper-r-statep (r, load-addr) ∧ (¬ errorp (r-psw (r (r-step (r), n − 1))))) → same-signature (r-usr-data-segment (r),

r-usr-data-segment (r (r-step (r), n − 1)))

Theorem: same-signature-r-transitivity-lemma2 ((n ∈ N) ∧ (n ≠ 0) ∧ same-signature (r-sys-data-segment (r-step (r)),

r-sys-data-segment (r (r-step (r), n − 1)))

∧ proper-r-statep (r, load-addr) ∧ (¬ errorp (r-psw (r (r-step (r), n − 1))))) → same-signature (r-sys-data-segment (r),

r-sys-data-segment (r (r-step (r), n − 1)))

Theorem: same-signature-r (proper-r-statep (r, load-addr) ∧ (¬ errorp (r-psw (r (r, n))))) → ((r-prog-segment (r (r, n)) = r-prog-segment (r))

∧ same-signature (r-usr-data-segment (r),

r-usr-data-segment (r (r, n)))

∧ same-signature (r-sys-data-segment (r), r-sys-data-segment (r (r, n))))

; So now we can derive from this same-signature invariance the fact that
; the length of the mapped down memory is preserved by the r machine.
; The key lemma relating same-signature and link-mem...

Theorem: same-signature-implies-length-link-mem (same-signature (usr-data-segment1 , usr-data-segment2 ) ∧ same-signature (sys-data-segment1 , sys-data-segment2 ))

→ (length (link-mem (boot-lst, load-addr, usr-data-segment2 , prog-segment, sys-data-segment2 , tables, word-size))

= length (link-mem (boot-lst, load-addr, usr-data-segment1 , prog-segment, sys-data-segment1 , tables, word-size)))

; ... which we can use to show that the mapped down memory is the same size:

Theorem: length-m-mem-r->i->m (proper-r-statep (r, load-addr) ∧ (load-addr ∈ N) ∧ (¬ errorp (r-psw (r (r, n)))) ∧ (r-word-size (r) = 32)) → (length (m-mem (i->m (r->i (r (r, n)), boot-lst, load-addr)))

= length (m-mem (i->m (r->i (r), boot-lst, load-addr))))

Theorem: i-usr-data-segment-p->r->i i-usr-data-segment (r->i (p->r (p))) = p-data-segment (p)

Theorem: once-errorp-always-errorp{mapping} (proper-p-statep (p0 ) ∧ p-loadablep (p0 , load-addr) ∧ (¬ errorp (p-psw (p (p0 , n))))) → (¬ errorp (r-psw (r (p->r (p0 ), n))))

Theorem: length-m-mem-p->r->i->m length (m-mem (i->m (r->i (p->r (p0 )), boot-lst, load-addr))) = (load-addr

+ segment-length (p-data-segment (p0 ))

+ segment-length (icompile (p-prog-segment (p0 )))

+ segment-length (p->r sys-data-segment (p-ctrl-stk (p0 ), p-max-ctrl-stk-size (p0 ), p-temp-stk (p0 ), p-max-temp-stk-size (p0 ))))

Theorem: i-prog-segment-p->r->i i-prog-segment (r->i (p->r (p0 ))) = icompile (p-prog-segment (p0 ))

Theorem: consolidated-plausibility-argument-lemma (proper-p-statep (p0 ) ∧ p-loadablep (p0 , load-addr) ∧ (load-addr ∈ N) ∧ (p-word-size (p0 ) = 32) ∧ (¬ errorp (p-psw (p (p0 , n)))) ∧ plausible-data-link-tablep (type-specification (p-data-segment (p0 )),

load-addr

+ segment-length (p-data-segment (p0 ))

+ segment-length (icompile (p-prog-segment (p0 )))

+ segment-length (p->r sys-data-segment (p-ctrl-stk (p0 ), p-max-ctrl-stk-size (p0 ), p-temp-stk (p0 ), p-max-temp-stk-size (p0 ))),

link-table-for-segment (p-data-segment (p0 ),

load-addr)))

→ plausible-data-link-tablep (type-specification (p-data-segment (p (p0 , n))),

length (m-mem (i->m (r->i (r (p->r (p0 ), n)), boot-lst, load-addr))),

usr-data-links (i-link-tables (r->i (p->r (p0 )), load-addr)))

; So to establish the desired plausibility condition we can backchain through
; the above and reduce the goal to:
; (plausible-data-link-tablep
;            (type-specification (p-data-segment p0))
;            (plus (segment-length (icompile (p-prog-segment p0)))
;                  (segment-length (p-data-segment p0))
;                  (segment-length
;                   (p->r_sys-data-segment (p-ctrl-stk p0)
;                                          (p-max-ctrl-stk-size p0)
;                                          (p-temp-stk p0)
;                                          (p-max-temp-stk-size p0))))
;            (link-table-for-segment (p-data-segment p0)
;                                    (segment-length (icompile (p-prog-segment p0)))))
; Which is in fact an instance of
; (plausible-data-link-tablep

;            (type-specification seg)
;            (plus i (segment-length seg) j)
;            (link-table-for-segment seg i))
; It is this more general plausibility condition that we now attack.

Theorem: not-lessp-segment-length-plus-link-table-entry-length segment-length (segment) ≮ (link-table-entry (name, segment) + length (cdr (assoc (name, segment))))

Theorem: lessp-absolute-address-segment-length-rewrite{weakened-instance} (definedp (name, segment) ∧ (i = length (cdr (assoc (name, segment))))) → (segment-length (segment) ≮ (i + link-table-entry (name, segment)))

Theorem: plausible-data-link-tablep-link-table-for-segment (subsegmentp (seg1 , seg2 ) ∧ (i ∈ N) ∧ (max ≮ (i + segment-length (seg2 )))) → plausible-data-link-tablep (type-specification (seg1 ),

max,

link-table-for-segment (seg2 , i))

Theorem: r-usr-data-segment-p->r r-usr-data-segment (p->r (p)) = p-data-segment (p)

; Note:  The use and disable hints below were unnecessary
; before load-addr became an insidious free variable.

Theorem: proper-p-statep-implies-proper-i-usr-data-segmentp (proper-p-statep (p) ∧ p-loadablep (p, load-addr) ∧ (load-addr ∈ N)) → proper-i-usr-data-segmentp (p-data-segment (p), r->i (p->r (p)))

Event: Disable length-m-mem-p->r->i->m.

Event: Disable length-m-mem-r->i->m.

Theorem: consolidated-plausibility-argument (proper-p-statep (p0 ) ∧ p-loadablep (p0 , load-addr) ∧ (load-addr ∈ N) ∧ (¬ errorp (p-psw (p (p0 , n)))) ∧ (p-word-size (p0 ) = 32))

→ plausible-data-link-tablep (type-specification (p-data-segment (p (p0 , n))),

length (m-mem (i->m (r->i (r (p->r (p0 ), n)), boot-lst, load-addr))),

usr-data-links (i-link-tables (r->i (p->r (p0 )), load-addr)))

; Book:  Top-goal.  Ok, so here, at long last, is the statement that
; Piton is implemented on FM9001!

Theorem: top-goal (proper-p-statep (p0 ) ∧ (load-addr ∈ N) ∧ p-loadablep (p0 , load-addr) ∧ (p-word-size (p0 ) = 32) ∧ (pn = p (p0 , n)) ∧ (¬ errorp (p-psw (pn))) ∧ (ts = type-specification (p-data-segment (pn)))) → (p-data-segment (pn)

= display-fm9001-data-segment (fm9001 (load (p0 , boot-lst, load-addr),

fm9001-clock (p0 , n)), ts, link-tables (p0 , load-addr)))

Event: Set the status of all events. The status of each event is to be set as follows. Each ‘boot-strap’ satellite is to be returned to the initial condition. Each ‘add-shell’ satellite is to be enabled. enabled. Anything not otherwise mentioned is to be disabled. Name this event ‘close-data-base-6’.

; The rest of this file is related to the implementation of the
; fm9001.  Since this version of Piton is built on an fm9001 events
; file that does not go down to that level, we omit the events below.
#|
(enable-theory (fm9001=fm9001-interpreter
                fm9001-statep
                map-down
                map-up-inverts-map-down
                fm9001-statep-implies-fm9001-state-structure
                fm9001-statep-implies-macrocycle-invariant-lemma1
                fm9001-statep-implies-macrocycle-invariant
                fm9001=chip-system-lemma1
                fm9001=chip-system))

; Book:  Piton to Dual-Eval.  We now wish to connect Piton to DUAL-EVAL, i.e.,
; to eliminate FM9001 and go straight down to the bottom.  The motivation is
; to make it easier for the user of Piton to connect his machine to the gate
; level, so that stacks can be built step-wise:  Each layer should finish by
; connecting to the bottom in one step.

; We now develop the lemmas leading to the theorem that maps Piton all the
; way down to the dual-eval level.
(defn ram-tree-hint (lst n)
  (cond ((zerop n) t)
        ((nlistp lst) t)
        (t (cons (ram-tree-hint (firstn (exp 2 (sub1 n)) lst)
                                (sub1 n))
                 (ram-tree-hint (restn (exp 2 (sub1 n)) lst)
                                (sub1 n))))))
(prove-lemma not-equal-times-2-x-1 (rewrite)
  (not (equal (times 2 x) 1))
  ((enable times-0)))
(prove-lemma bvp-listp-firstn (rewrite)
  (implies (bvp-listp lst)
           (bvp-listp (firstn n lst))))
(prove-lemma bvp-listp-restn (rewrite)
  (implies (bvp-listp lst)
           (bvp-listp (restn n lst))))
(prove-lemma memory-okp-ram-tree (rewrite)
  (implies (bvp-listp lst)
           (memory-okp n 32 (ram-tree lst (exp 2 n))))
  ((enable quotient-times-instance-temp)
   (induct (ram-tree-hint lst n))))
(prove-lemma memory-okp-ram-tree-bridge (rewrite)
  (implies (and (bvp-listp lst)
                (equal k (exp 2 n)))
           (memory-okp n 32 (ram-tree lst k))))
(disable memory-okp-ram-tree)

(prove-lemma bvp-listp-cons (rewrite)
(equal (bvp-listp (cons bv lst))
(and (bvp bv)
(equal (length bv) 32)
(bvp-listp lst))))
(prove-lemma all-ramp-mem-ram-tree (rewrite)
(implies (not (lessp (length lst) (exp 2 n)))
(all-ramp-mem n (ram-tree lst (exp 2 n))))
((enable quotient-times-instance-temp length-firstn length-restn  lessp-0-exp)
(induct (ram-tree-hint lst n))))
(prove-lemma all-ramp-mem-ram-tree-bridge (rewrite)
(implies (and (equal k (exp 2 n))
(not (lessp (length lst) k)))
(all-ramp-mem n (ram-tree lst k))))
(disable all-ramp-mem-ram-tree)
(prove-lemma fm9001-statep-load (rewrite)
(implies (and (proper-p-statep p0)
(p-loadablep p0 load-addr)
(equal (p-word-size p0) 32))
(fm9001-statep (load p0 boot-lst load-addr)))
((disable proper-p-statep p-loadablep link-word  p->r_cfp p->r_csp p->r_tsp
p->r_sys-data-segment r->i_pc icompile r->i_psw i-link-tables
all-ramp-mem memory-okp ram-tree)
(enable *1*exp length-cons size-link-word bvp-link-word bvp-listp-append
bvp-listp-boot-code
bvp-listp-link-segment bool-to-logical-non-f)))
(disable fm9001=fm9001-interpreter)
(prove-lemma piton-to-dual-eval (rewrite)
(implies (and (proper-p-statep p0)
(p-loadablep p0 load-addr)
(numberp load-addr)
(equal (p-word-size p0) 32)
(not (errorp (p-psw (p p0 n))))
(equal ts (type-specification (p-data-segment (p p0 n))))
(chip-system& netlist)
(chip-system-operating-inputs-p inputs
                                (total-microcycles (map-down (load p0 boot-lst load-addr))
                                                   (map-up-inputs inputs)

                                                (fm9001-clock p0 n)))
(operating-inputs-p (map-up-inputs inputs)
                 (total-microcycles (map-down (load p0 boot-lst load-addr))
                                    (map-up-inputs inputs)
                                    (fm9001-clock p0 n))))
(equal (p-data-segment (p p0 n))
(display-fm9001-data-segment
(map-up
 (simulate-dual-eval-2 'chip-system inputs
                       (map-down (load p0 boot-lst load-addr))
                       netlist
                       (total-microcycles (map-down (load p0 boot-lst load-addr))
                                          (map-up-inputs inputs)
                                          (fm9001-clock p0 n))))
ts
(link-tables p0 load-addr))))
((enable fm9001=chip-system)
(disable proper-p-statep p-loadablep errorp type-specification p chip-system&
chip-system-operating-inputs-p total-microcycles map-down load map-up-inputs
fm9001-clock operating-inputs-p display-fm9001-data-segment map-up
simulate-dual-eval-2 link-tables)
(use (top-goal (pn (p p0 n))))))
(set-status close-data-base-7 t ((boot-strap initial)
              (add-shell enable)
              ((defn *1*defn) enable)
              (otherwise disable)))
|#

Event: Make the library "piton" and compile it.

Index

a-immediate, 45, 177 a-immediate-p, 45, 176 absolute-address, 26, 27, 199–202 add-addp-1-folded, 505 add-addr, 48, 49, 57–62, 271, 277–

280, 286–288, 294, 295, 300, 301, 358, 604

add-addr-one-way-correspondence -p-r, 667 -r-i, 510

add-addr-preserves-p-loadablep, 787 add-addr-preserves-proper-p-statep,

708 add-addr-preserves-r-equal, 753 add-addr-proper-r-statep, 556 add-adp, 48, 144, 353, 357, 358, 360,

361, 369, 505, 507, 513, 514, 517, 525, 538, 549, 557, 884

add-adp-0-untag-r-tsp, 538 add-adp-add-adp, 369 add-adp-cons, 357 add-int-one-way-correspondence-

r-i, 515 add-int-one-way-correspondence-p

-r, 673 add-int-preserves-p-loadablep, 791 add-int-preserves-proper-p-statep, 714 add-int-preserves-r-equal, 762 add-int-proper-r-statep, 558 add-int-with-carry-one-way-corre

spondence-p-r, 674 spondence-r-i, 516

add-int-with-carry-preserves-p-

loadablep, 792 add-int-with-carry-preserves-pr

oper-p-statep, 714 add-int-with-carry-preserves-r-eq

ual, 762 add-int-with-carry-proper-r-statep, 558 add-nat-one-way-correspondence-

r-i, 519 add-nat-one-way-correspondence-p

-r, 675 add-nat-preserves-p-loadablep, 793 add-nat-preserves-proper-p-statep, 715 add-nat-preserves-r-equal, 766 add-nat-proper-r-statep, 559 add-nat-with-carry-one-way-corre

spondence-p-r, 668 spondence-r-i, 519 add-nat-with-carry-preserves-p-

loadablep, 788 add-nat-with-carry-preserves-pr oper-p-statep, 709

add-nat-with-carry-preserves-r-eq

ual, 753 add-nat-with-carry-proper-r-statep, 559 add1-add1-plus-length-length-di fference-length-add1, 539 add1-addr, 49, 52, 54, 274, 276, 297, 525, 590, 591

add1-adp, 48

add1-i-pc, 54–76, 79–107

add1-i-pcp, 54–65, 67–76, 79–100,

102–107 add1-int-one-way-correspondence

-p-r, 674 -r-i, 516

add1-int-preserves-p-loadablep, 792 add1-int-preserves-proper-p-statep, 714 add1-int-preserves-r-equal, 763 add1-int-proper-r-statep, 558 add1-nat-one-way-correspondence

-p-r, 667 -r-i, 520

add1-nat-preserves-p-loadablep, 787 add1-nat-preserves-proper-p-statep,

708 add1-nat-preserves-r-equal, 752 add1-nat-proper-r-statep, 559 add1-p-pc, 590, 592–620 add1-r-pc, 274, 278–288, 290, 291,

293–296, 299–318, 320–330 add1-r-pcp, 274, 275, 277–287, 290,

291, 293–296, 299–314, 316– 318, 320–329, 741, 784

add1-r-pcp-on-pop-call-state, 784 add2-i-pc, 54, 58, 67, 76–79, 81, 83,

101, 106 add2-i-pcp, 54, 58, 66, 76–79, 81,

83, 101, 105 add4-plus-difference-difference, 532 addp-add-adp-untag-r->i pc, 361 addp-add-adp-untag-r->i pc-0, 369 addr-to-v, 27, 28, 148, 201, 202 addressp, 48, 52, 54, 58, 60, 61, 780 adp-name, 5, 6, 25, 26, 48, 52, 144–

146, 151, 152, 154, 160, 161, 165, 166, 199, 204, 205, 222, 269, 344, 345, 352, 353, 356– 362, 500, 501, 505, 506, 525, 528, 531, 540, 544, 545, 547– 549, 553, 557, 563

adp-name-add-adp, 144 adp-name-cons, 144 adp-name-sub-adp, 144 adp-name-untag-r->i pc, 360 adp-offset, 6, 26, 48, 144, 146, 151,

152, 154, 160, 161, 163–166, 181, 199, 222, 246, 269, 344, 345, 352, 353, 355, 357, 359, 361, 362, 499, 500, 505, 506, 513, 514, 517, 528, 530, 534, 536, 538, 540, 541, 543–545, 563, 884

adp-offset-add-adp, 144 adp-offset-cons, 144 adp-offset-sub-adp, 144 adpp, 48, 53, 143, 199–204, 271, 343–

345, 361, 368, 369, 499, 500, 502, 503, 505–507, 511, 517, 529–533, 540, 543, 555, 557, 563, 589, 640, 706, 884

adpp-add-adp-hack, 884 adpp-backchainer, 500 adpp-deposit-adp, 368 adpp-deposit-adp-generalized, 543 adpp-deposit-lst, 543 adpp-implies-lessp-exp-2-word-si

ze, 507 adpp-implies-numberp-adp-offset, 530 adpp-prelude, 529 adpp-put-assoc, 368 adpp-sub-adp, 530 adpp-sub-adp-generalize, 543 all-but-last, 51, 219, 659–662, 693 all-but-last-append, 661 all-but-last-cdr-p->r ctrl-st

k, 693 all-but-last-cdr-p->r temp-st

k, 662 all-but-last-put, 662 all-find-labelp, 589, 629, 722 all-find-labelp-implies-find-la

belp-get, 722 all-i-usr-data-objectps, 54, 247, 588 all-litatoms, 635, 636, 723, 724 all-litatoms-formal-vars, 723 all-litatoms-formal-vars-genera

lized, 723 all-litatoms-implies-properp, 724 all-names-definedp, 846 all-names-definedp-cdr, 846 all-names-definedp-reflexive, 846 all-p-objectps, 590, 637, 696, 702,

704, 723, 724, 738, 847 all-p-objectps-append, 723 all-p-objectps-first-n, 724 all-p-objectps-implies-all-r-ob

jectps, 738 all-p-objectps-implies-all-r-us

r-data-objectps, 847 all-p-objectps-implies-p-objectp, 702 all-p-objectps-put, 704 all-p-objectps-rev, 723 all-r-objectps, 271, 275, 530, 531,

534, 536, 546, 738, 776, 784 all-r-objectps-append, 531 all-r-objectps-implies-r-objectp

-get, 530 all-r-objectps-on-pop-call-state, 783 all-r-objectps-strip-cadrs-rev, 531 all-r-usr-data-objectps, 272, 273, 502,

551, 555, 588, 848 all-r-usr-data-objectps-cdr-ass

oc, 502 all-r-usr-data-objectps-implies

-all-i-usr-data-objectps, 588 all-r-usr-data-objectps-put, 555 all-zero-bitvp, 51, 99, 196, 197, 207,

270, 299 all-zero-bitvp-not-v-nzerop-bitv

-to-v, 196 all-zero-bitvp-xor-bitv, 197 alu-thm bitv-bv-and, 117 alu-thm bitv-bv-asr, 118 alu-thm bitv-bv-lsr, 118 alu-thm bitv-bv-move-15, 117 alu-thm bitv-bv-not, 117 alu-thm bitv-bv-or, 118 alu-thm bitv-bv-ror, 119 alu-thm bitv-bv-xor, 118 alu-thm bitv-c-and, 117 alu-thm bitv-c-asr, 118 alu-thm bitv-c-lsr, 118 alu-thm bitv-c-move-15, 117 alu-thm bitv-c-not, 117 alu-thm bitv-c-or, 118 alu-thm bitv-c-ror, 119 alu-thm bitv-c-xor, 118 alu-thm bitv-zb-move-15, 194 alu-thm bitv-zb-sub, 216 alu-thm bitv-zb-xor, 209 alu-thm nat-bv-add, 123 alu-thm nat-bv-addc, 124 alu-thm nat-bv-decr, 123 alu-thm nat-bv-incr, 124 alu-thm nat-bv-lsr, 120 alu-thm nat-bv-sub, 120 alu-thm nat-bv-subb, 121 alu-thm nat-c-add, 123 alu-thm nat-c-addc, 124 alu-thm nat-c-decr, 123 alu-thm nat-c-incr, 124 alu-thm nat-c-lsr, 120 alu-thm nat-c-sub, 120 alu-thm nat-c-subb, 121 alu-thm tc-bv-add, 134 alu-thm tc-bv-add-lemma1, 133 alu-thm tc-bv-add-lemma2, 133 alu-thm tc-bv-addc, 137 alu-thm tc-bv-addc-lemma1, 134 alu-thm tc-bv-addc-lemma2, 134 alu-thm tc-bv-addc-lemma3, 136 alu-thm tc-bv-addc-lemma3-kille

r1, 135 r2, 135 r3, 135

alu-thm tc-bv-addc-lemma3-lemm a1, 135 a2, 135

alu-thm tc-bv-addc-lemma4, 136 alu-thm tc-bv-addc-lemma4-lemm

a1, 136 alu-thm tc-bv-asr, 125 alu-thm tc-bv-decr, 130 alu-thm tc-bv-decr-lemma1, 130 alu-thm tc-bv-decr-lemma2, 130 alu-thm tc-bv-incr, 140 alu-thm tc-bv-incr-lemma1, 140 alu-thm tc-bv-incr-lemma2, 140 alu-thm tc-bv-neg, 133 alu-thm tc-bv-neg-lemma1, 131 alu-thm tc-bv-neg-lemma2, 131 alu-thm tc-bv-neg-lemma3, 131 alu-thm tc-bv-neg-lemma4, 132 alu-thm tc-bv-neg-lemma5, 132 alu-thm tc-bv-neg-lemma6, 132 alu-thm tc-bv-sub, 127 alu-thm tc-bv-sub-lemma, 126 alu-thm tc-bv-sub-lemma2, 126 alu-thm tc-bv-subb, 129 alu-thm tc-bv-subb-lemma1, 128 alu-thm tc-bv-subb-lemma2, 128 alu-thm tc-bv-subb-lemma2-lemm

a1, 128 alu-thm tc-v-addc, 139 alu-thm tc-v-addc-lemma1, 137 alu-thm tc-v-addc-lemma2, 137 alu-thm tc-v-addc-lemma3, 138 alu-thm tc-v-addc-lemma4, 138 alu-thm tc-v-addc-lemma5, 138 alu-thm tc-v-addc-lemma6, 138 alu-thm tc-v-addc-lemma7, 139 alu-thm tc-v-addc-lemma8, 139 alu-thm tc-v-sub, 127 alu-thm tc-v-subb, 129 and-bit, 50, 51 and-bitv, 51, 64, 218, 325, 617, 717 and-bitv-one-way-correspondence

-p-r, 676 -r-i, 522

and-bitv-preserves-p-loadablep, 794 and-bitv-preserves-proper-p-statep, 718 and-bitv-preserves-r-equal, 769 and-bitv-proper-r-statep, 561 and-bool, 49, 65, 329, 619, 719 and-bool-one-way-correspondence

-p-r, 678 -r-i, 524

and-bool-preserves-p-loadablep, 795 and-bool-preserves-proper-p-statep,

719 and-bool-preserves-r-equal, 771 and-bool-proper-r-statep, 561 append-nil, 39 append-nil{special}, 685 append-right-id, 533 area-name, 6, 23, 52, 66, 72–74, 87,

93, 97, 274, 276, 303, 360, 367, 510, 590, 600, 605, 637, 701

area-type-specification, 35 assoc-append, 150 assoc-cdrp, 25, 26, 204, 205 assoc-cdrp-link-table-for-label

s-f, 205 s-t, 204

assoc-cstk-p->r sys-data-seg

ment, 649 assoc-deposit-adp, 553 assoc-deposit-lst, 545 assoc-empty-temp-stk-addr-p-> r sys-data-segment, 650 assoc-full-ctrl-stk-addr-p->r sys-data-segment, 649 assoc-full-temp-stk-addr-p->r sys-data-segment, 649

assoc-icompile, 358

assoc-link-table-for-labels, 191 assoc-link-table-for-prog-label

s, 191 assoc-link-table-for-segment, 151 assoc-of-append, 352 assoc-put-assoc, 227 assoc-put-assoc-1, 657 assoc-put-assoc-2, 660 assoc-put-assoc{gen}, 367 assoc-tstk, 546 assoc-tstk-p->r sys-data-seg

ment, 649

b-if, 38, 182 b-if-is-if, 182 backchainer-trick, 172 base-address, 25–27, 36, 203–206, 241,

242 bindings, 6, 7, 22, 590, 592, 597,

636, 640, 642, 643, 653–655, 680–682, 691, 728

bindings-p-frame, 640

bit-vectorp, 50, 53, 143, 196–198, 217–220, 270, 343, 503, 589, 639, 706, 717, 718

bit-vectorp-and-bitv, 717

bit-vectorp-append-singleton, 198 bit-vectorp-lsh-bitv, 718 bit-vectorp-not-bitv, 717 bit-vectorp-or-bitv, 717 bit-vectorp-rsh-bitv, 718 bit-vectorp-v-to-bitv, 198 bit-vectorp-v-to-bitv-hint, 198 bit-vectorp-v-to-bitv-lemma, 198 bit-vectorp-v-to-bitv-link-data

-word, 198 bit-vectorp-xor-bitv, 717 bitn, 5, 118, 119, 169–171 bitn-compl, 170 bitn-cons, 171 bitn-exp-2-sub1-word-size, 171 bitn-nat-to-v-0, 170 bitn-of-negatives-is-t, 171 bitn-of-negatives-is-t-lemma, 171 bitn-of-negatives-is-t-lemma-hyp, 171 bitn-of-positive-is-f, 169 bitp, 50, 198 bitv-to-v, 26, 27, 148, 174, 196, 198,

208, 217–220 bitv-to-v-inverts-v-to-bitv, 208 bitv-to-v-xor-bitv, 208 bitv-to-v-xor-xxx-is-v-xor-link

-word, 208 bool, 49, 55, 62, 63, 75, 88, 89, 94,

95, 99–101, 107, 283, 284, 297–299, 302, 303, 306, 307, 310, 312, 313, 315, 316, 319, 320, 322, 323, 511, 605, 607, 609, 610, 612–615, 713

bool-to-logical, 34, 158, 192 bool-to-logical-non-f, 192 bool-to-nat, 49, 62, 63, 94, 95, 306,

307, 309, 310, 315, 319, 320, 515, 607, 609, 612, 613

bool-to-v, 26, 27, 148, 198 booleanp, 49, 53, 143, 145, 147, 198,

270, 343, 346, 503, 511, 526, 589, 639, 706, 719

booleanp-and-bool, 719 booleanp-not-bool, 719 booleanp-or-bool, 719 booleanp-subtypes, 526 booleanp-untag-bool, 511 boolp, 117–121, 123–125, 127, 129–

131, 133, 134, 137, 139, 140, 158, 182, 194, 209, 216

boolp-bool-to-logical, 158 boolp-truep, 119 boot-code, 33, 34, 153, 154, 244–

246, 856 bv, 38, 42, 117–121, 123–125, 127,

129, 131, 133, 134, 137, 140, 183, 184

bv2p, 119, 124 bvp, 42–45, 117–121, 123–134, 136–

140, 169, 170, 172, 174, 175, 182, 194, 197, 198, 207–209, 216–218, 221

bvp-bitv-to-v, 174 bvp-firstn-v-adder, 44 bvp-link-data-word, 207 bvp-link-word, 175 bvp-listp, 42–47, 268, 856 bvp-listp-append, 856 bvp-listp-boot-code, 856 bvp-listp-if, 45 bvp-listp-link-area, 856 bvp-listp-link-segment, 856 bvp-listp-update-nth, 42 bvp-listp-update-v-nth, 42 bvp-v-dec, 44 bvp-v-inc, 44

c, 38, 117–121, 123, 124, 183, 184 c-set, 38, 183, 184 call-one-way-correspondence-p-r, 688 call-one-way-correspondence-r-i, 545 call-preserves-p-loadablep, 798 call-preserves-proper-p-statep, 725 call-preserves-r-equal, 782 call-proper-r-statep, 564 car-append, 359 car-append{general}, 684 car-assoc, 191 car-cdr-elim-accelerator, 246 car-cdr-n-is-get, 244 car-first-n, 351 car-p->r ctrl-stk, 655 car-p->r temp-stk, 655 car-tag, 347 carry, 120, 121, 124, 129, 130, 137,

140 cdar-link-table-for-segment, 199 cddr-bool, 511 cddr-r->i pc, 368 cddr-tag, 227 cdr-append, 219 cdr-bitv-to-v, 219 cdr-cdr-n, 244 cdr-n, 243, 244, 358, 359, 530, 659–

661, 663, 666, 667, 669, 670, 684, 690, 693, 694, 710

cdr-n-append, 358 cdr-n-append-1, 684 cdr-n-append-2, 667 cdr-n-append-pop2, 666 cdr-n-append-ret, 694 cdr-n-append{special}, 661 cdr-n-cdr, 663 cdr-n-length-icompile-program-b

ody-first-n, 359 cdr-n-nil, 659 cdr-n-plus, 358 cdr-n-plus-append, 670 cdr-n-plus-append-commuted, 670 cdr-n-plus-append-pop-call, 690 cdr-n-plus-sub1-append-commuted, 670 cdr-n-put, 669 cfp-in-correct-position, 692 clock, 340, 588, 851, 856 close-data-base-1, 4 close-data-base-2, 47 close-data-base-3, 269 close-data-base-4, 588 close-data-base-5, 850 close-data-base-6, 898 commutativity-of-and-bitv, 218 commutativity-of-or-bitv, 217 commutativity-of-plus-applicati

on, 545 commutativity-of-plus-hack, 222 commutativity-of-xor-bitv, 208 commutativity-of-xor-xxx, 208 compl-compl, 170 components-of-r-halt, 690 cons-adp-name-adp-offset, 199 consolidated-plausibility-argume

nt, 897

nt-lemma, 896 cstk-implies-not-zerop-segment-

length, 246 cstkp, 52, 53, 65, 273, 276, 534, 536, 540, 541, 552, 553 current-instruction, 36, 46, 154 current-instruction-i->m, 154

definedp, 47, 48, 52, 54, 145–147, 150–152, 160, 161, 163–168, 187, 191, 205, 213, 227, 243– 246, 269, 271, 273, 275, 280, 287, 295, 343–345, 355, 357, 358, 360, 362, 367, 500–505, 529, 530, 532, 534, 536–538, 540, 541, 543, 555, 564, 589, 626–629, 637, 640, 642–644, 650, 660, 664, 685, 695, 702– 704, 706, 711, 722–724, 743, 746, 750, 778–780, 782, 845, 846, 884, 897 definedp-cstk-p->r sys-data-

segment, 650 definedp-deposit-adp, 884 definedp-icompile, 360 definedp-p-data-segment-implies

-listp, 703

-listp-generalized, 703 definedp-put-assoc, 168 definedp-put-assoc{special}, 543 definedp-tstk-p->r sys-data-

segment, 650 definiens, 48, 52, 191, 273, 280, 287,

290, 291, 295, 368, 500, 501, 553, 590, 664 definition, 5, 23, 48, 66, 72–74, 97,

269, 273–276, 290, 358, 360, 361, 367, 509, 510, 553, 590, 591, 627–629, 636 deposit, 49, 56–58, 60, 64, 65, 67–

72, 76–80, 85–90, 92, 93, 96, 97, 101–108, 271, 278– 282, 286–288, 291–293, 295, 301–305, 307–314, 316–318, 320–330, 534, 539, 597, 601, 606

deposit-adp, 48, 49, 368, 499, 506, 511, 531, 533, 540, 543, 553, 555, 884

deposit-adp-deposit-adp, 368 deposit-lst, 271, 276, 532, 533, 535,

537, 541, 543–545, 563, 685, 778, 780–782

deposit-lst-append, 532 deposit-lst-equal-deposit-lst1, 778 deposit-lst-equivalence, 533 deposit-lst-put-assoc-append, 685 deposit-lst-put-assoc-append-hi

nt, 684, 685 deposit-lst1, 777–779, 781, 782 deposit-lst1-append, 777 deposit-one-way-correspondence-

r-i, 514 deposit-one-way-correspondence-p

-r, 666 deposit-preserves-p-loadablep, 787 deposit-preserves-proper-p-statep, 708 deposit-preserves-r-equal, 752 deposit-proper-r-statep, 557 deposit-temp-stk-one-way-corresp

ondence-p-r, 669 ondence-r-i, 514

deposit-temp-stk-preserves-p-lo

adablep, 788 deposit-temp-stk-preserves-prope

r-p-statep, 710 deposit-temp-stk-preserves-r-eq

ual, 755 deposit-temp-stk-proper-r-statep, 558 diff-diff, 126 diff-plus-cancellation-hack2, 128 diff-plus-plus-plus-cancellatio

n, 133 diff-plus-sub1-hack1, 128 diff-plus-sub1-hack2, 128 difference-1, 169 difference-add1, 353 difference-add1-add1-x-2, 39 difference-add1-i-i, 548 difference-add1-plus-i-j-i, 548 difference-add1-x-x, 666 difference-add1{special}, 652 difference-add2-i-i, 548 difference-add2-plus-i-j-i, 548 difference-difference, 686 difference-difference-difference, 651 difference-difference-hack, 120 difference-difference-plus, 120 difference-elim-rewrite, 142 difference-p-ctrl-stk-size-folde

r, 691 difference-plus, 122 difference-plus-k-k-length, 538 difference-plus-plus-plus-cance

llation, 694 difference-plus-x-y-y, 681 difference-plus{special}, 653 difference-sub1, 668 difference-sub1-plus-etc, 778 difference-x-0, 355 difference-x-difference, 670 difference-x-sub1-x, 652 difference-x-sub2-x, 652 display-array, 242, 268 display-array-decomposition, 242 display-data-area, 242 display-data-segment, 242, 268 display-data-segment-decompositi

on, 242 display-fm9001-array, 36, 268 display-fm9001-data-area, 36 display-fm9001-data-segment, 36, 268,

898 display-fm9001-data-segment-m->

fm9001, 268 display-fm9001-data-segment1, 36, 268 display-m-data-segment, 242, 248, 268,

853 display-m-data-segment-inverts-i

->m, 247

->m-bridge, 853

div2-nat-one-way-correspondence -p-r, 676 -r-i, 522

div2-nat-preserves-p-loadablep, 794 div2-nat-preserves-proper-p-statep, 717 div2-nat-preserves-r-equal, 768 div2-nat-proper-r-statep, 560 dl, 6–8, 20, 368, 529, 548 dl-block, 20, 367

empty-stkp, 52, 56, 57, 59, 60, 63– 71, 76–80, 85–88, 90–93, 95– 100, 104–107, 273, 276–279, 283–292, 294–296, 300–314, 316–318, 320–330, 499, 517, 557, 744, 747–751, 754, 779, 781

empty-stkp-backchainer, 751 empty-stkp-deposit-adp, 499 eq-one-way-correspondence-p-r, 673 eq-one-way-correspondence-r-i, 512 eq-preserves-p-loadablep, 791 eq-preserves-proper-p-statep, 713 eq-preserves-r-equal, 761 eq-proper-r-statep, 557 equal-add-adp-cons-adp-name, 357 equal-addr-to-v, 201 equal-append, 168 equal-append-generalized, 197 equal-bitv-to-v, 198 equal-bool-to-v, 198 equal-difference-zero, 216 equal-i-psw-i-ins-step-run, 155 equal-i-psw-if-1, 155 equal-i-psw-if-2, 155 equal-i-word-size-if-1, 226 equal-i-word-size-if-2, 226 equal-if, 833 equal-if-if, 586 equal-int-to-v, 198 equal-ipc-to-v, 200 equal-label-to-v, 206 equal-length-0, 126 equal-lessp-rewriter, 550 equal-link-data-word, 207 equal-link-word, 208 equal-link-word-lemma1, 207 equal-link-word-lemma2, 207 equal-plus-cancellation1, 357 equal-plus-cancellation2, 358 equal-strip-cars-implies-equal-

lengths, 653 equal-sub-adp-cons-adp-name, 506 equal-sub1-difference, 743 equal-sub1-difference-0, 660 equal-subr-to-v, 204 equal-sys-addr-to-v, 202 equal-tag, 357 equal-tags, 638 equal-types-and-untags, 206 equal-untag-bool-f, 511 equal-untag-bool-t, 511 equal-v-to-bitv, 197 equal-v-to-nat-v-to-nat, 216 equality-stuffer, 344 errorp, 5, 371, 587, 588, 830, 831,

835, 849–852, 856, 871, 894– 898

exp, 21, 30, 32, 35, 38–47, 49, 50, 53, 88, 89, 94, 120–140, 146, 154, 158, 169–173, 194, 195, 200–204, 211, 216, 220, 221, 224, 225, 267, 268, 272, 319, 346, 504, 506, 507, 522, 528, 613, 637, 643, 711, 712, 716, 849 exp-2-at-least-2, 522 extract-cvnz, 32, 33 extract-mode, 32, 33 extract-move-bits, 31, 33 extract-op, 31, 33 extract-reg, 32, 33 extract-reg1, 32

fall-off-proofp, 635

fetch, 49, 54, 56–60, 63–72, 76, 80, 82, 84–93, 95–103, 105–108, 154, 271, 273, 276–278, 280– 282, 284–330, 593, 606, 878 fetch-adp, 48, 49, 345, 360, 367, 368,

502, 510, 512, 521, 528–530, 539, 547–549, 557

fetch-adp-add-adp-untag-r->i, 360 fetch-adp-add-adp-untag-r->i-

0, 367 fetch-adp-deposit-adp, 368 fetch-adp-postlude0, 547 fetch-adp-postlude1, 548 fetch-adp-postlude2, 548 fetch-adp-prelude-0, 529 fetch-adp-prelude-1, 529 fetch-adp-prelude1-even, 530 fetch-adp-prelude1-even-lemma, 530 fetch-adp-prelude1-odd, 530 fetch-adp-prelude1-odd-lemma, 530 fetch-adp-prelude2, 538 fetch-adp-prelude2-lemma, 538 fetch-n, 271, 276, 540, 541, 543, 545,

563, 684, 689, 776, 777, 785 fetch-n-p->r sys-data-segment

-call, 684

-generalized, 684 -generalized-hint, 683 -pop-call, 688

fetch-n-tstk-deposit-adp-cstk, 540 fetch-n-tstk-deposit-lst-cstk, 545 fetch-one-way-correspondence-p-

r, 673 fetch-one-way-correspondence-r-i, 513 fetch-preserves-p-loadablep, 791 fetch-preserves-proper-p-statep, 714 fetch-preserves-r-equal, 761 fetch-proper-r-statep, 557 fetch-temp-stk-one-way-correspo

ndence-p-r, 669 ndence-r-i, 514

fetch-temp-stk-preserves-p-load

ablep, 788 fetch-temp-stk-preserves-proper

-p-statep, 709 fetch-temp-stk-preserves-r-equa

l, 754 fetch-temp-stk-proper-r-statep, 558 find-containing-area-name, 25, 26, 199 find-containing-area-name-link-t able-for-segment, 199 find-containing-label-table, 26, 205 find-containing-label-table-base

-address, 205

-address-generalized, 205 find-label, 6, 23, 54, 151, 191, 204,

206, 346, 347, 351–355, 357, 359, 361, 362, 509, 510, 525, 528, 547, 549, 711 find-label-add-adp-1-icompile-p rogram-body, 353 find-label-append, 346 find-label-cdr-icompile-program, 361 find-label-failure-extends-to-c

dr, 351 find-label-generate-postlude, 357 find-label-generate-prelude, 355 find-label-generate-prelude1, 354 find-label-icode, 351 find-label-icode1, 351 find-label-icode12, 351 find-label-icompile-program-bod

y, 352

y-lemma1, 351 y-lemma2, 351 y-lemma3, 352

find-label-if, 347

find-label-jump *-lst, 347 find-label-postlude, 547 find-label-prelude, 528 find-labelp, 51, 52, 191, 204–206, 279,

283, 292, 293, 296, 346, 589, 627–629, 711, 722, 837

find-labelp-implies-listp-link-t able-for-labels, 206 find-labelp-is-find-label, 346 find-position-of-var, 7, 504, 653–655,

682 first-n, 244, 245, 351–353, 356–359,

532, 533, 535, 547, 590, 684, 687, 689, 690, 723, 724

first-n-length, 535 first-n-length-embedded, 245 first-n-length-properp, 547 first-n-opener-right-end, 532 firstn, 35, 38, 40, 41, 44, 172, 173 firstn-update-nth, 41 firstn-update-nth-plus, 41 fix-int, 126, 131 fix-small-integer, 50, 63, 89, 90, 95,

306, 307, 309, 310, 312, 515, 518, 607, 609

fix-small-natural, 49, 55, 62, 315, 322,

612, 615, 709 fm-state, 35 fm9001, 47, 851, 898 fm9001-alu-operation, 42 fm9001-clock, 856, 898 fm9001-m-owc, 851 fm9001-operand-a, 46 fm9001-operand-b, 44 fm9001-step, 47 formal-vars, 5, 7, 275, 276, 290, 361,

504, 529, 538–545, 590, 591, 636, 642, 644, 653–655, 682, 686–690, 723, 729

free-stk-size, 52, 67, 68, 101–104, 275, 278–283, 293, 321, 322, 749, 780

generate-postlude, 8, 20, 357, 361 generate-prelude, 7, 20, 355, 361,

504, 529, 538, 547–549 generate-prelude1, 7, 354, 360, 530 generate-prelude2, 7, 354, 360, 538 get, 6, 48, 142, 150, 152, 153, 157,

160, 162–164, 213, 241–244, 267, 274, 292, 353, 356–358, 360, 361, 367, 502, 505, 508, 527, 528, 530, 532–534, 538, 544, 589, 590, 592, 600, 635, 651–654, 659, 681, 682, 692, 702, 709, 721, 722, 742, 747, 748

get-0, 508 get-0-cons, 157 get-1, 652 get-2, 652 get-2n-jump *-lst, 528 get-add1-2n-jump *-lst, 528 get-add1-cons, 157 get-append, 530 get-append-1, 150 get-append-2, 150 get-append-2-add1, 162 get-append-2-sub1, 162 get-append-3, 150 get-append-3-add1, 162 get-append-3-sub1, 163 get-append-bridge, 538 get-areas, 241, 243, 246 get-areas-link-mem, 246 get-array, 241, 242, 244, 245 get-array-link-mem, 244 get-array-link-mem-instance, 245 get-car-cdr-n, 358 get-cdr-p->r ctrl-stk-1, 654 get-cdr-p->r ctrl-stk-2, 681 get-cdr-p->r temp-stk, 651 get-difference-sub1-length-rev, 533 get-equal-car-cdr-n, 659 get-find-position-of-var, 653 get-find-position-of-var-bindin

gs, 682 get-find-position-of-var-genera

lized, 682 get-link-area, 150 get-link-table-entry-link-segme

nt, 152

nt-add1, 160 nt-cstk, 163 nt-cstk-add1, 163 nt-cstk-sub1, 164 nt-generalized, 243 nt-sub1, 160 nt-tstk, 163 nt-tstk-add1, 164 nt-tstk-sub1, 164

get-nlistp, 367 get-non-numberp, 681 get-past-boot-code, 153 get-past-boot-code-add1, 153 get-past-boot-code-sub1, 153 get-put, 367 get-put{special}, 742 get-rev, 532 get-strip-cdrs, 681

hint-prelude1, 533, 534 hint-prelude2, 539

i, 116, 226, 267, 370, 504–514, 516, 517, 519–528, 545, 546, 549, 586–588, 851

i*, 370, 372–374, 529, 535, 536, 541,

542 i*-done, 374 i*-opener, 371 i*-plus, 529 i*-plus-prelude1-prelude2, 529 i*-prelude1, 536 i*-prelude1-generalized, 534 i*-prelude2, 541 i*-prelude2-generalized, 540 i*-prelude2-hyp-5-reliever, 543 i->m, 34, 35, 175, 185–197, 209–

226, 247, 851, 853, 856, 895, 896, 898

i-0, 586 i-add <c> x x{n}-okp, 55, 108, 214,

236, 261, 375 i-add <c> x x{n}-step, 55, 112, 214,

236, 261, 436 i-add <tsp> <tsp>{n}

-okp, 56, 108, 214, 236, 261,

376 -step, 56, 57, 112, 214, 236, 262,

438 i-add <tsp> <tsp>{v}

-okp, 56, 108, 221, 239, 265,

376 -step, 56, 112, 221, 239, 265,

437 i-add <tsp>{a} x{n}-o

kp, 57, 108, 196, 233, 257, 377 i-add <tsp>{a} x{n}-step, 57, 112, 196, 233, 257, 438

i-add <tsp>{i} x{i}-o

kp, 59, 108, 185, 227, 248, 379 i-add <tsp>{i} x{i}-step, 59, 112, 185, 227, 248, 441

i-add <tsp>{n} x{n}-o

kp, 60, 108, 212, 235, 260, 380 i-add <tsp>{n} x{n}-step, 60, 112, 212, 235, 260, 441 i-add pc x{n}-okp, 60, 108, 223, 240,

266, 380 i-add pc x{n}-step, 60, 112, 223, 240,

266, 442 i-add tsp *{n}-okp, 58, 108, 196, 233,

257, 378 i-add tsp *{n}-step, 58, 112, 196, 233,

257, 439 i-add tsp x{n}-okp, 58, 108, 197, 233,

257, 378 i-add tsp x{n}-step, 58, 112, 197, 233,

257, 440 i-add x x{n}-okp, 61, 108, 223, 240,

266, 381 i-add x x{n}-step, 61, 112, 223, 240,

266, 443 i-add x{n} csp-okp, 61, 108, 187, 229,

250, 382 i-add x{n} csp-step, 62, 112, 187, 229,

250, 443 i-addc <c> x{n} y{n}

-okp, 62, 108, 212, 235, 260,

383 -step, 62, 112, 212, 235, 260,

444 i-addc <v> x{i} y{i}

-okp, 63, 108, 223, 240, 267,

383 -step, 63, 113, 223, 240, 267,

445 i-and <tsp>{b} x{b}-o

kp, 64, 109, 222, 239, 265, 385 i-and <tsp>{b} x{b}-step, 64, 113,

222, 239, 266, 446 i-and <tsp>{v} x{v}-o

kp, 63, 108, 218, 238, 264, 384 i-and <tsp>{v} x{v}-step, 63, 64,

113, 218, 238, 264, 446 i-asr <c> <tsp> <t

sp>{b}-okp, 65, 109, 211, 235,

260, 385 sp>{b}-step, 65, 113, 211, 235,

260, 447 i-c-flg, 34, 53, 55–64, 66–87, 89–107,

145, 147, 158 i-cfp, 34, 53, 55–107, 145, 146, 151,

158, 246 i-cpop cfp-okp, 65, 109, 186, 228,

249, 386 i-cpop cfp-step, 65, 113, 186, 228,

250, 448 i-cpop pc-okp, 66, 109, 191, 231, 253,

387 i-cpop pc-step, 66, 113, 191, 231, 254,

449 i-cpush <tsp>+-okp, 67, 109, 186,

228, 249, 388 i-cpush <tsp>+-step, 67, 113, 186,

228, 249, 450 i-cpush *-okp, 66, 109, 185, 227, 248,

387 i-cpush *-step, 67, 113, 185, 227, 248,

449 i-cpush cfp-okp, 68, 109, 185, 240,

248, 389 i-cpush cfp-step, 68, 113, 185, 240,

248, 451 i-csp, 34, 53, 55–107, 145, 146, 151,

158 i-current-instruction, 54, 116, 156,

175, 185–197, 209–225, 248– 267, 370, 372

i-current-instruction-packer, 225 i-current-instruction-packer-le

mma, 225 i-decr <tsp> <tsp>{i}

-okp, 68, 109, 211, 235, 259,

390 -step, 68, 113, 211, 235, 259,

451 i-decr <tsp> <tsp>{n}

-okp, 69, 109, 214, 236, 261,

390 -step, 69, 113, 214, 236, 261,

452 i-halt, 55, 116, 147, 225, 241, 370 i-id-on-non-run, 370 i-if, 586 i-incr <tsp> <tsp>{i}

-okp, 69, 109, 210, 234, 259,

391 -step, 70, 113, 210, 234, 259,

453 i-incr <tsp> <tsp>{n}

-okp, 70, 109, 212, 236, 260,

392 -step, 70, 113, 212, 236, 260,

454 i-incr y y{n}-okp, 71, 109, 212, 236,

261, 392 i-incr y y{n}-step, 71, 113, 212, 236,

261, 454 i-ins-okp, 108, 116, 156, 225, 240, 267, 370, 373–435

i-ins-okp-opener, 374

i-ins-step, 112, 116, 155, 225, 226,

240, 267, 370, 373, 436–498 i-ins-step-opener, 435 i-int-to-nat-okp, 71, 109, 213, 236,

261, 393 i-int-to-nat-step, 71, 113, 213, 236,

261, 455 i-jump-n x-okp, 72, 109, 192, 231,

254, 394 i-jump-n x-step, 72, 113, 192, 231,

254, 456 i-jump-nn x-okp, 72, 109, 192, 232,

255, 395 i-jump-nn x-step, 73, 113, 193, 232,

255, 457 i-jump-nz x-okp, 73, 109, 193, 232,

255, 395 i-jump-nz x-step, 73, 113, 193, 232,

255, 457 i-jump-z x-okp, 74, 109, 193, 232,

255, 396 i-jump-z x-step, 74, 113, 193, 232,

255, 458 i-jump *-okp, 74, 109, 191, 231, 253,

397 i-jump *-step, 74, 113, 191, 231, 253,

459 i-jump x{subr}-okp, 75, 109, 192, 231,

254, 397 i-jump x{subr}-step, 75, 113, 192,

231, 254, 459 i-link-tables, 25, 34, 35, 55, 149, 154,

157, 207, 208, 242, 243, 247– 267, 853, 856, 896, 898

i-link-tables-i, 267 i-link-tables-i-state, 157 i-link-tables-ins-okp-step, 267 i-link-tables-r->i, 856 i-link-tables-step, 267 i-link-tables-step-add <c>

x x{n}, 261 i-link-tables-step-add <tsp>

<tsp>{n}, 261 <tsp>{v}, 265 {a} x{n}, 256 {i} x{i}, 248 {n} x{n}, 260

i-link-tables-step-add pc x{n}, 266 i-link-tables-step-add tsp *{n}, 257 i-link-tables-step-add tsp x{n}, 257 i-link-tables-step-add x x{n}, 266 i-link-tables-step-add x{n}

csp, 250 i-link-tables-step-addc <c>

x{n} y{n}, 260 i-link-tables-step-addc <v>

x{i} y{i}, 266 i-link-tables-step-and <tsp>

{b} x{b}, 265 {v} x{v}, 264 i-link-tables-step-asr <c>

<tsp> <tsp>{b}, 260 i-link-tables-step-cpop cfp, 249 i-link-tables-step-cpop pc, 253 i-link-tables-step-cpush <tsp

>+, 249 i-link-tables-step-cpush *, 248 i-link-tables-step-cpush cfp, 248 i-link-tables-step-decr <tsp

> <tsp>{i}, 259

> <tsp>{n}, 261

i-link-tables-step-incr <tsp > <tsp>{i}, 259

> <tsp>{n}, 260

i-link-tables-step-incr y y{n}, 260 i-link-tables-step-int-to-nat, 261 i-link-tables-step-jump-n x, 254 i-link-tables-step-jump-nn x, 254 i-link-tables-step-jump-nz x, 255 i-link-tables-step-jump-z x, 255 i-link-tables-step-jump *, 253 i-link-tables-step-jump x{subr}, 254 i-link-tables-step-lsr <c>

x x{n}, 262 i-link-tables-step-lsr <tsp>

<tsp>{v}, 265 i-link-tables-step-move-c <t

sp> *, 263 i-link-tables-step-move-n x *, 258 i-link-tables-step-move-v <t

sp> *, 264 i-link-tables-step-move-z <t

sp> *, 258 i-link-tables-step-move <tsp

> *, 258 i-link-tables-step-move <x{a}

> <tsp>, 254 i-link-tables-step-move <x{s}

> <tsp>, 254 i-link-tables-step-move cfp c

sp, 248 i-link-tables-step-move csp c

fp, 249 i-link-tables-step-move x <

x{s}>, 250

i-link-tables-step-move x *, 250 i-link-tables-step-move x tsp, 249 i-link-tables-step-move x x, 248 i-link-tables-step-move y <

y{s}>, 250 i-link-tables-step-move y *, 250 i-link-tables-step-move y tsp, 251 i-link-tables-step-neg <tsp>

<tsp>{i}, 259 i-link-tables-step-not <tsp>

<tsp>{v}, 264 i-link-tables-step-or <tsp>

{b} x{b}, 265

{v} x{v}, 264

i-link-tables-step-sub <c> <tsp>{a} x{a}, 263

<tsp>{n} x{n}, 262

i-link-tables-step-sub <nv>

<tsp>{i} x{i}, 262 i-link-tables-step-sub <tsp>

{a} x{n}, 257

{i} x{i}, 259
{n} x{n}, 262
{s} x{s}, 263

i-link-tables-step-sub <z>

x{s} y{s}, 263 i-link-tables-step-sub x{s}

y{n}, 257 i-link-tables-step-subb <c>

x{n} y{n}, 262 i-link-tables-step-subb <v>

x{i} y{i}, 267 i-link-tables-step-tpop <c>

x, 255 i-link-tables-step-tpop <x{a}

>, 253 i-link-tables-step-tpop <x{s}

>, 253 i-link-tables-step-tpop pc, 255 i-link-tables-step-tpop x, 252 i-link-tables-step-tpop y, 252 i-link-tables-step-tpop{b} <

z> y, 256 i-link-tables-step-tpop{i} <

zn> y, 256 i-link-tables-step-tpop{n} <

z> y, 256 i-link-tables-step-tpop{v} <

z> y, 256 i-link-tables-step-tpush <x{a}

>, 252 i-link-tables-step-tpush <x{s}

>, 252 i-link-tables-step-tpush *, 252 i-link-tables-step-tpush csp, 251 i-link-tables-step-tpush tsp, 251 i-link-tables-step-tpush x, 251 i-link-tables-step-xor <tsp>

<tsp>, 258

{b} *{b}, 266
{b} x{b}, 266
{v} x{v}, 264

i-link-tables-step-xor <z> <tsp> x, 258 i-loadable-r->i, 856 i-loadablep, 53, 54, 200–202, 204, 206–208, 246, 856 i-loadablep-and-cstk-implies-not -zerop-i-word-size, 246 i-lsr <c> x x{n}-okp, 75, 109, 214, 237, 262, 398 i-lsr <c> x x{n}-step, 75, 113, 214, 237, 262, 460

i-lsr <tsp> <tsp>{v}

-okp, 76, 109, 219, 239, 265,

399 -step, 76, 114, 220, 239, 265,

461 i-m-one-way-correspondence, 226 i-m-one-way-correspondence-ins-

okp-step, 225 i-m-one-way-correspondence-step, 225

-add <c> x x{n}, 214

-add <tsp> <tsp>{n}, 214
-add <tsp> <tsp>{v}, 221
-add <tsp>{a} x{n}, 196
-add <tsp>{i} x{i}, 185

-add <tsp>{n} x{n}, 212 -add pc x{n}, 223 -add tsp *{n}, 196 -add tsp x{n}, 197 -add x x{n}, 223 -add x{n} csp, 187 -addc <c> x{n} y{n}, 212 -addc <v> x{i} y{i}, 223 -and <tsp>{b} x{b}, 221 -and <tsp>{v} x{v}, 218 -asr <c> <tsp> <tsp>{b}, 211 -cpop cfp, 186 -cpop pc, 191 -cpush <tsp>+, 186 -cpush *, 185 -cpush cfp, 185 -decr <tsp> <tsp>{i}, 211 -decr <tsp> <tsp>{n}, 214 -incr <tsp> <tsp>{i}, 210 -incr <tsp> <tsp>{n}, 212 -incr y y{n}, 212 -int-to-nat, 213 -jump-n x, 192 -jump-nn x, 192 -jump-nz x, 193 -jump-z x, 193 -jump *, 191 -jump x{subr}, 192 -lsr <c> x x{n}, 214 -lsr <tsp> <tsp>{v}, 219 -move-c <tsp> *, 217 -move-n x *, 210 -move-v <tsp> *, 217 -move-z <tsp> *, 210 -move <tsp> *, 210 -move <x{a}> <tsp>, 192 -move <x{s}> <tsp>, 191 -move cfp csp, 185 -move csp cfp, 186 -move x <x{s}>, 187 -move x *, 187 -move x tsp, 186 -move x x, 175 -move y <y{s}>, 188 -move y *, 187 -move y tsp, 188 -neg <tsp> <tsp>{i}, 211 -not <tsp> <tsp>{v}, 218 -or <tsp>{b} x{b}, 221 -or <tsp>{v} x{v}, 217 -sub <c> <tsp>{a} x{a}, 215 -sub <c> <tsp>{n} x{n}, 215 -sub <nv> <tsp>{i} x{i}, 225 -sub <tsp>{a} x{n}, 197 -sub <tsp>{i} x{i}, 211 -sub <tsp>{n} x{n}, 215 -sub <tsp>{s} x{s}, 216 -sub <z> x{s} y{s}, 216 -sub x{s} y{n}, 197 -subb <c> x{n} y{n}, 215 -subb <v> x{i} y{i}, 224 -tpop <c> x, 193 -tpop <x{a}>, 190 -tpop <x{s}>, 190 -tpop pc, 193 -tpop x, 190 -tpop y, 190 -tpop{b} <z> y, 195 -tpop{i} <zn> y, 195 -tpop{n} <z> y, 194 -tpop{v} <z> y, 196 -tpush <x{a}>, 189 -tpush <x{s}>, 189 -tpush *, 189 -tpush csp, 188 -tpush tsp, 188 -tpush x, 189 -xor <tsp> <tsp>, 209 -xor <tsp>{b} *{b}, 222 -xor <tsp>{b} x{b}, 222 -xor <tsp>{v} x{v}, 219 -xor <z> <tsp> x, 209

i-m-owc, 851

i-move-c <tsp> *-okp, 76, 109, 217, 238, 263, 399 i-move-c <tsp> *-step, 76, 114, 217, 238, 264, 462 i-move-n x *-okp, 78, 110, 210, 234,

258, 402 i-move-n x *-step, 78, 114, 210, 234,

258, 464 i-move-v <tsp> *-okp, 77, 110, 217,

238, 264, 400 i-move-v <tsp> *-step, 77, 114, 217,

238, 264, 462 i-move-z <tsp> *-okp, 78, 110, 210,

234, 258, 401 i-move-z <tsp> *-step, 78, 114, 210,

234, 258, 463 i-move <tsp> *-okp, 79, 110, 210,

234, 259, 402 i-move <tsp> *-step, 79, 114, 210,

234, 259, 465 i-move <x{a}> <tsp>

-okp, 79, 110, 192, 231, 254,

403 -step, 79, 114, 192, 231, 254,

465 i-move <x{s}> <tsp>

-okp, 80, 110, 192, 231, 254,

404 -step, 80, 114, 192, 231, 254,

466 i-move cfp csp-okp, 80, 110, 185, 227,

249, 404 i-move cfp csp-step, 80, 114, 186, 227,

249, 467 i-move csp cfp-okp, 81, 110, 186, 228,

249, 405 i-move csp cfp-step, 81, 114, 186, 228,

249, 467 i-move x <x{s}>-okp, 82, 110, 188,

229, 250, 407 i-move x <x{s}>-step, 82, 114, 188,

229, 250, 469 i-move x *-okp, 81, 110, 187, 228,

250, 406 i-move x *-step, 81, 114, 187, 228,

250, 468 i-move x tsp-okp, 82, 110, 186, 228,

249, 407 i-move x tsp-step, 82, 114, 186, 228,

249, 470 i-move x x-okp, 83, 110, 175, 227,

248, 408 i-move x x-step, 83, 114, 175, 227,

248, 470 i-move y <y{s}>-okp, 83, 84, 110, 188, 229, 251, 409 i-move y <y{s}>-step, 84, 114, 188, 229, 251, 472 i-move y *-okp, 83, 110, 187, 228,

250, 409 i-move y *-step, 83, 114, 187, 228,

250, 471 i-move y tsp-okp, 84, 110, 188, 229,

251, 410 i-move y tsp-step, 84, 114, 188, 229,

251, 473 i-n-flg, 34, 54–107, 145, 147, 158 i-neg <tsp> <tsp>{i}

-okp, 84, 110, 211, 235, 259,

411 -step, 85, 114, 211, 235, 260,

473 i-nextword, 54, 58, 66, 67, 74, 76–

79, 81, 83, 101, 105, 106 i-not <tsp> <tsp>{v}

-okp, 85, 110, 218, 238, 264,

411 -step, 85, 114, 218, 238, 264,

474 i-objectp, 52, 53, 66, 76–79, 82, 84,

95, 98, 101, 102, 104, 168, 207, 208, 246, 501, 503, 505, 511, 512, 522

i-objectp-bool, 511

i-objectp-cons-sys-addr, 505

i-objectp-nat-0, 522 i-objectp-nat-1, 522 i-objectp-quote-bool, 512 i-objectp-tag, 503 i-objectp-type, 53–66, 68–76, 79, 80,

82, 84–97, 99, 100, 102, 105, 106, 142, 143, 207, 208 i-objectp-type-simplifier, 142 i-or <tsp>{b} x{b}-okp, 87, 110, 221,

239, 265, 413 i-or <tsp>{b} x{b}-step, 87, 114, 221,

239, 265, 475 i-or <tsp>{v} x{v}-okp, 86, 110, 217,

238, 264, 412 i-or <tsp>{v} x{v}-step, 86, 114, 217,

238, 264, 475 i-pc, 34, 53–55, 60, 145, 146, 154,

158, 222 i-plus, 587 i-prog-segment, 25, 34, 53–108, 143,

145, 146, 149, 154, 157, 181, 200–204, 206, 222, 503, 896

i-prog-segment-p->r->i, 896 i-psw, 116, 147, 155, 156, 175, 185–

197, 209–219, 221–240, 248– 267, 370, 851, 852

i-psw-i-halt, 147 i-psw-i-run, 226 i-psw-i-step-run, 156 i-psw-r->i, 852 i-state, 23, 24, 55–108, 157, 371–

499, 501, 535–537, 541–543 i-state-okp, 53, 116, 145, 156, 175,

185–197, 209–219, 221–225, 227–241, 247–267, 370, 371, 851, 853

i-state-okp-i-add <c> x

x{n}-step, 236 i-state-okp-i-add <tsp> <t

sp>{n}-step, 236 sp>{v}-step, 239

i-state-okp-i-add <tsp>{a}

x{n}-step, 233 i-state-okp-i-add <tsp>{i}

x{i}-step, 227 i-state-okp-i-add <tsp>{n}

x{n}-step, 235 i-state-okp-i-add pc x{n}-step, 239 i-state-okp-i-add tsp *{n}-

step, 233 i-state-okp-i-add tsp x{n}-

step, 233 i-state-okp-i-add x x{n}-step, 240 i-state-okp-i-add x{n} csp-

step, 228 i-state-okp-i-addc <c> x{n}

y{n}-step, 235 i-state-okp-i-addc <v> x{i}

y{i}-step, 240 i-state-okp-i-and <tsp>{b}

x{b}-step, 239 i-state-okp-i-and <tsp>{v}

x{v}-step, 238 i-state-okp-i-asr <c> <t

sp> <tsp>{b}-step, 235 i-state-okp-i-cpop cfp-step, 228 i-state-okp-i-cpop pc-step, 231 i-state-okp-i-cpush <tsp>+

-step, 228 i-state-okp-i-cpush *-step, 227 i-state-okp-i-cpush cfp-step, 240 i-state-okp-i-decr <tsp>

<tsp>{i}-step, 235 <tsp>{n}-step, 236

i-state-okp-i-halt, 241 i-state-okp-i-incr <tsp>

<tsp>{i}-step, 234 <tsp>{n}-step, 236

i-state-okp-i-incr y y{n}-step, 236 i-state-okp-i-ins-step, 240 i-state-okp-i-int-to-nat-step, 236 i-state-okp-i-jump-n x-step, 231 i-state-okp-i-jump-nn x-step, 232 i-state-okp-i-jump-nz x-step, 232 i-state-okp-i-jump-z x-step, 232 i-state-okp-i-jump *-step, 231 i-state-okp-i-jump x{subr}-step, 231 i-state-okp-i-lsr <c> x

x{n}-step, 236 i-state-okp-i-lsr <tsp> <t

sp>{v}-step, 239 i-state-okp-i-move-c <tsp>

*-step, 238 i-state-okp-i-move-n x *-step, 234 i-state-okp-i-move-v <tsp>

*-step, 238 i-state-okp-i-move-z <tsp>

*-step, 234 i-state-okp-i-move <tsp>

*-step, 234 i-state-okp-i-move <x{a}>

<tsp>-step, 231 i-state-okp-i-move <x{s}>

<tsp>-step, 231 i-state-okp-i-move cfp csp-step, 227 i-state-okp-i-move csp cfp-step, 228 i-state-okp-i-move x <x{s}

>-step, 229 i-state-okp-i-move x *-step, 228 i-state-okp-i-move x tsp-step, 228 i-state-okp-i-move x x-step, 227 i-state-okp-i-move y <y{s}

>-step, 229 i-state-okp-i-move y *-step, 228 i-state-okp-i-move y tsp-step, 229 i-state-okp-i-neg <tsp> <t

sp>{i}-step, 235 i-state-okp-i-not <tsp> <t

sp>{v}-step, 238 i-state-okp-i-or <tsp>{b}

x{b}-step, 239 i-state-okp-i-or <tsp>{v}

x{v}-step, 238 i-state-okp-i-step, 241 i-state-okp-i-sub <c> <t

sp>{a} x{a}-step, 237 sp>{n} x{n}-step, 237

i-state-okp-i-sub <nv> <t

sp>{i} x{i}-step, 237 i-state-okp-i-sub <tsp>{a}

x{n}-step, 233 i-state-okp-i-sub <tsp>{i}

x{i}-step, 235 i-state-okp-i-sub <tsp>{n}

x{n}-step, 237 i-state-okp-i-sub <tsp>{s}

x{s}-step, 237 i-state-okp-i-sub <z> x{s}

y{s}-step, 240 i-state-okp-i-sub x{s} y{n}

-step, 234 i-state-okp-i-subb <c> x{n}

y{n}-step, 237 i-state-okp-i-subb <v> x{i}

y{i}-step, 240 i-state-okp-i-tpop <c> x-

step, 232 i-state-okp-i-tpop <x{a}>

-step, 230 i-state-okp-i-tpop <x{s}>

-step, 230 i-state-okp-i-tpop pc-step, 232 i-state-okp-i-tpop x-step, 230 i-state-okp-i-tpop y-step, 230 i-state-okp-i-tpop{b} <z>

y-step, 233 i-state-okp-i-tpop{i} <zn>

y-step, 232 i-state-okp-i-tpop{n} <z>

y-step, 232 i-state-okp-i-tpop{v} <z>

y-step, 233 i-state-okp-i-tpush <x{a}>

-step, 230 i-state-okp-i-tpush <x{s}>

-step, 230 i-state-okp-i-tpush *-step, 230 i-state-okp-i-tpush csp-step, 229 i-state-okp-i-tpush tsp-step, 229 i-state-okp-i-tpush x-step, 229 i-state-okp-i-xor <tsp> <t

sp>-step, 234 i-state-okp-i-xor <tsp>{b}

*{b}-step, 239

x{b}-step, 239

i-state-okp-i-xor <tsp>{v}

x{v}-step, 238 i-state-okp-i-xor <z> <t

sp> x-step, 234 i-state-okp-implies-i-is-i*, 370 i-state-okp-restructuring, 145 i-state-types-okp, 145, 146, 154, 158 i-state-types-okp-properties, 146 i-state-types-okp-property2, 158 i-statep, 53, 145, 146 i-step, 116, 156, 225, 226, 241, 267 i-step1, 116 i-sub <c> <tsp>{a}

x{a}-okp, 87, 110, 216, 237, 263,

414 x{a}-step, 87, 114, 216, 237, 263,

476 i-sub <c> <tsp>{n}

x{n}-okp, 88, 110, 215, 237, 262,

414 x{n}-step, 88, 115, 215, 237, 262,

477 i-sub <nv> <tsp>{i}

x{i}-okp, 89, 110, 225, 237, 262,

415 x{i}-step, 89, 115, 225, 237,

262, 478 i-sub <tsp>{a} x{n}-o

kp, 90, 111, 197, 233, 257, 416 i-sub <tsp>{a} x{n}-step, 90, 115,

197, 233, 257, 478 i-sub <tsp>{i} x{i}-o

kp, 91, 111, 211, 235, 259, 417 i-sub <tsp>{i} x{i}-step, 91, 115, 211,

235, 259, 480 i-sub <tsp>{n} x{n}-o

kp, 92, 111, 215, 237, 263, 418 i-sub <tsp>{n} x{n}-step, 92, 115,

215, 237, 263, 481 i-sub <tsp>{s} x{s}-o

kp, 93, 111, 216, 238, 263, 418 i-sub <tsp>{s} x{s}-step, 93, 115,

216, 238, 263, 481 i-sub <z> x{s} y{s}-

okp, 93, 111, 216, 240, 263, 419 step, 93, 115, 216, 240, 263, 482

i-sub x{s} y{n}-okp, 91, 111, 197,

234, 257, 416 i-sub x{s} y{n}-step, 91, 115, 197,

234, 258, 479 i-subb <c> x{n} y{n} -okp, 94, 111, 215, 237, 262,

420 -step, 94, 115, 215, 237, 262,

483 i-subb <v> x{i} y{i}

-okp, 95, 111, 224, 240, 267,

421 -step, 95, 115, 224, 240, 267,

483 i-sys-data-segment, 25, 35, 53, 55–

108, 143, 145–147, 149, 151, 152, 154, 157, 200–203, 246, 503, 505

i-tpop <c> x-okp, 95, 111, 193, 232,

255, 421 i-tpop <c> x-step, 95, 96, 115, 194,

232, 256, 484 i-tpop <x{a}>-okp, 96, 111, 191, 231,

253, 422 i-tpop <x{a}>-step, 96, 115, 191,

231, 253, 485 i-tpop <x{s}>-okp, 96, 111, 190, 230,

253, 423 i-tpop <x{s}>-step, 97, 115, 190, 230,

253, 486 i-tpop pc-okp, 97, 111, 193, 232, 255,

423 i-tpop pc-step, 97, 115, 193, 232, 255,

486 i-tpop x-okp, 98, 111, 190, 230, 252,

424 i-tpop x-step, 98, 115, 190, 230, 252,

487 i-tpop y-okp, 98, 111, 190, 230, 253,

425 i-tpop y-step, 98, 115, 190, 230, 253,

488 i-tpop{b} <z> y-okp, 99, 111, 195,

233, 256, 426 i-tpop{b} <z> y-step, 99, 115, 195,

233, 256, 489 i-tpop{i} <zn> y-okp, 100, 111, 195,

233, 256, 427 i-tpop{i} <zn> y-step, 100, 115, 195,

233, 256, 490 i-tpop{n} <z> y-okp, 100, 111, 194,

232, 256, 428 i-tpop{n} <z> y-step, 101, 115, 194,

232, 256, 491 i-tpop{v} <z> y-okp, 99, 111, 196,

233, 256, 426 i-tpop{v} <z> y-step, 99, 115, 196,

233, 256, 489 i-tpush <x{a}>-okp, 101, 102, 111,

189, 230, 252, 429 i-tpush <x{a}>-step, 102, 115, 189,

230, 252, 492 i-tpush <x{s}>-okp, 102, 111, 189,

230, 252, 430 i-tpush <x{s}>-step, 102, 116, 189,

230, 252, 493 i-tpush *-okp, 101, 111, 189, 230,

252, 428 i-tpush *-step, 101, 115, 189, 230,

252, 491 i-tpush csp-okp, 103, 111, 188, 229,

251, 430 i-tpush csp-step, 103, 116, 188, 229,

251, 494 i-tpush tsp-okp, 103, 112, 188, 229,

251, 431 i-tpush tsp-step, 103, 116, 188, 229,

251, 494 i-tpush x-okp, 104, 112, 189, 229,

251, 432 i-tpush x-step, 104, 116, 189, 229,

252, 495 i-tsp, 34, 53, 55–108, 145, 146, 152,

158, 181 i-usr-data-objectp, 53, 54, 107, 247 i-usr-data-segment, 25, 34, 53, 55–

108, 143, 146, 149, 154, 157, 181, 200–206, 222, 242, 247, 248, 503, 853, 895

i-usr-data-segment-p->r->i, 895 i-usr-data-segment-r->i, 853 i-usr-data-typep, 53, 511 i-usr-data-typep-is-r-usr-data-t

ypep, 511 i-v-flg, 34, 54–62, 64–94, 96–107, 145,

147, 158 i-word-size, 34, 52, 53, 55–108, 142,

143, 146, 154, 175, 185–197, 200–204, 206–219, 221–226, 246–267, 503, 522, 851, 852, 856

i-word-size-i-halt, 225 i-word-size-i-ins-step, 226 i-word-size-i-step, 226 i-word-size-r->i, 852 i-x, 34, 55–108, 222 i-xor <tsp> <tsp>-okp, 104, 112, 209,

234, 258, 433 i-xor <tsp> <tsp>-step, 104, 116,

209, 234, 258, 496 i-xor <tsp>{b} *{b}-o

kp, 105, 112, 222, 239, 266, 434 i-xor <tsp>{b} *{b}-step, 106, 116,

222, 239, 266, 497 i-xor <tsp>{b} x{b}-o

kp, 106, 112, 222, 239, 266, 435 i-xor <tsp>{b} x{b}-step, 106, 116,

222, 239, 266, 498 i-xor <tsp>{v} x{v}-o

kp, 105, 112, 219, 238, 265, 433 i-xor <tsp>{v} x{v}-step, 105, 116,

219, 238, 265, 497 i-xor <z> <tsp> x-okp, 107, 112, 209,

235, 258, 435 i-xor <z> <tsp> x-step, 107, 116,

209, 235, 258, 499 i-y, 34, 55–98, 101–107 i-z-flg, 34, 54–93, 95–99, 101–106,

145, 147, 158 icode, 20, 351, 353, 356–361, 363,

367, 527 icode-add-addr, 13, 18, 350, 365 icode-add-int, 14, 19, 347, 365 icode-add-int-with-carry, 14, 19, 347,

365 icode-add-nat, 15, 19, 348, 366 icode-add-nat-with-carry, 15, 19, 348, icode-add1-int, 14, 19, 348, 365 icode-add1-nat, 15, 19, 348, 366 icode-and-bitv, 16, 20, 348, 366 icode-and-bool, 17, 20, 349, 367 icode-call, 7, 17, 349, 363 icode-deposit, 14, 19, 347, 365 icode-deposit-temp-stk, 10, 18, 350,

364 icode-div2-nat, 16, 19, 348, 366 icode-eq, 13, 18, 347, 365 icode-fetch, 13, 19, 347, 365 icode-fetch-temp-stk, 10, 18, 350, 364 icode-instructionp, 33, 149, 158, 187,

207, 246 icode-instructionp-data-word, 187 icode-int-to-nat, 15, 19, 348, 366 icode-is-shorter-than-icompile-p

rogram, 527 icode-jump, 11, 18, 350, 364 icode-jump-case, 11, 18, 350, 365 icode-jump-if-temp-stk-empty, 9, 17,

349, 364 icode-jump-if-temp-stk-full, 9, 17, 349,

364 icode-labelp, 52, 53, 143, 204, 206,

503 icode-locn, 8, 17, 349, 363 icode-lsh-bitv, 17, 20, 349, 367 icode-lt-addr, 13, 19, 347, 365 icode-lt-int, 14, 19, 348, 366 icode-lt-nat, 16, 19, 348, 366 icode-mult2-nat, 16, 19, 348, 366 icode-mult2-nat-with-carry-out, 16,

19, 348, 366 icode-neg-int, 14, 19, 348, 366 icode-no-op, 13, 18, 350, 365 icode-not-bitv, 16, 20, 348, 367 icode-not-bool, 17, 20, 349, 367 icode-opener, 363 icode-or-bitv, 16, 20, 348, 366 icode-or-bool, 17, 20, 349, 367 icode-pop, 9, 17, 349, 364 icode-pop*, 9, 10, 18, 349, 364 icode-pop-call, 10, 18, 350, 364 icode-pop-global, 10, 18, 349, 364 icode-pop-local, 10, 18, 349, 364 icode-pop-locn, 10, 18, 350, 364 icode-popj, 11, 18, 350, 365 icode-popn, 10, 18, 349, 364 icode-push-constant, 8, 17, 349, 363 icode-push-ctrl-stk-free-size, 8, 17, 349,

364 icode-push-global, 8, 17, 349, 364 icode-push-local, 8, 17, 349, 364 icode-push-temp-stk-free-size, 9, 17,

349, 364 icode-push-temp-stk-index, 9, 17, 349,

364 icode-pushj, 11, 18, 350, 365 icode-ret, 8, 17, 349, 363 icode-rsh-bitv, 17, 20, 348, 367 icode-set-global, 11, 18, 350, 365 icode-set-local, 11, 18, 350, 365 icode-sub-addr, 13, 18, 350, 365 icode-sub-int, 14, 19, 348, 366 icode-sub-int-with-carry, 14, 19, 348,

366 icode-sub-nat, 15, 19, 348, 366 icode-sub-nat-with-carry, 15, 19, 348,

366 icode-sub1-int, 14, 19, 348, 366 icode-sub1-nat, 15, 19, 348, 366 icode-test-bitv-and-jump, 13, 18, 350,

365 icode-test-bool-and-jump, 12, 18, 350,

365 icode-test-int-and-jump, 12, 18, 350,

365 icode-test-nat-and-jump, 11, 12, 18,

350, 365 icode-xor-bitv, 16, 20, 348, 367 icode1, 17, 20, 350, 351, 356 icode1-is-icode11, 350 icode11, 349, 350 icode12, 347, 350, 351, 355 icompile, 20, 21, 24, 271, 346, 358,

360, 361, 367, 369, 371, 501, 504, 529, 530, 534–537, 539, 541, 542, 547, 548, 849, 895, 896

icompile-program, 20, 23, 358, 361– 363, 500, 504, 509, 510, 525, 527, 528, 547, 549

icompile-program-body, 20, 351–353,

356–359, 547–549 icompile-program-body-append, 353 icompile-program-body-cdr-n-exp

ander, 359 idifference, 68, 69, 89–92, 95, 308–

312, 515, 518, 608, 609 idiv, 125 idiv-is-mod2, 125 ilessp, 50, 313, 518, 610 ilessp-is-xor-case1, 518 ilessp-is-xor-case2, 518 ilessp-is-xor-case3, 518 ilessp-is-xor-case4, 518 incr, 5, 148, 169–171 incr-f, 169 incr-f-is-noop, 171 induct-hint1, 356 ineg, 125–129, 131, 132, 224 ineg-exp-2-x, 126 ineg-is-inegate, 224 inegate, 50, 85, 223–225, 311, 312,

610 int-to-nat-one-way-corresponden

ce-p-r, 675 ce-r-i, 519

int-to-nat-preserves-p-loadablep, 793 int-to-nat-preserves-proper-p-st

atep, 715 int-to-nat-preserves-r-equal, 765 int-to-nat-proper-r-statep, 559 int-to-v, 27, 125–137, 140, 148, 172,

175, 194, 195, 198, 210, 213 int-to-v-is-nat-to-v-on-nats, 213 integerp, 50, 125, 131, 132, 169, 224 integerp-inegate, 224 invert-absolute-address, 26, 27, 199,

200 invert-absolute-address-inverts -absolute-address, 199 invert-base-address, 25–27, 203, 206 invert-base-address-inverts-base -address-on-labels, 206 -address-on-subrs, 203 invert-label-address, 26, 27 ipc, 54, 66, 72–74, 97 ipc-to-v, 27, 28, 148, 200, 201 iplus, 50, 59, 63, 70, 95, 125–140,

169, 224, 225, 305–310, 515, 606–609

iplus-0, 126 iplus-0-2, 131 iplus-0{special}, 515

jump-case-instruction-is-much-s horter-than-icode, 527 jump-case-number-is-very-small, 528 jump-case-one-way-correspondence

-p-r, 682 -r-i, 528

jump-case-preserves-p-loadablep, 797 jump-case-preserves-proper-p-st

atep, 722 jump-case-preserves-r-equal, 776 jump-case-proper-r-statep, 563 jump-if-temp-stk-empty-one-way-correspondence-p-r, 679 correspondence-r-i, 525 jump-if-temp-stk-empty-preserve

s-p-loadablep, 796 s-proper-p-statep, 720 s-r-equal, 773

jump-if-temp-stk-empty-proper-r

-statep, 562 jump-if-temp-stk-full-one-way-c orrespondence-p-r, 678 orrespondence-r-i, 524 jump-if-temp-stk-full-preserves -p-loadablep, 796 -proper-p-statep, 720 -r-equal, 772

jump-if-temp-stk-full-proper-r-

statep, 562 jump-one-way-correspondence-p-r, 672 jump-one-way-correspondence-r-i, 509 jump-preserves-p-loadablep, 790 jump-preserves-proper-p-statep, 713 jump-preserves-r-equal, 759 jump-proper-r-statep, 556 jump *-lst, 11, 347, 527, 528

label-address, 25, 27 label-links, 25 label-table-entry, 151 label-to-v, 27, 28, 148, 206 labelledp, 6, 24, 51, 270, 272 labels-are-nlistp, 711 labels-are-nlistp-generalized, 711 last-instruction, 357 last-instruction-0, 357 legal-labelp, 270, 272, 635, 641 length, 7, 8, 21, 22, 24, 36, 38–48,

52, 117–121, 123–140, 142, 146, 148–154, 158, 160–168, 170–172, 181, 182, 187, 190, 194, 196–198, 203–205, 207– 209, 213, 216–218, 221, 241– 246, 267–269, 273–276, 290– 292, 344–347, 351–362, 368, 499–502, 504–506, 517, 527– 530, 532–536, 538–545, 547– 549, 553, 555, 563, 589–600, 615, 616, 626–632, 635, 637, 642, 643, 648, 650, 651, 653, 654, 656–666, 668–670, 680, 681, 683–691, 693–695, 701– 704, 708–712, 721–724, 726, 728, 729, 742–747, 751, 754, 776–780, 782, 836, 848, 878, 884, 895–898

length-all-but-last, 659 length-bindings, 653 length-bit-vectorp, 196 length-boot-code, 153 length-boot-code-linear, 153 length-bv-v-alu, 42 length-cdr-assoc-deposit-adp, 506 length-cdr-assoc-deposit-lst, 544 length-cdr-assoc-deposit-lst1, 778 length-cdr-cdr-n, 670 length-cdr-n, 661 length-cdr-p->r ctrl-stk, 651 length-cdr-p->r temp-stk, 651 length-fetch-n, 563 length-first-n, 351 length-generate-postlude, 361 length-generate-prelude, 361 length-generate-prelude1, 360 length-generate-prelude2, 360 length-icompile-program, 549 length-if{jsm}, 347 length-jump *-lst, 527 length-link-area-is-length, 150 length-link-segment-is-segment-

length, 152 length-m-mem-p->r->i->m, 895 length-m-mem-r->i->m, 895 length-nat-0s, 650 length-nth, 42 length-p->r ctrl-stk1, 650 length-pair-temps-with-initial-v

alues, 683 length-pairlist, 683 length-put, 158 length-put-assoc, 654 length-put-value-indirect, 680 length-read-mem, 42 length-reg-file, 158 length-rev, 40 length-rn-a, 46 length-rn-b, 41 length-strip-cadrs, 543 length-strip-cars, 504 length-strip-cdrs, 650 length-type-lst, 246 length-update-nth, 43 length-update-v-nth, 43 length-v-adder, 44 length-v-dec, 44 length-v-inc, 44 length-v-nth1, 42 length-v-to-bitv, 197 leq-means-lessp-is-not-equal, 357 lessp-0-exp, 122 lessp-0-length, 203 lessp-absolute-address-ipc, 200 lessp-absolute-address-segment-

length-adp-name, 151 length-adp-name-add1, 161 length-cfp, 151 length-csp, 151 length-generalized, 151 length-rewrite, 187 length-rewrite{weakened-instance},

897 length-tsp, 152

lessp-absolute-address-sys-data, 202 lessp-absolute-address-usr-data, 201 lessp-base-address-link-table-f

or-labels, 204 or-segment, 203

lessp-cdar-link-table-for-label

s, 205 lessp-difference, 40 lessp-difference-x-y-x, 665 lessp-exp-sub1-exp, 169 lessp-find-label, 711 lessp-find-label-cdar-link-table

-for-labels, 206 lessp-find-label-icompile-progr

am, 362 lessp-find-label-length, 204 lessp-find-position-of-var, 504 lessp-find-position-of-var-exp, 504 lessp-length-assoc-segment-lengt

h, 506 lessp-length-assoc-tstk-exp-2-w

ord-size, 506 lessp-length-bindings, 728 lessp-length-bindings-p-ctrl-st

k, 729 lessp-length-cdr, 665 lessp-length-icompile-program, 504 lessp-length-local-vars, 504 lessp-link-table-entry, 243 lessp-p-ctrl-stk-size, 692 lessp-quotient{special}, 521 lessp-remainder{special}, 519 lessp-v-to-nat-exp-gen, 123 link-area, 33, 150, 165, 168, 213, 243–

245, 247, 856 link-area-put-unlabel, 168 link-areas, 243, 246, 247 link-data-word, 27, 33, 55, 148, 149,

198, 207, 247 link-data-word-expander, 148 link-instr-word, 33, 147, 149 link-instr-word-expander, 147 link-instruction-alist, 28, 33, 147 link-mem, 33–35, 895 link-segment, 33, 34, 152, 154, 160,

163, 164, 166–169, 213, 243– 246, 856

link-segment-put-unlabel, 168 link-table-entry, 151, 152, 154, 160,

161, 163, 164, 166–168, 187, 191, 204, 205, 213, 222, 243– 245, 897

link-table-entry-put-assoc, 168 link-table-for-labels, 24, 191, 204–

206 link-table-for-prog-labels, 24, 25, 149,

191, 205, 206 link-table-for-segment, 24, 25, 149,

151, 157, 168, 199–204, 243, 246, 896, 897

link-table-for-segment-put-asso

c, 168 link-tables, 35, 898 link-word, 33, 34, 149, 150, 152, 155,

160, 163–168, 172, 175, 208, 213, 243

link-word-expander, 149 list-of-bvs, 158, 159 list-of-nats, 116, 159 listp-append, 219 listp-assoc-cstk, 751 listp-assoc-implies-definedp, 344 listp-assoc-tstk, 744 listp-cdr-assoc-deposit-adp, 511 listp-cdr-icompile-program, 500 listp-cdr-n, 359 listp-first-n, 351 listp-icode1, 356 listp-icode12, 355 listp-icompile-program-body, 356 listp-if, 355 listp-int-to-v, 210 listp-link-table-for-segment, 199 listp-nat-to-v, 210 listp-operand-a, 45 listp-p-current-instruction, 702 listp-program-body, 564 listp-program-body-generalized, 564 listp-program-body-generalized{special},

722 listp-program-body{special}, 722 listp-rev, 530 litatom-adp-name, 501 litatom-adp-name-instance, 557 litatom-cadr-unlabel, 555 load, 35, 898 local-var-value, 590, 592, 593, 597 local-vars, 5, 7, 275, 504, 627–629,

636 locn-one-way-correspondence-p-r, 682 locn-one-way-correspondence-r-i, 527 locn-preserves-p-loadablep, 797 locn-preserves-proper-p-statep, 721 locn-preserves-r-equal, 775 locn-proper-r-statep, 563 lsh-bitv, 51, 56, 328, 618, 718 lsh-bitv-one-way-correspondence

-p-r, 677 -r-i, 523

lsh-bitv-preserves-p-loadablep, 795 lsh-bitv-preserves-proper-p-statep, 719 lsh-bitv-preserves-r-equal, 771 lsh-bitv-proper-r-statep, 561 lsh-lemma-1, 220 lsh-lemma-2, 220 lsh-lemma-3, 220 lsh-lemma-4, 220 lsh-lemma-5, 221 lsh-lemma-6, 221 lsh-lemma-7, 221 lt-addr-one-way-correspondence-

r-i, 512 lt-addr-one-way-correspondence-p

-r, 673 lt-addr-preserves-p-loadablep, 791 lt-addr-preserves-proper-p-statep, 713 lt-addr-preserves-r-equal, 761 lt-addr-proper-r-statep, 557 lt-int-one-way-correspondence-p

-r, 675 lt-int-one-way-correspondence-r

-i, 518 lt-int-preserves-p-loadablep, 793 lt-int-preserves-proper-p-statep, 715 lt-int-preserves-r-equal, 765 lt-int-proper-r-statep, 559 lt-nat-one-way-correspondence-p

-r, 676 lt-nat-one-way-correspondence-r

-i, 521 lt-nat-preserves-p-loadablep, 794 lt-nat-preserves-proper-p-statep, 716 lt-nat-preserves-r-equal, 767 lt-nat-proper-r-statep, 560

m, 47, 226, 851

m->fm9001, 35, 41, 44, 46, 47, 268,

851 m->n, 159 m-alu-operation, 37, 38, 41, 43, 44, 179–181, 183 m-alu-operation-is-fm9001-alu-ope

ration, 41 m-alu-operation-opener, 182 m-alu-operation-preserves-hyps, 43 m-c-flg, 35, 46, 159 m-mem, 35, 42, 46, 47, 159, 242, 268, 895, 896, 898

m-n-flg, 35, 46, 159

m-operand-a, 45, 46, 174, 176 m-operand-a-is-fm9001-operand-a, 46 m-operand-a-opener, 176 m-operand-a-preserves-hyps, 46 m-operand-b, 43–46, 177–179 m-operand-b-is-fm9001-operand-b, 44 m-operand-b-opener, 178 m-operand-b-preserves-hyps, 45 m-regs, 35, 42, 46, 47, 159 m-state, 24, 35, 38, 159, 174, 183–

185 m-statep, 42 m-step, 46, 47, 159, 175, 185–197,

209–225 m-step-is-fm9001-step, 47 m-step-preserves-hyps, 47 m-step1, 46, 174 m-step1-opener, 173 m-store-resultp, 37, 38, 183 m-store-resultp-is-store-resultp, 37 m-v-flg, 35, 46, 159 m-z-flg, 35, 46, 159 make-p-call-frame, 590, 591 mci, 33, 147 member-assoc, 355 member-get, 505 member-get-rev, 532 member-implies-lessp-find-positi

on-of-var, 653 member-rev, 531 mod2, 124, 125 mode-a, 45, 46, 177, 178 mode-b, 38, 43, 44, 179, 180, 183 mult2-nat-one-way-correspondence

-p-r, 676 -r-i, 521

mult2-nat-preserves-p-loadablep, 794 mult2-nat-preserves-proper-p-st

atep, 717 mult2-nat-preserves-r-equal, 768 mult2-nat-proper-r-statep, 560 mult2-nat-with-carry-out-one-wa

y-correspondence-p-r, 668 y-correspondence-r-i, 521

mult2-nat-with-carry-out-preserve s-p-loadablep, 788 s-proper-p-statep, 709 s-r-equal, 754

mult2-nat-with-carry-out-proper

-r-statep, 560 my-bvp-int-to-v, 175 my-integerp-v-to-int, 125 my-length-int-to-v, 130 my-lessp-quotient, 35 my-lessp-v-to-nat-exp, 40 my-properp-pairlist, 722 my-quotient-add1-plus-x-x-2, 125 my-quotient-times, 170 my-v-nzerop-int-to-v, 195 my-v-nzerop-nat-to-v, 194 my-v-to-nat-append, 39

n, 38, 183, 184 n->m, 159 n-set, 38, 183, 184 n-step, 159 name, 5–8, 10–12, 20, 54, 272, 351–

353, 357, 361–363, 528, 636, 846

name-assoc, 357 name-cons, 363 name-icompile-program, 363 nat-0s, 21, 22, 650, 662, 663, 666–

668, 685, 687, 689, 690, 693 nat-0s-opener-at-right-end, 663 nat-0s-opener-at-right-end-on-a

dd1, 663 nat-to-v, 26–28, 31, 33, 35, 36, 39,

46, 47, 120–124, 128, 135, 142, 148, 154, 158, 169–174, 176, 178, 179, 194, 195, 209, 210, 213, 216, 220, 221, 267

nat-to-v-equivalence, 158 nat-to-v-inverts-v-to-nat, 172 neg-int-one-way-correspondence-

r-i, 517 neg-int-one-way-correspondence-p

-r, 675 neg-int-preserves-p-loadablep, 792 neg-int-preserves-proper-p-statep, 715 neg-int-preserves-r-equal, 764 neg-int-proper-r-statep, 559 negativep-ineg, 126 nlistp-implies-not-p-objectp, 711 no-op-one-way-correspondence-p-

r, 665 no-op-one-way-correspondence-r-i, 503 no-op-preserves-p-loadablep, 786 no-op-preserves-proper-p-statep, 702 no-op-preserves-proper-r-statep, 553 no-op-preserves-r-equal, 742 non-zero-total-i-system-size, 181 not-bit, 50, 51 not-bitv, 51, 86, 218, 325, 617, 717 not-bitv-one-way-correspondence

-p-r, 677 -r-i, 523

not-bitv-preserves-p-loadablep, 795 not-bitv-preserves-proper-p-statep, 718 not-bitv-preserves-r-equal, 769 not-bitv-proper-r-statep, 561 not-bool, 269, 299, 330, 524, 526,

620, 719 not-bool-of-non-f, 526 not-bool-one-way-correspondence

-p-r, 678 -r-i, 524

not-bool-preserves-p-loadablep, 796 not-bool-preserves-proper-p-statep, 720 not-bool-preserves-r-equal, 772 not-bool-proper-r-statep, 562 not-definedp-put-assoc, 555 not-empty-stkp-implies-adpp-add

-adp, 557 not-empty-stkp-implies-adpp-pop, 517 not-empty-stkp-push, 499 not-empty-stkp-push-csp, 781 not-empty-stkp-push{special}, 744 not-empty-stkp-temp-stk-index, 754 not-equal-exp-0, 126 not-equal-link-word-btm, 172 not-equal-p-ctrl-stk-size-1, 708 not-equal-p-max-temp-stk-size-0, 666 not-equal-sub1-difference-p-max -ctrl-stk-size-etc, 688 not-equal-sub1-p-max-temp-stk-si

ze-0, 668 not-equal-x-y-error-msg-halt, 342 not-equal-x-y-error-msg-run, 147 not-find-label-generate-prelude

2, 354 not-icode-instructionp, 246 not-icode-instructionp-tag, 158 not-lessp-length-cdr-backchaine

r, 708 not-lessp-length-find-label, 359 not-lessp-remainder, 717 not-lessp-segment-length-plus-li nk-table-entry-length, 897 not-lessp-sub1-p-max-temp-stk-si

ze, 666 not-lessp-sub1-sub1-difference-p -max-ctrl-stk-size-etc, 688 not-lessp-sub1-sub1-p-max-temp-

stk-size, 668 not-r-objectp, 505 not-zerop-exp-2-32, 211 not-zerop-sub1-difference, 557 nth, 36, 40, 42, 142 nth-firstn, 40 nth-is-get, 142 nth-restn-plus, 40 numberp-base-address-link-table

-for-labels, 204 -for-segment, 203

offset, 48, 52, 88, 90, 91, 93, 94, 274, 276, 301, 303, 358, 360, 361, 367, 590, 604, 605 offset-from-csp, 7, 8, 10, 11, 277– 280, 286–288, 294, 295

once-errorp-always-errorp, 587 once-errorp-always-errorp-step, 587 once-errorp-always-errorp-step{special},

849 once-errorp-always-errorp{mapping},

895 once-errorp-always-errorp{special}, 849 one-way-correspondence-display-

array, 268

fm9001-data-segment1, 268 one-way-correspondence-m-fm9001, 47 one-way-correspondence-p-r, 849 one-way-correspondence-r-i, 588 one-way-correspondence-r-i-step, 587

-simplified, 587 2-simplified, 587

op-code, 38, 183–185 open-first-n-at-high-end, 353 or-bit, 50, 51 or-bitv, 51, 86, 217, 324, 616, 717 or-bitv-one-way-correspondence-

r-i, 522 or-bitv-one-way-correspondence-p

-r, 676 or-bitv-preserves-p-loadablep, 794 or-bitv-preserves-proper-p-statep, 718 or-bitv-preserves-r-equal, 768 or-bitv-proper-r-statep, 561 or-bool, 49, 87, 328, 619, 719 or-bool-one-way-correspondence-

r-i, 524 or-bool-one-way-correspondence-p

-r, 678 or-bool-preserves-p-loadablep, 795 or-bool-preserves-proper-p-statep, 719 or-bool-preserves-r-equal, 771 or-bool-proper-r-statep, 561

p, 626, 849–851, 871, 895–898 p->r, 22, 35, 648, 665–682, 688, 690,

694, 727–739, 828–830, 849, 851, 852, 856, 895–898

p->r-if, 828 p->r cfp, 22, 692 p->r csp, 22 p->r ctrl-stk, 22, 649, 651, 654, 655,

680–682, 692, 693 p->r ctrl-stk1, 22, 650, 653, 687, 689,

693 p->r ctrl-stk1-opener, 653 p->r p-frame, 22, 653 p->r sys-data-segment, 22, 23, 649,

650, 655–658, 661, 664, 678, 684, 687, 689, 690, 693, 849, 895, 896

p->r temp-stk, 21, 22, 649, 651, 655,

662 p->r tsp, 22 p-add-addr-okp, 603, 621, 667, 708,

729, 788, 819, 825, 864 p-add-addr-okp-implies-r-add-ad

dr-okp, 729 p-add-addr-step, 604, 625, 667, 708, 788, 823, 864 p-add-int-okp, 606, 622, 673, 714,

733, 791, 817, 824, 865 p-add-int-okp-implies-r-add-int

-okp, 733 p-add-int-step, 606, 625, 674, 714, 791, 820, 865 p-add-int-with-carry-okp, 607, 622,

674, 714, 733, 792, 817, 824, 865

p-add-int-with-carry-okp-implie

s-r-add-int-with-carry-okp, 733 p-add-int-with-carry-step, 607, 625,

674, 714, 792, 820, 865 p-add-nat-okp, 611, 622, 675, 715,

734, 793, 817, 824, 867 p-add-nat-okp-implies-r-add-nat

-okp, 734 p-add-nat-step, 611, 625, 675, 715, 793, 820, 867 p-add-nat-with-carry-okp, 611, 622,

668, 709, 730, 788, 817, 824, 867

p-add-nat-with-carry-okp-implie

s-r-add-nat-with-carry-okp, 729 p-add-nat-with-carry-step, 612, 625, 668, 709, 788, 820, 867

p-add1-int-okp, 607, 622, 674, 714,

733, 792, 817, 824, 866 p-add1-int-okp-implies-r-add1-i

nt-okp, 733 p-add1-int-step, 608, 625, 674, 714,

792, 820, 866 p-add1-nat-okp, 612, 622, 667, 708,

729, 787, 817, 824, 867 p-add1-nat-okp-implies-r-add1-n

at-okp, 729 p-add1-nat-step, 612, 625, 667, 708,

787, 820, 867 p-and-bitv-okp, 616, 623, 677, 718,

735, 795, 817, 824, 869 p-and-bitv-okp-implies-r-and-bitv

-okp, 735 p-and-bitv-step, 617, 626, 677, 718,

795, 821, 869 p-and-bool-okp, 619, 623, 678, 719,

736, 796, 818, 824, 870 p-and-bool-okp-implies-r-and-bo

ol-okp, 736 p-and-bool-step, 619, 626, 678, 719,

796, 821, 870 p-call-okp, 590, 598, 620, 688, 725,

739, 798, 818, 824, 858 p-call-okp-implies-r-call-okp, 738 p-call-step, 591, 598, 623, 688, 725,

798, 821, 858 p-ctrl-stk, 22, 23, 588, 591–620, 637,

642–644, 653–655, 680–682, 684, 686–692, 694, 708, 726, 729, 848, 849, 895, 896

p-ctrl-stk-size, 7, 22, 591, 593, 637, 643, 650, 651, 654, 655, 663, 680–683, 686–689, 691–693, 701, 708, 728, 729, 848

p-ctrl-stk-size-cons-p-frame, 683 p-ctrl-stk-size-cons-p-frame-put

-assoc, 654 p-ctrl-stk-size-put-value-indire

ct, 681 p-current-instruction, 590, 626, 642,

643, 648, 665–682, 688, 690, 694, 702, 703, 706–722, 725– 739, 786–798, 828–831, 835, 858–871

p-current-program, 590, 592, 594, 595,

599–601 p-data-segment, 21, 23, 588, 589, 591–

620, 627–629, 637, 640, 643, 644, 695–699, 701, 703, 706, 728, 738, 847, 848, 851, 858– 871, 895–898

p-deposit-okp, 606, 622, 666, 708,

729, 787, 817, 823, 865 p-deposit-okp-implies-r-deposit

-okp, 729 p-deposit-step, 606, 625, 666, 708,

787, 820, 865 p-deposit-temp-stk-okp, 599, 621, 669,

710, 730, 788, 819, 825, 862 p-deposit-temp-stk-okp-implies-

r-deposit-temp-stk-okp, 730 p-deposit-temp-stk-step, 599, 624, 669,

710, 788, 822, 862 p-div2-nat-okp, 616, 623, 676, 717,

735, 794, 817, 824, 869 p-div2-nat-okp-implies-r-div2-n

at-okp, 735 p-div2-nat-step, 616, 626, 676, 717,

794, 821, 869 p-eq-okp, 604, 622, 673, 713, 732,

791, 816, 823, 864 p-eq-okp-implies-r-eq-okp, 732 p-eq-step, 604, 605, 625, 673, 713,

791, 820, 864 p-fetch-okp, 605, 622, 673, 714, 733,

791, 816, 823, 865 p-fetch-okp-implies-r-fetch-okp, 733 p-fetch-step, 605, 625, 673, 714, 791,

820, 865 p-fetch-temp-stk-okp, 598, 621, 669,

709, 730, 788, 819, 825, 862 p-fetch-temp-stk-okp-implies-r-

fetch-temp-stk-okp, 730 p-fetch-temp-stk-step, 598, 624, 669,

709, 788, 822, 862 p-frame, 590, 597, 640, 654, 655,

681, 687, 690, 707 p-frame-properties, 707 p-frame-size, 7, 683 p-halt, 588, 591, 626, 821 p-ins-okp, 620, 626, 820, 824, 826,

828, 830, 831, 835, 871 p-ins-okp-backchainer, 824 p-ins-okp-exhausted, 826 p-ins-okp-is-p-ins-okp1, 820 p-ins-okp1, 818, 820 p-ins-okp2, 816, 819, 823, 827–830,

835 p-ins-okp2-backchainer, 823 p-ins-okp2-exhausted, 827 p-ins-step, 623, 626, 823, 830, 831,

835, 871 p-ins-step-is-p-ins-step1, 823 p-ins-step-preserves-p-loadablep, 835 p-ins-step-preserves-proper-p-st

atep, 831 p-ins-step-preserves-ur-proper-p

-statep, 831 p-ins-step1, 821, 823 p-ins-step2, 820, 823, 829, 830, 835 p-ins-step2-preserves-p-loadablep, 835 p-ins-step2-preserves-ur-proper

-p-statep, 830 p-int-to-nat-okp, 610, 622, 675, 715,

734, 793, 817, 824, 867 p-int-to-nat-okp-implies-r-int-t

o-nat-okp, 734 p-int-to-nat-step, 611, 625, 675, 715,

793, 820, 867 p-jump-case-okp, 599, 621, 682, 722,

738, 797, 819, 825, 862 p-jump-case-okp-implies-r-jump-

case-okp, 738 p-jump-case-step, 600, 624, 682, 722,

797, 822, 862 p-jump-if-temp-stk-empty-okp, 595,

621, 679, 720, 737, 796, 818, 825, 860

p-jump-if-temp-stk-empty-okp-imp

lies-r-jump-if-temp-stk-empty-okp,

737 p-jump-if-temp-stk-empty-step, 595,

624, 679, 720, 796, 822, 860 p-jump-if-temp-stk-full-okp, 594, 620,

679, 720, 737, 796, 818, 825, 860

p-jump-if-temp-stk-full-okp-imp

lies-r-jump-if-temp-stk-full-okp,

737 p-jump-if-temp-stk-full-step, 594, 624, 679, 720, 796, 822, 860

p-jump-okp, 599, 621, 672, 713, 732, 790, 819, 825, 862 p-jump-okp-implies-r-jump-okp, 732 p-jump-step, 599, 624, 672, 713, 790,

822, 862 p-loadablep, 21, 695, 718, 786–798,

835, 848, 849, 851, 895–898 p-loadablep-if, 835 p-loadablep-implies-not-zerop-p

-word-size, 718 p-loadablep-implies-r-loadablep, 848 p-locn-okp, 592, 620, 682, 721, 738, 797, 818, 824, 858 p-locn-okp-implies-r-locn-okp, 738 p-locn-step, 592, 623, 682, 721, 797,

821, 858 p-lsh-bitv-okp, 618, 623, 677, 719,

736, 795, 818, 824, 870 p-lsh-bitv-okp-implies-r-lsh-bitv

-okp, 736 p-lsh-bitv-step, 618, 626, 677, 719, 795, 821, 870 p-lt-addr-okp, 605, 622, 673, 713,

732, 791, 816, 823, 865 p-lt-addr-okp-implies-r-lt-addr

-okp, 732 p-lt-addr-step, 605, 625, 673, 713, 791, 820, 865 p-lt-int-okp, 610, 622, 675, 715, 734, 793, 817, 824, 867

p-lt-int-okp-implies-r-lt-int-o

kp, 734 p-lt-int-step, 610, 625, 675, 715, 793,

820, 867 p-lt-nat-okp, 614, 622, 676, 716, 735, 794, 817, 824, 868 p-lt-nat-okp-implies-r-lt-nat-o

kp, 735 p-lt-nat-step, 614, 626, 676, 716, 794,

821, 868 p-max-ctrl-stk-size, 21–23, 588, 590–

620, 637, 643, 653–655, 680– 682, 684, 686–692, 695–701, 711, 848, 849, 895, 896

p-max-temp-stk-size, 21–23, 588, 591– 620, 637, 643, 666, 668, 684, 688, 689, 695–701, 712, 848, 849, 895, 896

p-mult2-nat-okp, 615, 622, 676, 717,

735, 794, 817, 824, 868 p-mult2-nat-okp-implies-r-mult2

-nat-okp, 735 p-mult2-nat-step, 615, 626, 676, 717,

794, 821, 868 p-mult2-nat-with-carry-out-okp, 615,

623, 668, 709, 730, 788, 817, 824, 869

p-mult2-nat-with-carry-out-okp-i

mplies-r-mult2-nat-with-carry-out-

okp, 730 p-mult2-nat-with-carry-out-step, 615,

626, 668, 709, 788, 821, 869 p-neg-int-okp, 609, 622, 675, 715,

734, 793, 817, 824, 866 p-neg-int-okp-implies-r-neg-int

-okp, 734 p-neg-int-step, 610, 625, 675, 715,

793, 820, 866 p-no-op-okp, 603, 621, 665, 702, 727,

786, 819, 825, 864 p-no-op-okp-implies-r-no-op-okp, 727 p-no-op-step, 603, 625, 665, 702, 786,

823, 864 p-not-bitv-okp, 617, 623, 677, 718,

736, 795, 818, 824, 869 p-not-bitv-okp-implies-r-not-bitv

-okp, 735 p-not-bitv-step, 617, 626, 677, 718,

795, 821, 869 p-not-bool-okp, 620, 623, 678, 720,

736, 796, 818, 824, 871 p-not-bool-okp-implies-r-not-bo

ol-okp, 736 p-not-bool-step, 620, 626, 678, 720,

796, 821, 871 p-objectp, 589, 590, 627, 636, 637,

639, 640, 696, 702–705, 707, 709, 711, 713, 721, 727, 728, 845, 847

p-objectp-bool, 713 p-objectp-cadr-assoc-p-data-seg

ment, 703 p-objectp-cdr-assoc-proper-p-ali

stp, 707 p-objectp-cdr-get-proper-p-alistp, 721 p-objectp-get-p-data-segment, 702 p-objectp-get-temp-stk, 709 p-objectp-implies-not-dl, 845 p-objectp-implies-r-objectp, 728 p-objectp-implies-r-usr-data-ob

jectp, 847 p-objectp-implies-r-usr-data-typep, 847 p-objectp-is-r-usr-data-typep, 727 p-objectp-opener, 639 p-objectp-top-p-temp-stk, 704 p-objectp-top1-p-temp-stk, 704 p-objectp-top2-p-temp-stk, 705 p-objectp-type, 589, 592, 596–601,

603–620, 636, 637, 701, 705, 706

p-objectp-type-opener, 705 p-or-bitv-okp, 616, 623, 676, 718,

735, 794, 817, 824, 869 p-or-bitv-okp-implies-r-or-bitv

-okp, 735 p-or-bitv-step, 616, 626, 676, 718,

794, 821, 869 p-or-bool-okp, 619, 623, 678, 719,

736, 795, 818, 824, 870 p-or-bool-okp-implies-r-or-bool

-okp, 736 p-or-bool-step, 619, 626, 678, 719,

795, 821, 870 p-pc, 22, 588, 590, 591, 598, 600, 637, 642–644, 648, 653–655, 682, 687, 689, 690, 726, 729

p-pop*-okp, 595, 621, 670, 710, 730,

789, 819, 825, 860 p-pop*-okp-implies-r-pop*-okp, 730 p-pop*-step, 595, 624, 670, 710, 789,

822, 860 p-pop-call-okp, 598, 621, 690, 725,

739, 798, 819, 825, 861 p-pop-call-okp-implies-r-pop-ca

ll-okp, 739 p-pop-call-step, 598, 624, 690, 725,

798, 822, 861 p-pop-global-okp, 596, 621, 665, 706,

728, 787, 819, 825, 861 p-pop-global-okp-implies-r-pop-

global-okp, 728 p-pop-global-step, 597, 624, 665, 706,

787, 822, 861 p-pop-local-okp, 596, 621, 666, 708,

729, 787, 819, 825, 861 p-pop-local-okp-implies-r-pop-l

ocal-okp, 729 p-pop-local-step, 596, 624, 666, 708,

787, 822, 861 p-pop-locn-okp, 597, 621, 681, 721,

738, 797, 819, 825, 861 p-pop-locn-okp-implies-r-pop-lo

cn-okp, 737 p-pop-locn-step, 597, 624, 681, 721,

797, 822, 861 p-pop-okp, 595, 621, 672, 712, 732,

790, 818, 825, 860 p-pop-okp-implies-r-pop-okp, 732 p-pop-step, 595, 624, 672, 712, 790,

822, 860 p-popj-okp, 600, 621, 672, 713, 732,

791, 819, 825, 862 p-popj-okp-implies-r-popj-okp, 732 p-popj-step, 600, 624, 672, 713, 791,

822, 863 p-popn-okp, 596, 621, 670, 710, 730,

789, 819, 825, 860 p-popn-okp-implies-r-popn-okp, 730 p-popn-step, 596, 624, 670, 710, 789,

822, 860 p-preserves-proper-p-statep, 850 p-prog-segment, 21, 23, 588–620, 626–

629, 636, 637, 640, 642–644, 648, 653–655, 682, 686–690, 695–701, 706, 711, 722, 723, 726, 728, 729, 738, 845–849, 895, 896

p-psw, 23, 626, 665–682, 688, 690, 694, 702, 703, 706–722, 725– 739, 786–798, 828–831, 835, 849–851, 858–871, 895–898

p-push-constant-okp, 592, 620, 671,

711, 731, 789, 818, 824, 858 p-push-constant-okp-implies-r-p ush-constant-okp, 731 p-push-constant-step, 592, 623, 671, 711, 789, 821, 858 p-push-ctrl-stk-free-size-okp, 593, 620,

671, 712, 731, 789, 818, 825, 859

p-push-ctrl-stk-free-size-okp-i

mplies-r-push-ctrl-stk-free-size-

okp, 731 p-push-ctrl-stk-free-size-step, 593, 623, 671, 712, 789, 822, 859 p-push-global-okp, 593, 620, 665, 703, 727, 786, 818, 825, 859

p-push-global-okp-implies-r-pus h-global-okp, 727

p-push-global-step, 593, 623, 665, 703,

786, 822, 859 p-push-local-okp, 592, 620, 666, 707, 729, 787, 818, 824, 859

p-push-local-okp-implies-r-push

-local-okp, 729 p-push-local-step, 593, 623, 666, 707, 787, 822, 859 p-push-temp-stk-free-size-okp, 594,

620, 671, 712, 731, 790, 818, 825, 859 p-push-temp-stk-free-size-okp-i

mplies-r-push-temp-stk-free-size-

okp, 731 p-push-temp-stk-free-size-step, 594,

623, 671, 712, 790, 822, 859 p-push-temp-stk-index-okp, 594, 620,

672, 712, 731, 790, 818, 825, 859

p-push-temp-stk-index-okp-implie

s-r-push-temp-stk-index-okp, 731 p-push-temp-stk-index-step, 594, 624,

672, 712, 790, 822, 859 p-pushj-okp, 600, 621, 672, 713, 732,

790, 819, 825, 862 p-pushj-okp-implies-r-pushj-okp, 732 p-pushj-step, 600, 624, 672, 713, 790,

822, 862 p-r-ins-okp, 828 p-r-ins-okp2, 828 p-r-ins-step-owc, 830 p-r-ins-step2-owc, 829 p-r-owc-corrolary, 851 p-ret-okp, 591, 620, 694, 726, 739,

798, 818, 824, 858 p-ret-okp-implies-r-ret-okp, 739 p-ret-step, 591, 623, 694, 726, 798,

821, 858 p-rsh-bitv-okp, 618, 623, 677, 719,

736, 795, 818, 824, 870 p-rsh-bitv-okp-implies-r-rsh-bitv

-okp, 736 p-rsh-bitv-step, 618, 626, 677, 719,

795, 821, 870 p-set-global-okp, 601, 621, 671, 710,

731, 789, 819, 825, 863 p-set-global-okp-implies-r-set-

global-okp, 731 p-set-global-step, 601, 624, 671, 710,

789, 822, 863 p-set-local-okp, 601, 621, 671, 710,

731, 789, 819, 825, 863 p-set-local-okp-implies-r-set-l

ocal-okp, 731 p-set-local-step, 601, 624, 671, 710,

789, 822, 863 p-state, 5, 588, 591–620, 695–701 p-statep, 637, 642, 643 p-step, 626, 830, 831, 835, 849, 871 p-step-preserves-p-loadablep, 835 p-step-preserves-proper-p-statep, 831 p-step1, 626 p-sub-addr-okp, 604, 622, 672, 713,

732, 791, 819, 825, 864 p-sub-addr-okp-implies-r-sub-ad

dr-okp, 732 p-sub-addr-step, 604, 625, 672, 713, 791, 823, 864 p-sub-int-okp, 608, 622, 674, 714,

733, 792, 817, 824, 866 p-sub-int-okp-implies-r-sub-int

-okp, 733 p-sub-int-step, 608, 625, 674, 714, 792, 820, 866 p-sub-int-with-carry-okp, 608, 622,

674, 715, 733, 792, 817, 824, 866

p-sub-int-with-carry-okp-implie

s-r-sub-int-with-carry-okp, 733 p-sub-int-with-carry-step, 609, 625,

674, 715, 792, 820, 866 p-sub-nat-okp, 612, 622, 675, 716,

734, 793, 817, 824, 868 p-sub-nat-okp-implies-r-sub-nat

-okp, 734 p-sub-nat-step, 613, 625, 675, 716, 793, 820, 868 p-sub-nat-with-carry-okp, 613, 622,

675, 716, 734, 793, 817, 824, 868

p-sub-nat-with-carry-okp-implie

s-r-sub-nat-with-carry-okp, 734 p-sub-nat-with-carry-step, 613, 625,

676, 716, 793, 821, 868 p-sub1-int-okp, 609, 622, 674, 715,

734, 792, 817, 824, 866 p-sub1-int-okp-implies-r-sub1-i

nt-okp, 733 p-sub1-int-step, 609, 625, 674, 715, 792, 820, 866 p-sub1-nat-okp, 614, 622, 676, 716,

735, 794, 817, 824, 868 p-sub1-nat-okp-implies-r-sub1-n

at-okp, 735 p-sub1-nat-step, 614, 625, 676, 716,

794, 821, 868 p-temp-stk, 22, 23, 588, 591–620,

637, 643, 644, 662, 666, 668, 684, 687–690, 712, 727, 728, 848, 849, 895, 896

p-test-and-jump-okp, 601–603 p-test-and-jump-step, 601–603 p-test-bitv-and-jump-okp, 603, 621,

680, 721, 737, 797, 819, 825, 864

p-test-bitv-and-jump-okp-implie

s-r-test-bitv-and-jump-okp, 737 p-test-bitv-and-jump-step, 603, 624,

680, 721, 797, 823, 864 p-test-bitvp, 270, 299, 603 p-test-bool-and-jump-okp, 602, 621,

680, 720, 737, 797, 819, 825, 863

p-test-bool-and-jump-okp-implie

s-r-test-bool-and-jump-okp, 737 p-test-bool-and-jump-step, 603, 624,

680, 720, 797, 823, 864 p-test-boolp, 270, 298, 603 p-test-int-and-jump-okp, 602, 621,

680, 720, 737, 797, 819, 825, 863

p-test-int-and-jump-okp-implies

-r-test-int-and-jump-okp, 737 p-test-int-and-jump-step, 602, 624,

680, 720, 797, 823, 863 p-test-intp, 269, 297, 602 p-test-nat-and-jump-okp, 602, 621,

679, 720, 737, 796, 819, 825, 863

p-test-nat-and-jump-okp-implies

-r-test-nat-and-jump-okp, 737 p-test-nat-and-jump-step, 602, 624,

679, 720, 796, 823, 863 p-test-natp, 269, 297, 602 p-word-size, 21, 23, 588, 589, 591–

620, 627, 628, 637, 639, 643, 695–701, 705, 706, 711, 712, 718, 728, 738, 847–849, 852, 896–898

p-xor-bitv-okp, 617, 623, 677, 719,

736, 795, 818, 824, 870 p-xor-bitv-okp-implies-r-xor-bitv

-okp, 736 p-xor-bitv-step, 617, 618, 626, 677,

719, 795, 821, 870 pack-instruction, 30, 33 pair-formal-vars-with-actuals, 590 pair-temps-with-initial-values, 590, 683,

686, 687, 690, 724, 725 pathological-difference, 120 pc, 6, 8, 9, 11–13, 279, 283, 284, 292,

293, 296–299, 528, 592, 594, 595, 599–601

pcpp, 269, 271, 274, 343, 503, 505,

589, 640, 706 pcpp-cons, 505 piton-opcodes, 270, 272, 845 plausible-data-link-tablep, 268, 857,

896–898 plausible-data-link-tablep-link

-table-for-segment, 897 plus-1, 211 plus-add1-first, 508 plus-commutes2, 122 plus-difference, 353 plus-difference{special}, 778 plus-equal-0, 243 plus-sub1, 160 plus-zerop, 160 pop, 6, 22, 589–591, 595–600, 602–

620, 637, 653, 701 pop*-one-way-correspondence-p-r, 670 pop*-one-way-correspondence-r-i, 507 pop*-preserves-p-loadablep, 788 pop*-preserves-proper-p-statep, 710 pop*-preserves-r-equal, 755 pop*-proper-r-statep, 555 pop-call-one-way-correspondence -p-r, 690 -r-i, 546

pop-call-preserves-p-loadablep, 798 pop-call-preserves-proper-p-statep, 725 pop-call-preserves-r-equal, 785 pop-call-proper-r-statep, 564 pop-global-one-way-corresponden

ce-p-r, 665 ce-r-i, 508

pop-global-preserves-p-loadablep, 787 pop-global-preserves-proper-p-st

atep, 706 pop-global-preserves-r-equal, 749 pop-global-proper-r-statep, 556 pop-local-one-way-correspondence

-p-r, 666 -r-i, 508

pop-local-preserves-p-loadablep, 787 pop-local-preserves-proper-p-st

atep, 708 pop-local-preserves-r-equal, 751 pop-local-proper-r-statep, 555 pop-locn-one-way-correspondence

-p-r, 681 -r-i, 527

pop-locn-preserves-p-loadablep, 797 pop-locn-preserves-proper-p-statep, 721 pop-locn-preserves-r-equal, 775 pop-locn-proper-r-statep, 563 pop-one-way-correspondence-p-r, 672 pop-one-way-correspondence-r-i, 507 pop-preserves-p-loadablep, 790 pop-preserves-proper-p-statep, 712 pop-preserves-r-equal, 758 pop-proper-r-statep, 554 pop-stk, 52, 66, 67, 96–101, 271, 273,

276, 277, 284, 286–289, 291, 293, 294, 296, 300–310, 312– 320, 323–326, 328, 329, 539, 744, 776

pop-stk-n, 271, 275, 284, 285, 541,

542 popj-one-way-correspondence-p-r, 672 popj-one-way-correspondence-r-i, 510 popj-preserves-p-loadablep, 790 popj-preserves-proper-p-statep, 713 popj-preserves-r-equal, 760 popj-proper-r-statep, 556 popn, 589, 591, 596, 669 popn-is-cdr-n, 669 popn-one-way-correspondence-p-r, 670 popn-one-way-correspondence-r-i, 508 popn-preserves-p-loadablep, 789 popn-preserves-proper-p-statep, 710 popn-preserves-r-equal, 756 popn-proper-r-statep, 555 post-inc-p, 43, 45, 177, 180 powerful-length-put, 499 pre-dec-p, 43–46, 177, 179 prog-label-tables, 25, 28, 148, 149 prog-label-tables-i-link-tables, 149 prog-links, 25, 28, 148, 149 prog-links-i-link-tables, 149 program-body, 5, 6, 8, 20, 269, 272,

274, 279, 283, 292, 293, 296, 344, 356–362, 367, 500, 505, 509, 527, 528, 544, 547–549, 564, 590, 627–629, 636, 642, 643, 648, 711, 722, 726, 746, 845

proper-alistp, 501, 502, 555, 557, 857,

858 proper-alistp-p-data-segment, 858 proper-alistp-put-assoc, 502 proper-alistp-r-usr-data-segment, 502 proper-i-usr-data-area, 54 proper-i-usr-data-segmentp, 54, 246,

247, 588, 853, 855, 897 proper-labeled-p-instructionsp, 635,

641, 698, 711, 837, 845, 846 proper-labeled-p-instructionsp-i

mplies-labelp-and-instructionp,

641 mplies-litatom-labels, 837 mplies-r-program-bodyp, 846

proper-m-statep, 42, 43, 45–47, 268,

851, 856 proper-m-statep-i->m, 856 proper-p-add-addr-instructionp, 630,

633, 646, 844 proper-p-add-int-instructionp, 630, 634,

646, 841 proper-p-add-int-with-carry-inst

ructionp, 630, 634, 647, 841 proper-p-add-nat-instructionp, 631,

634, 647, 841 proper-p-add-nat-with-carry-inst

ructionp, 631, 634, 647, 841 proper-p-add1-int-instructionp, 630,

634, 647, 841 proper-p-add1-nat-instructionp, 631,

634, 647, 841 proper-p-alistp, 636, 642, 643, 653,

654, 696, 707, 721–724 proper-p-alistp-append, 722 proper-p-alistp-pair-temps-with

-initial-values, 724 proper-p-alistp-pairlist, 723 proper-p-alistp-put-assoc, 707 proper-p-alistp-put-value-indire

ct, 721 proper-p-and-bitv-instructionp, 631,

635, 648, 842 proper-p-and-bool-instructionp, 632,

635, 648, 842 proper-p-area, 637 proper-p-call-instructionp, 626, 632,

644, 842 proper-p-ctrl-stkp, 636, 637, 643, 644,

693, 697, 701, 726 proper-p-ctrl-stkp-implies-prope

r-p-ctrl-stkp, 726 r-p-framep, 726 rp, 693

proper-p-data-segmentp, 637, 643, 644,

700–704, 848, 857 proper-p-data-segmentp-implies-

all-p-objectps, 702 proper-p-data-segmentp-implies-p

roper-r-usr-data-segmentp, 848 proper-p-data-segmentp-proper-a

listp, 857 proper-p-data-segmentp-put-asso

c, 704 proper-p-deposit-instructionp, 630, 634, 646, 841 proper-p-deposit-temp-stk-instr uctionp, 628, 633, 645, 843 proper-p-div2-nat-instructionp, 631, 635, 647, 842 proper-p-eq-instructionp, 630, 634,

646, 841 proper-p-fetch-instructionp, 630, 634,

646, 841 proper-p-fetch-temp-stk-instructi onp, 628, 633, 645, 843 proper-p-framep, 636, 637, 697, 701,

726 proper-p-instructionp, 632, 635, 641– 644, 698, 844, 845 proper-p-instructionp-implies-me mber-piton-opcodes, 845 proper-p-instructionp-implies-r -instructionp, 845 proper-p-instructionp-is-proper -p-instructionp1, 844 proper-p-instructionp-opener, 644 proper-p-instructionp1, 842, 844 proper-p-instructionp2, 841, 844 proper-p-instructionp2-implies-

member-piton-opcodes, 844 proper-p-int-to-nat-instructionp, 631,

634, 647, 841 proper-p-jump-case-instructionp, 629,

633, 646, 843 proper-p-jump-if-temp-stk-empty

-instructionp, 628, 633, 645, 843 proper-p-jump-if-temp-stk-full-i

nstructionp, 627, 632, 645, 843 proper-p-jump-instructionp, 628, 633,

645, 843 proper-p-locn-instructionp, 627, 632,

644, 842 proper-p-lsh-bitv-instructionp, 632, 635, 648, 842 proper-p-lt-addr-instructionp, 630, 634,

646, 841 proper-p-lt-int-instructionp, 630, 634,

647, 841 proper-p-lt-nat-instructionp, 631, 634,

647, 842 proper-p-mult2-nat-instructionp, 631,

634, 647, 842 proper-p-mult2-nat-with-carry-o

ut-instructionp, 631, 635, 647,

842 proper-p-neg-int-instructionp, 630, 634,

647, 841 proper-p-no-op-instructionp, 630, 633,

646, 844 proper-p-not-bitv-instructionp, 631,

635, 648, 842 proper-p-not-bool-instructionp, 632,

635, 648, 842 proper-p-or-bitv-instructionp, 631, 635,

648, 842 proper-p-or-bool-instructionp, 632, 635,

648, 842 proper-p-pop*-instructionp, 628, 633,

645, 843 proper-p-pop-call-instructionp, 628,

633, 645, 843 proper-p-pop-global-instructionp, 628,

633, 645, 843 proper-p-pop-instructionp, 628, 633,

645, 843 proper-p-pop-local-instructionp, 628,

633, 645, 843 proper-p-pop-locn-instructionp, 628,

633, 645, 843 proper-p-popj-instructionp, 629, 633,

646, 844 proper-p-popn-instructionp, 628, 633,

645, 843 proper-p-prog-segmentp, 636, 637, 641–

644, 699, 711, 722–724, 845– 847

proper-p-prog-segmentp-contains -proper-labeled-p-instructionsp,

845 proper-p-prog-segmentp-implies-r-prog-segmentp, 847 r-prog-segmentp-generalized, 846

proper-p-prog-segmentp-implies-p roper-labled-p-instructionsp, 711 roper-p-programp, 641 roper-p-temp-var-dclsp, 724 proper-p-program-bodyp, 635, 636,

699 proper-p-programp, 636, 641, 699 proper-p-push-constant-instructi onp, 627, 632, 644, 842, 845

proper-p-push-ctrl-stk-free-size

-instructionp, 627, 632, 645, 843 proper-p-push-global-instructio np, 627, 632, 644, 843

proper-p-push-local-instructionp, 627,

632, 644, 843 proper-p-push-temp-stk-free-size

-instructionp, 627, 632, 645, 843 proper-p-push-temp-stk-index-in

structionp, 627, 632, 645, 843 proper-p-pushj-instructionp, 629, 633,

646, 843 proper-p-ret-instructionp, 627, 632,

644, 842 proper-p-rsh-bitv-instructionp, 632, 635, 648, 842

proper-p-set-global-instructionp, 629,

633, 646, 844 proper-p-set-local-instructionp, 629, 633, 646, 844 proper-p-statep, 637, 643, 665–682,

688, 690, 694, 701–703, 706– 722, 725–739, 786–798, 828– 831, 835, 849–851, 858–871, 895–898

proper-p-statep-implies-add1-p-p

cp, 648 proper-p-statep-implies-proper-

r-statep, 849 proper-p-statep-implies-proper-i -usr-data-segmentp, 897 proper-p-statep-implies-proper-p

-instructionp, 642 proper-p-statep-implies-small-n

aturalp-length-p-temp-stk, 712 aturalp-p-max-ctrl-stk-size, 711 aturalp-p-max-temp-stk-size, 712

proper-p-statep-restructuring, 643 proper-p-statep1, 642, 643, 648, 653–

655, 662, 680–682, 684, 688, 694, 703, 708, 711, 722, 726– 729

proper-p-statep1-implies-proper

-p-framep, 726 proper-p-statep1-properties, 643 proper-p-sub-addr-instructionp, 630,

634, 646, 844 proper-p-sub-int-instructionp, 630, 634,

647, 841 proper-p-sub-int-with-carry-inst

ructionp, 630, 634, 647, 841 proper-p-sub-nat-instructionp, 631,

634, 647, 841 proper-p-sub-nat-with-carry-inst

ructionp, 631, 634, 647, 842 proper-p-sub1-int-instructionp, 630,

634, 647, 841 proper-p-sub1-nat-instructionp, 631,

634, 647, 842 proper-p-temp-stk-cdr, 704 proper-p-temp-stkp, 637, 643, 644,

661, 697, 701, 704, 705, 709, 710, 724

proper-p-temp-stkp-cdr-n, 710 proper-p-temp-stkp-implies-prope

rp, 661 proper-p-temp-stkp-put, 709 proper-p-temp-var-dclsp, 636, 698,

724, 738, 837 proper-p-temp-var-dclsp-implies

-all-p-objectps, 738 -r-temp-var-dclsp, 837

proper-p-test-bitv-and-jump-inst

ructionp, 629, 633, 646, 844 proper-p-test-bool-and-jump-inst

ructionp, 629, 633, 646, 844 proper-p-test-int-and-jump-inst

ructionp, 629, 633, 646, 844 proper-p-test-nat-and-jump-inst ructionp, 629, 633, 646, 844 proper-p-xor-bitv-instructionp, 631, 635, 648, 842 proper-r-state-implies-legal-r-t

sp, 545 proper-r-statep, 273, 344, 356, 358–

362, 367, 369, 371, 500, 502– 528, 532, 534, 536, 537, 540, 541, 545–564, 576, 585, 587, 588, 741, 742, 744, 746–776, 781–786, 834–836, 849, 851, 855, 856, 872–895

proper-r-statep-if, 585

proper-r-statep-implies-cstkp, 751 proper-r-statep-implies-i-state

-okp-r->i, 371

-okp-r->i-opened, 371 -okp-r->i-rewrite, 851 proper-r-statep-implies-lessp-0 -r-word-size, 518

proper-r-statep-implies-non-empt

y-stkp-push, 749 proper-r-statep-implies-proper-i -user-data-segmentp, 588 -user-data-segmentp-bridge, 855

proper-r-statep-implies-r-instr

uctionp, 505 proper-r-statep-implies-r-loada blep-and-cstk, 517 proper-r-statep-implies-r-progr

amp, 362 proper-r-statep-implies-tag-unt

ag, 745 ag-cstk, 781

proper-r-statep-implies-tstkp, 744 proper-r-statep-properties, 344 proper-r-statep-properties{augmented},

746 proper-r-statep-r, 588 proper-r-statep-r-halt, 576 proper-r-statep-r-ins-step2, 585 proper-r-statep-r-state, 552 proper-r-statep-r-step, 585 proper-r-usr-data-area, 272, 273 proper-r-usr-data-segmentp, 273, 346,

502, 551, 553, 555, 588, 848 proper-r-usr-data-segmentp-depo

sit-adp, 555 proper-r-usr-data-segmentp-implie

s-proper-alistp, 502

s-proper-i-usr-data-segmentp, 588 properp, 39, 197, 198, 531, 533, 547,

632, 644, 659, 661, 662, 669, 670, 685, 686, 693, 694, 722– 724, 842

properp-all-but-last, 659 properp-cdr-cdr-n, 670 properp-cdr-n, 669 properp-first-n, 723 properp-implies-properp-cdr, 662 properp-p->r ctrl-stk1, 693 properp-p-ctrl-stkp, 694 properp-p-temp-stkp, 662 properp-program-body, 547 properp-put, 669 properp-rev, 39 properp-strip-cadrs, 531 properp-v-to-bitv, 197 push, 589–594, 597, 598, 600, 604–

620 push-constant-one-way-correspon

dence-p-r, 671 dence-r-i, 505

push-constant-preserves-p-loada

blep, 789 push-constant-preserves-proper-p

-statep, 711 push-constant-preserves-r-equal, 757 push-constant-proper-r-statep, 554 push-ctrl-stk-free-size-one-way

-correspondence-p-r, 671 -correspondence-r-i, 506

push-ctrl-stk-free-size-preserve s-p-loadablep, 789 s-proper-p-statep, 712 s-r-equal, 757

push-ctrl-stk-free-size-proper-

r-statep, 554 push-global-one-way-corresponde

nce-p-r, 665 nce-r-i, 504

push-global-preserves-p-loadablep, 786 push-global-preserves-proper-p-

statep, 703 push-global-preserves-r-equal, 746 push-global-proper-r-statep, 553 push-local-one-way-corresponden

ce-p-r, 666 ce-r-i, 504

push-local-preserves-p-loadablep, 787 push-local-preserves-proper-p-st

atep, 707 push-local-preserves-r-equal, 749 push-local-proper-r-statep, 554 push-stk, 52, 67, 68, 101–104, 271,

276, 278–282, 293, 322, 323, 533–535, 537, 539, 541, 543, 780

push-stk-n, 271, 275, 532, 535, 536, 541, 542, 780 push-temp-stk-free-size-one-way -correspondence-p-r, 671 -correspondence-r-i, 506 push-temp-stk-free-size-preserve s-p-loadablep, 790 s-proper-p-statep, 712 s-r-equal, 758

push-temp-stk-free-size-proper-

r-statep, 554 push-temp-stk-index-one-way-cor respondence-p-r, 672 respondence-r-i, 507 push-temp-stk-index-preserves-p

-loadablep, 790 roper-p-statep, 712 push-temp-stk-index-preserves-r

-equal, 758 push-temp-stk-index-proper-r-st

atep, 554 pushj-one-way-correspondence-p-

r, 672 pushj-one-way-correspondence-r-i, 510 pushj-preserves-p-loadablep, 790 pushj-preserves-proper-p-statep, 713 pushj-preserves-r-equal, 759 pushj-proper-r-statep, 556 put, 48, 142, 153, 158, 164–169, 196,

213, 367, 368, 499, 555, 589, 654, 655, 662, 663, 667–669, 680, 704, 709, 742–744, 750, 751, 777

put-add1-cons, 158 put-append, 663 put-append-1, 164 put-append-1{special}, 663 put-append-2, 165 put-append-2-add1, 165 put-append-2-sub1, 165 put-append-2{special}, 667 put-append-3, 165 put-append-3-add1, 165 put-append-3-sub1, 165 put-append-nat-0s-sub1-sub1, 668 put-assoc, 47, 48, 165–169, 190, 227,

367, 368, 501, 502, 543, 555, 654, 655, 657, 658, 660, 664, 685, 687, 689, 703, 704, 707, 742–744, 751, 777, 779

put-assoc-cdr-assoc, 744 put-assoc-cstk-p->r sys-data

-segment-call, 686 -segment-local, 655 -segment-pop-call, 689

put-assoc-put-assoc, 368 put-cdr-p->r ctrl-stk-1, 655 put-cdr-p->r ctrl-stk-2, 680 put-equal, 196 put-find-position-of-var, 654 put-is-put-value-indirect, 680 put-link-area, 165 put-link-area-no-op, 213 put-link-segment, 165 put-link-segment-cstk, 166 put-link-segment-cstk-add1, 166 put-link-segment-cstk-sub1, 167 put-link-segment-no-op, 213 put-link-segment-tstk, 166 put-link-segment-tstk-add1, 167 put-link-segment-tstk-sub1, 167 put-past-boot-code, 153 put-past-boot-code-add1, 153 put-past-boot-code-sub1, 153 put-plus-append, 654 put-plus-append-commuted, 680 put-put, 368 put-value, 48, 590 put-value-indirect, 597, 680, 681, 721 put-zero-cons, 158

quotient-add1-xx-2, 221 quotient-add1-xxyy-2, 220 quotient-exp-2-2, 171 quotient-xx-2, 220 quotient-xxyy-2, 220

r, 336, 337, 587, 588, 836, 849, 851,

856, 857, 894–896, 898 r->i, 23, 35, 371, 503–517, 519–528,

545, 546, 549, 586–588, 851– 853, 855, 856, 895–898

r->i-if, 586 r->i-r-halt, 587 r->i pc, 23, 358, 360, 361, 367–369,

371, 509, 510, 525, 537, 549 r->i pc-folder-ret-case, 549 r->i pc-folder-test-int-and-

jump-case, 525 r->i pc-opener-in-jump-case, 509 r->i pc-opener-in-popj-case, 510 r->i pc-prelude, 537 r->i pc-tag-add-adp-1, 358 r->i pc-tag-add-adp-1-lemma1, 358

-0, 358 r->i pc-tag-add-adp-1-lemma2, 358 r->i psw, 23, 24 r-add-addr-okp, 300, 332, 510, 556,

577, 729, 752, 753, 816, 882 r-add-addr-step, 300, 335, 510, 556,

581, 667, 753, 882 r-add-addr-step-clock, 301, 338, 510,

584 r-add-int-okp, 305, 332, 515, 558,

577, 733, 762, 813, 832, 884 r-add-int-step, 305, 335, 515, 558,

578, 674, 762, 884 r-add-int-step-clock, 306, 338, 516,

581 r-add-int-with-carry-okp, 306, 332,

516, 558, 577, 733, 762, 813, 832, 885

r-add-int-with-carry-step, 306, 335,

516, 558, 578, 674, 762, 885 r-add-int-with-carry-step-clock, 307,

338, 516, 581 r-add-nat-okp, 313, 332, 519, 559,

577, 734, 765, 766, 813, 832, 887

r-add-nat-step, 314, 335, 519, 559,

579, 675, 766, 887 r-add-nat-step-clock, 314, 339, 519,

582 r-add-nat-with-carry-okp, 314, 332,

519, 559, 577, 730, 753, 813, 832, 887

r-add-nat-with-carry-step, 315, 335, 519, 559, 579, 668, 753, 887, 888

r-add-nat-with-carry-step-clock, 316,

339, 519, 582 r-add1-int-okp, 307, 332, 516, 558,

577, 733, 763, 813, 832, 885 r-add1-int-step, 307, 335, 516, 558,

578, 674, 763, 885 r-add1-int-step-clock, 308, 338, 516,

581 r-add1-nat-okp, 316, 332, 520, 559,

577, 729, 752, 813, 832, 888 r-add1-nat-step, 316, 335, 520, 559,

579, 667, 752, 888 r-add1-nat-step-clock, 316, 339, 520,

582 r-and-bitv-okp, 324, 333, 522, 561,

578, 735, 769, 814, 832, 891 r-and-bitv-step, 324, 336, 522, 561,

579, 677, 769, 891 r-and-bitv-step-clock, 325, 339, 522,

582 r-and-bool-okp, 329, 333, 524, 561,

578, 736, 771, 814, 832, 892 r-and-bool-step, 329, 336, 524, 561,

579, 678, 772, 892, 893 r-and-bool-step-clock, 329, 340, 524,

583 r-c-flg, 24, 273, 275–295, 297, 299–

302, 304, 305, 307, 308, 311– 314, 316–318, 321, 324–330, 346, 371, 691

r-call-okp, 275, 289, 330, 545, 564,

576, 739, 776, 783, 814, 872 r-call-step, 275, 290, 333, 545, 564,

580, 688, 783, 872 r-call-step-clock, 276, 337, 545, 583 r-cfp, 23, 273–296, 299–318, 320–

330, 344, 371, 517, 549, 690, 739, 746

r-csp, 24, 273–296, 299–318, 320– 330, 344, 345, 371, 543–545, 690, 739, 746, 748, 751, 781, 786

r-current-instruction, 274, 336, 340, 503–517, 519–528, 545, 546, 549, 553–564, 585, 587, 648, 741, 742, 746, 749–776, 782– 786, 834, 835, 872–893

r-current-instruction-p->r, 648 r-current-program, 274, 277–280, 283,

284, 286–288, 292–299, 358 r-deposit-okp, 304, 332, 514, 557,

577, 729, 752, 813, 832, 884 r-deposit-step, 304, 335, 514, 557,

578, 666, 752, 884 r-deposit-step-clock, 305, 338, 514,

581 r-deposit-temp-stk-okp, 291, 331, 514,

558, 576, 730, 755, 815, 878 r-deposit-temp-stk-step, 291, 334, 514,

558, 580, 669, 755, 878, 879 r-deposit-temp-stk-step-clock, 292, 338,

514, 584 r-div2-nat-okp, 322, 333, 522, 560,

577, 735, 768, 814, 832, 890 r-div2-nat-step, 322, 336, 522, 560,

579, 676, 768, 890 r-div2-nat-step-clock, 323, 339, 522,

582 r-eq-okp, 301, 302, 332, 512, 557,

577, 732, 760, 761, 813, 831, 883

r-eq-step, 302, 335, 512, 557, 578,

673, 761, 883 r-eq-step-clock, 302, 338, 512, 581 r-equal, 274, 665–682, 688, 690, 694,

739–742, 746–777, 783–786, 829, 830, 834–836, 849

r-equal-if, 829 r-equal-implies-equal-add1-r-pcp, 741 r-equal-implies-equal-all-r-obje

ctps, 776 r-equal-implies-equal-empty-stkp, 747 r-equal-implies-equal-fetch-n-c

all, 777 r-equal-implies-equal-fetch-n-p

op-call, 785 r-equal-implies-equal-get-cstk, 748 r-equal-implies-equal-get-tstk, 747 r-equal-implies-equal-length, 747 r-equal-implies-equal-r-add-add

r-okp, 752 r-equal-implies-equal-r-add-int

-okp, 762

-with-carry-okp, 762 r-equal-implies-equal-r-add-nat

-okp, 765

-with-carry-okp, 753 r-equal-implies-equal-r-add1-int

-okp, 762 r-equal-implies-equal-r-add1-nat

-okp, 752 r-equal-implies-equal-r-and-bitv

-okp, 769 r-equal-implies-equal-r-and-boo

l-okp, 771 r-equal-implies-equal-r-call-okp, 776 r-equal-implies-equal-r-current -instruction, 740 r-equal-implies-equal-r-deposit

-okp, 752

-temp-stk-okp, 755 r-equal-implies-equal-r-div2-nat

-okp, 768 r-equal-implies-equal-r-eq-okp, 760 r-equal-implies-equal-r-fetch-o

kp, 761 r-equal-implies-equal-r-fetch-te mp-stk-okp, 754

r-equal-implies-equal-r-ins-okp, 834

2, 834 r-equal-implies-equal-r-int-to-

nat-okp, 765 r-equal-implies-equal-r-jump-ca

se-okp, 775 r-equal-implies-equal-r-jump-if -temp-stk-empty-okp, 772 -temp-stk-full-okp, 772 r-equal-implies-equal-r-jump-okp, 759 r-equal-implies-equal-r-locn-okp, 775 r-equal-implies-equal-r-lsh-bitv

-okp, 770 r-equal-implies-equal-r-lt-addr

-okp, 761 r-equal-implies-equal-r-lt-int-

okp, 765 r-equal-implies-equal-r-lt-nat-

okp, 767 r-equal-implies-equal-r-mult2-n

at-okp, 767

at-with-carry-out-okp, 753 r-equal-implies-equal-r-neg-int

-okp, 764 r-equal-implies-equal-r-no-op-o

kp, 741 r-equal-implies-equal-r-not-bitv

-okp, 769 r-equal-implies-equal-r-not-boo

l-okp, 772 r-equal-implies-equal-r-objectp, 748

-type, 748 r-equal-implies-equal-r-or-bitv

-okp, 768 r-equal-implies-equal-r-or-bool

-okp, 771 r-equal-implies-equal-r-pop*-okp, 755 r-equal-implies-equal-r-pop-cal

l-okp, 784 r-equal-implies-equal-r-pop-glo

bal-okp, 749 r-equal-implies-equal-r-pop-loc

al-okp, 750 n-okp, 775

r-equal-implies-equal-r-pop-okp, 758 r-equal-implies-equal-r-popj-okp, 760 r-equal-implies-equal-r-popn-okp, 755 r-equal-implies-equal-r-push-co

nstant-okp, 757 r-equal-implies-equal-r-push-ct

rl-stk-free-size-okp, 757 r-equal-implies-equal-r-push-gl

obal-okp, 742 r-equal-implies-equal-r-push-lo

cal-okp, 749 r-equal-implies-equal-r-push-te

mp-stk-free-size-okp, 757 mp-stk-index-okp, 758

r-equal-implies-equal-r-pushj-o

kp, 759 r-equal-implies-equal-r-ret-okp, 785 r-equal-implies-equal-r-rsh-bitv

-okp, 770 r-equal-implies-equal-r-set-glo

bal-okp, 756 r-equal-implies-equal-r-set-loc

al-okp, 756 r-equal-implies-equal-r-sub-add

r-okp, 760 r-equal-implies-equal-r-sub-int -okp, 763 -with-carry-okp, 763 r-equal-implies-equal-r-sub-nat

-okp, 766

-with-carry-okp, 766 r-equal-implies-equal-r-sub1-int

-okp, 764 r-equal-implies-equal-r-sub1-nat

-okp, 767 r-equal-implies-equal-r-test-bitv -and-jump-okp, 774 r-equal-implies-equal-r-test-bo ol-and-jump-okp, 774 r-equal-implies-equal-r-test-int -and-jump-okp, 773 r-equal-implies-equal-r-test-nat -and-jump-okp, 773 r-equal-implies-equal-r-usr-dat

a-objectp, 748 r-equal-implies-equal-r-xor-bitv

-okp, 770 r-equal-implies-r-equal-r-halt, 786 r-equal-implies-stk-equal-exten ds-upwards-cstk, 785 ds-upwards-tstk, 746

r-equal-properties, 739 r-equal-r-state, 740 r-equal-reflexive, 829 r-fetch-okp, 303, 332, 513, 557, 577,

733, 761, 813, 831, 883 r-fetch-step, 303, 335, 513, 557, 578, 673, 762, 883, 884 r-fetch-step-clock, 304, 338, 513, 581 r-fetch-temp-stk-okp, 290, 331, 514,

558, 576, 730, 754, 815, 878 r-fetch-temp-stk-step, 290, 334, 514,

558, 580, 669, 754, 878 r-fetch-temp-stk-step-clock, 291, 338,

514, 584 r-halt, 274, 276, 336, 576, 579, 586, 587, 690, 691, 786

r-halt-run, 586 r-i-owc, 851 r-ins-okp, 330, 336, 340, 576, 585,

587, 816, 828, 832, 834, 835, 893

r-ins-okp-backchainer, 576 r-ins-okp-exhausted, 832 r-ins-okp-is-r-ins-okp1, 816 r-ins-okp1, 814, 816 r-ins-okp2, 813, 816, 828, 831, 833,

834 r-ins-okp2-backchainer, 831 r-ins-step, 333, 336, 584, 830, 835,

893 r-ins-step-clock, 337, 340, 584 r-ins-step-clock-is-r-ins-step-

clock1, 584 r-ins-step-clock1, 583, 584 r-ins-step-clock2, 581, 584, 587 r-ins-step-is-r-ins-step1, 584 r-ins-step-preserves-r-equal, 834 r-ins-step1, 580, 584 r-ins-step2, 578, 581, 585, 587, 829,

834 r-ins-step2-preserves-r-equal, 834 r-instructionp, 272, 340, 351, 505,

845 r-instructionp-observation, 340 r-int-to-nat-okp, 313, 332, 519, 559,

577, 734, 765, 813, 832, 887 r-int-to-nat-step, 313, 335, 519, 559,

579, 675, 765, 887 r-int-to-nat-step-clock, 313, 339, 519,

582 r-jump-case-okp, 292, 331, 528, 563,

577, 738, 775, 776, 815, 879 r-jump-case-step, 292, 334, 528, 563,

581, 682, 776, 879 r-jump-case-step-clock, 293, 338, 528,

584 r-jump-if-temp-stk-empty-okp, 283,

331, 525, 562, 576, 737, 773, 815, 875

r-jump-if-temp-stk-empty-step, 283, 334, 525, 562, 580, 679, 773, 875 r-jump-if-temp-stk-empty-step-c lock, 284, 337, 525, 583 r-jump-if-temp-stk-full-okp, 283, 331,

525, 562, 576, 737, 772, 815, 875

r-jump-if-temp-stk-full-step, 283, 334,

525, 562, 580, 679, 772, 875 r-jump-if-temp-stk-full-step-cl ock, 283, 337, 525, 583 r-jump-okp, 292, 331, 509, 556, 576, 732, 759, 815, 879 r-jump-step, 292, 334, 509, 556, 581, 672, 759, 879 r-jump-step-clock, 292, 338, 510, 584 r-loadablep, 272, 273, 517 r-loadablep-and-cstk-implies-not -zerop-r-word-size, 517 r-locn-okp, 277, 330, 527, 563, 576, 738, 775, 814, 873 r-locn-step, 278, 333, 527, 563, 580, 682, 775, 873 r-locn-step-clock, 278, 337, 527, 583 r-lsh-bitv-okp, 327, 333, 523, 561,

578, 736, 770, 771, 814, 832, 892

r-lsh-bitv-step, 327, 336, 523, 561, 579, 677, 771, 892 r-lsh-bitv-step-clock, 328, 339, 523,

582 r-lt-addr-okp, 302, 332, 513, 557, 577, 732, 761, 813, 831, 883

r-lt-addr-step, 303, 335, 513, 557, 578, 673, 761, 883 r-lt-addr-step-clock, 303, 338, 513,

581 r-lt-int-okp, 312, 332, 519, 559, 577,

734, 765, 813, 832, 886 r-lt-int-step, 312, 335, 519, 559, 579, 675, 765, 886, 887 r-lt-int-step-clock, 313, 339, 519, 582 r-lt-nat-okp, 320, 333, 521, 560, 577,

735, 767, 814, 832, 889 r-lt-nat-step, 320, 336, 521, 560, 579, 676, 767, 889 r-lt-nat-step-clock, 321, 339, 521, 582 r-mult2-nat-okp, 321, 333, 521, 560,

577, 735, 768, 814, 832, 889 r-mult2-nat-step, 321, 336, 521, 560,

579, 676, 768, 889 r-mult2-nat-step-clock, 321, 339, 521,

582 r-mult2-nat-with-carry-out-okp, 321,

333, 521, 560, 577, 730, 754, 814, 832, 890

r-mult2-nat-with-carry-out-step, 321, 322, 336, 521, 560, 579, 668, 754, 890

-clock, 322, 339, 521, 582 r-n-flg, 24, 273, 275–295, 297, 299–

308, 310, 311, 313–330, 346, 371, 691

r-neg-int-okp, 311, 332, 517, 559, 577,

734, 764, 813, 832, 886 r-neg-int-step, 311, 335, 517, 559,

579, 675, 764, 886 r-neg-int-step-clock, 312, 339, 517,

582 r-no-op-okp, 299, 332, 503, 553, 577,

727, 741, 742, 816, 882 r-no-op-step, 299, 335, 503, 553, 581,

665, 742, 882 r-no-op-step-clock, 300, 338, 503, 584 r-not-bitv-okp, 325, 333, 523, 561,

578, 736, 769, 814, 832, 891 r-not-bitv-step, 325, 336, 523, 561,

579, 677, 769, 891 r-not-bitv-step-clock, 325, 339, 523,

582 r-not-bool-okp, 329, 333, 524, 562,

578, 736, 772, 814, 832, 893 r-not-bool-step, 330, 336, 524, 562,

579, 678, 772, 893 r-not-bool-step-clock, 330, 340, 524,

583 r-objectp, 270, 271, 278, 284, 501–

503, 505, 512, 513, 530, 546, 550, 728, 748, 783

r-objectp-fetch-adp-r-usr-data-

segment, 502 r-objectp-get-all-r-usr-data-ob

jectps, 502 r-objectp-implies-i-objectp, 500 r-objectp-on-pop-call-state, 783 r-objectp-opener, 502 r-objectp-type, 271, 273, 276, 277,

279, 284–292, 294, 296, 300– 318, 320–330, 342, 343, 552, 553, 748 r-objectp-type-simplifier, 342 r-objectps-of-same-type-equal-i ff-untags-equal, 512 ff-untags-equal-rewrite, 512 r-or-bitv-okp, 323, 333, 522, 561, 578,

735, 768, 769, 814, 832, 890 r-or-bitv-step, 323, 336, 522, 561, 579, 676, 769, 890 r-or-bitv-step-clock, 324, 339, 522,

582 r-or-bool-okp, 328, 333, 524, 561,

578, 736, 771, 814, 832, 892 r-or-bool-step, 328, 336, 524, 561, 579, 678, 771, 892 r-or-bool-step-clock, 329, 340, 524,

583 r-pc, 23, 273, 274, 276, 289, 297,

344, 356, 358–361, 367, 369, 371, 505, 525, 528, 544, 547, 548, 690, 739, 746, 784

r-pop*-okp, 284, 331, 507, 555, 576, 730, 755, 815, 876 r-pop*-step, 285, 334, 507, 555, 580, 670, 755, 876 r-pop*-step-clock, 285, 337, 507, 583 r-pop-call-okp, 289, 331, 546, 564,

576, 739, 784, 785, 815, 877 r-pop-call-step, 289, 334, 546, 564,

580, 690, 785, 877, 878 r-pop-call-step-clock, 290, 337, 546,

584 r-pop-global-okp, 287, 331, 508, 556, 576, 728, 749, 815, 877 r-pop-global-step, 287, 334, 508, 556,

580, 665, 749, 877 r-pop-global-step-clock, 287, 337, 508,

583 r-pop-local-okp, 286, 331, 508, 555,

576, 729, 750, 751, 815, 876 r-pop-local-step, 286, 334, 508, 555,

580, 666, 751, 876, 877 r-pop-local-step-clock, 286, 337, 508,

583 r-pop-locn-okp, 287, 331, 527, 563,

576, 738, 775, 815, 877 r-pop-locn-step, 288, 334, 527, 563,

580, 681, 775, 877 r-pop-locn-step-clock, 289, 337, 527,

584 r-pop-okp, 284, 331, 507, 554, 576,

732, 758, 759, 815, 875 r-pop-step, 284, 334, 507, 554, 580,

672, 759, 875, 876 r-pop-step-clock, 284, 337, 507, 583 r-popj-okp, 293, 331, 510, 556, 577,

732, 760, 815, 880 r-popj-step, 294, 334, 510, 556, 581,

672, 760, 880 r-popj-step-clock, 294, 338, 510, 584 r-popn-okp, 285, 331, 508, 555, 576,

730, 755, 756, 815, 876 r-popn-step, 285, 334, 508, 555, 580,

670, 756, 876 r-popn-step-clock, 286, 337, 508, 583 r-preserves-r-equal, 836 r-preserves-r-equal-bridge, 849 r-prog-segment, 23, 24, 271, 273–

296, 300–306, 308, 310–330, 343, 344, 346, 356, 358–362, 367, 369, 371, 500, 501, 503– 505, 509, 510, 525, 528, 532– 552, 564, 691, 739, 746, 783, 784, 872–894

r-prog-segmentp, 272, 273, 346, 356,

362, 505, 564, 846, 847 r-prog-segmentp-contains-r-prog

ram-bodyps, 505 ramp, 362 r-program-bodyp, 272, 352, 353, 356,

361, 500, 505, 547, 846 r-program-bodyp-contains-r-inst

ructionps, 505 r-program-bodyp-implies-properp, 547 r-program-bodyp-program-body, 356 r-program-bodyp-program-body-an

y, 500 r-program-bodyp-program-body-le

mma, 356 r-programp, 272, 362 r-psw, 24, 274, 336, 340, 371, 503–

528, 545, 546, 549, 553–564, 585–588, 739, 741, 742, 746, 749–776, 782, 784–786, 830, 834, 851, 852, 856, 872–895

r-psw-p->r, 830 r-psw-r-halt, 587 r-push-constant-observation, 340 r-push-constant-okp, 278, 330, 505,

554, 576, 731, 757, 815, 873 r-push-constant-step, 279, 333, 505,

554, 580, 671, 757, 873 r-push-constant-step-clock, 279, 337,

505, 583 r-push-ctrl-stk-free-size-okp, 281, 331,

506, 554, 576, 731, 757, 815, 874

r-push-ctrl-stk-free-size-step, 281, 334,

506, 554, 580, 671, 757, 874 r-push-ctrl-stk-free-size-step-

clock, 281, 337, 506, 583 r-push-global-okp, 280, 330, 504, 554,

576, 727, 742, 746, 815, 873 r-push-global-step, 280, 334, 504, 554,

580, 665, 746, 874 r-push-global-step-clock, 281, 337, 504,

583 r-push-local-okp, 279, 330, 504, 554,

576, 729, 749, 750, 815, 873 r-push-local-step, 279, 333, 504, 554,

580, 666, 750, 873 r-push-local-step-clock, 280, 337, 504,

583 r-push-temp-stk-free-size-okp, 281, 331,

506, 554, 576, 731, 758, 815, 874

r-push-temp-stk-free-size-step, 281, 334, 506, 554, 580, 671, 758, 874

r-push-temp-stk-free-size-step-

clock, 282, 337, 506, 583 r-push-temp-stk-index-okp, 282, 331,

507, 554, 576, 731, 758, 815, 874

r-push-temp-stk-index-step, 282, 334,

507, 554, 580, 672, 758, 875 r-push-temp-stk-index-step-cloc

k, 283, 337, 507, 583 r-pushj-okp, 293, 331, 510, 556, 577,

732, 759, 815, 879 r-pushj-step, 293, 334, 510, 556, 581,

672, 759, 879, 880 r-pushj-step-clock, 293, 338, 510, 584 r-ret-okp, 276, 330, 549, 564, 576,

739, 785, 786, 814, 872 r-ret-step, 276, 333, 549, 564, 580,

694, 786, 872 r-ret-step-clock, 277, 337, 549, 583 r-rsh-bitv-okp, 326, 333, 523, 561,

578, 736, 770, 814, 832, 891 r-rsh-bitv-step, 327, 336, 523, 561,

579, 677, 770, 891, 892 r-rsh-bitv-step-clock, 327, 339, 523,

582 r-set-global-okp, 295, 331, 509, 556,

577, 731, 756, 816, 880 r-set-global-step, 295, 334, 509, 556,

581, 671, 757, 880 r-set-global-step-clock, 296, 338, 509,

584 r-set-local-okp, 294, 331, 509, 556,

577, 731, 756, 815, 880 r-set-local-step, 294, 334, 509, 556,

581, 671, 756, 880 r-set-local-step-clock, 295, 338, 509,

584 r-state, 21, 23, 275–287, 289–296, 300–305, 307–314, 316–318, 320–330, 550–552, 728, 738, 740, 783, 784, 847, 848

r-statep, 273, 274, 344, 586, 739,

829 r-step, 336, 337, 340, 585, 587, 830,

835, 849, 857, 894 r-step-clock, 340, 587 r-step-preserves-r-equal, 835 r-step1, 336, 857 r-step1-clock, 340 r-sub-addr-okp, 301, 332, 511, 557,

577, 732, 760, 816, 882 r-sub-addr-step, 301, 335, 511, 557,

581, 672, 760, 882, 883 r-sub-addr-step-clock, 301, 338, 511,

584 r-sub-int-okp, 308, 332, 516, 558, 577,

733, 763, 813, 832, 885 r-sub-int-step, 308, 335, 516, 558,

578, 674, 763, 885 r-sub-int-step-clock, 309, 339, 516,

582 r-sub-int-with-carry-okp, 309, 332,

516, 558, 577, 733, 763, 764, 813, 832, 886

r-sub-int-with-carry-step, 309, 335,

516, 558, 578, 674, 764, 886 r-sub-int-with-carry-step-clock, 310,

339, 516, 582 r-sub-nat-okp, 317, 332, 520, 560,

577, 734, 766, 814, 832, 888 r-sub-nat-step, 317, 336, 520, 560,

579, 675, 766, 888 r-sub-nat-step-clock, 318, 339, 520,

582 r-sub-nat-with-carry-okp, 318, 333,

520, 560, 577, 734, 766, 814, 832, 888

r-sub-nat-with-carry-step, 318, 336, 520, 560, 579, 676, 767, 888, 889

r-sub-nat-with-carry-step-clock, 320, 339, 520, 582 r-sub1-int-okp, 310, 332, 517, 559,

577, 734, 764, 813, 832, 886 r-sub1-int-step, 310, 335, 517, 559,

578, 674, 764, 886 r-sub1-int-step-clock, 311, 339, 517,

582 r-sub1-nat-okp, 316, 333, 520, 560,

577, 735, 767, 814, 832, 889 r-sub1-nat-step, 317, 336, 520, 560,

579, 676, 767, 889 r-sub1-nat-step-clock, 317, 339, 520,

582 r-sys-data-segment, 24, 271, 273–330,

343–346, 371, 501, 503, 506, 507, 510, 517, 521, 528, 534, 536, 545, 546, 549–553, 557, 691, 739, 744, 746–749, 751, 754, 777, 781, 783–786, 872– 894

r-temp-var-dclsp, 272, 354–356, 361,

531, 837 r-temp-var-dclsp-append, 354 r-temp-var-dclsp-rev, 354 r-temp-var-dclsp-temp-var-dcls, 356 r-temp-var-dclsp-temp-var-dcls-

lemma, 356 r-test-and-jump-okp, 296–299 r-test-and-jump-step, 296–299 r-test-bitv-and-jump-okp, 299, 332,

526, 563, 577, 737, 774, 816, 882

r-test-bitv-and-jump-step, 299, 335,

526, 563, 581, 680, 774, 882 r-test-bitv-and-jump-step-clock, 299,

338, 526, 584 r-test-bool-and-jump-okp, 298, 332,

526, 562, 577, 737, 774, 816, 881

r-test-bool-and-jump-step, 298, 335,

526, 562, 581, 680, 774, 881 r-test-bool-and-jump-step-clock, 299,

338, 526, 584 r-test-int-and-jump-okp, 297, 331, 526,

562, 577, 737, 773, 774, 816,

881 r-test-int-and-jump-step, 297, 335,

526, 562, 581, 680, 774, 881 r-test-int-and-jump-step-clock, 298,

338, 526, 584 r-test-nat-and-jump-okp, 297, 331,

525, 562, 577, 737, 773, 816, 881

r-test-nat-and-jump-step, 297, 334,

525, 562, 581, 679, 773, 881 r-test-nat-and-jump-step-clock, 297,

338, 525, 584 r-tsp, 24, 273–330, 345, 371, 510,

513, 521, 528, 545, 557, 690, 739, 744, 746, 747, 749, 777, 785, 878, 884

r-usr-data-objectp, 271, 272, 287, 291,

295, 302, 304, 555, 748, 847 r-usr-data-segment, 24, 271, 273–296,

300–305, 307, 308, 310–330, 343, 346, 371, 501–503, 534– 537, 541, 542, 546, 550–552, 557, 588, 691, 739, 783, 851, 853, 855, 872–894, 897

r-usr-data-segment-p->r, 897 r-usr-data-typep, 271, 511, 727, 728,

847 r-usr-data-typep-top, 727 r-usr-data-typep-top1, 727 r-usr-data-typep-top2, 728 r-v-flg, 24, 273, 275–295, 297–305,

307, 308, 311, 313–330, 346, 371, 691

r-word-size, 24, 270, 272, 274–289, 291–296, 300–330, 342, 343, 346, 371, 501–504, 506, 507, 517, 518, 528, 535–537, 541– 543, 546, 550–552, 691, 739, 783, 852, 856, 857, 895

r-word-size-p->r, 852 r-word-size-r, 857 r-word-size-r-step, 857 r-word-size-r-step1, 857 r-x, 24, 275, 277, 279, 285, 292–294, 299, 307, 311, 313, 316, 317, 321, 325, 327, 330, 371, 691

r-xor-bitv-okp, 325, 326, 333, 523, 561, 578, 736, 770, 814, 832, 891

r-xor-bitv-step, 326, 336, 523, 561,

579, 677, 770, 891 r-xor-bitv-step-clock, 326, 339, 523,

582 r-y, 24, 275, 277–282, 284–289, 292–

295, 300–305, 307, 308, 311– 314, 316–318, 320–330, 371, 691

r-z-flg, 24, 273, 275–282, 284–295, 300, 301, 303–306, 308, 310– 330, 346, 371, 691

ram, 35 ram-tree, 35, 39–42, 44, 46, 267, 268 read-mem, 36, 40, 42, 267 read-mem-ram-tree, 40 read-mem-ram-tree-is-get, 267 read-mem1, 40 read-mem1-ram-tree-hint, 38 read-mem1-rev-ram-tree, 40 read-mem1-rev-ram-tree-lemma1, 39 reg-direct-p, 38, 44, 46, 177–180, 183 remainder-add1-plus-x-x-2, 172 remainder-add1-xx-2, 221 remainder-add1-xxyy-2, 220 remainder-by-2, 214 remainder-by-2-not-1-lemma, 521 remainder-difference-hack, 120 remainder-exp-2-2, 170 remainder-hack2, 123 remainder-lessp, 122 remainder-opener, 122 remainder-quotient-rewrite, 122 remainder-times, 170 remainder-xx-2, 220 remainder-xxyy-2, 220 restn, 35, 38, 40, 41 restn-update-nth, 41 restn-update-nth-plus, 40 ret-one-way-correspondence-p-r, 694 ret-one-way-correspondence-r-i, 549 ret-pc, 6, 22, 590, 591, 597, 636,

637, 640, 642–644, 654, 655, 681, 692, 701, 726

ret-pc-in-correct-position, 692

ret-pc-p-frame, 640

ret-preserves-p-loadablep, 798 ret-preserves-proper-p-statep, 726 ret-preserves-r-equal, 786 ret-proper-r-statep, 564 rev, 38–41, 276, 354, 355, 530–535,

537, 590, 685, 687, 689, 690, 723, 778

rev-append, 40 rev-rev, 685 rev1, 38 rev1-is-rev, 38 reverse, 7, 355 reverse-is-rev, 355 rget, 589, 598 rn-a, 45, 46, 177, 178 rn-b, 38, 41, 43, 44, 179–181, 183 room-to-deposit-lst-implies-not -empty-stkp, 779

rput, 589, 599

rsh-bitv, 51, 76, 219, 327, 618, 718 rsh-bitv-one-way-correspondence

-p-r, 677 -r-i, 523

rsh-bitv-preserves-p-loadablep, 795 rsh-bitv-preserves-proper-p-statep, 719 rsh-bitv-preserves-r-equal, 770 rsh-bitv-proper-r-statep, 561

same-signature, 274, 500, 501, 531, 534, 536, 546, 550–552, 563, 664, 695–699, 701, 703, 728, 738–740, 782, 836, 847, 848, 857–894

same-signature-deposit-adp, 531 same-signature-deposit-lst, 563 same-signature-deposit-lst-hyp-

3-reliever-1, 564 3-reliever-2, 564 same-signature-deposit-lst1, 782 same-signature-deposit-lst{special},

782 same-signature-implies-adpp, 500 same-signature-implies-all-r-ob

jectps, 546 same-signature-implies-all-r-us

r-data-objectps, 550 same-signature-implies-equal-al

l-p-objectps, 696 same-signature-implies-equal-de

finedp, 695 same-signature-implies-equal-le

ngths, 695 same-signature-implies-equal-p-

loadablep, 695 objectp, 695

same-signature-implies-equal-pr oper-labeled-p-instructionsp, 698 oper-p-alistp, 696 oper-p-ctrl-stkp, 697 oper-p-data-segmentp, 699 oper-p-framep, 696 oper-p-instructionp, 698 oper-p-prog-segmentp, 699 oper-p-program-bodyp, 698 oper-p-programp, 699 oper-p-temp-stkp, 697 oper-p-temp-var-dclsp, 697

same-signature-implies-length-li

nk-mem, 894 same-signature-implies-proper-r

-usr-data-segmentp, 551 same-signature-implies-r-objectp, 546

-rewriter, 550 same-signature-p, 871 same-signature-p-ins-step, 871 same-signature-p-ins-step-add-a

ddr, 864 same-signature-p-ins-step-add-i

nt, 865 nt-with-carry, 865

same-signature-p-ins-step-add-n at, 867

at-with-carry, 867 same-signature-p-ins-step-add1-

nat, 867 same-signature-p-ins-step-add1-i

nt, 866 same-signature-p-ins-step-and-b

ool, 870 same-signature-p-ins-step-and-bitv, 869 same-signature-p-ins-step-call, 858 same-signature-p-ins-step-deposit, 865

-temp-stk, 862 same-signature-p-ins-step-div2-

nat, 869 same-signature-p-ins-step-eq, 864 same-signature-p-ins-step-fetch, 865

-temp-stk, 861 same-signature-p-ins-step-int-t

o-nat, 867 same-signature-p-ins-step-jump, 862 same-signature-p-ins-step-jump-

case, 862 same-signature-p-ins-step-jump-i

f-temp-stk-empty, 860 f-temp-stk-full, 860

same-signature-p-ins-step-locn, 858 same-signature-p-ins-step-lsh-bitv, 870 same-signature-p-ins-step-lt-ad

dr, 865 same-signature-p-ins-step-lt-int, 867 same-signature-p-ins-step-lt-nat, 868 same-signature-p-ins-step-mult2

-nat, 868

-nat-with-carry-out, 869 same-signature-p-ins-step-neg-i

nt, 866 same-signature-p-ins-step-no-op, 864 same-signature-p-ins-step-not-b

ool, 871 same-signature-p-ins-step-not-bitv, 869 same-signature-p-ins-step-or-bitv, 869 same-signature-p-ins-step-or-bo

ol, 870 same-signature-p-ins-step-pop, 860 same-signature-p-ins-step-pop*, 860 same-signature-p-ins-step-pop-c

all, 861 same-signature-p-ins-step-pop-g

lobal, 861 same-signature-p-ins-step-pop-l

ocal, 860 ocn, 861

same-signature-p-ins-step-popj, 862 same-signature-p-ins-step-popn, 860 same-signature-p-ins-step-push-

constant, 858 ctrl-stk-free-size, 859 global, 859 local, 859

same-signature-p-ins-step-push-te mp-stk-free-size, 859 mp-stk-index, 859

same-signature-p-ins-step-pushj, 862 same-signature-p-ins-step-ret, 858 same-signature-p-ins-step-rsh-bitv, 870 same-signature-p-ins-step-set-g

lobal, 863 same-signature-p-ins-step-set-l

ocal, 863 same-signature-p-ins-step-sub-a

ddr, 864 same-signature-p-ins-step-sub-i

nt, 866 nt-with-carry, 866

same-signature-p-ins-step-sub-n at, 868 at-with-carry, 868

same-signature-p-ins-step-sub1-

nat, 868 same-signature-p-ins-step-sub1-i

nt, 866 same-signature-p-ins-step-test-

bitv-and-jump, 864 bool-and-jump, 863 nat-and-jump, 863

same-signature-p-ins-step-test-i

nt-and-jump, 863 same-signature-p-ins-step-xor-bitv, 870 same-signature-p-step, 871 same-signature-p-transitivity-le

mma, 871 same-signature-plausible-data-li

nk-tablep, 857 same-signature-put-assoc, 501 same-signature-put-assoc-1, 664 same-signature-put-assoc-2, 664 same-signature-put-assoc-genera

lized, 703 same-signature-put-assoc{special}, 703 same-signature-r, 894 same-signature-r-ins-step-add-a

ddr, 882 same-signature-r-ins-step-add-i

nt, 884

nt-with-carry, 885 same-signature-r-ins-step-add-n

at, 887

at-with-carry, 887 same-signature-r-ins-step-add1-

nat, 888 same-signature-r-ins-step-add1-i

nt, 885 same-signature-r-ins-step-and-b

ool, 892 same-signature-r-ins-step-and-bitv, 890 same-signature-r-ins-step-call, 872 same-signature-r-ins-step-deposit, 884

-temp-stk, 878

-temp-stk-lemma, 878

-temp-stk-lemma-helper, 878 same-signature-r-ins-step-div2-

nat, 890 same-signature-r-ins-step-eq, 883 same-signature-r-ins-step-fetch, 883

-temp-stk, 878 same-signature-r-ins-step-int-t

o-nat, 887 same-signature-r-ins-step-jump, 879 same-signature-r-ins-step-jump-

case, 879 same-signature-r-ins-step-jump-i

f-temp-stk-empty, 875 f-temp-stk-full, 875 same-signature-r-ins-step-locn, 872 same-signature-r-ins-step-lsh-bitv, 892 same-signature-r-ins-step-lt-ad

dr, 883 same-signature-r-ins-step-lt-int, 886 same-signature-r-ins-step-lt-nat, 889 same-signature-r-ins-step-mult2

-nat, 889

-nat-with-carry-out, 890 same-signature-r-ins-step-neg-i

nt, 886 same-signature-r-ins-step-no-op, 882 same-signature-r-ins-step-not-b

ool, 893 same-signature-r-ins-step-not-bitv, 891 same-signature-r-ins-step-or-bitv, 890 same-signature-r-ins-step-or-bo

ol, 892 same-signature-r-ins-step-pop, 875 same-signature-r-ins-step-pop*, 876 same-signature-r-ins-step-pop-c

all, 877 same-signature-r-ins-step-pop-g

lobal, 877 same-signature-r-ins-step-pop-l

ocal, 876 ocn, 877

same-signature-r-ins-step-popj, 880 same-signature-r-ins-step-popn, 876 same-signature-r-ins-step-push-

constant, 873

ctrl-stk-free-size, 874 global, 873 local, 873

same-signature-r-ins-step-push-te mp-stk-free-size, 874 mp-stk-index, 874

same-signature-r-ins-step-pushj, 879 same-signature-r-ins-step-ret, 872 same-signature-r-ins-step-rsh-bitv, 891 same-signature-r-ins-step-set-g

lobal, 880 same-signature-r-ins-step-set-l

ocal, 880 same-signature-r-ins-step-sub-a

ddr, 882 same-signature-r-ins-step-sub-i

nt, 885

nt-with-carry, 885 same-signature-r-ins-step-sub-n

at, 888

at-with-carry, 888 same-signature-r-ins-step-sub1-

nat, 889 same-signature-r-ins-step-sub1-i

nt, 886 same-signature-r-ins-step-test-bitv-and-jump, 881 bool-and-jump, 881 nat-and-jump, 881 same-signature-r-ins-step-test-i nt-and-jump, 881

same-signature-r-ins-step-xor-bitv, 891 same-signature-r-prog-segment-r

-ins-step, 893 same-signature-r-step, 894 same-signature-r-sys-data-segme

nt-r-ins-step, 893 same-signature-r-transitivity-le

mma1, 894 mma2, 894

same-signature-r-usr-data-segme

nt-r-ins-step, 893 same-signature-reflexive, 501 same-signature-reflexive-1, 857 same-signature-reflexive{special}, 663 same-signature-segment-length, 550 segment-length, 21, 25, 53, 146, 149,

151, 152, 154, 157, 161, 181, 187, 190, 200–206, 222, 243, 246, 271, 346, 504, 506, 550, 848, 849, 895–897

segment-length-put-assoc, 190

set-flags, 38, 183, 184

set-global-one-way-corresponden ce-p-r, 671 ce-r-i, 509

set-global-preserves-p-loadablep, 789 set-global-preserves-proper-p-st

atep, 710 set-global-preserves-r-equal, 756 set-global-proper-r-statep, 556 set-local-one-way-correspondence

-p-r, 671 -r-i, 508

set-local-preserves-p-loadablep, 789 set-local-preserves-proper-p-st

atep, 710 set-local-preserves-r-equal, 756 set-local-proper-r-statep, 556 set-local-var-indirect, 597 set-local-var-value, 590, 596, 601 sign-extend, 45, 177 signature, 274 size-bitv-to-v, 148 size-compl, 148 size-incr, 148 size-int-to-v, 194 size-link-data-word, 148 size-link-instr-word, 149 size-link-word, 149 small-integerp, 50, 52, 59, 63, 68,

70, 85, 89, 91, 95, 142, 169, 172, 195, 198, 224, 225, 270, 305–308, 310–312, 342, 502, 503, 515, 518, 525, 589, 606– 610, 639, 705, 715

small-integerp-fix-small-intege r-case-1, 224 r-case-2, 224 r-difference-case, 515 r-plus-case, 515

small-integerp-implies-integerp, 169 small-integerp-implies-small-nat

uralp, 715 small-integerp-inegate, 224 small-integerp-subtypes, 525 small-naturalp, 49, 52, 55, 56, 60–

62, 70, 71, 142, 270, 314– 316, 321, 322, 342, 502, 503, 589, 611, 612, 615, 627, 628, 639, 705, 709, 711, 712, 715– 717

small-naturalp-difference, 716 small-naturalp-difference-exp-x, 716 small-naturalp-fix-small-natura

l, 709 small-naturalp-quotient, 717 small-naturalp-remainder, 717 small-naturalp-sub1, 716 step-one-way-correspondence-p-r, 830 stk-equal, 273, 274, 657, 658, 660,

661, 678, 693, 739, 740, 742– 747, 750, 751, 776, 779–782, 786, 829, 836

stk-equal-cstk-p->r sys-data

-segment, 693 stk-equal-cstk-put-assoc-tstk, 658 stk-equal-cstk-put-assoc-tstk2, 742 stk-equal-deposit-lst, 780 stk-equal-deposit-lst-generalize

d, 780 stk-equal-deposit-lst1, 779 stk-equal-extends-upwards, 745 stk-equal-extends-upwards-base-

case, 745 stk-equal-fetch-n-hint, 776 stk-equal-hint-1, 656 stk-equal-hint-2, 656, 657 stk-equal-hint-3, 657 stk-equal-hint-4, 658 stk-equal-hint-5, 745 stk-equal-implies-equal-fetch-n, 776 stk-equal-implies-equal-get, 747 stk-equal-is-equal-cdr-n-all-but

-last, 660

-last-lemma1, 659 -last-lemma2, 659 -last-lemma3, 660

stk-equal-put-assoc-above-top, 743 stk-equal-put-assoc-cdr-assoc, 779 stk-equal-put-assoc-insertion, 750 stk-equal-put-assoc-push, 743 stk-equal-reflexive, 829 stk-equal-reflexive-cstk, 657 stk-equal-reflexive-tstk, 658 stk-equal-reflexive-tstk-instan

ce, 678 stk-equal-tstk-deposit-lst-cstk, 782 stk-equal-tstk-deposit-lst1-cst

k, 781 stk-equal-tstk-p->r sys-data

-segment, 661 stk-equal-tstk-put-assoc-cstk2, 751 stk-length, 52, 275, 282, 290, 291,

540, 541, 776, 777, 785 store-cc, 38, 183 store-resultp, 37 strip-cadrs, 269, 275, 276, 530, 531,

533–537, 543, 686, 687, 689, 738

strip-cadrs-append, 531 strip-cars-append, 724 strip-cars-pair-temps-with-initi

al-values, 725 strip-cars-pairlist, 724 strip-cars-put-assoc, 707 strip-cars-put-value-indirect, 721 strip-cdrs, 5, 22, 650, 653, 654, 680,

681, 686 strip-cdrs-append, 686 strip-cdrs-pair-temps-with-initi

al-values, 686 strip-cdrs-pairlist, 686 stub, 35 stub-guts, 39 stubp, 39 sub-addr, 6, 22, 49, 90, 91, 271, 290–

292, 301, 604 sub-addr-one-way-correspondence

-p-r, 672 -r-i, 511

sub-addr-preserves-p-loadablep, 791 sub-addr-preserves-proper-p-statep,

713 sub-addr-preserves-r-equal, 760 sub-addr-proper-r-statep, 557 sub-adp, 6, 48, 144, 499, 506, 513,

514, 529, 530, 533, 538, 543,

545 sub-adp-0, 529 sub-adp-0-untag-r-tsp, 538 sub-adp-sub-adp, 506 sub-int-one-way-correspondence-

r-i, 516 sub-int-one-way-correspondence-p

-r, 674 sub-int-preserves-p-loadablep, 792 sub-int-preserves-proper-p-statep, 714 sub-int-preserves-r-equal, 763 sub-int-proper-r-statep, 558 sub-int-with-carry-one-way-corre spondence-p-r, 674 spondence-r-i, 516 sub-int-with-carry-preserves-p-

loadablep, 792 sub-int-with-carry-preserves-pr oper-p-statep, 714 sub-int-with-carry-preserves-r-eq

ual, 763 sub-int-with-carry-proper-r-statep, 558 sub-nat-one-way-correspondence-

r-i, 520 sub-nat-one-way-correspondence-p

-r, 675 sub-nat-preserves-p-loadablep, 793 sub-nat-preserves-proper-p-statep, 716 sub-nat-preserves-r-equal, 766 sub-nat-proper-r-statep, 560 sub-nat-with-carry-one-way-corre spondence-p-r, 675 spondence-r-i, 520 sub-nat-with-carry-preserves-p-

loadablep, 793 sub-nat-with-carry-preserves-pr oper-p-statep, 716

sub-nat-with-carry-preserves-r-eq

ual, 766 sub-nat-with-carry-proper-r-statep, 560 sub1-addr, 49, 52 sub1-adp, 48 sub1-adp-add1-adp, 513 sub1-adp-add2-adp, 514 sub1-difference, 506 sub1-int-one-way-correspondence

-p-r, 674 -r-i, 517

sub1-int-preserves-p-loadablep, 792 sub1-int-preserves-proper-p-statep, 715 sub1-int-preserves-r-equal, 764 sub1-int-proper-r-statep, 559 sub1-nat-one-way-correspondence

-p-r, 676 -r-i, 520

sub1-nat-preserves-p-loadablep, 794 sub1-nat-preserves-proper-p-statep, 716 sub1-nat-preserves-r-equal, 767 sub1-nat-proper-r-statep, 560 subr-to-v, 27, 28, 148, 204 subsegmentp, 245, 246, 897 subsegmentp-cdr, 245 subsegmentp-implies-definedp, 245 subsegmentp-implies-equal-assoc, 245 subsegmentp-reflexive, 246 subsegmentp-reflexive-lemma, 246 sys-addr-to-v, 27, 28, 148, 202, 203 sys-data-links, 25, 28, 148, 149 sys-data-links-i-link-tables, 149

tag, 6–12, 21–23, 28, 48, 49, 54–57, 59–65, 69–72, 75, 76, 85– 90, 92–96, 105–108, 143, 158, 227, 273, 275, 280–282, 287, 290, 291, 293, 295, 299, 305– 319, 321–330, 344, 345, 347, 357, 358, 499, 500, 503, 509, 510, 513, 529, 533–538, 540– 542, 549, 553, 557, 591, 593, 594, 597, 601, 607–620, 638, 649, 650, 657, 658, 661, 684, 685, 687, 689, 690, 693, 744– 751, 754, 780–782, 785, 786

tag-type-untag, 529 tag-untag, 513 tag-untag-r-tsp, 513 tc-add, 125, 127, 129–131, 133, 134,

137, 140, 169 tc-add-is-iplus, 169 tc-in-rangep, 125, 127, 129–131, 133, 134, 137, 140, 169 tc-in-rangep-is-small-integerp, 169 tc-minus, 125, 127, 129, 130, 133,

223 tc-minus-is-inegate, 223 temp-var-dcls, 5, 7, 272, 275, 276,

290, 355, 356, 361, 504, 529, 530, 532–537, 539–542, 544, 545, 591, 636, 642, 644, 653– 655, 682, 686–690, 724, 729

test-bitv-and-jump-one-way-corre spondence-p-r, 680 spondence-r-i, 526 test-bitv-and-jump-preserves-p-

loadablep, 797 test-bitv-and-jump-preserves-pr oper-p-statep, 721

test-bitv-and-jump-preserves-r-eq

ual, 774 test-bitv-and-jump-proper-r-statep, 562 test-bool-and-jump-one-way-corre

spondence-p-r, 680 spondence-r-i, 526 test-bool-and-jump-preserves-p-

loadablep, 797 test-bool-and-jump-preserves-pr oper-p-statep, 720

test-bool-and-jump-preserves-r-eq

ual, 774 test-bool-and-jump-proper-r-statep,

562 test-int-and-jump-one-way-corre spondence-p-r, 679 spondence-r-i, 526 test-int-and-jump-preserves-p-l

oadablep, 796 test-int-and-jump-preserves-prope

r-p-statep, 720 test-int-and-jump-preserves-r-eq

ual, 773 test-int-and-jump-proper-r-statep, 562 test-nat-and-jump-one-way-corre spondence-p-r, 679 spondence-r-i, 525

test-nat-and-jump-preserves-p-l

oadablep, 796 test-nat-and-jump-preserves-prope

r-p-statep, 720 test-nat-and-jump-preserves-r-eq

ual, 773 test-nat-and-jump-proper-r-statep, 562 times-0, 528 times-add1{gen}, 504 times-commutes2, 122 times-non-numberp, 170 top, 6, 7, 22, 589–592, 596–620, 637,

653, 691, 701, 728 top-goal, 898 top1, 589, 599, 603–614, 616–619 top2, 589, 607, 609, 611–613 total-i-system-size, 53 total-p-system-size, 21 total-r-system-size, 271, 272 transitivity-of-r-equal, 836 transitivity-of-same-signature, 836 transitivity-of-stk-equal, 836 tstkp, 52, 53, 273, 540, 541, 553 type, 6, 27, 35, 48, 52, 53, 107, 142,

143, 145–148, 168, 172, 206– 208, 247, 270, 271, 302, 342– 346, 368, 502, 503, 511–513, 529, 589, 604, 639, 640, 642– 644, 705, 706, 727, 728, 745, 781, 847

type-bool, 511 type-lst, 35, 246, 247 type-r->i pc, 368 type-specification, 35, 246, 247, 853,

857, 896–898 type-tag, 143

unabbreviate-constant, 592 unconditional-get-append, 532 unlabel, 6, 20, 33, 54, 150, 152, 154,

160, 163–168, 213, 243, 272, 274, 340, 351, 363–368, 500, 505, 527, 528, 531, 532, 544, 555, 590, 635, 641 unlabel-cadr-get-rev-temp-var-d

cls, 532

cls-lemma, 531 unlabel-dl, 368 unlabel-i-objectp, 168 unlabel-non-dl, 505 unlabel-tag, 500 unlabel-tagged-object, 168 unlink-areas, 241–243, 247 unlink-areas-link-areas, 247 unlink-data-word, 28, 36, 241, 242,

247 unlink-data-word-array, 241, 242, 247 unlink-data-word-array-link-are

a, 247 unlink-data-word-link-data-word, 247 untag, 6, 23, 27, 28, 34, 48, 49, 52,

53, 55–66, 68–78, 85–92, 94, 95, 97, 99–101, 105–107, 142, 143, 145–148, 151, 152, 154, 172, 181, 207, 222, 246, 270, 271, 274, 277, 278, 285, 288– 293, 297–302, 305–330, 342– 346, 356, 358–361, 367, 369, 499, 502, 503, 505, 510–513, 517, 521, 525, 526, 528, 529, 532–534, 536, 539–541, 543– 545, 547–549, 557, 563, 589, 592, 596–600, 602–620, 639, 640, 642–644, 648, 653–655, 660, 682, 687–690, 705, 706, 726, 729, 742–751, 776–778, 781, 782, 785, 786, 836, 878, 884

untag-tag, 143

update-nth, 40–43, 142 update-nth-is-put, 142 update-v-nth, 38, 41–43, 45, 46, 177– 180, 183, 184

ur-proper-p-statep, 701–703, 706–722, 725, 726, 830, 831

ur-proper-p-statep-if, 830 ur-proper-p-statep-p-state, 701 usr-data-links, 25, 28, 36, 148, 149,

242, 268, 896, 898 usr-data-links-i-link-tables, 149

v, 38, 127, 130, 140, 183, 184 v-adder, 44, 172, 173 v-adder-f-1-is-nat-to-v-sub1, 173 v-adder-t-0-is-nat-to-v-add1, 172 v-alu, 38, 42, 117–121, 123–125, 127,

129–131, 133, 134, 137, 140, 183–185, 194, 209, 216

v-alu-correct-int-rewriter, 124 v-alu-correct-nat-rewriter, 119 v-alu-int, 124 v-alu-nat, 119 v-and, 117, 218 v-and-append, 218 v-and-bitv-to-v, 218 v-asr, 118 v-buf, 219 v-buf-append, 219 v-dec, 43–46, 173, 177, 179, 180 v-dec-nat-to-v, 173 v-inc, 43–46, 173, 177, 178, 180 v-inc-nat-to-v, 173 v-lsr, 118, 219 v-lsr-bitv-to-v, 219 v-negp, 195 v-negp-int-to-v, 195 v-negp-nat-to-v, 195 v-not, 117, 148, 170, 171, 173, 218 v-not-append, 218 v-not-bitv-to-v, 218 v-nth1, 36, 40, 42–46, 177–181 v-nzerop, 194–196, 209, 216 v-nzerop-nat-to-v-bridge, 216 v-nzerop-v-xor, 209 v-or, 118, 217 v-or-append, 217 v-or-bitv-to-v, 217 v-ror, 119 v-set, 38, 183, 184 v-to-addr, 27, 28, 201 v-to-addr-inverts-addr-to-v, 201 v-to-bitv, 26, 28, 55, 197, 198, 208 v-to-bitv-inverts-bitv-to-v, 198 v-to-bool, 26, 28, 198 v-to-bool-inverts-bool-to-v, 198 v-to-int, 28, 125–140, 172 v-to-int-int-to-v-0, 130 v-to-int-inverts-int-to-v, 172 v-to-int-inverts-int-to-v-lemma

1, 170 v-to-int-inverts-link-word, 172 v-to-ipc, 200 v-to-ipc-inverts-ipc-to-v, 200 v-to-label, 27, 28, 206 v-to-label-inverts-label-to-v, 206 v-to-nat, 27, 28, 36, 39, 40, 116,

120–124, 128, 135, 136, 142, 170, 172, 195, 200, 207, 216, 221

v-to-nat-inverts-nat-to-v, 142

v-to-nat-nat-to-v, 122 v-to-nat-rev-rev, 40 v-to-nat-v-xor-xx, 207 v-to-subr, 27, 28, 204 v-to-subr-inverts-subr-to-v, 204 v-to-sys-addr, 27, 28, 202 v-to-sys-addr-inverts-sys-addr-t

o-v, 202 v-xor, 118, 207–209, 218 v-xor-append, 208 v-xor-bitv-to-v, 218 v-xor-is-equal, 207 v-xor-x-x-is-0, 209

weak-monotonicity-of-icompile-p rogram-body, 356 rogram-body-0, 357

write-mem, 41

write-mem-ram-tree, 41

write-mem1, 41

write-mem1-rev-ram-tree, 41

x-y-error-msg, 52, 116, 147, 336, 342, 370, 373, 626 xor, 5 xor-bit, 50, 51 xor-bitv, 51, 55, 105, 197, 208, 218,

326, 618, 717 xor-bitv-one-way-correspondence

-p-r, 677 -r-i, 523

xor-bitv-preserves-p-loadablep, 795 xor-bitv-preserves-proper-p-statep, 719 xor-bitv-preserves-r-equal, 770 xor-bitv-proper-r-statep, 561 xor-bool, 49, 106, 107, 524 xor-bool-t-is-not-bool, 524 xor-xxx, 55, 108, 207, 208 xor-xxx-is-equal, 207

z-set, 38, 183, 184 zb, 38, 183–185, 194, 209, 216 zerop-difference, 351 zerop-difference-p-ctrl-stk-size, 692 zerop-v-to-nat-int-to-v, 195