BJQSZC43ZA4A6T4NSQOWQ5OQE2QK7JWWXLAWITMIKJTGUHP2RRRAC
read : {n : ℕ} {A : Set} → memory n A → (Word n → A)
read ram ∅ = ram
read ram (w ○) = proj₁ (read ram w)
read ram (w ●) = proj₂ (read ram w)
read : {n : ℕ} {A : Set} → memory n A → (Word n → Maybe A)
read ram ∅ = just ram
read ram (w ○) = Maybe.map proj₁ (read ram w)
read ram (w ●) = Maybe.map proj₂ (read ram w)
read ram (w ◍) = nothing
op₀ : {n : ℕ} → Bool → Word n
op₁ : {n : ℕ} → (Bool → Bool) → (Word n → Word n)
op₂ : {n : ℕ} → (Bool → Bool → Bool) → (Word n → Word n → Word n)
op₀ : {n : ℕ} → Bit → Word n
op₁ : {n : ℕ} → (Bit → Bit) → (Word n → Word n)
op₂ : {n : ℕ} → (Bit → Bit → Bit) → (Word n → Word n → Word n)
nat-from-word : {n : ℕ} → Word n → ℕ
nat-from-word ∅ = 0
nat-from-word (push-low (b , w)) = (if b then 1 else 0) + 2 * nat-from-word w
nat-from-word : {n : ℕ} → Word n → Maybe ℕ
nat-from-word ∅ = Maybe.just 0
nat-from-word (push-low (b , w)) with Bit.bool-from-bit b | nat-from-word w
... | just b | just w = just ((Bool.if b then 1 else 0) + 2 * w)
... | _ | _ = nothing
full-adder : Bool → Bool → Bool → Bool × Bool
full-adder false false false = (false , false)
full-adder false false true = ( true , false)
full-adder false true false = ( true , false)
full-adder false true true = (false , true)
full-adder true false false = ( true , false)
full-adder true false true = (false , true)
full-adder true true false = (false , true)
full-adder true true true = ( true , true)
add-with-carry : {n : ℕ} → Bool → Word n → Word n → Word n × Bool
add-with-carry : {n : ℕ} → Bit → Word n → Word n → Word n × Bit
sub-with-inverted-borrow : {n : ℕ} → Bool → Word n → Word n → Word n × Bool
sub-with-inverted-borrow inverted-borrow w₀ w₁ = add-with-carry inverted-borrow w₀ (op₁ Bool.not w₁)
sub-with-inverted-borrow : {n : ℕ} → Bit → Word n → Word n → Word n × Bit
sub-with-inverted-borrow inverted-borrow w₀ w₁ = add-with-carry inverted-borrow w₀ (op₁ not w₁)
suc $ read (increment (+ 1) $ State.program-counter s) $ λ ADL →
suc $ read (increment (+ 2) $ State.program-counter s) $ λ ADH →
suc $ read (increment (+ 1) $ State.program-counter s) $ λ ADL → just $
suc $ read (increment (+ 2) $ State.program-counter s) $ λ ADH → just $
suc $ read (increment (+ 1) $ State.program-counter s) $ λ IAL →
suc $ read (increment (+ 2) $ State.program-counter s) $ λ IAH →
suc $ read (concat (IAL , IAH)) $ λ ADL →
suc $ read (concat (increment (+ 1) IAL , IAH)) $ λ ADH →
suc $ read (increment (+ 1) $ State.program-counter s) $ λ IAL → just $
suc $ read (increment (+ 2) $ State.program-counter s) $ λ IAH → just $
suc $ read (concat (IAL , IAH)) $ λ ADL → just $
suc $ read (concat (increment (+ 1) IAL , IAH)) $ λ ADH → just $
if carry ∨ not read-only then (
suc $ read (concat (ADL , BAH)) $ λ _ →
continuation $ concat (ADL , (if carry then increment (+ 1) BAH else BAH))
flip Maybe.map (bool-from-bit carry) $ λ carry →
Bool.if carry Bool.∨ Bool.not read-only then (
suc $ read (concat (ADL , BAH)) $ λ _ → just $
continuation $ concat (ADL , (Bool.if carry then increment (+ 1) BAH else BAH))
if carry ∨ not read-only then (
suc $ read (concat (ADL , BAH)) $ λ _ →
continuation $ concat (ADL , (if carry then increment (+ 1) BAH else BAH))
flip Maybe.map (bool-from-bit carry) $ λ carry →
Bool.if carry Bool.∨ Bool.not read-only then (
suc $ read (concat (ADL , BAH)) $ λ _ → just $
continuation $ concat (ADL , (Bool.if carry then increment (+ 1) BAH else BAH))
if carry ∨ not read-only then (
suc $ read (concat (ADL , BAH)) $ λ _ →
continuation $ concat (ADL , (if carry then increment (+ 1) BAH else BAH))
flip Maybe.map (bool-from-bit carry) $ λ carry →
Bool.if carry Bool.∨ Bool.not read-only then (
suc $ read (concat (ADL , BAH)) $ λ _ → just $
continuation $ concat (ADL , (Bool.if carry then increment (+ 1) BAH else BAH))
page-change = Data.Integer._-_ (if carry then + 1 else + 0) (if bit offset 7 then + 1 else + 0)
in
bool-from-bit carry Maybe.>>= λ carry →
bool-from-bit (bit offset 7) Maybe.>>= λ backwards →
let
page-change = Data.Integer._-_ (Bool.if carry then + 1 else + 0) (Bool.if backwards then + 1 else + 0)
(hi , carry-out) = if no-decimal-carry then (hi , carry-out) else (hi-minus-10 , true)
in record s {
in bool-from-bit no-decimal-carry Maybe.>>= λ no-decimal-carry → let
(hi , carry-out) = Bool.if no-decimal-carry then (hi , carry-out) else (hi-minus-10 , true)
in just $ record s {
suc $ read (increment (+ 1) $ State.program-counter s) $ λ ADL →
suc $ read (concat (State.stack-pointer s , op₀ false ●)) $ λ _ →
suc $ read (increment (+ 1) $ State.program-counter s) $ λ ADL → just $
suc $ read (concat (State.stack-pointer s , op₀ false ●)) $ λ _ → just $
run LDA instruction = execute-read-op $ \(s , w) → record (setZN w s) {register-A = w}
run LDX instruction = execute-read-op $ \(s , w) → record (setZN w s) {register-X = w}
run LDY instruction = execute-read-op $ \(s , w) → record (setZN w s) {register-Y = w}
run LDA instruction = execute-read-op $ \(s , w) → just $ record (setZN w s) {register-A = w}
run LDX instruction = execute-read-op $ \(s , w) → just $ record (setZN w s) {register-X = w}
run LDY instruction = execute-read-op $ \(s , w) → just $ record (setZN w s) {register-Y = w}
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ →
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ →
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ w →
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ → just $
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ → just $
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ w → just $
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ →
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ →
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ w →
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ → just $
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ → just $
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ w → just $
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ →
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ →
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ P →
suc $ read (concat (increment (+ 2) (State.stack-pointer s) , op₀ false ●)) $ λ PCL →
suc $ read (concat (increment (+ 3) (State.stack-pointer s) , op₀ false ●)) $ λ PCH →
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ → just $
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ → just $
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ P → just $
suc $ read (concat (increment (+ 2) (State.stack-pointer s) , op₀ false ●)) $ λ PCL → just $
suc $ read (concat (increment (+ 3) (State.stack-pointer s) , op₀ false ●)) $ λ PCH → just $
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ →
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ →
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ PCL →
suc $ read (concat (increment (+ 2) (State.stack-pointer s) , op₀ false ●)) $ λ PCH →
suc $ read (concat (PCL , PCH)) $ λ _ →
suc $ read (increment (+ 1) $ State.program-counter s) $ λ _ → just $
suc $ read (concat ( State.stack-pointer s , op₀ false ●)) $ λ _ → just $
suc $ read (concat (increment (+ 1) (State.stack-pointer s) , op₀ false ●)) $ λ PCL → just $
suc $ read (concat (increment (+ 2) (State.stack-pointer s) , op₀ false ●)) $ λ PCH → just $
suc $ read (concat (PCL , PCH)) $ λ _ → just $
lo = if inv-borrow-mid then lo else add lo (∅ ● ○ ● ○)
(hi , inv-borrow-out) = sub-with-inverted-borrow inv-borrow-mid hi₀ hi₁
in
bool-from-bit inv-borrow-mid Maybe.>>= λ inv-borrow-mid →
bool-from-bit inv-borrow-out Maybe.>>= λ inv-borrow-out →
let
lo = Bool.if inv-borrow-mid then lo else add lo (∅ ● ○ ● ○)
step s =
record {
addr = State.program-counter s;
r/w = true;
continuation = Data.Maybe.map (λ (instr , mode) → run_instruction instr mode s) ∘′ parse-opcode
}
step s = read (State.program-counter s) $
Maybe.map (λ (instr , mode) → run_instruction instr mode s) ∘′ parse-opcode