Monday, February 11, 2008

COMFY-6502: a slight correction

After all the work to write a post showing off COMFY-6502's ability to reproduce the Red Book tone routine, I made a slight mistake in translation. The code I presented differed ever-so-slightly from the Red Book routine in the case where the Y-register reached zero.

In the original, when the Y-register reaches zero, the DEX is still executed. In the code I posted, the expiring "duration tick" skips a count on the pitch. A minor error, but one I should own up to.

Here's a better effort. COMPILE-SYMBOLIC contains a MACROLET defining MODULE as a call to COMFY-6502:COMPILE.


(compile-symbolic
(equ speaker #xc030)
(equ duration 1)
(equ pitch 0)
(module
(comfy-6502:loop
;; repeat until some clause loses: actually, only exit is
;; through return, so each clause should be ensured of winning.
(LDX pitch)
(LDA speaker)
(not
(comfy-6502:loop ;; repeat until whap time
DEY
(not (seq zero? (DEC duration) zero? return))
(seq DEX (not zero?)))))))


resulting in


(; reload-pitch
(LDX :ZERO-PAGE) (:ZERO-PAGE 0)
(LDA :ABSOLUTE) (:ABSOLUTE 49200)
; spin
(DEY)
(BNE) (:BRANCH 6) ; not-duration-tick
(DEC :ZERO-PAGE) (:ZERO-PAGE 1)
(BNE) (:BRANCH 2)
(RTS)
; not-duration-tick
(DEX)
(BEQ) (:BRANCH 4) ; goto-reload-pitch
(JMP :ABSOLUTE) (:LONG-BRANCH -12) ; spin
; goto-reload-pitch
(JMP :ABSOLUTE) (:LONG-BRANCH -20) ; reload-pitch
)


For fun, I tried to get the code to emit the RTS at the very end, as in the original.


(compile-symbolic
(equ speaker #xc030)
(equ duration 1)
(equ pitch 0)
(module
(alt (loop (seq (LDX pitch) (LDA speaker))
(not (while
(seq DEY (not (seq zero? (seq (DEC duration) zero?)))
(seq DEX (not zero?)))))
RTS)))



(; reload
(LDX :ZERO-PAGE) (:ZERO-PAGE 0)
(LDA :ABSOLUTE) (:ABSOLUTE 49200)
; spin
(DEY)
(BNE) (:BRANCH 5) ; not-duration
; duration-tick
(DEC :ZERO-PAGE) (:ZERO-PAGE 1)
(BEQ) (:BRANCH 10) ; exit
; not-duration
(DEX)
(BEQ) (:BRANCH 4) ; goto-reload
; goto-spin
(JMP :ABSOLUTE) (:LONG-BRANCH -11)
; goto-reload
(JMP :ABSOLUTE) (:LONG-BRANCH -19) ; reload
; exit
(RTS))


"Loop tightening" could change (BEQ) (:BRANCH 4) to (BEQ) (:BRANCH -14); the (JMP :ABSOLUTE) (:LONG-BRANCH -19) is then never used, and could be omitted, changing (BEQ) (:BRANCH 10) to (BEQ) (:BRANCH 7).

"Loop compaction" could potentially recognize (BEQ) (:BRANCH -14) (JMP :ABSOLUTE) (:LONG-BRANCH -11), where no other instruction references the JMP, could be converted to (BEQ) (:BRANCH -14) (BNE) (:BRANCH -11), shortening the (BEQ) (:BRANCH 7) one byte more to (BNE) (:BRANCH 6).

Note some interesting equivalents I should probably implement as COMFY macros.

(if A B C) where C is do-nothing-but-win is (not (seq A (not B)). If A wins, B is executed to determine the result of the form. If A loses, the if wins. I will probably call this (when A B).

(if A B C) where B is a do-nothing-but-win is (alt A C), where alt is the "dual" of seq. (alt A B C ...) == (not (seq (not A) (not B) (not C) ...). For the two-argument case, I would call this (unless A B).

The one twist I can think of is to add an "implied SEQ" to these forms. (when A B C ...) would be (when A (seq B C ...)). (unless A B C ...) would be (unless A (seq B C ...)).

No comments:

Post a Comment