-(define (compare-instrs A-ptr B-ptr modifier test)
- (let ((A-instr (core-get A-ptr))
- (B-instr (core-get B-ptr)))
- (case modifier
- ((A) (test (A-instr 'A-num) (B-instr 'A-num)))
- ((B) (test (A-instr 'B-num) (B-instr 'B-num)))
- ((AB) (test (A-instr 'A-num) (B-instr 'B-num)))
- ((BA) (test (A-instr 'B-num) (B-instr 'A-num)))
- ((F) (and
- (test (A-instr 'A-num) (B-instr 'A-num))
- (test (A-instr 'B-num) (B-instr 'B-num))))
- ((X) (and
- (test (A-instr 'A-num) (B-instr 'B-num))
- (test (A-instr 'B-num) (B-instr 'A-num))))
- ((I) (and
- (if (eq? test =)
- (and
- (eq? (A-instr 'opcode) (B-instr 'opcode))
- (eq? (A-instr 'modifier) (B-instr 'modifier))
- (eq? (A-instr 'A-mode) (B-instr 'B-mode))
- (eq? (A-instr 'B-mode) (B-instr 'A-mode)))
- #t)
- (test (A-instr 'A-num) (B-instr 'B-num))
- (test (A-instr 'B-num) (B-instr 'A-num)))))))
-
-(define (instr-zero? ptr modifier decrement)
- (let ((instr (core-get ptr)))
- (case modifier
- ((A AB)
- (if decrement (instr 'set-A-num! (addr+ (instr 'A-num) -1)))
- (= 0 (instr 'A-num)))
- ((A AB)
- (if decrement (instr 'set-B-num! (addr+ (instr 'B-num) -1)))
- (= 0 (instr 'B-num)))
- ((X I F)
- (if decrement
- (begin
- (instr 'set-A-num! (addr+ (instr 'A-num) -1))
- (instr 'set-B-num! (addr+ (instr 'B-num) -1))))
- (and (= 0 (instr 'A-num))
- (= 0 (instr 'B-num)))))))
+(define (compare-instrs core A-ptr B-ptr modifier test)
+ (case modifier
+ ((A) (test (core A-ptr 'A-num) (core B-ptr 'A-num)))
+ ((B) (test (core A-ptr 'B-num) (core B-ptr 'B-num)))
+ ((AB) (test (core A-ptr 'A-num) (core B-ptr 'B-num)))
+ ((BA) (test (core A-ptr 'B-num) (core B-ptr 'A-num)))
+ ((F) (and
+ (test (core A-ptr 'A-num) (core B-ptr 'A-num))
+ (test (core A-ptr 'B-num) (core B-ptr 'B-num))))
+ ((X) (and
+ (test (core A-ptr 'A-num) (core B-ptr 'B-num))
+ (test (core A-ptr 'B-num) (core B-ptr 'A-num))))
+ ((I) (and
+ (if (eq? test =)
+ (and
+ (eq? (core A-ptr 'opcode) (core B-ptr 'opcode))
+ (eq? (core A-ptr 'modifier) (core B-ptr 'modifier))
+ (eq? (core A-ptr 'A-mode) (core B-ptr 'B-mode))
+ (eq? (core A-ptr 'B-mode) (core B-ptr 'A-mode)))
+ #t)
+ (test (core A-ptr 'A-num) (core B-ptr 'B-num))
+ (test (core A-ptr 'B-num) (core B-ptr 'A-num))))))
+
+(define (instr-zero? core ptr modifier decrement name)
+ (case modifier
+ ((A AB)
+ (if decrement (core ptr 'set! 'A-num (addr+ (core ptr 'A-num) -1) name))
+ (= 0 (core ptr 'A-num)))
+ ((A AB)
+ (if decrement (core ptr 'set! 'B-num (addr+ (core ptr 'B-num) -1) name))
+ (= 0 (core ptr 'B-num)))
+ ((X I F)
+ (if decrement
+ (begin
+ (core ptr 'set! 'A-num (addr+ (core ptr 'A-num) -1) name)
+ (core ptr 'set! 'B-num (addr+ (core ptr 'B-num) -1) name)))
+ (and (= 0 (core ptr 'A-num))
+ (= 0 (core ptr 'B-num))))))