AS65 Assembler for R6502 [1.42]. Copyright 1994-2007, Frank A. Kingswood Page 1 ---------------------------------------------------- 6502_functional_test.a65 ---------------------------------------------------- 6321 lines read, no errors in pass 1. ; ; 6 5 0 2 F U N C T I O N A L T E S T ; ; Copyright (C) 2012-2015 Klaus Dormann ; ; This program is free software: you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation, either version 3 of the License, or ; (at your option) any later version. ; ; This program is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with this program. If not, see . ; This program is designed to test all opcodes of a 6502 emulator using all ; addressing modes with focus on propper setting of the processor status ; register bits. ; ; version 04-dec-2017 ; contact info at http://2m5.de or email K@2m5.de ; ; assembled with AS65 from http://www.kingswood-consulting.co.uk/assemblers/ ; command line switches: -l -m -s2 -w -h0 ; | | | | no page headers in listing ; | | | wide listing (133 char/col) ; | | write intel hex file instead of binary ; | expand macros in listing ; generate pass2 listing ; ; No IO - should be run from a monitor with access to registers. ; To run load intel hex image with a load command, than alter PC to 400 hex ; (code_segment) and enter a go command. ; Loop on program counter determines error or successful completion of test. ; Check listing for relevant traps (jump/branch *). ; Please note that in early tests some instructions will have to be used before ; they are actually tested! ; ; RESET, NMI or IRQ should not occur and will be trapped if vectors are enabled. ; Tests documented behavior of the original NMOS 6502 only! No unofficial ; opcodes. Additional opcodes of newer versions of the CPU (65C02, 65816) will ; not be tested. Decimal ops will only be tested with valid BCD operands and ; N V Z flags will be ignored. ; ; Debugging hints: ; Most of the code is written sequentially. if you hit a trap, check the ; immediately preceeding code for the instruction to be tested. Results are ; tested first, flags are checked second by pushing them onto the stack and ; pulling them to the accumulator after the result was checked. The "real" ; flags are no longer valid for the tested instruction at this time! ; If the tested instruction was indexed, the relevant index (X or Y) must ; also be checked. Opposed to the flags, X and Y registers are still valid. ; ; versions: ; 28-jul-2012 1st version distributed for testing ; 29-jul-2012 fixed references to location 0, now #0 ; added license - GPLv3 ; 30-jul-2012 added configuration options ; 01-aug-2012 added trap macro to allow user to change error handling ; 01-dec-2012 fixed trap in branch field must be a branch ; 02-mar-2013 fixed PLA flags not tested ; 19-jul-2013 allowed ROM vectors to be loaded when load_data_direct = 0 ; added test sequence check to detect if tests jump their fence ; 23-jul-2013 added RAM integrity check option ; 16-aug-2013 added error report to standard output option ; 13-dec-2014 added binary/decimal opcode table switch test ; 14-dec-2014 improved relative address test ; 23-aug-2015 added option to disable self modifying tests ; 24-aug-2015 all self modifying immediate opcodes now execute in data RAM ; added small branch offset pretest ; 21-oct-2015 added option to disable decimal mode ADC & SBC tests ; 04-dec-2017 fixed BRK only tested with interrupts enabled ; added option to skip the remainder of a failing test ; in report.i65 ; C O N F I G U R A T I O N ;ROM_vectors writable (0=no, 1=yes) ;if ROM vectors can not be used interrupts will not be trapped ;as a consequence BRK can not be tested but will be emulated to test RTI 0001 = ROM_vectors = 1 ;load_data_direct (0=move from code segment, 1=load directly) ;loading directly is preferred but may not be supported by your platform ;0 produces only consecutive object code, 1 is not suitable for a binary image 0001 = load_data_direct = 1 ;I_flag behavior (0=force enabled, 1=force disabled, 2=prohibit change, 3=allow ;change) 2 requires extra code and is not recommended. SEI & CLI can only be ;tested if you allow changing the interrupt status (I_flag = 3) 0003 = I_flag = 3 ;configure memory - try to stay away from memory used by the system ;zero_page memory start address, $50 (80) consecutive Bytes required ; add 2 if I_flag = 2 000a = zero_page = $a ;data_segment memory start address, $6A (106) consecutive Bytes required 0200 = data_segment = $200 if (data_segment & $ff) != 0 ERROR ERROR ERROR low byte of data_segment MUST be $00 !! endif ;code_segment memory start address, 13kB of consecutive space required ; add 2.5 kB if I_flag = 2 0400 = code_segment = $400 ;self modifying code may be disabled to allow running in ROM ;0=part of the code is self modifying and must reside in RAM ;1=tests disabled: branch range 0000 = disable_selfmod = 0 ;report errors through I/O channel (0=use standard self trap loops, 1=include ;report.i65 as I/O channel, add 3.5 kB) 0001 = report = 1 ;RAM integrity test option. Checks for undesired RAM writes. ;set lowest non RAM or RAM mirror address page (-1=disable, 0=64k, $40=16k) ;leave disabled if a monitor, OS or background interrupt is allowed to alter RAM ffff = ram_top = -1 ;disable test decimal mode ADC & SBC, 0=enable, 1=disable, ;2=disable including decimal flag in processor status 0000 = disable_decimal = 0 noopt ;do not take shortcuts ;macros for error & success traps to allow user modification ;example: ;trap macro ; jsr my_error_handler ; endm ;trap_eq macro ; bne skip\? ; trap ;failed equal (zero) ;skip\? ; endm ; ; my_error_handler should pop the calling address from the stack and report it. ; putting larger portions of code (more than 3 bytes) inside the trap macro ; may lead to branch range problems for some tests. if report = 0 trap macro jmp * ;failed anyway endm trap_eq macro beq * ;failed equal (zero) endm trap_ne macro bne * ;failed not equal (non zero) endm trap_cs macro bcs * ;failed carry set endm trap_cc macro bcc * ;failed carry clear endm trap_mi macro bmi * ;failed minus (bit 7 set) endm trap_pl macro bpl * ;failed plus (bit 7 clear) endm trap_vs macro bvs * ;failed overflow set endm trap_vc macro bvc * ;failed overflow clear endm ; please observe that during the test the stack gets invalidated ; therefore a RTS inside the success macro is not possible success macro jmp * ;test passed, no errors endm endif if report = 1 trap macro jsr report_error endm trap_eq macro bne skip\? trap ;failed equal (zero) skip\? endm trap_ne macro beq skip\? trap ;failed not equal (non zero) skip\? endm trap_cs macro bcc skip\? trap ;failed carry set skip\? endm trap_cc macro bcs skip\? trap ;failed carry clear skip\? endm trap_mi macro bpl skip\? trap ;failed minus (bit 7 set) skip\? endm trap_pl macro bmi skip\? trap ;failed plus (bit 7 clear) skip\? endm trap_vs macro bvc skip\? trap ;failed overflow set skip\? endm trap_vc macro bvs skip\? trap ;failed overflow clear skip\? endm ; please observe that during the test the stack gets invalidated ; therefore a RTS inside the success macro is not possible success macro jsr report_success endm endif 0001 = carry equ %00000001 ;flag bits in status 0002 = zero equ %00000010 0004 = intdis equ %00000100 0008 = decmode equ %00001000 0010 = break equ %00010000 0020 = reserv equ %00100000 0040 = overfl equ %01000000 0080 = minus equ %10000000 0001 = fc equ carry 0002 = fz equ zero 0003 = fzc equ carry+zero 0040 = fv equ overfl 0042 = fvz equ overfl+zero 0080 = fn equ minus 0081 = fnc equ minus+carry 0082 = fnz equ minus+zero 0083 = fnzc equ minus+zero+carry 00c0 = fnv equ minus+overfl 0030 = fao equ break+reserv ;bits always on after PHP, BRK 0034 = fai equ fao+intdis ;+ forced interrupt disable 0038 = faod equ fao+decmode ;+ ignore decimal 003c = faid equ fai+decmode ;+ ignore decimal 00ff = m8 equ $ff ;8 bit mask 00fb = m8i equ $ff&~intdis ;8 bit mask - interrupt disable ;macros to allow masking of status bits. ;masking test of decimal bit ;masking of interrupt enable/disable on load and compare ;masking of always on bits after PHP or BRK (unused & break) on compare if disable_decimal < 2 if I_flag = 0 load_flag macro lda #\1&m8i ;force enable interrupts (mask I) endm cmp_flag macro cmp #(\1|fao)&m8i ;I_flag is always enabled + always on bits endm eor_flag macro eor #(\1&m8i|fao) ;mask I, invert expected flags + always on bits endm endif if I_flag = 1 load_flag macro lda #\1|intdis ;force disable interrupts endm cmp_flag macro cmp #(\1|fai)&m8 ;I_flag is always disabled + always on bits endm eor_flag macro eor #(\1|fai) ;invert expected flags + always on bits + I endm endif if I_flag = 2 load_flag macro lda #\1 ora flag_I_on ;restore I-flag and flag_I_off endm cmp_flag macro eor flag_I_on ;I_flag is never changed cmp #(\1|fao)&m8i ;expected flags + always on bits, mask I endm eor_flag macro eor flag_I_on ;I_flag is never changed eor #(\1&m8i|fao) ;mask I, invert expected flags + always on bits endm endif if I_flag = 3 load_flag macro lda #\1 ;allow test to change I-flag (no mask) endm cmp_flag macro cmp #(\1|fao)&m8 ;expected flags + always on bits endm eor_flag macro eor #\1|fao ;invert expected flags + always on bits endm endif else if I_flag = 0 load_flag macro lda #\1&m8i ;force enable interrupts (mask I) endm cmp_flag macro ora #decmode ;ignore decimal mode bit cmp #(\1|faod)&m8i ;I_flag is always enabled + always on bits endm eor_flag macro ora #decmode ;ignore decimal mode bit eor #(\1&m8i|faod) ;mask I, invert expected flags + always on bits endm endif if I_flag = 1 load_flag macro lda #\1|intdis ;force disable interrupts endm cmp_flag macro ora #decmode ;ignore decimal mode bit cmp #(\1|faid)&m8 ;I_flag is always disabled + always on bits endm eor_flag macro ora #decmode ;ignore decimal mode bit eor #(\1|faid) ;invert expected flags + always on bits + I endm endif if I_flag = 2 load_flag macro lda #\1 ora flag_I_on ;restore I-flag and flag_I_off endm cmp_flag macro eor flag_I_on ;I_flag is never changed ora #decmode ;ignore decimal mode bit cmp #(\1|faod)&m8i ;expected flags + always on bits, mask I endm eor_flag macro eor flag_I_on ;I_flag is never changed ora #decmode ;ignore decimal mode bit eor #(\1&m8i|faod) ;mask I, invert expected flags + always on bits endm endif if I_flag = 3 load_flag macro lda #\1 ;allow test to change I-flag (no mask) endm cmp_flag macro ora #decmode ;ignore decimal mode bit cmp #(\1|faod)&m8 ;expected flags + always on bits endm eor_flag macro ora #decmode ;ignore decimal mode bit eor #\1|faod ;invert expected flags + always on bits endm endif endif ;macros to set (register|memory|zeropage) & status set_stat macro ;setting flags in the processor status register load_flag \1 pha ;use stack to load status plp endm set_a macro ;precharging accu & status load_flag \2 pha ;use stack to load status lda #\1 ;precharge accu plp endm set_x macro ;precharging index & status load_flag \2 pha ;use stack to load status ldx #\1 ;precharge index x plp endm set_y macro ;precharging index & status load_flag \2 pha ;use stack to load status ldy #\1 ;precharge index y plp endm set_ax macro ;precharging indexed accu & immediate status load_flag \2 pha ;use stack to load status lda \1,x ;precharge accu plp endm set_ay macro ;precharging indexed accu & immediate status load_flag \2 pha ;use stack to load status lda \1,y ;precharge accu plp endm set_z macro ;precharging indexed zp & immediate status load_flag \2 pha ;use stack to load status lda \1,x ;load to zeropage sta zpt plp endm set_zx macro ;precharging zp,x & immediate status load_flag \2 pha ;use stack to load status lda \1,x ;load to indexed zeropage sta zpt,x plp endm set_abs macro ;precharging indexed memory & immediate status load_flag \2 pha ;use stack to load status lda \1,x ;load to memory sta abst plp endm set_absx macro ;precharging abs,x & immediate status load_flag \2 pha ;use stack to load status lda \1,x ;load to indexed memory sta abst,x plp endm ;macros to test (register|memory|zeropage) & status & (mask) tst_stat macro ;testing flags in the processor status register php ;save status pla ;use stack to retrieve status pha cmp_flag \1 trap_ne plp ;restore status endm tst_a macro ;testing result in accu & flags php ;save flags cmp #\1 ;test result trap_ne pla ;load status pha cmp_flag \2 trap_ne plp ;restore status endm tst_x macro ;testing result in x index & flags php ;save flags cpx #\1 ;test result trap_ne pla ;load status pha cmp_flag \2 trap_ne plp ;restore status endm tst_y macro ;testing result in y index & flags php ;save flags cpy #\1 ;test result trap_ne pla ;load status pha cmp_flag \2 trap_ne plp ;restore status endm tst_ax macro ;indexed testing result in accu & flags php ;save flags cmp \1,x ;test result trap_ne pla ;load status eor_flag \3 cmp \2,x ;test flags trap_ne ; endm tst_ay macro ;indexed testing result in accu & flags php ;save flags cmp \1,y ;test result trap_ne ; pla ;load status eor_flag \3 cmp \2,y ;test flags trap_ne endm tst_z macro ;indexed testing result in zp & flags php ;save flags lda zpt cmp \1,x ;test result trap_ne pla ;load status eor_flag \3 cmp \2,x ;test flags trap_ne endm tst_zx macro ;testing result in zp,x & flags php ;save flags lda zpt,x cmp \1,x ;test result trap_ne pla ;load status eor_flag \3 cmp \2,x ;test flags trap_ne endm tst_abs macro ;indexed testing result in memory & flags php ;save flags lda abst cmp \1,x ;test result trap_ne pla ;load status eor_flag \3 cmp \2,x ;test flags trap_ne endm tst_absx macro ;testing result in abs,x & flags php ;save flags lda abst,x cmp \1,x ;test result trap_ne pla ;load status eor_flag \3 cmp \2,x ;test flags trap_ne endm ; RAM integrity test ; verifies that none of the previous tests has altered RAM outside of the ; designated write areas. ; uses zpt word as indirect pointer, zpt+2 word as checksum if ram_top > -1 check_ram macro cld lda #0 sta zpt ;set low byte of indirect pointer sta zpt+3 ;checksum high byte if disable_selfmod = 0 sta range_adr ;reset self modifying code endif clc ldx #zp_bss-zero_page ;zeropage - write test area ccs3\? adc zero_page,x bcc ccs2\? inc zpt+3 ;carry to high byte clc ccs2\? inx bne ccs3\? ldx #hi(abs1) ;set high byte of indirect pointer stx zpt+1 ldy #lo(abs1) ;data after write & execute test area ccs5\? adc (zpt),y bcc ccs4\? inc zpt+3 ;carry to high byte clc ccs4\? iny bne ccs5\? inx ;advance RAM high address stx zpt+1 cpx #ram_top bne ccs5\? sta zpt+2 ;checksum low is cmp ram_chksm ;checksum low expected trap_ne ;checksum mismatch lda zpt+3 ;checksum high is cmp ram_chksm+1 ;checksum high expected trap_ne ;checksum mismatch endm else check_ram macro ;RAM check disabled - RAM size not set endm endif next_test macro ;make sure, tests don't jump the fence lda test_case ;previous test cmp #test_num trap_ne ;test is out of sequence test_num = test_num + 1 lda #test_num ;*** next tests' number sta test_case ;check_ram ;uncomment to find altered RAM after each test endm if load_data_direct = 1 data else bss ;uninitialized segment, copy of data at end of code! endif 000a = org zero_page ;break test interrupt save 000a : 00 irq_a ds 1 ;a register 000b : 00 irq_x ds 1 ;x register if I_flag = 2 ;masking for I bit in status flag_I_on ds 1 ;or mask to load flags flag_I_off ds 1 ;and mask to load flags endif 000c : zpt ;5 bytes store/modify test area ;add/subtract operand generation and result/flag prediction 000c : 00 adfc ds 1 ;carry flag before op 000d : 00 ad1 ds 1 ;operand 1 - accumulator 000e : 00 ad2 ds 1 ;operand 2 - memory / immediate 000f : 00 adrl ds 1 ;expected result bits 0-7 0010 : 00 adrh ds 1 ;expected result bit 8 (carry) 0011 : 00 adrf ds 1 ;expected flags NV0000ZC (only binary mode) 0012 : 00 sb2 ds 1 ;operand 2 complemented for subtract 0013 : zp_bss 0013 : c3824100 zp1 db $c3,$82,$41,0 ;test patterns for LDx BIT ROL ROR ASL LSR 0017 : 7f zp7f db $7f ;test pattern for compare ;logical zeropage operands 0018 : 001f7180 zpOR db 0,$1f,$71,$80 ;test pattern for OR 001c : 0fff7f80 zpAN db $0f,$ff,$7f,$80 ;test pattern for AND 0020 : ff0f8f8f zpEO db $ff,$0f,$8f,$8f ;test pattern for EOR ;indirect addressing pointers 0024 : 1702 ind1 dw abs1 ;indirect pointer to pattern in absolute memory 0026 : 1802 dw abs1+1 0028 : 1902 dw abs1+2 002a : 1a02 dw abs1+3 002c : 1b02 dw abs7f 002e : 1f01 inw1 dw abs1-$f8 ;indirect pointer for wrap-test pattern 0030 : 0302 indt dw abst ;indirect pointer to store area in absolute memory 0032 : 0402 dw abst+1 0034 : 0502 dw abst+2 0036 : 0602 dw abst+3 0038 : 0b01 inwt dw abst-$f8 ;indirect pointer for wrap-test store 003a : 4e02 indAN dw absAN ;indirect pointer to AND pattern in absolute memory 003c : 4f02 dw absAN+1 003e : 5002 dw absAN+2 0040 : 5102 dw absAN+3 0042 : 5202 indEO dw absEO ;indirect pointer to EOR pattern in absolute memory 0044 : 5302 dw absEO+1 0046 : 5402 dw absEO+2 0048 : 5502 dw absEO+3 004a : 4a02 indOR dw absOR ;indirect pointer to OR pattern in absolute memory 004c : 4b02 dw absOR+1 004e : 4c02 dw absOR+2 0050 : 4d02 dw absOR+3 ;add/subtract indirect pointers 0052 : 0302 adi2 dw ada2 ;indirect pointer to operand 2 in absolute memory 0054 : 0402 sbi2 dw sba2 ;indirect pointer to complemented operand 2 (SBC) 0056 : 0401 adiy2 dw ada2-$ff ;with offset for indirect indexed 0058 : 0501 sbiy2 dw sba2-$ff 005a : zp_bss_end 0200 = org data_segment 0200 : 00 test_case ds 1 ;current test number 0201 : 0000 ram_chksm ds 2 ;checksum for RAM integrity test ;add/subtract operand copy - abs tests write area 0203 : abst ;5 bytes store/modify test area 0203 : 00 ada2 ds 1 ;operand 2 0204 : 00 sba2 ds 1 ;operand 2 complemented for subtract 0205 : 000000 ds 3 ;fill remaining bytes 0208 : data_bss if load_data_direct = 1 0208 : 2900 ex_andi and #0 ;execute immediate opcodes 020a : 60 rts 020b : 4900 ex_eori eor #0 ;execute immediate opcodes 020d : 60 rts 020e : 0900 ex_orai ora #0 ;execute immediate opcodes 0210 : 60 rts 0211 : 6900 ex_adci adc #0 ;execute immediate opcodes 0213 : 60 rts 0214 : e900 ex_sbci sbc #0 ;execute immediate opcodes 0216 : 60 rts else ex_andi ds 3 ex_eori ds 3 ex_orai ds 3 ex_adci ds 3 ex_sbci ds 3 endif 0217 : c3824100 abs1 db $c3,$82,$41,0 ;test patterns for LDx BIT ROL ROR ASL LSR 021b : 7f abs7f db $7f ;test pattern for compare ;loads 021c : 80800002 fLDx db fn,fn,0,fz ;expected flags for load ;shifts 0220 : rASL ;expected result ASL & ROL -carry 0220 : 86048200 rROL db $86,$04,$82,0 ; " 0224 : 87058301 rROLc db $87,$05,$83,1 ;expected result ROL +carry 0228 : rLSR ;expected result LSR & ROR -carry 0228 : 61412000 rROR db $61,$41,$20,0 ; " 022c : e1c1a080 rRORc db $e1,$c1,$a0,$80 ;expected result ROR +carry 0230 : fASL ;expected flags for shifts 0230 : 81018002 fROL db fnc,fc,fn,fz ;no carry in 0234 : 81018000 fROLc db fnc,fc,fn,0 ;carry in 0238 : fLSR 0238 : 01000102 fROR db fc,0,fc,fz ;no carry in 023c : 81808180 fRORc db fnc,fn,fnc,fn ;carry in ;increments (decrements) 0240 : 7f80ff0001 rINC db $7f,$80,$ff,0,1 ;expected result for INC/DEC 0245 : 0080800200 fINC db 0,fn,fn,fz,0 ;expected flags for INC/DEC ;logical memory operand 024a : 001f7180 absOR db 0,$1f,$71,$80 ;test pattern for OR 024e : 0fff7f80 absAN db $0f,$ff,$7f,$80 ;test pattern for AND 0252 : ff0f8f8f absEO db $ff,$0f,$8f,$8f ;test pattern for EOR ;logical accu operand 0256 : 00f11f00 absORa db 0,$f1,$1f,0 ;test pattern for OR 025a : f0ffffff absANa db $f0,$ff,$ff,$ff ;test pattern for AND 025e : fff0f00f absEOa db $ff,$f0,$f0,$0f ;test pattern for EOR ;logical results 0262 : 00ff7f80 absrlo db 0,$ff,$7f,$80 0266 : 02800080 absflo db fz,fn,0,fn 026a : data_bss_end code 0400 = org code_segment 0400 : d8 start cld 0401 : a2ff ldx #$ff 0403 : 9a txs 0404 : a900 lda #0 ;*** test 0 = initialize 0406 : 8d0002 sta test_case 0000 = test_num = 0 ;stop interrupts before initializing BSS if I_flag = 1 sei endif ;initialize I/O for report channel if report = 1 0409 : 204c44 jsr report_init endif ;pretest small branch offset 040c : a205 ldx #5 040e : 4c3604 jmp psb_test 0411 : psb_bwok 0411 : a005 ldy #5 0413 : d008 bne psb_forw trap ;branch should be taken 0415 : 205b44 > jsr report_error 0418 : 88 dey ;forward landing zone 0419 : 88 dey 041a : 88 dey 041b : 88 dey 041c : 88 dey 041d : psb_forw 041d : 88 dey 041e : 88 dey 041f : 88 dey 0420 : 88 dey 0421 : 88 dey 0422 : f017 beq psb_fwok trap ;forward offset 0424 : 205b44 > jsr report_error 0427 : ca dex ;backward landing zone 0428 : ca dex 0429 : ca dex 042a : ca dex 042b : ca dex 042c : psb_back 042c : ca dex 042d : ca dex 042e : ca dex 042f : ca dex 0430 : ca dex 0431 : f0de beq psb_bwok trap ;backward offset 0433 : 205b44 > jsr report_error 0436 : psb_test 0436 : d0f4 bne psb_back trap ;branch should be taken 0438 : 205b44 > jsr report_error 043b : psb_fwok ;initialize BSS segment if load_data_direct != 1 ldx #zp_end-zp_init-1 ld_zp lda zp_init,x sta zp_bss,x dex bpl ld_zp ldx #data_end-data_init-1 ld_data lda data_init,x sta data_bss,x dex bpl ld_data if ROM_vectors = 1 ldx #5 ld_vect lda vec_init,x sta vec_bss,x dex bpl ld_vect endif endif ;retain status of interrupt flag if I_flag = 2 php pla and #4 ;isolate flag sta flag_I_on ;or mask eor #lo(~4) ;reverse sta flag_I_off ;and mask endif ;generate checksum for RAM integrity test if ram_top > -1 lda #0 sta zpt ;set low byte of indirect pointer sta ram_chksm+1 ;checksum high byte if disable_selfmod = 0 sta range_adr ;reset self modifying code endif clc ldx #zp_bss-zero_page ;zeropage - write test area gcs3 adc zero_page,x bcc gcs2 inc ram_chksm+1 ;carry to high byte clc gcs2 inx bne gcs3 ldx #hi(abs1) ;set high byte of indirect pointer stx zpt+1 ldy #lo(abs1) ;data after write & execute test area gcs5 adc (zpt),y bcc gcs4 inc ram_chksm+1 ;carry to high byte clc gcs4 iny bne gcs5 inx ;advance RAM high address stx zpt+1 cpx #ram_top bne gcs5 sta ram_chksm ;checksum complete endif next_test 043b : ad0002 > lda test_case ;previous test 043e : c900 > cmp #test_num > trap_ne ;test is out of sequence 0440 : f003 > beq skip0006 > trap ;failed not equal (non zero) 0442 : 205b44 > jsr report_error > 0445 : >skip0006 > 0001 = >test_num = test_num + 1 0445 : a901 > lda #test_num ;*** next tests' number 0447 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test if disable_selfmod = 0 ;testing relative addressing with BEQ 044a : a0fe ldy #$fe ;testing maximum range, not -1/-2 (invalid/self adr) 044c : range_loop 044c : 88 dey ;next relative address 044d : 98 tya 044e : aa tax ;precharge count to end of loop 044f : 1008 bpl range_fw ;calculate relative address 0451 : 18 clc ;avoid branch self or to relative address of branch 0452 : 6902 adc #2 0454 : ea nop ;offset landing zone - tolerate +/-5 offset to branch 0455 : ea nop 0456 : ea nop 0457 : ea nop 0458 : ea nop 0459 : range_fw 0459 : ea nop 045a : ea nop 045b : ea nop 045c : ea nop 045d : ea nop 045e : 497f eor #$7f ;complement except sign 0460 : 8dec04 sta range_adr ;load into test target 0463 : a900 lda #0 ;should set zero flag in status register 0465 : 4ceb04 jmp range_op 0468 : ca dex ; offset landing zone - backward branch too far 0469 : ca dex 046a : ca dex 046b : ca dex 046c : ca dex ;relative address target field with branch under test in the middle 046d : ca dex ;-128 - max backward 046e : ca dex 046f : ca dex 0470 : ca dex 0471 : ca dex 0472 : ca dex 0473 : ca dex 0474 : ca dex 0475 : ca dex ;-120 0476 : ca dex 0477 : ca dex 0478 : ca dex 0479 : ca dex 047a : ca dex 047b : ca dex 047c : ca dex 047d : ca dex 047e : ca dex 047f : ca dex ;-110 0480 : ca dex 0481 : ca dex 0482 : ca dex 0483 : ca dex 0484 : ca dex 0485 : ca dex 0486 : ca dex 0487 : ca dex 0488 : ca dex 0489 : ca dex ;-100 048a : ca dex 048b : ca dex 048c : ca dex 048d : ca dex 048e : ca dex 048f : ca dex 0490 : ca dex 0491 : ca dex 0492 : ca dex 0493 : ca dex ;-90 0494 : ca dex 0495 : ca dex 0496 : ca dex 0497 : ca dex 0498 : ca dex 0499 : ca dex 049a : ca dex 049b : ca dex 049c : ca dex 049d : ca dex ;-80 049e : ca dex 049f : ca dex 04a0 : ca dex 04a1 : ca dex 04a2 : ca dex 04a3 : ca dex 04a4 : ca dex 04a5 : ca dex 04a6 : ca dex 04a7 : ca dex ;-70 04a8 : ca dex 04a9 : ca dex 04aa : ca dex 04ab : ca dex 04ac : ca dex 04ad : ca dex 04ae : ca dex 04af : ca dex 04b0 : ca dex 04b1 : ca dex ;-60 04b2 : ca dex 04b3 : ca dex 04b4 : ca dex 04b5 : ca dex 04b6 : ca dex 04b7 : ca dex 04b8 : ca dex 04b9 : ca dex 04ba : ca dex 04bb : ca dex ;-50 04bc : ca dex 04bd : ca dex 04be : ca dex 04bf : ca dex 04c0 : ca dex 04c1 : ca dex 04c2 : ca dex 04c3 : ca dex 04c4 : ca dex 04c5 : ca dex ;-40 04c6 : ca dex 04c7 : ca dex 04c8 : ca dex 04c9 : ca dex 04ca : ca dex 04cb : ca dex 04cc : ca dex 04cd : ca dex 04ce : ca dex 04cf : ca dex ;-30 04d0 : ca dex 04d1 : ca dex 04d2 : ca dex 04d3 : ca dex 04d4 : ca dex 04d5 : ca dex 04d6 : ca dex 04d7 : ca dex 04d8 : ca dex 04d9 : ca dex ;-20 04da : ca dex 04db : ca dex 04dc : ca dex 04dd : ca dex 04de : ca dex 04df : ca dex 04e0 : ca dex 04e1 : ca dex 04e2 : ca dex 04e3 : ca dex ;-10 04e4 : ca dex 04e5 : ca dex 04e6 : ca dex 04e7 : ca dex 04e8 : ca dex 04e9 : ca dex 04ea : ca dex ;-3 04eb : range_op ;test target with zero flag=0, z=1 if previous dex 04ec = range_adr = *+1 ;modifiable relative address 04eb : f03e beq *+64 ;+64 if called without modification 04ed : ca dex ;+0 04ee : ca dex 04ef : ca dex 04f0 : ca dex 04f1 : ca dex 04f2 : ca dex 04f3 : ca dex 04f4 : ca dex 04f5 : ca dex 04f6 : ca dex 04f7 : ca dex ;+10 04f8 : ca dex 04f9 : ca dex 04fa : ca dex 04fb : ca dex 04fc : ca dex 04fd : ca dex 04fe : ca dex 04ff : ca dex 0500 : ca dex 0501 : ca dex ;+20 0502 : ca dex 0503 : ca dex 0504 : ca dex 0505 : ca dex 0506 : ca dex 0507 : ca dex 0508 : ca dex 0509 : ca dex 050a : ca dex 050b : ca dex ;+30 050c : ca dex 050d : ca dex 050e : ca dex 050f : ca dex 0510 : ca dex 0511 : ca dex 0512 : ca dex 0513 : ca dex 0514 : ca dex 0515 : ca dex ;+40 0516 : ca dex 0517 : ca dex 0518 : ca dex 0519 : ca dex 051a : ca dex 051b : ca dex 051c : ca dex 051d : ca dex 051e : ca dex 051f : ca dex ;+50 0520 : ca dex 0521 : ca dex 0522 : ca dex 0523 : ca dex 0524 : ca dex 0525 : ca dex 0526 : ca dex 0527 : ca dex 0528 : ca dex 0529 : ca dex ;+60 052a : ca dex 052b : ca dex 052c : ca dex 052d : ca dex 052e : ca dex 052f : ca dex 0530 : ca dex 0531 : ca dex 0532 : ca dex 0533 : ca dex ;+70 0534 : ca dex 0535 : ca dex 0536 : ca dex 0537 : ca dex 0538 : ca dex 0539 : ca dex 053a : ca dex 053b : ca dex 053c : ca dex 053d : ca dex ;+80 053e : ca dex 053f : ca dex 0540 : ca dex 0541 : ca dex 0542 : ca dex 0543 : ca dex 0544 : ca dex 0545 : ca dex 0546 : ca dex 0547 : ca dex ;+90 0548 : ca dex 0549 : ca dex 054a : ca dex 054b : ca dex 054c : ca dex 054d : ca dex 054e : ca dex 054f : ca dex 0550 : ca dex 0551 : ca dex ;+100 0552 : ca dex 0553 : ca dex 0554 : ca dex 0555 : ca dex 0556 : ca dex 0557 : ca dex 0558 : ca dex 0559 : ca dex 055a : ca dex 055b : ca dex ;+110 055c : ca dex 055d : ca dex 055e : ca dex 055f : ca dex 0560 : ca dex 0561 : ca dex 0562 : ca dex 0563 : ca dex 0564 : ca dex 0565 : ca dex ;+120 0566 : ca dex 0567 : ca dex 0568 : ca dex 0569 : ca dex 056a : ca dex 056b : ca dex 056c : ea nop ;offset landing zone - forward branch too far 056d : ea nop 056e : ea nop 056f : ea nop 0570 : ea nop 0571 : f008 beq range_ok ;+127 - max forward trap ; bad range 0573 : 205b44 > jsr report_error 0576 : ea nop ;offset landing zone - tolerate +/-5 offset to branch 0577 : ea nop 0578 : ea nop 0579 : ea nop 057a : ea nop 057b : range_ok 057b : ea nop 057c : ea nop 057d : ea nop 057e : ea nop 057f : ea nop 0580 : c000 cpy #0 0582 : f003 beq range_end 0584 : 4c4c04 jmp range_loop 0587 : range_end ;range test successful endif next_test 0587 : ad0002 > lda test_case ;previous test 058a : c901 > cmp #test_num > trap_ne ;test is out of sequence 058c : f003 > beq skip0010 > trap ;failed not equal (non zero) 058e : 205b44 > jsr report_error > 0591 : >skip0010 > 0002 = >test_num = test_num + 1 0591 : a902 > lda #test_num ;*** next tests' number 0593 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ;partial test BNE & CMP, CPX, CPY immediate 0596 : c001 cpy #1 ;testing BNE true 0598 : d003 bne test_bne trap 059a : 205b44 > jsr report_error 059d : test_bne 059d : a900 lda #0 059f : c900 cmp #0 ;test compare immediate trap_ne 05a1 : f003 > beq skip0013 > trap ;failed not equal (non zero) 05a3 : 205b44 > jsr report_error > 05a6 : >skip0013 trap_cc 05a6 : b003 > bcs skip0015 > trap ;failed carry clear 05a8 : 205b44 > jsr report_error > 05ab : >skip0015 trap_mi 05ab : 1003 > bpl skip0017 > trap ;failed minus (bit 7 set) 05ad : 205b44 > jsr report_error > 05b0 : >skip0017 05b0 : c901 cmp #1 trap_eq 05b2 : d003 > bne skip0019 > trap ;failed equal (zero) 05b4 : 205b44 > jsr report_error > 05b7 : >skip0019 trap_cs 05b7 : 9003 > bcc skip0021 > trap ;failed carry set 05b9 : 205b44 > jsr report_error > 05bc : >skip0021 trap_pl 05bc : 3003 > bmi skip0023 > trap ;failed plus (bit 7 clear) 05be : 205b44 > jsr report_error > 05c1 : >skip0023 05c1 : aa tax 05c2 : e000 cpx #0 ;test compare x immediate trap_ne 05c4 : f003 > beq skip0025 > trap ;failed not equal (non zero) 05c6 : 205b44 > jsr report_error > 05c9 : >skip0025 trap_cc 05c9 : b003 > bcs skip0027 > trap ;failed carry clear 05cb : 205b44 > jsr report_error > 05ce : >skip0027 trap_mi 05ce : 1003 > bpl skip0029 > trap ;failed minus (bit 7 set) 05d0 : 205b44 > jsr report_error > 05d3 : >skip0029 05d3 : e001 cpx #1 trap_eq 05d5 : d003 > bne skip0031 > trap ;failed equal (zero) 05d7 : 205b44 > jsr report_error > 05da : >skip0031 trap_cs 05da : 9003 > bcc skip0033 > trap ;failed carry set 05dc : 205b44 > jsr report_error > 05df : >skip0033 trap_pl 05df : 3003 > bmi skip0035 > trap ;failed plus (bit 7 clear) 05e1 : 205b44 > jsr report_error > 05e4 : >skip0035 05e4 : a8 tay 05e5 : c000 cpy #0 ;test compare y immediate trap_ne 05e7 : f003 > beq skip0037 > trap ;failed not equal (non zero) 05e9 : 205b44 > jsr report_error > 05ec : >skip0037 trap_cc 05ec : b003 > bcs skip0039 > trap ;failed carry clear 05ee : 205b44 > jsr report_error > 05f1 : >skip0039 trap_mi 05f1 : 1003 > bpl skip0041 > trap ;failed minus (bit 7 set) 05f3 : 205b44 > jsr report_error > 05f6 : >skip0041 05f6 : c001 cpy #1 trap_eq 05f8 : d003 > bne skip0043 > trap ;failed equal (zero) 05fa : 205b44 > jsr report_error > 05fd : >skip0043 trap_cs 05fd : 9003 > bcc skip0045 > trap ;failed carry set 05ff : 205b44 > jsr report_error > 0602 : >skip0045 trap_pl 0602 : 3003 > bmi skip0047 > trap ;failed plus (bit 7 clear) 0604 : 205b44 > jsr report_error > 0607 : >skip0047 next_test 0607 : ad0002 > lda test_case ;previous test 060a : c902 > cmp #test_num > trap_ne ;test is out of sequence 060c : f003 > beq skip0050 > trap ;failed not equal (non zero) 060e : 205b44 > jsr report_error > 0611 : >skip0050 > 0003 = >test_num = test_num + 1 0611 : a903 > lda #test_num ;*** next tests' number 0613 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ;testing stack operations PHA PHP PLA PLP 0616 : a2ff ldx #$ff ;initialize stack 0618 : 9a txs 0619 : a955 lda #$55 061b : 48 pha 061c : a9aa lda #$aa 061e : 48 pha 061f : cdfe01 cmp $1fe ;on stack ? trap_ne 0622 : f003 > beq skip0052 > trap ;failed not equal (non zero) 0624 : 205b44 > jsr report_error > 0627 : >skip0052 0627 : ba tsx 0628 : 8a txa ;overwrite accu 0629 : c9fd cmp #$fd ;sp decremented? trap_ne 062b : f003 > beq skip0054 > trap ;failed not equal (non zero) 062d : 205b44 > jsr report_error > 0630 : >skip0054 0630 : 68 pla 0631 : c9aa cmp #$aa ;successful retreived from stack? trap_ne 0633 : f003 > beq skip0056 > trap ;failed not equal (non zero) 0635 : 205b44 > jsr report_error > 0638 : >skip0056 0638 : 68 pla 0639 : c955 cmp #$55 trap_ne 063b : f003 > beq skip0058 > trap ;failed not equal (non zero) 063d : 205b44 > jsr report_error > 0640 : >skip0058 0640 : cdff01 cmp $1ff ;remains on stack? trap_ne 0643 : f003 > beq skip0060 > trap ;failed not equal (non zero) 0645 : 205b44 > jsr report_error > 0648 : >skip0060 0648 : ba tsx 0649 : e0ff cpx #$ff ;sp incremented? trap_ne 064b : f003 > beq skip0062 > trap ;failed not equal (non zero) 064d : 205b44 > jsr report_error > 0650 : >skip0062 next_test 0650 : ad0002 > lda test_case ;previous test 0653 : c903 > cmp #test_num > trap_ne ;test is out of sequence 0655 : f003 > beq skip0065 > trap ;failed not equal (non zero) 0657 : 205b44 > jsr report_error > 065a : >skip0065 > 0004 = >test_num = test_num + 1 065a : a904 > lda #test_num ;*** next tests' number 065c : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ;testing branch decisions BPL BMI BVC BVS BCC BCS BNE BEQ set_stat $ff ;all on > load_flag $ff 065f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0661 : 48 > pha ;use stack to load status 0662 : 28 > plp 0663 : 101a bpl nbr1 ;branches should not be taken 0665 : 501b bvc nbr2 0667 : 901c bcc nbr3 0669 : d01d bne nbr4 066b : 3003 bmi br1 ;branches should be taken trap 066d : 205b44 > jsr report_error 0670 : 7003 br1 bvs br2 trap 0672 : 205b44 > jsr report_error 0675 : b003 br2 bcs br3 trap 0677 : 205b44 > jsr report_error 067a : f00f br3 beq br4 trap 067c : 205b44 > jsr report_error 067f : nbr1 trap ;previous bpl taken 067f : 205b44 > jsr report_error 0682 : nbr2 trap ;previous bvc taken 0682 : 205b44 > jsr report_error 0685 : nbr3 trap ;previous bcc taken 0685 : 205b44 > jsr report_error 0688 : nbr4 trap ;previous bne taken 0688 : 205b44 > jsr report_error 068b : 08 br4 php 068c : ba tsx 068d : e0fe cpx #$fe ;sp after php? trap_ne 068f : f003 > beq skip0077 > trap ;failed not equal (non zero) 0691 : 205b44 > jsr report_error > 0694 : >skip0077 0694 : 68 pla cmp_flag $ff ;returned all flags on? 0695 : c9ff > cmp #($ff |fao)&m8 ;expected flags + always on bits trap_ne 0697 : f003 > beq skip0080 > trap ;failed not equal (non zero) 0699 : 205b44 > jsr report_error > 069c : >skip0080 069c : ba tsx 069d : e0ff cpx #$ff ;sp after php? trap_ne 069f : f003 > beq skip0082 > trap ;failed not equal (non zero) 06a1 : 205b44 > jsr report_error > 06a4 : >skip0082 set_stat 0 ;all off > load_flag 0 06a4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 06a6 : 48 > pha ;use stack to load status 06a7 : 28 > plp 06a8 : 301a bmi nbr11 ;branches should not be taken 06aa : 701b bvs nbr12 06ac : b01c bcs nbr13 06ae : f01d beq nbr14 06b0 : 1003 bpl br11 ;branches should be taken trap 06b2 : 205b44 > jsr report_error 06b5 : 5003 br11 bvc br12 trap 06b7 : 205b44 > jsr report_error 06ba : 9003 br12 bcc br13 trap 06bc : 205b44 > jsr report_error 06bf : d00f br13 bne br14 trap 06c1 : 205b44 > jsr report_error 06c4 : nbr11 trap ;previous bmi taken 06c4 : 205b44 > jsr report_error 06c7 : nbr12 trap ;previous bvs taken 06c7 : 205b44 > jsr report_error 06ca : nbr13 trap ;previous bcs taken 06ca : 205b44 > jsr report_error 06cd : nbr14 trap ;previous beq taken 06cd : 205b44 > jsr report_error 06d0 : 08 br14 php 06d1 : 68 pla cmp_flag 0 ;flags off except break (pushed by sw) + reserved? 06d2 : c930 > cmp #(0 |fao)&m8 ;expected flags + always on bits trap_ne 06d4 : f003 > beq skip0095 > trap ;failed not equal (non zero) 06d6 : 205b44 > jsr report_error > 06d9 : >skip0095 ;crosscheck flags set_stat zero > load_flag zero 06d9 : a902 > lda #zero ;allow test to change I-flag (no mask) > 06db : 48 > pha ;use stack to load status 06dc : 28 > plp 06dd : d002 bne brzs1 06df : f003 beq brzs2 06e1 : brzs1 trap ;branch zero/non zero 06e1 : 205b44 > jsr report_error 06e4 : b002 brzs2 bcs brzs3 06e6 : 9003 bcc brzs4 06e8 : brzs3 trap ;branch carry/no carry 06e8 : 205b44 > jsr report_error 06eb : 3002 brzs4 bmi brzs5 06ed : 1003 bpl brzs6 06ef : brzs5 trap ;branch minus/plus 06ef : 205b44 > jsr report_error 06f2 : 7002 brzs6 bvs brzs7 06f4 : 5003 bvc brzs8 06f6 : brzs7 trap ;branch overflow/no overflow 06f6 : 205b44 > jsr report_error 06f9 : brzs8 set_stat carry > load_flag carry 06f9 : a901 > lda #carry ;allow test to change I-flag (no mask) > 06fb : 48 > pha ;use stack to load status 06fc : 28 > plp 06fd : f002 beq brcs1 06ff : d003 bne brcs2 0701 : brcs1 trap ;branch zero/non zero 0701 : 205b44 > jsr report_error 0704 : 9002 brcs2 bcc brcs3 0706 : b003 bcs brcs4 0708 : brcs3 trap ;branch carry/no carry 0708 : 205b44 > jsr report_error 070b : 3002 brcs4 bmi brcs5 070d : 1003 bpl brcs6 070f : brcs5 trap ;branch minus/plus 070f : 205b44 > jsr report_error 0712 : 7002 brcs6 bvs brcs7 0714 : 5003 bvc brcs8 0716 : brcs7 trap ;branch overflow/no overflow 0716 : 205b44 > jsr report_error 0719 : brcs8 set_stat minus > load_flag minus 0719 : a980 > lda #minus ;allow test to change I-flag (no mask) > 071b : 48 > pha ;use stack to load status 071c : 28 > plp 071d : f002 beq brmi1 071f : d003 bne brmi2 0721 : brmi1 trap ;branch zero/non zero 0721 : 205b44 > jsr report_error 0724 : b002 brmi2 bcs brmi3 0726 : 9003 bcc brmi4 0728 : brmi3 trap ;branch carry/no carry 0728 : 205b44 > jsr report_error 072b : 1002 brmi4 bpl brmi5 072d : 3003 bmi brmi6 072f : brmi5 trap ;branch minus/plus 072f : 205b44 > jsr report_error 0732 : 7002 brmi6 bvs brmi7 0734 : 5003 bvc brmi8 0736 : brmi7 trap ;branch overflow/no overflow 0736 : 205b44 > jsr report_error 0739 : brmi8 set_stat overfl > load_flag overfl 0739 : a940 > lda #overfl ;allow test to change I-flag (no mask) > 073b : 48 > pha ;use stack to load status 073c : 28 > plp 073d : f002 beq brvs1 073f : d003 bne brvs2 0741 : brvs1 trap ;branch zero/non zero 0741 : 205b44 > jsr report_error 0744 : b002 brvs2 bcs brvs3 0746 : 9003 bcc brvs4 0748 : brvs3 trap ;branch carry/no carry 0748 : 205b44 > jsr report_error 074b : 3002 brvs4 bmi brvs5 074d : 1003 bpl brvs6 074f : brvs5 trap ;branch minus/plus 074f : 205b44 > jsr report_error 0752 : 5002 brvs6 bvc brvs7 0754 : 7003 bvs brvs8 0756 : brvs7 trap ;branch overflow/no overflow 0756 : 205b44 > jsr report_error 0759 : brvs8 set_stat $ff-zero > load_flag $ff-zero 0759 : a9fd > lda #$ff-zero ;allow test to change I-flag (no mask) > 075b : 48 > pha ;use stack to load status 075c : 28 > plp 075d : f002 beq brzc1 075f : d003 bne brzc2 0761 : brzc1 trap ;branch zero/non zero 0761 : 205b44 > jsr report_error 0764 : 9002 brzc2 bcc brzc3 0766 : b003 bcs brzc4 0768 : brzc3 trap ;branch carry/no carry 0768 : 205b44 > jsr report_error 076b : 1002 brzc4 bpl brzc5 076d : 3003 bmi brzc6 076f : brzc5 trap ;branch minus/plus 076f : 205b44 > jsr report_error 0772 : 5002 brzc6 bvc brzc7 0774 : 7003 bvs brzc8 0776 : brzc7 trap ;branch overflow/no overflow 0776 : 205b44 > jsr report_error 0779 : brzc8 set_stat $ff-carry > load_flag $ff-carry 0779 : a9fe > lda #$ff-carry ;allow test to change I-flag (no mask) > 077b : 48 > pha ;use stack to load status 077c : 28 > plp 077d : d002 bne brcc1 077f : f003 beq brcc2 0781 : brcc1 trap ;branch zero/non zero 0781 : 205b44 > jsr report_error 0784 : b002 brcc2 bcs brcc3 0786 : 9003 bcc brcc4 0788 : brcc3 trap ;branch carry/no carry 0788 : 205b44 > jsr report_error 078b : 1002 brcc4 bpl brcc5 078d : 3003 bmi brcc6 078f : brcc5 trap ;branch minus/plus 078f : 205b44 > jsr report_error 0792 : 5002 brcc6 bvc brcc7 0794 : 7003 bvs brcc8 0796 : brcc7 trap ;branch overflow/no overflow 0796 : 205b44 > jsr report_error 0799 : brcc8 set_stat $ff-minus > load_flag $ff-minus 0799 : a97f > lda #$ff-minus ;allow test to change I-flag (no mask) > 079b : 48 > pha ;use stack to load status 079c : 28 > plp 079d : d002 bne brpl1 079f : f003 beq brpl2 07a1 : brpl1 trap ;branch zero/non zero 07a1 : 205b44 > jsr report_error 07a4 : 9002 brpl2 bcc brpl3 07a6 : b003 bcs brpl4 07a8 : brpl3 trap ;branch carry/no carry 07a8 : 205b44 > jsr report_error 07ab : 3002 brpl4 bmi brpl5 07ad : 1003 bpl brpl6 07af : brpl5 trap ;branch minus/plus 07af : 205b44 > jsr report_error 07b2 : 5002 brpl6 bvc brpl7 07b4 : 7003 bvs brpl8 07b6 : brpl7 trap ;branch overflow/no overflow 07b6 : 205b44 > jsr report_error 07b9 : brpl8 set_stat $ff-overfl > load_flag $ff-overfl 07b9 : a9bf > lda #$ff-overfl ;allow test to change I-flag (no mask) > 07bb : 48 > pha ;use stack to load status 07bc : 28 > plp 07bd : d002 bne brvc1 07bf : f003 beq brvc2 07c1 : brvc1 trap ;branch zero/non zero 07c1 : 205b44 > jsr report_error 07c4 : 9002 brvc2 bcc brvc3 07c6 : b003 bcs brvc4 07c8 : brvc3 trap ;branch carry/no carry 07c8 : 205b44 > jsr report_error 07cb : 1002 brvc4 bpl brvc5 07cd : 3003 bmi brvc6 07cf : brvc5 trap ;branch minus/plus 07cf : 205b44 > jsr report_error 07d2 : 7002 brvc6 bvs brvc7 07d4 : 5003 bvc brvc8 07d6 : brvc7 trap ;branch overflow/no overflow 07d6 : 205b44 > jsr report_error 07d9 : brvc8 next_test 07d9 : ad0002 > lda test_case ;previous test 07dc : c904 > cmp #test_num > trap_ne ;test is out of sequence 07de : f003 > beq skip0146 > trap ;failed not equal (non zero) 07e0 : 205b44 > jsr report_error > 07e3 : >skip0146 > 0005 = >test_num = test_num + 1 07e3 : a905 > lda #test_num ;*** next tests' number 07e5 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; test PHA does not alter flags or accumulator but PLA does 07e8 : a255 ldx #$55 ;x & y protected 07ea : a0aa ldy #$aa set_a 1,$ff ;push > load_flag $ff 07ec : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 07ee : 48 > pha ;use stack to load status 07ef : a901 > lda #1 ;precharge accu 07f1 : 28 > plp 07f2 : 48 pha tst_a 1,$ff 07f3 : 08 > php ;save flags 07f4 : c901 > cmp #1 ;test result > trap_ne 07f6 : f003 > beq skip0151 > trap ;failed not equal (non zero) 07f8 : 205b44 > jsr report_error > 07fb : >skip0151 > 07fb : 68 > pla ;load status 07fc : 48 > pha > cmp_flag $ff 07fd : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits > > trap_ne 07ff : f003 > beq skip0154 > trap ;failed not equal (non zero) 0801 : 205b44 > jsr report_error > 0804 : >skip0154 > 0804 : 28 > plp ;restore status set_a 0,0 > load_flag 0 0805 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0807 : 48 > pha ;use stack to load status 0808 : a900 > lda #0 ;precharge accu 080a : 28 > plp 080b : 48 pha tst_a 0,0 080c : 08 > php ;save flags 080d : c900 > cmp #0 ;test result > trap_ne 080f : f003 > beq skip0159 > trap ;failed not equal (non zero) 0811 : 205b44 > jsr report_error > 0814 : >skip0159 > 0814 : 68 > pla ;load status 0815 : 48 > pha > cmp_flag 0 0816 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0818 : f003 > beq skip0162 > trap ;failed not equal (non zero) 081a : 205b44 > jsr report_error > 081d : >skip0162 > 081d : 28 > plp ;restore status set_a $ff,$ff > load_flag $ff 081e : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0820 : 48 > pha ;use stack to load status 0821 : a9ff > lda #$ff ;precharge accu 0823 : 28 > plp 0824 : 48 pha tst_a $ff,$ff 0825 : 08 > php ;save flags 0826 : c9ff > cmp #$ff ;test result > trap_ne 0828 : f003 > beq skip0167 > trap ;failed not equal (non zero) 082a : 205b44 > jsr report_error > 082d : >skip0167 > 082d : 68 > pla ;load status 082e : 48 > pha > cmp_flag $ff 082f : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits > > trap_ne 0831 : f003 > beq skip0170 > trap ;failed not equal (non zero) 0833 : 205b44 > jsr report_error > 0836 : >skip0170 > 0836 : 28 > plp ;restore status set_a 1,0 > load_flag 0 0837 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0839 : 48 > pha ;use stack to load status 083a : a901 > lda #1 ;precharge accu 083c : 28 > plp 083d : 48 pha tst_a 1,0 083e : 08 > php ;save flags 083f : c901 > cmp #1 ;test result > trap_ne 0841 : f003 > beq skip0175 > trap ;failed not equal (non zero) 0843 : 205b44 > jsr report_error > 0846 : >skip0175 > 0846 : 68 > pla ;load status 0847 : 48 > pha > cmp_flag 0 0848 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 084a : f003 > beq skip0178 > trap ;failed not equal (non zero) 084c : 205b44 > jsr report_error > 084f : >skip0178 > 084f : 28 > plp ;restore status set_a 0,$ff > load_flag $ff 0850 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0852 : 48 > pha ;use stack to load status 0853 : a900 > lda #0 ;precharge accu 0855 : 28 > plp 0856 : 48 pha tst_a 0,$ff 0857 : 08 > php ;save flags 0858 : c900 > cmp #0 ;test result > trap_ne 085a : f003 > beq skip0183 > trap ;failed not equal (non zero) 085c : 205b44 > jsr report_error > 085f : >skip0183 > 085f : 68 > pla ;load status 0860 : 48 > pha > cmp_flag $ff 0861 : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits > > trap_ne 0863 : f003 > beq skip0186 > trap ;failed not equal (non zero) 0865 : 205b44 > jsr report_error > 0868 : >skip0186 > 0868 : 28 > plp ;restore status set_a $ff,0 > load_flag 0 0869 : a900 > lda #0 ;allow test to change I-flag (no mask) > 086b : 48 > pha ;use stack to load status 086c : a9ff > lda #$ff ;precharge accu 086e : 28 > plp 086f : 48 pha tst_a $ff,0 0870 : 08 > php ;save flags 0871 : c9ff > cmp #$ff ;test result > trap_ne 0873 : f003 > beq skip0191 > trap ;failed not equal (non zero) 0875 : 205b44 > jsr report_error > 0878 : >skip0191 > 0878 : 68 > pla ;load status 0879 : 48 > pha > cmp_flag 0 087a : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 087c : f003 > beq skip0194 > trap ;failed not equal (non zero) 087e : 205b44 > jsr report_error > 0881 : >skip0194 > 0881 : 28 > plp ;restore status set_a 0,$ff ;pull > load_flag $ff 0882 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0884 : 48 > pha ;use stack to load status 0885 : a900 > lda #0 ;precharge accu 0887 : 28 > plp 0888 : 68 pla tst_a $ff,$ff-zero 0889 : 08 > php ;save flags 088a : c9ff > cmp #$ff ;test result > trap_ne 088c : f003 > beq skip0199 > trap ;failed not equal (non zero) 088e : 205b44 > jsr report_error > 0891 : >skip0199 > 0891 : 68 > pla ;load status 0892 : 48 > pha > cmp_flag $ff-zero 0893 : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0895 : f003 > beq skip0202 > trap ;failed not equal (non zero) 0897 : 205b44 > jsr report_error > 089a : >skip0202 > 089a : 28 > plp ;restore status set_a $ff,0 > load_flag 0 089b : a900 > lda #0 ;allow test to change I-flag (no mask) > 089d : 48 > pha ;use stack to load status 089e : a9ff > lda #$ff ;precharge accu 08a0 : 28 > plp 08a1 : 68 pla tst_a 0,zero 08a2 : 08 > php ;save flags 08a3 : c900 > cmp #0 ;test result > trap_ne 08a5 : f003 > beq skip0207 > trap ;failed not equal (non zero) 08a7 : 205b44 > jsr report_error > 08aa : >skip0207 > 08aa : 68 > pla ;load status 08ab : 48 > pha > cmp_flag zero 08ac : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 08ae : f003 > beq skip0210 > trap ;failed not equal (non zero) 08b0 : 205b44 > jsr report_error > 08b3 : >skip0210 > 08b3 : 28 > plp ;restore status set_a $fe,$ff > load_flag $ff 08b4 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 08b6 : 48 > pha ;use stack to load status 08b7 : a9fe > lda #$fe ;precharge accu 08b9 : 28 > plp 08ba : 68 pla tst_a 1,$ff-zero-minus 08bb : 08 > php ;save flags 08bc : c901 > cmp #1 ;test result > trap_ne 08be : f003 > beq skip0215 > trap ;failed not equal (non zero) 08c0 : 205b44 > jsr report_error > 08c3 : >skip0215 > 08c3 : 68 > pla ;load status 08c4 : 48 > pha > cmp_flag $ff-zero-minus 08c5 : c97d > cmp #($ff-zero-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 08c7 : f003 > beq skip0218 > trap ;failed not equal (non zero) 08c9 : 205b44 > jsr report_error > 08cc : >skip0218 > 08cc : 28 > plp ;restore status set_a 0,0 > load_flag 0 08cd : a900 > lda #0 ;allow test to change I-flag (no mask) > 08cf : 48 > pha ;use stack to load status 08d0 : a900 > lda #0 ;precharge accu 08d2 : 28 > plp 08d3 : 68 pla tst_a $ff,minus 08d4 : 08 > php ;save flags 08d5 : c9ff > cmp #$ff ;test result > trap_ne 08d7 : f003 > beq skip0223 > trap ;failed not equal (non zero) 08d9 : 205b44 > jsr report_error > 08dc : >skip0223 > 08dc : 68 > pla ;load status 08dd : 48 > pha > cmp_flag minus 08de : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 08e0 : f003 > beq skip0226 > trap ;failed not equal (non zero) 08e2 : 205b44 > jsr report_error > 08e5 : >skip0226 > 08e5 : 28 > plp ;restore status set_a $ff,$ff > load_flag $ff 08e6 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 08e8 : 48 > pha ;use stack to load status 08e9 : a9ff > lda #$ff ;precharge accu 08eb : 28 > plp 08ec : 68 pla tst_a 0,$ff-minus 08ed : 08 > php ;save flags 08ee : c900 > cmp #0 ;test result > trap_ne 08f0 : f003 > beq skip0231 > trap ;failed not equal (non zero) 08f2 : 205b44 > jsr report_error > 08f5 : >skip0231 > 08f5 : 68 > pla ;load status 08f6 : 48 > pha > cmp_flag $ff-minus 08f7 : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 08f9 : f003 > beq skip0234 > trap ;failed not equal (non zero) 08fb : 205b44 > jsr report_error > 08fe : >skip0234 > 08fe : 28 > plp ;restore status set_a $fe,0 > load_flag 0 08ff : a900 > lda #0 ;allow test to change I-flag (no mask) > 0901 : 48 > pha ;use stack to load status 0902 : a9fe > lda #$fe ;precharge accu 0904 : 28 > plp 0905 : 68 pla tst_a 1,0 0906 : 08 > php ;save flags 0907 : c901 > cmp #1 ;test result > trap_ne 0909 : f003 > beq skip0239 > trap ;failed not equal (non zero) 090b : 205b44 > jsr report_error > 090e : >skip0239 > 090e : 68 > pla ;load status 090f : 48 > pha > cmp_flag 0 0910 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0912 : f003 > beq skip0242 > trap ;failed not equal (non zero) 0914 : 205b44 > jsr report_error > 0917 : >skip0242 > 0917 : 28 > plp ;restore status 0918 : e055 cpx #$55 ;x & y unchanged? trap_ne 091a : f003 > beq skip0244 > trap ;failed not equal (non zero) 091c : 205b44 > jsr report_error > 091f : >skip0244 091f : c0aa cpy #$aa trap_ne 0921 : f003 > beq skip0246 > trap ;failed not equal (non zero) 0923 : 205b44 > jsr report_error > 0926 : >skip0246 next_test 0926 : ad0002 > lda test_case ;previous test 0929 : c905 > cmp #test_num > trap_ne ;test is out of sequence 092b : f003 > beq skip0249 > trap ;failed not equal (non zero) 092d : 205b44 > jsr report_error > 0930 : >skip0249 > 0006 = >test_num = test_num + 1 0930 : a906 > lda #test_num ;*** next tests' number 0932 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; partial pretest EOR # set_a $3c,0 > load_flag 0 0935 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0937 : 48 > pha ;use stack to load status 0938 : a93c > lda #$3c ;precharge accu 093a : 28 > plp 093b : 49c3 eor #$c3 tst_a $ff,fn 093d : 08 > php ;save flags 093e : c9ff > cmp #$ff ;test result > trap_ne 0940 : f003 > beq skip0254 > trap ;failed not equal (non zero) 0942 : 205b44 > jsr report_error > 0945 : >skip0254 > 0945 : 68 > pla ;load status 0946 : 48 > pha > cmp_flag fn 0947 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 0949 : f003 > beq skip0257 > trap ;failed not equal (non zero) 094b : 205b44 > jsr report_error > 094e : >skip0257 > 094e : 28 > plp ;restore status set_a $c3,0 > load_flag 0 094f : a900 > lda #0 ;allow test to change I-flag (no mask) > 0951 : 48 > pha ;use stack to load status 0952 : a9c3 > lda #$c3 ;precharge accu 0954 : 28 > plp 0955 : 49c3 eor #$c3 tst_a 0,fz 0957 : 08 > php ;save flags 0958 : c900 > cmp #0 ;test result > trap_ne 095a : f003 > beq skip0262 > trap ;failed not equal (non zero) 095c : 205b44 > jsr report_error > 095f : >skip0262 > 095f : 68 > pla ;load status 0960 : 48 > pha > cmp_flag fz 0961 : c932 > cmp #(fz|fao)&m8 ;expected flags + always on bits > > trap_ne 0963 : f003 > beq skip0265 > trap ;failed not equal (non zero) 0965 : 205b44 > jsr report_error > 0968 : >skip0265 > 0968 : 28 > plp ;restore status next_test 0969 : ad0002 > lda test_case ;previous test 096c : c906 > cmp #test_num > trap_ne ;test is out of sequence 096e : f003 > beq skip0268 > trap ;failed not equal (non zero) 0970 : 205b44 > jsr report_error > 0973 : >skip0268 > 0007 = >test_num = test_num + 1 0973 : a907 > lda #test_num ;*** next tests' number 0975 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; PC modifying instructions except branches (NOP, JMP, JSR, RTS, BRK, RTI) ; testing NOP 0978 : a224 ldx #$24 097a : a042 ldy #$42 set_a $18,0 > load_flag 0 097c : a900 > lda #0 ;allow test to change I-flag (no mask) > 097e : 48 > pha ;use stack to load status 097f : a918 > lda #$18 ;precharge accu 0981 : 28 > plp 0982 : ea nop tst_a $18,0 0983 : 08 > php ;save flags 0984 : c918 > cmp #$18 ;test result > trap_ne 0986 : f003 > beq skip0273 > trap ;failed not equal (non zero) 0988 : 205b44 > jsr report_error > 098b : >skip0273 > 098b : 68 > pla ;load status 098c : 48 > pha > cmp_flag 0 098d : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 098f : f003 > beq skip0276 > trap ;failed not equal (non zero) 0991 : 205b44 > jsr report_error > 0994 : >skip0276 > 0994 : 28 > plp ;restore status 0995 : e024 cpx #$24 trap_ne 0997 : f003 > beq skip0278 > trap ;failed not equal (non zero) 0999 : 205b44 > jsr report_error > 099c : >skip0278 099c : c042 cpy #$42 trap_ne 099e : f003 > beq skip0280 > trap ;failed not equal (non zero) 09a0 : 205b44 > jsr report_error > 09a3 : >skip0280 09a3 : a2db ldx #$db 09a5 : a0bd ldy #$bd set_a $e7,$ff > load_flag $ff 09a7 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 09a9 : 48 > pha ;use stack to load status 09aa : a9e7 > lda #$e7 ;precharge accu 09ac : 28 > plp 09ad : ea nop tst_a $e7,$ff 09ae : 08 > php ;save flags 09af : c9e7 > cmp #$e7 ;test result > trap_ne 09b1 : f003 > beq skip0285 > trap ;failed not equal (non zero) 09b3 : 205b44 > jsr report_error > 09b6 : >skip0285 > 09b6 : 68 > pla ;load status 09b7 : 48 > pha > cmp_flag $ff 09b8 : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits > > trap_ne 09ba : f003 > beq skip0288 > trap ;failed not equal (non zero) 09bc : 205b44 > jsr report_error > 09bf : >skip0288 > 09bf : 28 > plp ;restore status 09c0 : e0db cpx #$db trap_ne 09c2 : f003 > beq skip0290 > trap ;failed not equal (non zero) 09c4 : 205b44 > jsr report_error > 09c7 : >skip0290 09c7 : c0bd cpy #$bd trap_ne 09c9 : f003 > beq skip0292 > trap ;failed not equal (non zero) 09cb : 205b44 > jsr report_error > 09ce : >skip0292 next_test 09ce : ad0002 > lda test_case ;previous test 09d1 : c907 > cmp #test_num > trap_ne ;test is out of sequence 09d3 : f003 > beq skip0295 > trap ;failed not equal (non zero) 09d5 : 205b44 > jsr report_error > 09d8 : >skip0295 > 0008 = >test_num = test_num + 1 09d8 : a908 > lda #test_num ;*** next tests' number 09da : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; jump absolute set_stat $0 > load_flag $0 09dd : a900 > lda #$0 ;allow test to change I-flag (no mask) > 09df : 48 > pha ;use stack to load status 09e0 : 28 > plp 09e1 : a946 lda #'F' 09e3 : a241 ldx #'A' 09e5 : a052 ldy #'R' ;N=0, V=0, Z=0, C=0 09e7 : 4c8c42 jmp test_far 09ea : ea nop 09eb : ea nop trap_ne ;runover protection 09ec : f003 > beq skip0299 > trap ;failed not equal (non zero) 09ee : 205b44 > jsr report_error > 09f1 : >skip0299 09f1 : e8 inx 09f2 : e8 inx 09f3 : far_ret trap_eq ;returned flags OK? 09f3 : d003 > bne skip0301 > trap ;failed equal (zero) 09f5 : 205b44 > jsr report_error > 09f8 : >skip0301 trap_pl 09f8 : 3003 > bmi skip0303 > trap ;failed plus (bit 7 clear) 09fa : 205b44 > jsr report_error > 09fd : >skip0303 trap_cc 09fd : b003 > bcs skip0305 > trap ;failed carry clear 09ff : 205b44 > jsr report_error > 0a02 : >skip0305 trap_vc 0a02 : 7003 > bvs skip0307 > trap ;failed overflow clear 0a04 : 205b44 > jsr report_error > 0a07 : >skip0307 0a07 : c9ec cmp #('F'^$aa) ;returned registers OK? trap_ne 0a09 : f003 > beq skip0309 > trap ;failed not equal (non zero) 0a0b : 205b44 > jsr report_error > 0a0e : >skip0309 0a0e : e042 cpx #('A'+1) trap_ne 0a10 : f003 > beq skip0311 > trap ;failed not equal (non zero) 0a12 : 205b44 > jsr report_error > 0a15 : >skip0311 0a15 : c04f cpy #('R'-3) trap_ne 0a17 : f003 > beq skip0313 > trap ;failed not equal (non zero) 0a19 : 205b44 > jsr report_error > 0a1c : >skip0313 0a1c : ca dex 0a1d : c8 iny 0a1e : c8 iny 0a1f : c8 iny 0a20 : 49aa eor #$aa ;N=0, V=1, Z=0, C=1 0a22 : 4c2e0a jmp test_near 0a25 : ea nop 0a26 : ea nop trap_ne ;runover protection 0a27 : f003 > beq skip0315 > trap ;failed not equal (non zero) 0a29 : 205b44 > jsr report_error > 0a2c : >skip0315 0a2c : e8 inx 0a2d : e8 inx 0a2e : test_near trap_eq ;passed flags OK? 0a2e : d003 > bne skip0317 > trap ;failed equal (zero) 0a30 : 205b44 > jsr report_error > 0a33 : >skip0317 trap_mi 0a33 : 1003 > bpl skip0319 > trap ;failed minus (bit 7 set) 0a35 : 205b44 > jsr report_error > 0a38 : >skip0319 trap_cc 0a38 : b003 > bcs skip0321 > trap ;failed carry clear 0a3a : 205b44 > jsr report_error > 0a3d : >skip0321 trap_vc 0a3d : 7003 > bvs skip0323 > trap ;failed overflow clear 0a3f : 205b44 > jsr report_error > 0a42 : >skip0323 0a42 : c946 cmp #'F' ;passed registers OK? trap_ne 0a44 : f003 > beq skip0325 > trap ;failed not equal (non zero) 0a46 : 205b44 > jsr report_error > 0a49 : >skip0325 0a49 : e041 cpx #'A' trap_ne 0a4b : f003 > beq skip0327 > trap ;failed not equal (non zero) 0a4d : 205b44 > jsr report_error > 0a50 : >skip0327 0a50 : c052 cpy #'R' trap_ne 0a52 : f003 > beq skip0329 > trap ;failed not equal (non zero) 0a54 : 205b44 > jsr report_error > 0a57 : >skip0329 next_test 0a57 : ad0002 > lda test_case ;previous test 0a5a : c908 > cmp #test_num > trap_ne ;test is out of sequence 0a5c : f003 > beq skip0332 > trap ;failed not equal (non zero) 0a5e : 205b44 > jsr report_error > 0a61 : >skip0332 > 0009 = >test_num = test_num + 1 0a61 : a909 > lda #test_num ;*** next tests' number 0a63 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; jump indirect set_stat 0 > load_flag 0 0a66 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0a68 : 48 > pha ;use stack to load status 0a69 : 28 > plp 0a6a : a949 lda #'I' 0a6c : a24e ldx #'N' 0a6e : a044 ldy #'D' ;N=0, V=0, Z=0, C=0 0a70 : 6cd242 jmp (ptr_tst_ind) 0a73 : ea nop trap_ne ;runover protection 0a74 : f003 > beq skip0336 > trap ;failed not equal (non zero) 0a76 : 205b44 > jsr report_error > 0a79 : >skip0336 0a79 : 88 dey 0a7a : 88 dey 0a7b : ind_ret 0a7b : 08 php ;either SP or Y count will fail, if we do not hit 0a7c : 88 dey 0a7d : 88 dey 0a7e : 88 dey 0a7f : 28 plp trap_eq ;returned flags OK? 0a80 : d003 > bne skip0338 > trap ;failed equal (zero) 0a82 : 205b44 > jsr report_error > 0a85 : >skip0338 trap_pl 0a85 : 3003 > bmi skip0340 > trap ;failed plus (bit 7 clear) 0a87 : 205b44 > jsr report_error > 0a8a : >skip0340 trap_cc 0a8a : b003 > bcs skip0342 > trap ;failed carry clear 0a8c : 205b44 > jsr report_error > 0a8f : >skip0342 trap_vc 0a8f : 7003 > bvs skip0344 > trap ;failed overflow clear 0a91 : 205b44 > jsr report_error > 0a94 : >skip0344 0a94 : c9e3 cmp #('I'^$aa) ;returned registers OK? trap_ne 0a96 : f003 > beq skip0346 > trap ;failed not equal (non zero) 0a98 : 205b44 > jsr report_error > 0a9b : >skip0346 0a9b : e04f cpx #('N'+1) trap_ne 0a9d : f003 > beq skip0348 > trap ;failed not equal (non zero) 0a9f : 205b44 > jsr report_error > 0aa2 : >skip0348 0aa2 : c03e cpy #('D'-6) trap_ne 0aa4 : f003 > beq skip0350 > trap ;failed not equal (non zero) 0aa6 : 205b44 > jsr report_error > 0aa9 : >skip0350 0aa9 : ba tsx ;SP check 0aaa : e0ff cpx #$ff trap_ne 0aac : f003 > beq skip0352 > trap ;failed not equal (non zero) 0aae : 205b44 > jsr report_error > 0ab1 : >skip0352 next_test 0ab1 : ad0002 > lda test_case ;previous test 0ab4 : c909 > cmp #test_num > trap_ne ;test is out of sequence 0ab6 : f003 > beq skip0355 > trap ;failed not equal (non zero) 0ab8 : 205b44 > jsr report_error > 0abb : >skip0355 > 000a = >test_num = test_num + 1 0abb : a90a > lda #test_num ;*** next tests' number 0abd : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; jump subroutine & return from subroutine set_stat 0 > load_flag 0 0ac0 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0ac2 : 48 > pha ;use stack to load status 0ac3 : 28 > plp 0ac4 : a94a lda #'J' 0ac6 : a253 ldx #'S' 0ac8 : a052 ldy #'R' ;N=0, V=0, Z=0, C=0 0aca : 202943 jsr test_jsr 0acc = jsr_ret = *-1 ;last address of jsr = return address 0acd : 08 php ;either SP or Y count will fail, if we do not hit 0ace : 88 dey 0acf : 88 dey 0ad0 : 88 dey 0ad1 : 28 plp trap_eq ;returned flags OK? 0ad2 : d003 > bne skip0359 > trap ;failed equal (zero) 0ad4 : 205b44 > jsr report_error > 0ad7 : >skip0359 trap_pl 0ad7 : 3003 > bmi skip0361 > trap ;failed plus (bit 7 clear) 0ad9 : 205b44 > jsr report_error > 0adc : >skip0361 trap_cc 0adc : b003 > bcs skip0363 > trap ;failed carry clear 0ade : 205b44 > jsr report_error > 0ae1 : >skip0363 trap_vc 0ae1 : 7003 > bvs skip0365 > trap ;failed overflow clear 0ae3 : 205b44 > jsr report_error > 0ae6 : >skip0365 0ae6 : c9e0 cmp #('J'^$aa) ;returned registers OK? trap_ne 0ae8 : f003 > beq skip0367 > trap ;failed not equal (non zero) 0aea : 205b44 > jsr report_error > 0aed : >skip0367 0aed : e054 cpx #('S'+1) trap_ne 0aef : f003 > beq skip0369 > trap ;failed not equal (non zero) 0af1 : 205b44 > jsr report_error > 0af4 : >skip0369 0af4 : c04c cpy #('R'-6) trap_ne 0af6 : f003 > beq skip0371 > trap ;failed not equal (non zero) 0af8 : 205b44 > jsr report_error > 0afb : >skip0371 0afb : ba tsx ;sp? 0afc : e0ff cpx #$ff trap_ne 0afe : f003 > beq skip0373 > trap ;failed not equal (non zero) 0b00 : 205b44 > jsr report_error > 0b03 : >skip0373 next_test 0b03 : ad0002 > lda test_case ;previous test 0b06 : c90a > cmp #test_num > trap_ne ;test is out of sequence 0b08 : f003 > beq skip0376 > trap ;failed not equal (non zero) 0b0a : 205b44 > jsr report_error > 0b0d : >skip0376 > 000b = >test_num = test_num + 1 0b0d : a90b > lda #test_num ;*** next tests' number 0b0f : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; break & return from interrupt if ROM_vectors = 1 load_flag 0 ;with interrupts enabled if allowed! 0b12 : a900 > lda #0 ;allow test to change I-flag (no mask) 0b14 : 48 pha 0b15 : a942 lda #'B' 0b17 : a252 ldx #'R' 0b19 : a04b ldy #'K' 0b1b : 28 plp ;N=0, V=0, Z=0, C=0 0b1c : 00 brk else lda #hi brk_ret0 ;emulated break pha lda #lo brk_ret0 pha load_flag fao ;set break & unused on stack pha load_flag intdis ;during interrupt pha lda #'B' ldx #'R' ldy #'K' plp ;N=0, V=0, Z=0, C=0 jmp irq_trap endif 0b1d : 88 dey ;should not be executed 0b1e : brk_ret0 ;address of break return 0b1e : 08 php ;either SP or Y count will fail, if we do not hit 0b1f : 88 dey 0b20 : 88 dey 0b21 : 88 dey 0b22 : c9e8 cmp #'B'^$aa ;returned registers OK? ;the IRQ vector was never executed if A & X stay unmodified trap_ne 0b24 : f003 > beq skip0379 > trap ;failed not equal (non zero) 0b26 : 205b44 > jsr report_error > 0b29 : >skip0379 0b29 : e053 cpx #'R'+1 trap_ne 0b2b : f003 > beq skip0381 > trap ;failed not equal (non zero) 0b2d : 205b44 > jsr report_error > 0b30 : >skip0381 0b30 : c045 cpy #'K'-6 trap_ne 0b32 : f003 > beq skip0383 > trap ;failed not equal (non zero) 0b34 : 205b44 > jsr report_error > 0b37 : >skip0383 0b37 : 68 pla ;returned flags OK (unchanged)? cmp_flag 0 0b38 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits trap_ne 0b3a : f003 > beq skip0386 > trap ;failed not equal (non zero) 0b3c : 205b44 > jsr report_error > 0b3f : >skip0386 0b3f : ba tsx ;sp? 0b40 : e0ff cpx #$ff trap_ne 0b42 : f003 > beq skip0388 > trap ;failed not equal (non zero) 0b44 : 205b44 > jsr report_error > 0b47 : >skip0388 if ROM_vectors = 1 load_flag $ff ;with interrupts disabled if allowed! 0b47 : a9ff > lda #$ff ;allow test to change I-flag (no mask) 0b49 : 48 pha 0b4a : a9bd lda #$ff-'B' 0b4c : a2ad ldx #$ff-'R' 0b4e : a0b4 ldy #$ff-'K' 0b50 : 28 plp ;N=1, V=1, Z=1, C=1 0b51 : 00 brk else lda #hi brk_ret1 ;emulated break pha lda #lo brk_ret1 pha load_flag $ff pha ;set break & unused on stack pha ;actual flags lda #$ff-'B' ldx #$ff-'R' ldy #$ff-'K' plp ;N=1, V=1, Z=1, C=1 jmp irq_trap endif 0b52 : 88 dey ;should not be executed 0b53 : brk_ret1 ;address of break return 0b53 : 08 php ;either SP or Y count will fail, if we do not hit 0b54 : 88 dey 0b55 : 88 dey 0b56 : 88 dey 0b57 : c917 cmp #($ff-'B')^$aa ;returned registers OK? ;the IRQ vector was never executed if A & X stay unmodified trap_ne 0b59 : f003 > beq skip0391 > trap ;failed not equal (non zero) 0b5b : 205b44 > jsr report_error > 0b5e : >skip0391 0b5e : e0ae cpx #$ff-'R'+1 trap_ne 0b60 : f003 > beq skip0393 > trap ;failed not equal (non zero) 0b62 : 205b44 > jsr report_error > 0b65 : >skip0393 0b65 : c0ae cpy #$ff-'K'-6 trap_ne 0b67 : f003 > beq skip0395 > trap ;failed not equal (non zero) 0b69 : 205b44 > jsr report_error > 0b6c : >skip0395 0b6c : 68 pla ;returned flags OK (unchanged)? cmp_flag $ff 0b6d : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits trap_ne 0b6f : f003 > beq skip0398 > trap ;failed not equal (non zero) 0b71 : 205b44 > jsr report_error > 0b74 : >skip0398 0b74 : ba tsx ;sp? 0b75 : e0ff cpx #$ff trap_ne 0b77 : f003 > beq skip0400 > trap ;failed not equal (non zero) 0b79 : 205b44 > jsr report_error > 0b7c : >skip0400 next_test 0b7c : ad0002 > lda test_case ;previous test 0b7f : c90b > cmp #test_num > trap_ne ;test is out of sequence 0b81 : f003 > beq skip0403 > trap ;failed not equal (non zero) 0b83 : 205b44 > jsr report_error > 0b86 : >skip0403 > 000c = >test_num = test_num + 1 0b86 : a90c > lda #test_num ;*** next tests' number 0b88 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; test set and clear flags CLC CLI CLD CLV SEC SEI SED set_stat $ff > load_flag $ff 0b8b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0b8d : 48 > pha ;use stack to load status 0b8e : 28 > plp 0b8f : 18 clc tst_stat $ff-carry 0b90 : 08 > php ;save status 0b91 : 68 > pla ;use stack to retrieve status 0b92 : 48 > pha > cmp_flag $ff-carry 0b93 : c9fe > cmp #($ff-carry|fao)&m8 ;expected flags + always on bits > > trap_ne 0b95 : f003 > beq skip0409 > trap ;failed not equal (non zero) 0b97 : 205b44 > jsr report_error > 0b9a : >skip0409 > 0b9a : 28 > plp ;restore status 0b9b : 38 sec tst_stat $ff 0b9c : 08 > php ;save status 0b9d : 68 > pla ;use stack to retrieve status 0b9e : 48 > pha > cmp_flag $ff 0b9f : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits > > trap_ne 0ba1 : f003 > beq skip0413 > trap ;failed not equal (non zero) 0ba3 : 205b44 > jsr report_error > 0ba6 : >skip0413 > 0ba6 : 28 > plp ;restore status if I_flag = 3 0ba7 : 58 cli tst_stat $ff-intdis 0ba8 : 08 > php ;save status 0ba9 : 68 > pla ;use stack to retrieve status 0baa : 48 > pha > cmp_flag $ff-intdis 0bab : c9fb > cmp #($ff-intdis|fao)&m8 ;expected flags + always on bits > > trap_ne 0bad : f003 > beq skip0417 > trap ;failed not equal (non zero) 0baf : 205b44 > jsr report_error > 0bb2 : >skip0417 > 0bb2 : 28 > plp ;restore status 0bb3 : 78 sei tst_stat $ff 0bb4 : 08 > php ;save status 0bb5 : 68 > pla ;use stack to retrieve status 0bb6 : 48 > pha > cmp_flag $ff 0bb7 : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits > > trap_ne 0bb9 : f003 > beq skip0421 > trap ;failed not equal (non zero) 0bbb : 205b44 > jsr report_error > 0bbe : >skip0421 > 0bbe : 28 > plp ;restore status endif 0bbf : d8 cld tst_stat $ff-decmode 0bc0 : 08 > php ;save status 0bc1 : 68 > pla ;use stack to retrieve status 0bc2 : 48 > pha > cmp_flag $ff-decmode 0bc3 : c9f7 > cmp #($ff-decmode|fao)&m8 ;expected flags + always on bits > > trap_ne 0bc5 : f003 > beq skip0425 > trap ;failed not equal (non zero) 0bc7 : 205b44 > jsr report_error > 0bca : >skip0425 > 0bca : 28 > plp ;restore status 0bcb : f8 sed tst_stat $ff 0bcc : 08 > php ;save status 0bcd : 68 > pla ;use stack to retrieve status 0bce : 48 > pha > cmp_flag $ff 0bcf : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits > > trap_ne 0bd1 : f003 > beq skip0429 > trap ;failed not equal (non zero) 0bd3 : 205b44 > jsr report_error > 0bd6 : >skip0429 > 0bd6 : 28 > plp ;restore status 0bd7 : b8 clv tst_stat $ff-overfl 0bd8 : 08 > php ;save status 0bd9 : 68 > pla ;use stack to retrieve status 0bda : 48 > pha > cmp_flag $ff-overfl 0bdb : c9bf > cmp #($ff-overfl|fao)&m8 ;expected flags + always on bits > > trap_ne 0bdd : f003 > beq skip0433 > trap ;failed not equal (non zero) 0bdf : 205b44 > jsr report_error > 0be2 : >skip0433 > 0be2 : 28 > plp ;restore status set_stat 0 > load_flag 0 0be3 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0be5 : 48 > pha ;use stack to load status 0be6 : 28 > plp tst_stat 0 0be7 : 08 > php ;save status 0be8 : 68 > pla ;use stack to retrieve status 0be9 : 48 > pha > cmp_flag 0 0bea : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0bec : f003 > beq skip0439 > trap ;failed not equal (non zero) 0bee : 205b44 > jsr report_error > 0bf1 : >skip0439 > 0bf1 : 28 > plp ;restore status 0bf2 : 38 sec tst_stat carry 0bf3 : 08 > php ;save status 0bf4 : 68 > pla ;use stack to retrieve status 0bf5 : 48 > pha > cmp_flag carry 0bf6 : c931 > cmp #(carry|fao)&m8 ;expected flags + always on bits > > trap_ne 0bf8 : f003 > beq skip0443 > trap ;failed not equal (non zero) 0bfa : 205b44 > jsr report_error > 0bfd : >skip0443 > 0bfd : 28 > plp ;restore status 0bfe : 18 clc tst_stat 0 0bff : 08 > php ;save status 0c00 : 68 > pla ;use stack to retrieve status 0c01 : 48 > pha > cmp_flag 0 0c02 : c930 > cmp #(0 |fao)&m8 ;expected flags + always on bits > > trap_ne 0c04 : f003 > beq skip0447 > trap ;failed not equal (non zero) 0c06 : 205b44 > jsr report_error > 0c09 : >skip0447 > 0c09 : 28 > plp ;restore status if I_flag = 3 0c0a : 78 sei tst_stat intdis 0c0b : 08 > php ;save status 0c0c : 68 > pla ;use stack to retrieve status 0c0d : 48 > pha > cmp_flag intdis 0c0e : c934 > cmp #(intdis|fao)&m8 ;expected flags + always on bits > > trap_ne 0c10 : f003 > beq skip0451 > trap ;failed not equal (non zero) 0c12 : 205b44 > jsr report_error > 0c15 : >skip0451 > 0c15 : 28 > plp ;restore status 0c16 : 58 cli tst_stat 0 0c17 : 08 > php ;save status 0c18 : 68 > pla ;use stack to retrieve status 0c19 : 48 > pha > cmp_flag 0 0c1a : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0c1c : f003 > beq skip0455 > trap ;failed not equal (non zero) 0c1e : 205b44 > jsr report_error > 0c21 : >skip0455 > 0c21 : 28 > plp ;restore status endif 0c22 : f8 sed tst_stat decmode 0c23 : 08 > php ;save status 0c24 : 68 > pla ;use stack to retrieve status 0c25 : 48 > pha > cmp_flag decmode 0c26 : c938 > cmp #(decmode|fao)&m8 ;expected flags + always on bits > > trap_ne 0c28 : f003 > beq skip0459 > trap ;failed not equal (non zero) 0c2a : 205b44 > jsr report_error > 0c2d : >skip0459 > 0c2d : 28 > plp ;restore status 0c2e : d8 cld tst_stat 0 0c2f : 08 > php ;save status 0c30 : 68 > pla ;use stack to retrieve status 0c31 : 48 > pha > cmp_flag 0 0c32 : c930 > cmp #(0 |fao)&m8 ;expected flags + always on bits > > trap_ne 0c34 : f003 > beq skip0463 > trap ;failed not equal (non zero) 0c36 : 205b44 > jsr report_error > 0c39 : >skip0463 > 0c39 : 28 > plp ;restore status set_stat overfl > load_flag overfl 0c3a : a940 > lda #overfl ;allow test to change I-flag (no mask) > 0c3c : 48 > pha ;use stack to load status 0c3d : 28 > plp tst_stat overfl 0c3e : 08 > php ;save status 0c3f : 68 > pla ;use stack to retrieve status 0c40 : 48 > pha > cmp_flag overfl 0c41 : c970 > cmp #(overfl|fao)&m8 ;expected flags + always on bits > > trap_ne 0c43 : f003 > beq skip0469 > trap ;failed not equal (non zero) 0c45 : 205b44 > jsr report_error > 0c48 : >skip0469 > 0c48 : 28 > plp ;restore status 0c49 : b8 clv tst_stat 0 0c4a : 08 > php ;save status 0c4b : 68 > pla ;use stack to retrieve status 0c4c : 48 > pha > cmp_flag 0 0c4d : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0c4f : f003 > beq skip0473 > trap ;failed not equal (non zero) 0c51 : 205b44 > jsr report_error > 0c54 : >skip0473 > 0c54 : 28 > plp ;restore status next_test 0c55 : ad0002 > lda test_case ;previous test 0c58 : c90c > cmp #test_num > trap_ne ;test is out of sequence 0c5a : f003 > beq skip0476 > trap ;failed not equal (non zero) 0c5c : 205b44 > jsr report_error > 0c5f : >skip0476 > 000d = >test_num = test_num + 1 0c5f : a90d > lda #test_num ;*** next tests' number 0c61 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; testing index register increment/decrement and transfer ; INX INY DEX DEY TAX TXA TAY TYA 0c64 : a2fe ldx #$fe set_stat $ff > load_flag $ff 0c66 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0c68 : 48 > pha ;use stack to load status 0c69 : 28 > plp 0c6a : e8 inx ;ff tst_x $ff,$ff-zero 0c6b : 08 > php ;save flags 0c6c : e0ff > cpx #$ff ;test result > trap_ne 0c6e : f003 > beq skip0481 > trap ;failed not equal (non zero) 0c70 : 205b44 > jsr report_error > 0c73 : >skip0481 > 0c73 : 68 > pla ;load status 0c74 : 48 > pha > cmp_flag $ff-zero 0c75 : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0c77 : f003 > beq skip0484 > trap ;failed not equal (non zero) 0c79 : 205b44 > jsr report_error > 0c7c : >skip0484 > 0c7c : 28 > plp ;restore status 0c7d : e8 inx ;00 tst_x 0,$ff-minus 0c7e : 08 > php ;save flags 0c7f : e000 > cpx #0 ;test result > trap_ne 0c81 : f003 > beq skip0487 > trap ;failed not equal (non zero) 0c83 : 205b44 > jsr report_error > 0c86 : >skip0487 > 0c86 : 68 > pla ;load status 0c87 : 48 > pha > cmp_flag $ff-minus 0c88 : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0c8a : f003 > beq skip0490 > trap ;failed not equal (non zero) 0c8c : 205b44 > jsr report_error > 0c8f : >skip0490 > 0c8f : 28 > plp ;restore status 0c90 : e8 inx ;01 tst_x 1,$ff-minus-zero 0c91 : 08 > php ;save flags 0c92 : e001 > cpx #1 ;test result > trap_ne 0c94 : f003 > beq skip0493 > trap ;failed not equal (non zero) 0c96 : 205b44 > jsr report_error > 0c99 : >skip0493 > 0c99 : 68 > pla ;load status 0c9a : 48 > pha > cmp_flag $ff-minus-zero 0c9b : c97d > cmp #($ff-minus-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0c9d : f003 > beq skip0496 > trap ;failed not equal (non zero) 0c9f : 205b44 > jsr report_error > 0ca2 : >skip0496 > 0ca2 : 28 > plp ;restore status 0ca3 : ca dex ;00 tst_x 0,$ff-minus 0ca4 : 08 > php ;save flags 0ca5 : e000 > cpx #0 ;test result > trap_ne 0ca7 : f003 > beq skip0499 > trap ;failed not equal (non zero) 0ca9 : 205b44 > jsr report_error > 0cac : >skip0499 > 0cac : 68 > pla ;load status 0cad : 48 > pha > cmp_flag $ff-minus 0cae : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0cb0 : f003 > beq skip0502 > trap ;failed not equal (non zero) 0cb2 : 205b44 > jsr report_error > 0cb5 : >skip0502 > 0cb5 : 28 > plp ;restore status 0cb6 : ca dex ;ff tst_x $ff,$ff-zero 0cb7 : 08 > php ;save flags 0cb8 : e0ff > cpx #$ff ;test result > trap_ne 0cba : f003 > beq skip0505 > trap ;failed not equal (non zero) 0cbc : 205b44 > jsr report_error > 0cbf : >skip0505 > 0cbf : 68 > pla ;load status 0cc0 : 48 > pha > cmp_flag $ff-zero 0cc1 : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0cc3 : f003 > beq skip0508 > trap ;failed not equal (non zero) 0cc5 : 205b44 > jsr report_error > 0cc8 : >skip0508 > 0cc8 : 28 > plp ;restore status 0cc9 : ca dex ;fe set_stat 0 > load_flag 0 0cca : a900 > lda #0 ;allow test to change I-flag (no mask) > 0ccc : 48 > pha ;use stack to load status 0ccd : 28 > plp 0cce : e8 inx ;ff tst_x $ff,minus 0ccf : 08 > php ;save flags 0cd0 : e0ff > cpx #$ff ;test result > trap_ne 0cd2 : f003 > beq skip0513 > trap ;failed not equal (non zero) 0cd4 : 205b44 > jsr report_error > 0cd7 : >skip0513 > 0cd7 : 68 > pla ;load status 0cd8 : 48 > pha > cmp_flag minus 0cd9 : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0cdb : f003 > beq skip0516 > trap ;failed not equal (non zero) 0cdd : 205b44 > jsr report_error > 0ce0 : >skip0516 > 0ce0 : 28 > plp ;restore status 0ce1 : e8 inx ;00 tst_x 0,zero 0ce2 : 08 > php ;save flags 0ce3 : e000 > cpx #0 ;test result > trap_ne 0ce5 : f003 > beq skip0519 > trap ;failed not equal (non zero) 0ce7 : 205b44 > jsr report_error > 0cea : >skip0519 > 0cea : 68 > pla ;load status 0ceb : 48 > pha > cmp_flag zero 0cec : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0cee : f003 > beq skip0522 > trap ;failed not equal (non zero) 0cf0 : 205b44 > jsr report_error > 0cf3 : >skip0522 > 0cf3 : 28 > plp ;restore status 0cf4 : e8 inx ;01 tst_x 1,0 0cf5 : 08 > php ;save flags 0cf6 : e001 > cpx #1 ;test result > trap_ne 0cf8 : f003 > beq skip0525 > trap ;failed not equal (non zero) 0cfa : 205b44 > jsr report_error > 0cfd : >skip0525 > 0cfd : 68 > pla ;load status 0cfe : 48 > pha > cmp_flag 0 0cff : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0d01 : f003 > beq skip0528 > trap ;failed not equal (non zero) 0d03 : 205b44 > jsr report_error > 0d06 : >skip0528 > 0d06 : 28 > plp ;restore status 0d07 : ca dex ;00 tst_x 0,zero 0d08 : 08 > php ;save flags 0d09 : e000 > cpx #0 ;test result > trap_ne 0d0b : f003 > beq skip0531 > trap ;failed not equal (non zero) 0d0d : 205b44 > jsr report_error > 0d10 : >skip0531 > 0d10 : 68 > pla ;load status 0d11 : 48 > pha > cmp_flag zero 0d12 : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0d14 : f003 > beq skip0534 > trap ;failed not equal (non zero) 0d16 : 205b44 > jsr report_error > 0d19 : >skip0534 > 0d19 : 28 > plp ;restore status 0d1a : ca dex ;ff tst_x $ff,minus 0d1b : 08 > php ;save flags 0d1c : e0ff > cpx #$ff ;test result > trap_ne 0d1e : f003 > beq skip0537 > trap ;failed not equal (non zero) 0d20 : 205b44 > jsr report_error > 0d23 : >skip0537 > 0d23 : 68 > pla ;load status 0d24 : 48 > pha > cmp_flag minus 0d25 : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0d27 : f003 > beq skip0540 > trap ;failed not equal (non zero) 0d29 : 205b44 > jsr report_error > 0d2c : >skip0540 > 0d2c : 28 > plp ;restore status 0d2d : a0fe ldy #$fe set_stat $ff > load_flag $ff 0d2f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0d31 : 48 > pha ;use stack to load status 0d32 : 28 > plp 0d33 : c8 iny ;ff tst_y $ff,$ff-zero 0d34 : 08 > php ;save flags 0d35 : c0ff > cpy #$ff ;test result > trap_ne 0d37 : f003 > beq skip0545 > trap ;failed not equal (non zero) 0d39 : 205b44 > jsr report_error > 0d3c : >skip0545 > 0d3c : 68 > pla ;load status 0d3d : 48 > pha > cmp_flag $ff-zero 0d3e : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0d40 : f003 > beq skip0548 > trap ;failed not equal (non zero) 0d42 : 205b44 > jsr report_error > 0d45 : >skip0548 > 0d45 : 28 > plp ;restore status 0d46 : c8 iny ;00 tst_y 0,$ff-minus 0d47 : 08 > php ;save flags 0d48 : c000 > cpy #0 ;test result > trap_ne 0d4a : f003 > beq skip0551 > trap ;failed not equal (non zero) 0d4c : 205b44 > jsr report_error > 0d4f : >skip0551 > 0d4f : 68 > pla ;load status 0d50 : 48 > pha > cmp_flag $ff-minus 0d51 : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0d53 : f003 > beq skip0554 > trap ;failed not equal (non zero) 0d55 : 205b44 > jsr report_error > 0d58 : >skip0554 > 0d58 : 28 > plp ;restore status 0d59 : c8 iny ;01 tst_y 1,$ff-minus-zero 0d5a : 08 > php ;save flags 0d5b : c001 > cpy #1 ;test result > trap_ne 0d5d : f003 > beq skip0557 > trap ;failed not equal (non zero) 0d5f : 205b44 > jsr report_error > 0d62 : >skip0557 > 0d62 : 68 > pla ;load status 0d63 : 48 > pha > cmp_flag $ff-minus-zero 0d64 : c97d > cmp #($ff-minus-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0d66 : f003 > beq skip0560 > trap ;failed not equal (non zero) 0d68 : 205b44 > jsr report_error > 0d6b : >skip0560 > 0d6b : 28 > plp ;restore status 0d6c : 88 dey ;00 tst_y 0,$ff-minus 0d6d : 08 > php ;save flags 0d6e : c000 > cpy #0 ;test result > trap_ne 0d70 : f003 > beq skip0563 > trap ;failed not equal (non zero) 0d72 : 205b44 > jsr report_error > 0d75 : >skip0563 > 0d75 : 68 > pla ;load status 0d76 : 48 > pha > cmp_flag $ff-minus 0d77 : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0d79 : f003 > beq skip0566 > trap ;failed not equal (non zero) 0d7b : 205b44 > jsr report_error > 0d7e : >skip0566 > 0d7e : 28 > plp ;restore status 0d7f : 88 dey ;ff tst_y $ff,$ff-zero 0d80 : 08 > php ;save flags 0d81 : c0ff > cpy #$ff ;test result > trap_ne 0d83 : f003 > beq skip0569 > trap ;failed not equal (non zero) 0d85 : 205b44 > jsr report_error > 0d88 : >skip0569 > 0d88 : 68 > pla ;load status 0d89 : 48 > pha > cmp_flag $ff-zero 0d8a : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0d8c : f003 > beq skip0572 > trap ;failed not equal (non zero) 0d8e : 205b44 > jsr report_error > 0d91 : >skip0572 > 0d91 : 28 > plp ;restore status 0d92 : 88 dey ;fe set_stat 0 > load_flag 0 0d93 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0d95 : 48 > pha ;use stack to load status 0d96 : 28 > plp 0d97 : c8 iny ;ff tst_y $ff,0+minus 0d98 : 08 > php ;save flags 0d99 : c0ff > cpy #$ff ;test result > trap_ne 0d9b : f003 > beq skip0577 > trap ;failed not equal (non zero) 0d9d : 205b44 > jsr report_error > 0da0 : >skip0577 > 0da0 : 68 > pla ;load status 0da1 : 48 > pha > cmp_flag 0+minus 0da2 : c9b0 > cmp #(0+minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0da4 : f003 > beq skip0580 > trap ;failed not equal (non zero) 0da6 : 205b44 > jsr report_error > 0da9 : >skip0580 > 0da9 : 28 > plp ;restore status 0daa : c8 iny ;00 tst_y 0,zero 0dab : 08 > php ;save flags 0dac : c000 > cpy #0 ;test result > trap_ne 0dae : f003 > beq skip0583 > trap ;failed not equal (non zero) 0db0 : 205b44 > jsr report_error > 0db3 : >skip0583 > 0db3 : 68 > pla ;load status 0db4 : 48 > pha > cmp_flag zero 0db5 : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0db7 : f003 > beq skip0586 > trap ;failed not equal (non zero) 0db9 : 205b44 > jsr report_error > 0dbc : >skip0586 > 0dbc : 28 > plp ;restore status 0dbd : c8 iny ;01 tst_y 1,0 0dbe : 08 > php ;save flags 0dbf : c001 > cpy #1 ;test result > trap_ne 0dc1 : f003 > beq skip0589 > trap ;failed not equal (non zero) 0dc3 : 205b44 > jsr report_error > 0dc6 : >skip0589 > 0dc6 : 68 > pla ;load status 0dc7 : 48 > pha > cmp_flag 0 0dc8 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0dca : f003 > beq skip0592 > trap ;failed not equal (non zero) 0dcc : 205b44 > jsr report_error > 0dcf : >skip0592 > 0dcf : 28 > plp ;restore status 0dd0 : 88 dey ;00 tst_y 0,zero 0dd1 : 08 > php ;save flags 0dd2 : c000 > cpy #0 ;test result > trap_ne 0dd4 : f003 > beq skip0595 > trap ;failed not equal (non zero) 0dd6 : 205b44 > jsr report_error > 0dd9 : >skip0595 > 0dd9 : 68 > pla ;load status 0dda : 48 > pha > cmp_flag zero 0ddb : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0ddd : f003 > beq skip0598 > trap ;failed not equal (non zero) 0ddf : 205b44 > jsr report_error > 0de2 : >skip0598 > 0de2 : 28 > plp ;restore status 0de3 : 88 dey ;ff tst_y $ff,minus 0de4 : 08 > php ;save flags 0de5 : c0ff > cpy #$ff ;test result > trap_ne 0de7 : f003 > beq skip0601 > trap ;failed not equal (non zero) 0de9 : 205b44 > jsr report_error > 0dec : >skip0601 > 0dec : 68 > pla ;load status 0ded : 48 > pha > cmp_flag minus 0dee : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0df0 : f003 > beq skip0604 > trap ;failed not equal (non zero) 0df2 : 205b44 > jsr report_error > 0df5 : >skip0604 > 0df5 : 28 > plp ;restore status 0df6 : a2ff ldx #$ff set_stat $ff > load_flag $ff 0df8 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0dfa : 48 > pha ;use stack to load status 0dfb : 28 > plp 0dfc : 8a txa tst_a $ff,$ff-zero 0dfd : 08 > php ;save flags 0dfe : c9ff > cmp #$ff ;test result > trap_ne 0e00 : f003 > beq skip0609 > trap ;failed not equal (non zero) 0e02 : 205b44 > jsr report_error > 0e05 : >skip0609 > 0e05 : 68 > pla ;load status 0e06 : 48 > pha > cmp_flag $ff-zero 0e07 : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0e09 : f003 > beq skip0612 > trap ;failed not equal (non zero) 0e0b : 205b44 > jsr report_error > 0e0e : >skip0612 > 0e0e : 28 > plp ;restore status 0e0f : 08 php 0e10 : e8 inx ;00 0e11 : 28 plp 0e12 : 8a txa tst_a 0,$ff-minus 0e13 : 08 > php ;save flags 0e14 : c900 > cmp #0 ;test result > trap_ne 0e16 : f003 > beq skip0615 > trap ;failed not equal (non zero) 0e18 : 205b44 > jsr report_error > 0e1b : >skip0615 > 0e1b : 68 > pla ;load status 0e1c : 48 > pha > cmp_flag $ff-minus 0e1d : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0e1f : f003 > beq skip0618 > trap ;failed not equal (non zero) 0e21 : 205b44 > jsr report_error > 0e24 : >skip0618 > 0e24 : 28 > plp ;restore status 0e25 : 08 php 0e26 : e8 inx ;01 0e27 : 28 plp 0e28 : 8a txa tst_a 1,$ff-minus-zero 0e29 : 08 > php ;save flags 0e2a : c901 > cmp #1 ;test result > trap_ne 0e2c : f003 > beq skip0621 > trap ;failed not equal (non zero) 0e2e : 205b44 > jsr report_error > 0e31 : >skip0621 > 0e31 : 68 > pla ;load status 0e32 : 48 > pha > cmp_flag $ff-minus-zero 0e33 : c97d > cmp #($ff-minus-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0e35 : f003 > beq skip0624 > trap ;failed not equal (non zero) 0e37 : 205b44 > jsr report_error > 0e3a : >skip0624 > 0e3a : 28 > plp ;restore status set_stat 0 > load_flag 0 0e3b : a900 > lda #0 ;allow test to change I-flag (no mask) > 0e3d : 48 > pha ;use stack to load status 0e3e : 28 > plp 0e3f : 8a txa tst_a 1,0 0e40 : 08 > php ;save flags 0e41 : c901 > cmp #1 ;test result > trap_ne 0e43 : f003 > beq skip0629 > trap ;failed not equal (non zero) 0e45 : 205b44 > jsr report_error > 0e48 : >skip0629 > 0e48 : 68 > pla ;load status 0e49 : 48 > pha > cmp_flag 0 0e4a : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0e4c : f003 > beq skip0632 > trap ;failed not equal (non zero) 0e4e : 205b44 > jsr report_error > 0e51 : >skip0632 > 0e51 : 28 > plp ;restore status 0e52 : 08 php 0e53 : ca dex ;00 0e54 : 28 plp 0e55 : 8a txa tst_a 0,zero 0e56 : 08 > php ;save flags 0e57 : c900 > cmp #0 ;test result > trap_ne 0e59 : f003 > beq skip0635 > trap ;failed not equal (non zero) 0e5b : 205b44 > jsr report_error > 0e5e : >skip0635 > 0e5e : 68 > pla ;load status 0e5f : 48 > pha > cmp_flag zero 0e60 : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0e62 : f003 > beq skip0638 > trap ;failed not equal (non zero) 0e64 : 205b44 > jsr report_error > 0e67 : >skip0638 > 0e67 : 28 > plp ;restore status 0e68 : 08 php 0e69 : ca dex ;ff 0e6a : 28 plp 0e6b : 8a txa tst_a $ff,minus 0e6c : 08 > php ;save flags 0e6d : c9ff > cmp #$ff ;test result > trap_ne 0e6f : f003 > beq skip0641 > trap ;failed not equal (non zero) 0e71 : 205b44 > jsr report_error > 0e74 : >skip0641 > 0e74 : 68 > pla ;load status 0e75 : 48 > pha > cmp_flag minus 0e76 : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0e78 : f003 > beq skip0644 > trap ;failed not equal (non zero) 0e7a : 205b44 > jsr report_error > 0e7d : >skip0644 > 0e7d : 28 > plp ;restore status 0e7e : a0ff ldy #$ff set_stat $ff > load_flag $ff 0e80 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 0e82 : 48 > pha ;use stack to load status 0e83 : 28 > plp 0e84 : 98 tya tst_a $ff,$ff-zero 0e85 : 08 > php ;save flags 0e86 : c9ff > cmp #$ff ;test result > trap_ne 0e88 : f003 > beq skip0649 > trap ;failed not equal (non zero) 0e8a : 205b44 > jsr report_error > 0e8d : >skip0649 > 0e8d : 68 > pla ;load status 0e8e : 48 > pha > cmp_flag $ff-zero 0e8f : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0e91 : f003 > beq skip0652 > trap ;failed not equal (non zero) 0e93 : 205b44 > jsr report_error > 0e96 : >skip0652 > 0e96 : 28 > plp ;restore status 0e97 : 08 php 0e98 : c8 iny ;00 0e99 : 28 plp 0e9a : 98 tya tst_a 0,$ff-minus 0e9b : 08 > php ;save flags 0e9c : c900 > cmp #0 ;test result > trap_ne 0e9e : f003 > beq skip0655 > trap ;failed not equal (non zero) 0ea0 : 205b44 > jsr report_error > 0ea3 : >skip0655 > 0ea3 : 68 > pla ;load status 0ea4 : 48 > pha > cmp_flag $ff-minus 0ea5 : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0ea7 : f003 > beq skip0658 > trap ;failed not equal (non zero) 0ea9 : 205b44 > jsr report_error > 0eac : >skip0658 > 0eac : 28 > plp ;restore status 0ead : 08 php 0eae : c8 iny ;01 0eaf : 28 plp 0eb0 : 98 tya tst_a 1,$ff-minus-zero 0eb1 : 08 > php ;save flags 0eb2 : c901 > cmp #1 ;test result > trap_ne 0eb4 : f003 > beq skip0661 > trap ;failed not equal (non zero) 0eb6 : 205b44 > jsr report_error > 0eb9 : >skip0661 > 0eb9 : 68 > pla ;load status 0eba : 48 > pha > cmp_flag $ff-minus-zero 0ebb : c97d > cmp #($ff-minus-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0ebd : f003 > beq skip0664 > trap ;failed not equal (non zero) 0ebf : 205b44 > jsr report_error > 0ec2 : >skip0664 > 0ec2 : 28 > plp ;restore status set_stat 0 > load_flag 0 0ec3 : a900 > lda #0 ;allow test to change I-flag (no mask) > 0ec5 : 48 > pha ;use stack to load status 0ec6 : 28 > plp 0ec7 : 98 tya tst_a 1,0 0ec8 : 08 > php ;save flags 0ec9 : c901 > cmp #1 ;test result > trap_ne 0ecb : f003 > beq skip0669 > trap ;failed not equal (non zero) 0ecd : 205b44 > jsr report_error > 0ed0 : >skip0669 > 0ed0 : 68 > pla ;load status 0ed1 : 48 > pha > cmp_flag 0 0ed2 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0ed4 : f003 > beq skip0672 > trap ;failed not equal (non zero) 0ed6 : 205b44 > jsr report_error > 0ed9 : >skip0672 > 0ed9 : 28 > plp ;restore status 0eda : 08 php 0edb : 88 dey ;00 0edc : 28 plp 0edd : 98 tya tst_a 0,zero 0ede : 08 > php ;save flags 0edf : c900 > cmp #0 ;test result > trap_ne 0ee1 : f003 > beq skip0675 > trap ;failed not equal (non zero) 0ee3 : 205b44 > jsr report_error > 0ee6 : >skip0675 > 0ee6 : 68 > pla ;load status 0ee7 : 48 > pha > cmp_flag zero 0ee8 : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0eea : f003 > beq skip0678 > trap ;failed not equal (non zero) 0eec : 205b44 > jsr report_error > 0eef : >skip0678 > 0eef : 28 > plp ;restore status 0ef0 : 08 php 0ef1 : 88 dey ;ff 0ef2 : 28 plp 0ef3 : 98 tya tst_a $ff,minus 0ef4 : 08 > php ;save flags 0ef5 : c9ff > cmp #$ff ;test result > trap_ne 0ef7 : f003 > beq skip0681 > trap ;failed not equal (non zero) 0ef9 : 205b44 > jsr report_error > 0efc : >skip0681 > 0efc : 68 > pla ;load status 0efd : 48 > pha > cmp_flag minus 0efe : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0f00 : f003 > beq skip0684 > trap ;failed not equal (non zero) 0f02 : 205b44 > jsr report_error > 0f05 : >skip0684 > 0f05 : 28 > plp ;restore status load_flag $ff 0f06 : a9ff > lda #$ff ;allow test to change I-flag (no mask) 0f08 : 48 pha 0f09 : a2ff ldx #$ff ;ff 0f0b : 8a txa 0f0c : 28 plp 0f0d : a8 tay tst_y $ff,$ff-zero 0f0e : 08 > php ;save flags 0f0f : c0ff > cpy #$ff ;test result > trap_ne 0f11 : f003 > beq skip0688 > trap ;failed not equal (non zero) 0f13 : 205b44 > jsr report_error > 0f16 : >skip0688 > 0f16 : 68 > pla ;load status 0f17 : 48 > pha > cmp_flag $ff-zero 0f18 : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0f1a : f003 > beq skip0691 > trap ;failed not equal (non zero) 0f1c : 205b44 > jsr report_error > 0f1f : >skip0691 > 0f1f : 28 > plp ;restore status 0f20 : 08 php 0f21 : e8 inx ;00 0f22 : 8a txa 0f23 : 28 plp 0f24 : a8 tay tst_y 0,$ff-minus 0f25 : 08 > php ;save flags 0f26 : c000 > cpy #0 ;test result > trap_ne 0f28 : f003 > beq skip0694 > trap ;failed not equal (non zero) 0f2a : 205b44 > jsr report_error > 0f2d : >skip0694 > 0f2d : 68 > pla ;load status 0f2e : 48 > pha > cmp_flag $ff-minus 0f2f : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0f31 : f003 > beq skip0697 > trap ;failed not equal (non zero) 0f33 : 205b44 > jsr report_error > 0f36 : >skip0697 > 0f36 : 28 > plp ;restore status 0f37 : 08 php 0f38 : e8 inx ;01 0f39 : 8a txa 0f3a : 28 plp 0f3b : a8 tay tst_y 1,$ff-minus-zero 0f3c : 08 > php ;save flags 0f3d : c001 > cpy #1 ;test result > trap_ne 0f3f : f003 > beq skip0700 > trap ;failed not equal (non zero) 0f41 : 205b44 > jsr report_error > 0f44 : >skip0700 > 0f44 : 68 > pla ;load status 0f45 : 48 > pha > cmp_flag $ff-minus-zero 0f46 : c97d > cmp #($ff-minus-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0f48 : f003 > beq skip0703 > trap ;failed not equal (non zero) 0f4a : 205b44 > jsr report_error > 0f4d : >skip0703 > 0f4d : 28 > plp ;restore status load_flag 0 0f4e : a900 > lda #0 ;allow test to change I-flag (no mask) 0f50 : 48 pha 0f51 : a900 lda #0 0f53 : 8a txa 0f54 : 28 plp 0f55 : a8 tay tst_y 1,0 0f56 : 08 > php ;save flags 0f57 : c001 > cpy #1 ;test result > trap_ne 0f59 : f003 > beq skip0707 > trap ;failed not equal (non zero) 0f5b : 205b44 > jsr report_error > 0f5e : >skip0707 > 0f5e : 68 > pla ;load status 0f5f : 48 > pha > cmp_flag 0 0f60 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0f62 : f003 > beq skip0710 > trap ;failed not equal (non zero) 0f64 : 205b44 > jsr report_error > 0f67 : >skip0710 > 0f67 : 28 > plp ;restore status 0f68 : 08 php 0f69 : ca dex ;00 0f6a : 8a txa 0f6b : 28 plp 0f6c : a8 tay tst_y 0,zero 0f6d : 08 > php ;save flags 0f6e : c000 > cpy #0 ;test result > trap_ne 0f70 : f003 > beq skip0713 > trap ;failed not equal (non zero) 0f72 : 205b44 > jsr report_error > 0f75 : >skip0713 > 0f75 : 68 > pla ;load status 0f76 : 48 > pha > cmp_flag zero 0f77 : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0f79 : f003 > beq skip0716 > trap ;failed not equal (non zero) 0f7b : 205b44 > jsr report_error > 0f7e : >skip0716 > 0f7e : 28 > plp ;restore status 0f7f : 08 php 0f80 : ca dex ;ff 0f81 : 8a txa 0f82 : 28 plp 0f83 : a8 tay tst_y $ff,minus 0f84 : 08 > php ;save flags 0f85 : c0ff > cpy #$ff ;test result > trap_ne 0f87 : f003 > beq skip0719 > trap ;failed not equal (non zero) 0f89 : 205b44 > jsr report_error > 0f8c : >skip0719 > 0f8c : 68 > pla ;load status 0f8d : 48 > pha > cmp_flag minus 0f8e : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0f90 : f003 > beq skip0722 > trap ;failed not equal (non zero) 0f92 : 205b44 > jsr report_error > 0f95 : >skip0722 > 0f95 : 28 > plp ;restore status load_flag $ff 0f96 : a9ff > lda #$ff ;allow test to change I-flag (no mask) 0f98 : 48 pha 0f99 : a0ff ldy #$ff ;ff 0f9b : 98 tya 0f9c : 28 plp 0f9d : aa tax tst_x $ff,$ff-zero 0f9e : 08 > php ;save flags 0f9f : e0ff > cpx #$ff ;test result > trap_ne 0fa1 : f003 > beq skip0726 > trap ;failed not equal (non zero) 0fa3 : 205b44 > jsr report_error > 0fa6 : >skip0726 > 0fa6 : 68 > pla ;load status 0fa7 : 48 > pha > cmp_flag $ff-zero 0fa8 : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0faa : f003 > beq skip0729 > trap ;failed not equal (non zero) 0fac : 205b44 > jsr report_error > 0faf : >skip0729 > 0faf : 28 > plp ;restore status 0fb0 : 08 php 0fb1 : c8 iny ;00 0fb2 : 98 tya 0fb3 : 28 plp 0fb4 : aa tax tst_x 0,$ff-minus 0fb5 : 08 > php ;save flags 0fb6 : e000 > cpx #0 ;test result > trap_ne 0fb8 : f003 > beq skip0732 > trap ;failed not equal (non zero) 0fba : 205b44 > jsr report_error > 0fbd : >skip0732 > 0fbd : 68 > pla ;load status 0fbe : 48 > pha > cmp_flag $ff-minus 0fbf : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits > > trap_ne 0fc1 : f003 > beq skip0735 > trap ;failed not equal (non zero) 0fc3 : 205b44 > jsr report_error > 0fc6 : >skip0735 > 0fc6 : 28 > plp ;restore status 0fc7 : 08 php 0fc8 : c8 iny ;01 0fc9 : 98 tya 0fca : 28 plp 0fcb : aa tax tst_x 1,$ff-minus-zero 0fcc : 08 > php ;save flags 0fcd : e001 > cpx #1 ;test result > trap_ne 0fcf : f003 > beq skip0738 > trap ;failed not equal (non zero) 0fd1 : 205b44 > jsr report_error > 0fd4 : >skip0738 > 0fd4 : 68 > pla ;load status 0fd5 : 48 > pha > cmp_flag $ff-minus-zero 0fd6 : c97d > cmp #($ff-minus-zero|fao)&m8 ;expected flags + always on bits > > trap_ne 0fd8 : f003 > beq skip0741 > trap ;failed not equal (non zero) 0fda : 205b44 > jsr report_error > 0fdd : >skip0741 > 0fdd : 28 > plp ;restore status load_flag 0 0fde : a900 > lda #0 ;allow test to change I-flag (no mask) 0fe0 : 48 pha 0fe1 : a900 lda #0 ;preset status 0fe3 : 98 tya 0fe4 : 28 plp 0fe5 : aa tax tst_x 1,0 0fe6 : 08 > php ;save flags 0fe7 : e001 > cpx #1 ;test result > trap_ne 0fe9 : f003 > beq skip0745 > trap ;failed not equal (non zero) 0feb : 205b44 > jsr report_error > 0fee : >skip0745 > 0fee : 68 > pla ;load status 0fef : 48 > pha > cmp_flag 0 0ff0 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits > > trap_ne 0ff2 : f003 > beq skip0748 > trap ;failed not equal (non zero) 0ff4 : 205b44 > jsr report_error > 0ff7 : >skip0748 > 0ff7 : 28 > plp ;restore status 0ff8 : 08 php 0ff9 : 88 dey ;00 0ffa : 98 tya 0ffb : 28 plp 0ffc : aa tax tst_x 0,zero 0ffd : 08 > php ;save flags 0ffe : e000 > cpx #0 ;test result > trap_ne 1000 : f003 > beq skip0751 > trap ;failed not equal (non zero) 1002 : 205b44 > jsr report_error > 1005 : >skip0751 > 1005 : 68 > pla ;load status 1006 : 48 > pha > cmp_flag zero 1007 : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits > > trap_ne 1009 : f003 > beq skip0754 > trap ;failed not equal (non zero) 100b : 205b44 > jsr report_error > 100e : >skip0754 > 100e : 28 > plp ;restore status 100f : 08 php 1010 : 88 dey ;ff 1011 : 98 tya 1012 : 28 plp 1013 : aa tax tst_x $ff,minus 1014 : 08 > php ;save flags 1015 : e0ff > cpx #$ff ;test result > trap_ne 1017 : f003 > beq skip0757 > trap ;failed not equal (non zero) 1019 : 205b44 > jsr report_error > 101c : >skip0757 > 101c : 68 > pla ;load status 101d : 48 > pha > cmp_flag minus 101e : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits > > trap_ne 1020 : f003 > beq skip0760 > trap ;failed not equal (non zero) 1022 : 205b44 > jsr report_error > 1025 : >skip0760 > 1025 : 28 > plp ;restore status next_test 1026 : ad0002 > lda test_case ;previous test 1029 : c90d > cmp #test_num > trap_ne ;test is out of sequence 102b : f003 > beq skip0763 > trap ;failed not equal (non zero) 102d : 205b44 > jsr report_error > 1030 : >skip0763 > 000e = >test_num = test_num + 1 1030 : a90e > lda #test_num ;*** next tests' number 1032 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ;TSX sets NZ - TXS does not ; This section also tests for proper stack wrap around. 1035 : a201 ldx #1 ;01 set_stat $ff > load_flag $ff 1037 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1039 : 48 > pha ;use stack to load status 103a : 28 > plp 103b : 9a txs 103c : 08 php 103d : ad0101 lda $101 cmp_flag $ff 1040 : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits trap_ne 1042 : f003 > beq skip0768 > trap ;failed not equal (non zero) 1044 : 205b44 > jsr report_error > 1047 : >skip0768 set_stat 0 > load_flag 0 1047 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1049 : 48 > pha ;use stack to load status 104a : 28 > plp 104b : 9a txs 104c : 08 php 104d : ad0101 lda $101 cmp_flag 0 1050 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits trap_ne 1052 : f003 > beq skip0773 > trap ;failed not equal (non zero) 1054 : 205b44 > jsr report_error > 1057 : >skip0773 1057 : ca dex ;00 set_stat $ff > load_flag $ff 1058 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 105a : 48 > pha ;use stack to load status 105b : 28 > plp 105c : 9a txs 105d : 08 php 105e : ad0001 lda $100 cmp_flag $ff 1061 : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits trap_ne 1063 : f003 > beq skip0778 > trap ;failed not equal (non zero) 1065 : 205b44 > jsr report_error > 1068 : >skip0778 set_stat 0 > load_flag 0 1068 : a900 > lda #0 ;allow test to change I-flag (no mask) > 106a : 48 > pha ;use stack to load status 106b : 28 > plp 106c : 9a txs 106d : 08 php 106e : ad0001 lda $100 cmp_flag 0 1071 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits trap_ne 1073 : f003 > beq skip0783 > trap ;failed not equal (non zero) 1075 : 205b44 > jsr report_error > 1078 : >skip0783 1078 : ca dex ;ff set_stat $ff > load_flag $ff 1079 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 107b : 48 > pha ;use stack to load status 107c : 28 > plp 107d : 9a txs 107e : 08 php 107f : adff01 lda $1ff cmp_flag $ff 1082 : c9ff > cmp #($ff|fao)&m8 ;expected flags + always on bits trap_ne 1084 : f003 > beq skip0788 > trap ;failed not equal (non zero) 1086 : 205b44 > jsr report_error > 1089 : >skip0788 set_stat 0 > load_flag 0 1089 : a900 > lda #0 ;allow test to change I-flag (no mask) > 108b : 48 > pha ;use stack to load status 108c : 28 > plp 108d : 9a txs 108e : 08 php 108f : adff01 lda $1ff cmp_flag 0 1092 : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits 1094 : a201 ldx #1 1096 : 9a txs ;sp=01 set_stat $ff > load_flag $ff 1097 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1099 : 48 > pha ;use stack to load status 109a : 28 > plp 109b : ba tsx ;clears Z, N 109c : 08 php ;sp=00 109d : e001 cpx #1 trap_ne 109f : f003 > beq skip0795 > trap ;failed not equal (non zero) 10a1 : 205b44 > jsr report_error > 10a4 : >skip0795 10a4 : ad0101 lda $101 cmp_flag $ff-minus-zero 10a7 : c97d > cmp #($ff-minus-zero|fao)&m8 ;expected flags + always on bits trap_ne 10a9 : f003 > beq skip0798 > trap ;failed not equal (non zero) 10ab : 205b44 > jsr report_error > 10ae : >skip0798 set_stat $ff > load_flag $ff 10ae : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 10b0 : 48 > pha ;use stack to load status 10b1 : 28 > plp 10b2 : ba tsx ;clears N, sets Z 10b3 : 08 php ;sp=ff 10b4 : e000 cpx #0 trap_ne 10b6 : f003 > beq skip0802 > trap ;failed not equal (non zero) 10b8 : 205b44 > jsr report_error > 10bb : >skip0802 10bb : ad0001 lda $100 cmp_flag $ff-minus 10be : c97f > cmp #($ff-minus|fao)&m8 ;expected flags + always on bits trap_ne 10c0 : f003 > beq skip0805 > trap ;failed not equal (non zero) 10c2 : 205b44 > jsr report_error > 10c5 : >skip0805 set_stat $ff > load_flag $ff 10c5 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 10c7 : 48 > pha ;use stack to load status 10c8 : 28 > plp 10c9 : ba tsx ;clears N, sets Z 10ca : 08 php ;sp=fe 10cb : e0ff cpx #$ff trap_ne 10cd : f003 > beq skip0809 > trap ;failed not equal (non zero) 10cf : 205b44 > jsr report_error > 10d2 : >skip0809 10d2 : adff01 lda $1ff cmp_flag $ff-zero 10d5 : c9fd > cmp #($ff-zero|fao)&m8 ;expected flags + always on bits trap_ne 10d7 : f003 > beq skip0812 > trap ;failed not equal (non zero) 10d9 : 205b44 > jsr report_error > 10dc : >skip0812 10dc : a201 ldx #1 10de : 9a txs ;sp=01 set_stat 0 > load_flag 0 10df : a900 > lda #0 ;allow test to change I-flag (no mask) > 10e1 : 48 > pha ;use stack to load status 10e2 : 28 > plp 10e3 : ba tsx ;clears Z, N 10e4 : 08 php ;sp=00 10e5 : e001 cpx #1 trap_ne 10e7 : f003 > beq skip0816 > trap ;failed not equal (non zero) 10e9 : 205b44 > jsr report_error > 10ec : >skip0816 10ec : ad0101 lda $101 cmp_flag 0 10ef : c930 > cmp #(0|fao)&m8 ;expected flags + always on bits trap_ne 10f1 : f003 > beq skip0819 > trap ;failed not equal (non zero) 10f3 : 205b44 > jsr report_error > 10f6 : >skip0819 set_stat 0 > load_flag 0 10f6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 10f8 : 48 > pha ;use stack to load status 10f9 : 28 > plp 10fa : ba tsx ;clears N, sets Z 10fb : 08 php ;sp=ff 10fc : e000 cpx #0 trap_ne 10fe : f003 > beq skip0823 > trap ;failed not equal (non zero) 1100 : 205b44 > jsr report_error > 1103 : >skip0823 1103 : ad0001 lda $100 cmp_flag zero 1106 : c932 > cmp #(zero|fao)&m8 ;expected flags + always on bits trap_ne 1108 : f003 > beq skip0826 > trap ;failed not equal (non zero) 110a : 205b44 > jsr report_error > 110d : >skip0826 set_stat 0 > load_flag 0 110d : a900 > lda #0 ;allow test to change I-flag (no mask) > 110f : 48 > pha ;use stack to load status 1110 : 28 > plp 1111 : ba tsx ;clears N, sets Z 1112 : 08 php ;sp=fe 1113 : e0ff cpx #$ff trap_ne 1115 : f003 > beq skip0830 > trap ;failed not equal (non zero) 1117 : 205b44 > jsr report_error > 111a : >skip0830 111a : adff01 lda $1ff cmp_flag minus 111d : c9b0 > cmp #(minus|fao)&m8 ;expected flags + always on bits trap_ne 111f : f003 > beq skip0833 > trap ;failed not equal (non zero) 1121 : 205b44 > jsr report_error > 1124 : >skip0833 1124 : 68 pla ;sp=ff next_test 1125 : ad0002 > lda test_case ;previous test 1128 : c90e > cmp #test_num > trap_ne ;test is out of sequence 112a : f003 > beq skip0836 > trap ;failed not equal (non zero) 112c : 205b44 > jsr report_error > 112f : >skip0836 > 000f = >test_num = test_num + 1 112f : a90f > lda #test_num ;*** next tests' number 1131 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; testing index register load & store LDY LDX STY STX all addressing modes ; LDX / STX - zp,y / abs,y 1134 : a003 ldy #3 1136 : tldx set_stat 0 > load_flag 0 1136 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1138 : 48 > pha ;use stack to load status 1139 : 28 > plp 113a : b613 ldx zp1,y 113c : 08 php ;test stores do not alter flags 113d : 8a txa 113e : 49c3 eor #$c3 1140 : 28 plp 1141 : 990302 sta abst,y 1144 : 08 php ;flags after load/store sequence 1145 : 49c3 eor #$c3 1147 : d91702 cmp abs1,y ;test result trap_ne 114a : f003 > beq skip0840 > trap ;failed not equal (non zero) 114c : 205b44 > jsr report_error > 114f : >skip0840 114f : 68 pla ;load status eor_flag 0 1150 : 4930 > eor #0|fao ;invert expected flags + always on bits 1152 : d91c02 cmp fLDx,y ;test flags trap_ne 1155 : f003 > beq skip0843 > trap ;failed not equal (non zero) 1157 : 205b44 > jsr report_error > 115a : >skip0843 115a : 88 dey 115b : 10d9 bpl tldx 115d : a003 ldy #3 115f : tldx1 set_stat $ff > load_flag $ff 115f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1161 : 48 > pha ;use stack to load status 1162 : 28 > plp 1163 : b613 ldx zp1,y 1165 : 08 php ;test stores do not alter flags 1166 : 8a txa 1167 : 49c3 eor #$c3 1169 : 28 plp 116a : 990302 sta abst,y 116d : 08 php ;flags after load/store sequence 116e : 49c3 eor #$c3 1170 : d91702 cmp abs1,y ;test result trap_ne 1173 : f003 > beq skip0847 > trap ;failed not equal (non zero) 1175 : 205b44 > jsr report_error > 1178 : >skip0847 1178 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1179 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 117b : d91c02 cmp fLDx,y ;test flags trap_ne 117e : f003 > beq skip0850 > trap ;failed not equal (non zero) 1180 : 205b44 > jsr report_error > 1183 : >skip0850 1183 : 88 dey 1184 : 10d9 bpl tldx1 1186 : a003 ldy #3 1188 : tldx2 set_stat 0 > load_flag 0 1188 : a900 > lda #0 ;allow test to change I-flag (no mask) > 118a : 48 > pha ;use stack to load status 118b : 28 > plp 118c : be1702 ldx abs1,y 118f : 08 php ;test stores do not alter flags 1190 : 8a txa 1191 : 49c3 eor #$c3 1193 : aa tax 1194 : 28 plp 1195 : 960c stx zpt,y 1197 : 08 php ;flags after load/store sequence 1198 : 49c3 eor #$c3 119a : d91300 cmp zp1,y ;test result trap_ne 119d : f003 > beq skip0854 > trap ;failed not equal (non zero) 119f : 205b44 > jsr report_error > 11a2 : >skip0854 11a2 : 68 pla ;load status eor_flag 0 11a3 : 4930 > eor #0|fao ;invert expected flags + always on bits 11a5 : d91c02 cmp fLDx,y ;test flags trap_ne 11a8 : f003 > beq skip0857 > trap ;failed not equal (non zero) 11aa : 205b44 > jsr report_error > 11ad : >skip0857 11ad : 88 dey 11ae : 10d8 bpl tldx2 11b0 : a003 ldy #3 11b2 : tldx3 set_stat $ff > load_flag $ff 11b2 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 11b4 : 48 > pha ;use stack to load status 11b5 : 28 > plp 11b6 : be1702 ldx abs1,y 11b9 : 08 php ;test stores do not alter flags 11ba : 8a txa 11bb : 49c3 eor #$c3 11bd : aa tax 11be : 28 plp 11bf : 960c stx zpt,y 11c1 : 08 php ;flags after load/store sequence 11c2 : 49c3 eor #$c3 11c4 : d91300 cmp zp1,y ;test result trap_ne 11c7 : f003 > beq skip0861 > trap ;failed not equal (non zero) 11c9 : 205b44 > jsr report_error > 11cc : >skip0861 11cc : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 11cd : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 11cf : d91c02 cmp fLDx,y ;test flags trap_ne 11d2 : f003 > beq skip0864 > trap ;failed not equal (non zero) 11d4 : 205b44 > jsr report_error > 11d7 : >skip0864 11d7 : 88 dey 11d8 : 10d8 bpl tldx3 11da : a003 ldy #3 ;testing store result 11dc : a200 ldx #0 11de : b90c00 tstx lda zpt,y 11e1 : 49c3 eor #$c3 11e3 : d91300 cmp zp1,y trap_ne ;store to zp data 11e6 : f003 > beq skip0866 > trap ;failed not equal (non zero) 11e8 : 205b44 > jsr report_error > 11eb : >skip0866 11eb : 960c stx zpt,y ;clear 11ed : b90302 lda abst,y 11f0 : 49c3 eor #$c3 11f2 : d91702 cmp abs1,y trap_ne ;store to abs data 11f5 : f003 > beq skip0868 > trap ;failed not equal (non zero) 11f7 : 205b44 > jsr report_error > 11fa : >skip0868 11fa : 8a txa 11fb : 990302 sta abst,y ;clear 11fe : 88 dey 11ff : 10dd bpl tstx next_test 1201 : ad0002 > lda test_case ;previous test 1204 : c90f > cmp #test_num > trap_ne ;test is out of sequence 1206 : f003 > beq skip0871 > trap ;failed not equal (non zero) 1208 : 205b44 > jsr report_error > 120b : >skip0871 > 0010 = >test_num = test_num + 1 120b : a910 > lda #test_num ;*** next tests' number 120d : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; indexed wraparound test (only zp should wrap) 1210 : a0fd ldy #3+$fa 1212 : b619 tldx4 ldx zp1-$fa&$ff,y ;wrap on indexed zp 1214 : 8a txa 1215 : 990901 sta abst-$fa,y ;no STX abs,y! 1218 : 88 dey 1219 : c0fa cpy #$fa 121b : b0f5 bcs tldx4 121d : a0fd ldy #3+$fa 121f : be1d01 tldx5 ldx abs1-$fa,y ;no wrap on indexed abs 1222 : 9612 stx zpt-$fa&$ff,y 1224 : 88 dey 1225 : c0fa cpy #$fa 1227 : b0f6 bcs tldx5 1229 : a003 ldy #3 ;testing wraparound result 122b : a200 ldx #0 122d : b90c00 tstx1 lda zpt,y 1230 : d91300 cmp zp1,y trap_ne ;store to zp data 1233 : f003 > beq skip0873 > trap ;failed not equal (non zero) 1235 : 205b44 > jsr report_error > 1238 : >skip0873 1238 : 960c stx zpt,y ;clear 123a : b90302 lda abst,y 123d : d91702 cmp abs1,y trap_ne ;store to abs data 1240 : f003 > beq skip0875 > trap ;failed not equal (non zero) 1242 : 205b44 > jsr report_error > 1245 : >skip0875 1245 : 8a txa 1246 : 990302 sta abst,y ;clear 1249 : 88 dey 124a : 10e1 bpl tstx1 next_test 124c : ad0002 > lda test_case ;previous test 124f : c910 > cmp #test_num > trap_ne ;test is out of sequence 1251 : f003 > beq skip0878 > trap ;failed not equal (non zero) 1253 : 205b44 > jsr report_error > 1256 : >skip0878 > 0011 = >test_num = test_num + 1 1256 : a911 > lda #test_num ;*** next tests' number 1258 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; LDY / STY - zp,x / abs,x 125b : a203 ldx #3 125d : tldy set_stat 0 > load_flag 0 125d : a900 > lda #0 ;allow test to change I-flag (no mask) > 125f : 48 > pha ;use stack to load status 1260 : 28 > plp 1261 : b413 ldy zp1,x 1263 : 08 php ;test stores do not alter flags 1264 : 98 tya 1265 : 49c3 eor #$c3 1267 : 28 plp 1268 : 9d0302 sta abst,x 126b : 08 php ;flags after load/store sequence 126c : 49c3 eor #$c3 126e : dd1702 cmp abs1,x ;test result trap_ne 1271 : f003 > beq skip0882 > trap ;failed not equal (non zero) 1273 : 205b44 > jsr report_error > 1276 : >skip0882 1276 : 68 pla ;load status eor_flag 0 1277 : 4930 > eor #0|fao ;invert expected flags + always on bits 1279 : dd1c02 cmp fLDx,x ;test flags trap_ne 127c : f003 > beq skip0885 > trap ;failed not equal (non zero) 127e : 205b44 > jsr report_error > 1281 : >skip0885 1281 : ca dex 1282 : 10d9 bpl tldy 1284 : a203 ldx #3 1286 : tldy1 set_stat $ff > load_flag $ff 1286 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1288 : 48 > pha ;use stack to load status 1289 : 28 > plp 128a : b413 ldy zp1,x 128c : 08 php ;test stores do not alter flags 128d : 98 tya 128e : 49c3 eor #$c3 1290 : 28 plp 1291 : 9d0302 sta abst,x 1294 : 08 php ;flags after load/store sequence 1295 : 49c3 eor #$c3 1297 : dd1702 cmp abs1,x ;test result trap_ne 129a : f003 > beq skip0889 > trap ;failed not equal (non zero) 129c : 205b44 > jsr report_error > 129f : >skip0889 129f : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 12a0 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 12a2 : dd1c02 cmp fLDx,x ;test flags trap_ne 12a5 : f003 > beq skip0892 > trap ;failed not equal (non zero) 12a7 : 205b44 > jsr report_error > 12aa : >skip0892 12aa : ca dex 12ab : 10d9 bpl tldy1 12ad : a203 ldx #3 12af : tldy2 set_stat 0 > load_flag 0 12af : a900 > lda #0 ;allow test to change I-flag (no mask) > 12b1 : 48 > pha ;use stack to load status 12b2 : 28 > plp 12b3 : bc1702 ldy abs1,x 12b6 : 08 php ;test stores do not alter flags 12b7 : 98 tya 12b8 : 49c3 eor #$c3 12ba : a8 tay 12bb : 28 plp 12bc : 940c sty zpt,x 12be : 08 php ;flags after load/store sequence 12bf : 49c3 eor #$c3 12c1 : d513 cmp zp1,x ;test result trap_ne 12c3 : f003 > beq skip0896 > trap ;failed not equal (non zero) 12c5 : 205b44 > jsr report_error > 12c8 : >skip0896 12c8 : 68 pla ;load status eor_flag 0 12c9 : 4930 > eor #0|fao ;invert expected flags + always on bits 12cb : dd1c02 cmp fLDx,x ;test flags trap_ne 12ce : f003 > beq skip0899 > trap ;failed not equal (non zero) 12d0 : 205b44 > jsr report_error > 12d3 : >skip0899 12d3 : ca dex 12d4 : 10d9 bpl tldy2 12d6 : a203 ldx #3 12d8 : tldy3 set_stat $ff > load_flag $ff 12d8 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 12da : 48 > pha ;use stack to load status 12db : 28 > plp 12dc : bc1702 ldy abs1,x 12df : 08 php ;test stores do not alter flags 12e0 : 98 tya 12e1 : 49c3 eor #$c3 12e3 : a8 tay 12e4 : 28 plp 12e5 : 940c sty zpt,x 12e7 : 08 php ;flags after load/store sequence 12e8 : 49c3 eor #$c3 12ea : d513 cmp zp1,x ;test result trap_ne 12ec : f003 > beq skip0903 > trap ;failed not equal (non zero) 12ee : 205b44 > jsr report_error > 12f1 : >skip0903 12f1 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 12f2 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 12f4 : dd1c02 cmp fLDx,x ;test flags trap_ne 12f7 : f003 > beq skip0906 > trap ;failed not equal (non zero) 12f9 : 205b44 > jsr report_error > 12fc : >skip0906 12fc : ca dex 12fd : 10d9 bpl tldy3 12ff : a203 ldx #3 ;testing store result 1301 : a000 ldy #0 1303 : b50c tsty lda zpt,x 1305 : 49c3 eor #$c3 1307 : d513 cmp zp1,x trap_ne ;store to zp,x data 1309 : f003 > beq skip0908 > trap ;failed not equal (non zero) 130b : 205b44 > jsr report_error > 130e : >skip0908 130e : 940c sty zpt,x ;clear 1310 : bd0302 lda abst,x 1313 : 49c3 eor #$c3 1315 : dd1702 cmp abs1,x trap_ne ;store to abs,x data 1318 : f003 > beq skip0910 > trap ;failed not equal (non zero) 131a : 205b44 > jsr report_error > 131d : >skip0910 131d : 8a txa 131e : 9d0302 sta abst,x ;clear 1321 : ca dex 1322 : 10df bpl tsty next_test 1324 : ad0002 > lda test_case ;previous test 1327 : c911 > cmp #test_num > trap_ne ;test is out of sequence 1329 : f003 > beq skip0913 > trap ;failed not equal (non zero) 132b : 205b44 > jsr report_error > 132e : >skip0913 > 0012 = >test_num = test_num + 1 132e : a912 > lda #test_num ;*** next tests' number 1330 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; indexed wraparound test (only zp should wrap) 1333 : a2fd ldx #3+$fa 1335 : b419 tldy4 ldy zp1-$fa&$ff,x ;wrap on indexed zp 1337 : 98 tya 1338 : 9d0901 sta abst-$fa,x ;no STX abs,x! 133b : ca dex 133c : e0fa cpx #$fa 133e : b0f5 bcs tldy4 1340 : a2fd ldx #3+$fa 1342 : bc1d01 tldy5 ldy abs1-$fa,x ;no wrap on indexed abs 1345 : 9412 sty zpt-$fa&$ff,x 1347 : ca dex 1348 : e0fa cpx #$fa 134a : b0f6 bcs tldy5 134c : a203 ldx #3 ;testing wraparound result 134e : a000 ldy #0 1350 : b50c tsty1 lda zpt,x 1352 : d513 cmp zp1,x trap_ne ;store to zp,x data 1354 : f003 > beq skip0915 > trap ;failed not equal (non zero) 1356 : 205b44 > jsr report_error > 1359 : >skip0915 1359 : 940c sty zpt,x ;clear 135b : bd0302 lda abst,x 135e : dd1702 cmp abs1,x trap_ne ;store to abs,x data 1361 : f003 > beq skip0917 > trap ;failed not equal (non zero) 1363 : 205b44 > jsr report_error > 1366 : >skip0917 1366 : 8a txa 1367 : 9d0302 sta abst,x ;clear 136a : ca dex 136b : 10e3 bpl tsty1 next_test 136d : ad0002 > lda test_case ;previous test 1370 : c912 > cmp #test_num > trap_ne ;test is out of sequence 1372 : f003 > beq skip0920 > trap ;failed not equal (non zero) 1374 : 205b44 > jsr report_error > 1377 : >skip0920 > 0013 = >test_num = test_num + 1 1377 : a913 > lda #test_num ;*** next tests' number 1379 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; LDX / STX - zp / abs / # set_stat 0 > load_flag 0 137c : a900 > lda #0 ;allow test to change I-flag (no mask) > 137e : 48 > pha ;use stack to load status 137f : 28 > plp 1380 : a613 ldx zp1 1382 : 08 php ;test stores do not alter flags 1383 : 8a txa 1384 : 49c3 eor #$c3 1386 : aa tax 1387 : 28 plp 1388 : 8e0302 stx abst 138b : 08 php ;flags after load/store sequence 138c : 49c3 eor #$c3 138e : aa tax 138f : e0c3 cpx #$c3 ;test result trap_ne 1391 : f003 > beq skip0924 > trap ;failed not equal (non zero) 1393 : 205b44 > jsr report_error > 1396 : >skip0924 1396 : 68 pla ;load status eor_flag 0 1397 : 4930 > eor #0|fao ;invert expected flags + always on bits 1399 : cd1c02 cmp fLDx ;test flags trap_ne 139c : f003 > beq skip0927 > trap ;failed not equal (non zero) 139e : 205b44 > jsr report_error > 13a1 : >skip0927 set_stat 0 > load_flag 0 13a1 : a900 > lda #0 ;allow test to change I-flag (no mask) > 13a3 : 48 > pha ;use stack to load status 13a4 : 28 > plp 13a5 : a614 ldx zp1+1 13a7 : 08 php ;test stores do not alter flags 13a8 : 8a txa 13a9 : 49c3 eor #$c3 13ab : aa tax 13ac : 28 plp 13ad : 8e0402 stx abst+1 13b0 : 08 php ;flags after load/store sequence 13b1 : 49c3 eor #$c3 13b3 : aa tax 13b4 : e082 cpx #$82 ;test result trap_ne 13b6 : f003 > beq skip0931 > trap ;failed not equal (non zero) 13b8 : 205b44 > jsr report_error > 13bb : >skip0931 13bb : 68 pla ;load status eor_flag 0 13bc : 4930 > eor #0|fao ;invert expected flags + always on bits 13be : cd1d02 cmp fLDx+1 ;test flags trap_ne 13c1 : f003 > beq skip0934 > trap ;failed not equal (non zero) 13c3 : 205b44 > jsr report_error > 13c6 : >skip0934 set_stat 0 > load_flag 0 13c6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 13c8 : 48 > pha ;use stack to load status 13c9 : 28 > plp 13ca : a615 ldx zp1+2 13cc : 08 php ;test stores do not alter flags 13cd : 8a txa 13ce : 49c3 eor #$c3 13d0 : aa tax 13d1 : 28 plp 13d2 : 8e0502 stx abst+2 13d5 : 08 php ;flags after load/store sequence 13d6 : 49c3 eor #$c3 13d8 : aa tax 13d9 : e041 cpx #$41 ;test result trap_ne 13db : f003 > beq skip0938 > trap ;failed not equal (non zero) 13dd : 205b44 > jsr report_error > 13e0 : >skip0938 13e0 : 68 pla ;load status eor_flag 0 13e1 : 4930 > eor #0|fao ;invert expected flags + always on bits 13e3 : cd1e02 cmp fLDx+2 ;test flags trap_ne 13e6 : f003 > beq skip0941 > trap ;failed not equal (non zero) 13e8 : 205b44 > jsr report_error > 13eb : >skip0941 set_stat 0 > load_flag 0 13eb : a900 > lda #0 ;allow test to change I-flag (no mask) > 13ed : 48 > pha ;use stack to load status 13ee : 28 > plp 13ef : a616 ldx zp1+3 13f1 : 08 php ;test stores do not alter flags 13f2 : 8a txa 13f3 : 49c3 eor #$c3 13f5 : aa tax 13f6 : 28 plp 13f7 : 8e0602 stx abst+3 13fa : 08 php ;flags after load/store sequence 13fb : 49c3 eor #$c3 13fd : aa tax 13fe : e000 cpx #0 ;test result trap_ne 1400 : f003 > beq skip0945 > trap ;failed not equal (non zero) 1402 : 205b44 > jsr report_error > 1405 : >skip0945 1405 : 68 pla ;load status eor_flag 0 1406 : 4930 > eor #0|fao ;invert expected flags + always on bits 1408 : cd1f02 cmp fLDx+3 ;test flags trap_ne 140b : f003 > beq skip0948 > trap ;failed not equal (non zero) 140d : 205b44 > jsr report_error > 1410 : >skip0948 set_stat $ff > load_flag $ff 1410 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1412 : 48 > pha ;use stack to load status 1413 : 28 > plp 1414 : a613 ldx zp1 1416 : 08 php ;test stores do not alter flags 1417 : 8a txa 1418 : 49c3 eor #$c3 141a : aa tax 141b : 28 plp 141c : 8e0302 stx abst 141f : 08 php ;flags after load/store sequence 1420 : 49c3 eor #$c3 1422 : aa tax 1423 : e0c3 cpx #$c3 ;test result trap_ne ; 1425 : f003 > beq skip0952 > trap ;failed not equal (non zero) 1427 : 205b44 > jsr report_error > 142a : >skip0952 142a : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 142b : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 142d : cd1c02 cmp fLDx ;test flags trap_ne 1430 : f003 > beq skip0955 > trap ;failed not equal (non zero) 1432 : 205b44 > jsr report_error > 1435 : >skip0955 set_stat $ff > load_flag $ff 1435 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1437 : 48 > pha ;use stack to load status 1438 : 28 > plp 1439 : a614 ldx zp1+1 143b : 08 php ;test stores do not alter flags 143c : 8a txa 143d : 49c3 eor #$c3 143f : aa tax 1440 : 28 plp 1441 : 8e0402 stx abst+1 1444 : 08 php ;flags after load/store sequence 1445 : 49c3 eor #$c3 1447 : aa tax 1448 : e082 cpx #$82 ;test result trap_ne 144a : f003 > beq skip0959 > trap ;failed not equal (non zero) 144c : 205b44 > jsr report_error > 144f : >skip0959 144f : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1450 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1452 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1455 : f003 > beq skip0962 > trap ;failed not equal (non zero) 1457 : 205b44 > jsr report_error > 145a : >skip0962 set_stat $ff > load_flag $ff 145a : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 145c : 48 > pha ;use stack to load status 145d : 28 > plp 145e : a615 ldx zp1+2 1460 : 08 php ;test stores do not alter flags 1461 : 8a txa 1462 : 49c3 eor #$c3 1464 : aa tax 1465 : 28 plp 1466 : 8e0502 stx abst+2 1469 : 08 php ;flags after load/store sequence 146a : 49c3 eor #$c3 146c : aa tax 146d : e041 cpx #$41 ;test result trap_ne ; 146f : f003 > beq skip0966 > trap ;failed not equal (non zero) 1471 : 205b44 > jsr report_error > 1474 : >skip0966 1474 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1475 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1477 : cd1e02 cmp fLDx+2 ;test flags trap_ne 147a : f003 > beq skip0969 > trap ;failed not equal (non zero) 147c : 205b44 > jsr report_error > 147f : >skip0969 set_stat $ff > load_flag $ff 147f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1481 : 48 > pha ;use stack to load status 1482 : 28 > plp 1483 : a616 ldx zp1+3 1485 : 08 php ;test stores do not alter flags 1486 : 8a txa 1487 : 49c3 eor #$c3 1489 : aa tax 148a : 28 plp 148b : 8e0602 stx abst+3 148e : 08 php ;flags after load/store sequence 148f : 49c3 eor #$c3 1491 : aa tax 1492 : e000 cpx #0 ;test result trap_ne 1494 : f003 > beq skip0973 > trap ;failed not equal (non zero) 1496 : 205b44 > jsr report_error > 1499 : >skip0973 1499 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 149a : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 149c : cd1f02 cmp fLDx+3 ;test flags trap_ne 149f : f003 > beq skip0976 > trap ;failed not equal (non zero) 14a1 : 205b44 > jsr report_error > 14a4 : >skip0976 set_stat 0 > load_flag 0 14a4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 14a6 : 48 > pha ;use stack to load status 14a7 : 28 > plp 14a8 : ae1702 ldx abs1 14ab : 08 php ;test stores do not alter flags 14ac : 8a txa 14ad : 49c3 eor #$c3 14af : aa tax 14b0 : 28 plp 14b1 : 860c stx zpt 14b3 : 08 php ;flags after load/store sequence 14b4 : 49c3 eor #$c3 14b6 : c513 cmp zp1 ;test result trap_ne 14b8 : f003 > beq skip0980 > trap ;failed not equal (non zero) 14ba : 205b44 > jsr report_error > 14bd : >skip0980 14bd : 68 pla ;load status eor_flag 0 14be : 4930 > eor #0|fao ;invert expected flags + always on bits 14c0 : cd1c02 cmp fLDx ;test flags trap_ne 14c3 : f003 > beq skip0983 > trap ;failed not equal (non zero) 14c5 : 205b44 > jsr report_error > 14c8 : >skip0983 set_stat 0 > load_flag 0 14c8 : a900 > lda #0 ;allow test to change I-flag (no mask) > 14ca : 48 > pha ;use stack to load status 14cb : 28 > plp 14cc : ae1802 ldx abs1+1 14cf : 08 php ;test stores do not alter flags 14d0 : 8a txa 14d1 : 49c3 eor #$c3 14d3 : aa tax 14d4 : 28 plp 14d5 : 860d stx zpt+1 14d7 : 08 php ;flags after load/store sequence 14d8 : 49c3 eor #$c3 14da : c514 cmp zp1+1 ;test result trap_ne 14dc : f003 > beq skip0987 > trap ;failed not equal (non zero) 14de : 205b44 > jsr report_error > 14e1 : >skip0987 14e1 : 68 pla ;load status eor_flag 0 14e2 : 4930 > eor #0|fao ;invert expected flags + always on bits 14e4 : cd1d02 cmp fLDx+1 ;test flags trap_ne 14e7 : f003 > beq skip0990 > trap ;failed not equal (non zero) 14e9 : 205b44 > jsr report_error > 14ec : >skip0990 set_stat 0 > load_flag 0 14ec : a900 > lda #0 ;allow test to change I-flag (no mask) > 14ee : 48 > pha ;use stack to load status 14ef : 28 > plp 14f0 : ae1902 ldx abs1+2 14f3 : 08 php ;test stores do not alter flags 14f4 : 8a txa 14f5 : 49c3 eor #$c3 14f7 : aa tax 14f8 : 28 plp 14f9 : 860e stx zpt+2 14fb : 08 php ;flags after load/store sequence 14fc : 49c3 eor #$c3 14fe : c515 cmp zp1+2 ;test result trap_ne 1500 : f003 > beq skip0994 > trap ;failed not equal (non zero) 1502 : 205b44 > jsr report_error > 1505 : >skip0994 1505 : 68 pla ;load status eor_flag 0 1506 : 4930 > eor #0|fao ;invert expected flags + always on bits 1508 : cd1e02 cmp fLDx+2 ;test flags trap_ne 150b : f003 > beq skip0997 > trap ;failed not equal (non zero) 150d : 205b44 > jsr report_error > 1510 : >skip0997 set_stat 0 > load_flag 0 1510 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1512 : 48 > pha ;use stack to load status 1513 : 28 > plp 1514 : ae1a02 ldx abs1+3 1517 : 08 php ;test stores do not alter flags 1518 : 8a txa 1519 : 49c3 eor #$c3 151b : aa tax 151c : 28 plp 151d : 860f stx zpt+3 151f : 08 php ;flags after load/store sequence 1520 : 49c3 eor #$c3 1522 : c516 cmp zp1+3 ;test result trap_ne 1524 : f003 > beq skip1001 > trap ;failed not equal (non zero) 1526 : 205b44 > jsr report_error > 1529 : >skip1001 1529 : 68 pla ;load status eor_flag 0 152a : 4930 > eor #0|fao ;invert expected flags + always on bits 152c : cd1f02 cmp fLDx+3 ;test flags trap_ne 152f : f003 > beq skip1004 > trap ;failed not equal (non zero) 1531 : 205b44 > jsr report_error > 1534 : >skip1004 set_stat $ff > load_flag $ff 1534 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1536 : 48 > pha ;use stack to load status 1537 : 28 > plp 1538 : ae1702 ldx abs1 153b : 08 php ;test stores do not alter flags 153c : 8a txa 153d : 49c3 eor #$c3 153f : aa tax 1540 : 28 plp 1541 : 860c stx zpt 1543 : 08 php ;flags after load/store sequence 1544 : 49c3 eor #$c3 1546 : aa tax 1547 : e413 cpx zp1 ;test result trap_ne 1549 : f003 > beq skip1008 > trap ;failed not equal (non zero) 154b : 205b44 > jsr report_error > 154e : >skip1008 154e : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 154f : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1551 : cd1c02 cmp fLDx ;test flags trap_ne 1554 : f003 > beq skip1011 > trap ;failed not equal (non zero) 1556 : 205b44 > jsr report_error > 1559 : >skip1011 set_stat $ff > load_flag $ff 1559 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 155b : 48 > pha ;use stack to load status 155c : 28 > plp 155d : ae1802 ldx abs1+1 1560 : 08 php ;test stores do not alter flags 1561 : 8a txa 1562 : 49c3 eor #$c3 1564 : aa tax 1565 : 28 plp 1566 : 860d stx zpt+1 1568 : 08 php ;flags after load/store sequence 1569 : 49c3 eor #$c3 156b : aa tax 156c : e414 cpx zp1+1 ;test result trap_ne 156e : f003 > beq skip1015 > trap ;failed not equal (non zero) 1570 : 205b44 > jsr report_error > 1573 : >skip1015 1573 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1574 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1576 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1579 : f003 > beq skip1018 > trap ;failed not equal (non zero) 157b : 205b44 > jsr report_error > 157e : >skip1018 set_stat $ff > load_flag $ff 157e : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1580 : 48 > pha ;use stack to load status 1581 : 28 > plp 1582 : ae1902 ldx abs1+2 1585 : 08 php ;test stores do not alter flags 1586 : 8a txa 1587 : 49c3 eor #$c3 1589 : aa tax 158a : 28 plp 158b : 860e stx zpt+2 158d : 08 php ;flags after load/store sequence 158e : 49c3 eor #$c3 1590 : aa tax 1591 : e415 cpx zp1+2 ;test result trap_ne 1593 : f003 > beq skip1022 > trap ;failed not equal (non zero) 1595 : 205b44 > jsr report_error > 1598 : >skip1022 1598 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1599 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 159b : cd1e02 cmp fLDx+2 ;test flags trap_ne 159e : f003 > beq skip1025 > trap ;failed not equal (non zero) 15a0 : 205b44 > jsr report_error > 15a3 : >skip1025 set_stat $ff > load_flag $ff 15a3 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 15a5 : 48 > pha ;use stack to load status 15a6 : 28 > plp 15a7 : ae1a02 ldx abs1+3 15aa : 08 php ;test stores do not alter flags 15ab : 8a txa 15ac : 49c3 eor #$c3 15ae : aa tax 15af : 28 plp 15b0 : 860f stx zpt+3 15b2 : 08 php ;flags after load/store sequence 15b3 : 49c3 eor #$c3 15b5 : aa tax 15b6 : e416 cpx zp1+3 ;test result trap_ne 15b8 : f003 > beq skip1029 > trap ;failed not equal (non zero) 15ba : 205b44 > jsr report_error > 15bd : >skip1029 15bd : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 15be : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 15c0 : cd1f02 cmp fLDx+3 ;test flags trap_ne 15c3 : f003 > beq skip1032 > trap ;failed not equal (non zero) 15c5 : 205b44 > jsr report_error > 15c8 : >skip1032 set_stat 0 > load_flag 0 15c8 : a900 > lda #0 ;allow test to change I-flag (no mask) > 15ca : 48 > pha ;use stack to load status 15cb : 28 > plp 15cc : a2c3 ldx #$c3 15ce : 08 php 15cf : ec1702 cpx abs1 ;test result trap_ne 15d2 : f003 > beq skip1036 > trap ;failed not equal (non zero) 15d4 : 205b44 > jsr report_error > 15d7 : >skip1036 15d7 : 68 pla ;load status eor_flag 0 15d8 : 4930 > eor #0|fao ;invert expected flags + always on bits 15da : cd1c02 cmp fLDx ;test flags trap_ne 15dd : f003 > beq skip1039 > trap ;failed not equal (non zero) 15df : 205b44 > jsr report_error > 15e2 : >skip1039 set_stat 0 > load_flag 0 15e2 : a900 > lda #0 ;allow test to change I-flag (no mask) > 15e4 : 48 > pha ;use stack to load status 15e5 : 28 > plp 15e6 : a282 ldx #$82 15e8 : 08 php 15e9 : ec1802 cpx abs1+1 ;test result trap_ne 15ec : f003 > beq skip1043 > trap ;failed not equal (non zero) 15ee : 205b44 > jsr report_error > 15f1 : >skip1043 15f1 : 68 pla ;load status eor_flag 0 15f2 : 4930 > eor #0|fao ;invert expected flags + always on bits 15f4 : cd1d02 cmp fLDx+1 ;test flags trap_ne 15f7 : f003 > beq skip1046 > trap ;failed not equal (non zero) 15f9 : 205b44 > jsr report_error > 15fc : >skip1046 set_stat 0 > load_flag 0 15fc : a900 > lda #0 ;allow test to change I-flag (no mask) > 15fe : 48 > pha ;use stack to load status 15ff : 28 > plp 1600 : a241 ldx #$41 1602 : 08 php 1603 : ec1902 cpx abs1+2 ;test result trap_ne 1606 : f003 > beq skip1050 > trap ;failed not equal (non zero) 1608 : 205b44 > jsr report_error > 160b : >skip1050 160b : 68 pla ;load status eor_flag 0 160c : 4930 > eor #0|fao ;invert expected flags + always on bits 160e : cd1e02 cmp fLDx+2 ;test flags trap_ne 1611 : f003 > beq skip1053 > trap ;failed not equal (non zero) 1613 : 205b44 > jsr report_error > 1616 : >skip1053 set_stat 0 > load_flag 0 1616 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1618 : 48 > pha ;use stack to load status 1619 : 28 > plp 161a : a200 ldx #0 161c : 08 php 161d : ec1a02 cpx abs1+3 ;test result trap_ne 1620 : f003 > beq skip1057 > trap ;failed not equal (non zero) 1622 : 205b44 > jsr report_error > 1625 : >skip1057 1625 : 68 pla ;load status eor_flag 0 1626 : 4930 > eor #0|fao ;invert expected flags + always on bits 1628 : cd1f02 cmp fLDx+3 ;test flags trap_ne 162b : f003 > beq skip1060 > trap ;failed not equal (non zero) 162d : 205b44 > jsr report_error > 1630 : >skip1060 set_stat $ff > load_flag $ff 1630 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1632 : 48 > pha ;use stack to load status 1633 : 28 > plp 1634 : a2c3 ldx #$c3 1636 : 08 php 1637 : ec1702 cpx abs1 ;test result trap_ne 163a : f003 > beq skip1064 > trap ;failed not equal (non zero) 163c : 205b44 > jsr report_error > 163f : >skip1064 163f : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1640 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1642 : cd1c02 cmp fLDx ;test flags trap_ne 1645 : f003 > beq skip1067 > trap ;failed not equal (non zero) 1647 : 205b44 > jsr report_error > 164a : >skip1067 set_stat $ff > load_flag $ff 164a : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 164c : 48 > pha ;use stack to load status 164d : 28 > plp 164e : a282 ldx #$82 1650 : 08 php 1651 : ec1802 cpx abs1+1 ;test result trap_ne 1654 : f003 > beq skip1071 > trap ;failed not equal (non zero) 1656 : 205b44 > jsr report_error > 1659 : >skip1071 1659 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 165a : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 165c : cd1d02 cmp fLDx+1 ;test flags trap_ne 165f : f003 > beq skip1074 > trap ;failed not equal (non zero) 1661 : 205b44 > jsr report_error > 1664 : >skip1074 set_stat $ff > load_flag $ff 1664 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1666 : 48 > pha ;use stack to load status 1667 : 28 > plp 1668 : a241 ldx #$41 166a : 08 php 166b : ec1902 cpx abs1+2 ;test result trap_ne 166e : f003 > beq skip1078 > trap ;failed not equal (non zero) 1670 : 205b44 > jsr report_error > 1673 : >skip1078 1673 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1674 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1676 : cd1e02 cmp fLDx+2 ;test flags trap_ne 1679 : f003 > beq skip1081 > trap ;failed not equal (non zero) 167b : 205b44 > jsr report_error > 167e : >skip1081 set_stat $ff > load_flag $ff 167e : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1680 : 48 > pha ;use stack to load status 1681 : 28 > plp 1682 : a200 ldx #0 1684 : 08 php 1685 : ec1a02 cpx abs1+3 ;test result trap_ne 1688 : f003 > beq skip1085 > trap ;failed not equal (non zero) 168a : 205b44 > jsr report_error > 168d : >skip1085 168d : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 168e : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1690 : cd1f02 cmp fLDx+3 ;test flags trap_ne 1693 : f003 > beq skip1088 > trap ;failed not equal (non zero) 1695 : 205b44 > jsr report_error > 1698 : >skip1088 1698 : a200 ldx #0 169a : a50c lda zpt 169c : 49c3 eor #$c3 169e : c513 cmp zp1 trap_ne ;store to zp data 16a0 : f003 > beq skip1090 > trap ;failed not equal (non zero) 16a2 : 205b44 > jsr report_error > 16a5 : >skip1090 16a5 : 860c stx zpt ;clear 16a7 : ad0302 lda abst 16aa : 49c3 eor #$c3 16ac : cd1702 cmp abs1 trap_ne ;store to abs data 16af : f003 > beq skip1092 > trap ;failed not equal (non zero) 16b1 : 205b44 > jsr report_error > 16b4 : >skip1092 16b4 : 8e0302 stx abst ;clear 16b7 : a50d lda zpt+1 16b9 : 49c3 eor #$c3 16bb : c514 cmp zp1+1 trap_ne ;store to zp data 16bd : f003 > beq skip1094 > trap ;failed not equal (non zero) 16bf : 205b44 > jsr report_error > 16c2 : >skip1094 16c2 : 860d stx zpt+1 ;clear 16c4 : ad0402 lda abst+1 16c7 : 49c3 eor #$c3 16c9 : cd1802 cmp abs1+1 trap_ne ;store to abs data 16cc : f003 > beq skip1096 > trap ;failed not equal (non zero) 16ce : 205b44 > jsr report_error > 16d1 : >skip1096 16d1 : 8e0402 stx abst+1 ;clear 16d4 : a50e lda zpt+2 16d6 : 49c3 eor #$c3 16d8 : c515 cmp zp1+2 trap_ne ;store to zp data 16da : f003 > beq skip1098 > trap ;failed not equal (non zero) 16dc : 205b44 > jsr report_error > 16df : >skip1098 16df : 860e stx zpt+2 ;clear 16e1 : ad0502 lda abst+2 16e4 : 49c3 eor #$c3 16e6 : cd1902 cmp abs1+2 trap_ne ;store to abs data 16e9 : f003 > beq skip1100 > trap ;failed not equal (non zero) 16eb : 205b44 > jsr report_error > 16ee : >skip1100 16ee : 8e0502 stx abst+2 ;clear 16f1 : a50f lda zpt+3 16f3 : 49c3 eor #$c3 16f5 : c516 cmp zp1+3 trap_ne ;store to zp data 16f7 : f003 > beq skip1102 > trap ;failed not equal (non zero) 16f9 : 205b44 > jsr report_error > 16fc : >skip1102 16fc : 860f stx zpt+3 ;clear 16fe : ad0602 lda abst+3 1701 : 49c3 eor #$c3 1703 : cd1a02 cmp abs1+3 trap_ne ;store to abs data 1706 : f003 > beq skip1104 > trap ;failed not equal (non zero) 1708 : 205b44 > jsr report_error > 170b : >skip1104 170b : 8e0602 stx abst+3 ;clear next_test 170e : ad0002 > lda test_case ;previous test 1711 : c913 > cmp #test_num > trap_ne ;test is out of sequence 1713 : f003 > beq skip1107 > trap ;failed not equal (non zero) 1715 : 205b44 > jsr report_error > 1718 : >skip1107 > 0014 = >test_num = test_num + 1 1718 : a914 > lda #test_num ;*** next tests' number 171a : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; LDY / STY - zp / abs / # set_stat 0 > load_flag 0 171d : a900 > lda #0 ;allow test to change I-flag (no mask) > 171f : 48 > pha ;use stack to load status 1720 : 28 > plp 1721 : a413 ldy zp1 1723 : 08 php ;test stores do not alter flags 1724 : 98 tya 1725 : 49c3 eor #$c3 1727 : a8 tay 1728 : 28 plp 1729 : 8c0302 sty abst 172c : 08 php ;flags after load/store sequence 172d : 49c3 eor #$c3 172f : a8 tay 1730 : c0c3 cpy #$c3 ;test result trap_ne 1732 : f003 > beq skip1111 > trap ;failed not equal (non zero) 1734 : 205b44 > jsr report_error > 1737 : >skip1111 1737 : 68 pla ;load status eor_flag 0 1738 : 4930 > eor #0|fao ;invert expected flags + always on bits 173a : cd1c02 cmp fLDx ;test flags trap_ne 173d : f003 > beq skip1114 > trap ;failed not equal (non zero) 173f : 205b44 > jsr report_error > 1742 : >skip1114 set_stat 0 > load_flag 0 1742 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1744 : 48 > pha ;use stack to load status 1745 : 28 > plp 1746 : a414 ldy zp1+1 1748 : 08 php ;test stores do not alter flags 1749 : 98 tya 174a : 49c3 eor #$c3 174c : a8 tay 174d : 28 plp 174e : 8c0402 sty abst+1 1751 : 08 php ;flags after load/store sequence 1752 : 49c3 eor #$c3 1754 : a8 tay 1755 : c082 cpy #$82 ;test result trap_ne 1757 : f003 > beq skip1118 > trap ;failed not equal (non zero) 1759 : 205b44 > jsr report_error > 175c : >skip1118 175c : 68 pla ;load status eor_flag 0 175d : 4930 > eor #0|fao ;invert expected flags + always on bits 175f : cd1d02 cmp fLDx+1 ;test flags trap_ne 1762 : f003 > beq skip1121 > trap ;failed not equal (non zero) 1764 : 205b44 > jsr report_error > 1767 : >skip1121 set_stat 0 > load_flag 0 1767 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1769 : 48 > pha ;use stack to load status 176a : 28 > plp 176b : a415 ldy zp1+2 176d : 08 php ;test stores do not alter flags 176e : 98 tya 176f : 49c3 eor #$c3 1771 : a8 tay 1772 : 28 plp 1773 : 8c0502 sty abst+2 1776 : 08 php ;flags after load/store sequence 1777 : 49c3 eor #$c3 1779 : a8 tay 177a : c041 cpy #$41 ;test result trap_ne 177c : f003 > beq skip1125 > trap ;failed not equal (non zero) 177e : 205b44 > jsr report_error > 1781 : >skip1125 1781 : 68 pla ;load status eor_flag 0 1782 : 4930 > eor #0|fao ;invert expected flags + always on bits 1784 : cd1e02 cmp fLDx+2 ;test flags trap_ne 1787 : f003 > beq skip1128 > trap ;failed not equal (non zero) 1789 : 205b44 > jsr report_error > 178c : >skip1128 set_stat 0 > load_flag 0 178c : a900 > lda #0 ;allow test to change I-flag (no mask) > 178e : 48 > pha ;use stack to load status 178f : 28 > plp 1790 : a416 ldy zp1+3 1792 : 08 php ;test stores do not alter flags 1793 : 98 tya 1794 : 49c3 eor #$c3 1796 : a8 tay 1797 : 28 plp 1798 : 8c0602 sty abst+3 179b : 08 php ;flags after load/store sequence 179c : 49c3 eor #$c3 179e : a8 tay 179f : c000 cpy #0 ;test result trap_ne 17a1 : f003 > beq skip1132 > trap ;failed not equal (non zero) 17a3 : 205b44 > jsr report_error > 17a6 : >skip1132 17a6 : 68 pla ;load status eor_flag 0 17a7 : 4930 > eor #0|fao ;invert expected flags + always on bits 17a9 : cd1f02 cmp fLDx+3 ;test flags trap_ne 17ac : f003 > beq skip1135 > trap ;failed not equal (non zero) 17ae : 205b44 > jsr report_error > 17b1 : >skip1135 set_stat $ff > load_flag $ff 17b1 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 17b3 : 48 > pha ;use stack to load status 17b4 : 28 > plp 17b5 : a413 ldy zp1 17b7 : 08 php ;test stores do not alter flags 17b8 : 98 tya 17b9 : 49c3 eor #$c3 17bb : a8 tay 17bc : 28 plp 17bd : 8c0302 sty abst 17c0 : 08 php ;flags after load/store sequence 17c1 : 49c3 eor #$c3 17c3 : a8 tay 17c4 : c0c3 cpy #$c3 ;test result trap_ne 17c6 : f003 > beq skip1139 > trap ;failed not equal (non zero) 17c8 : 205b44 > jsr report_error > 17cb : >skip1139 17cb : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 17cc : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 17ce : cd1c02 cmp fLDx ;test flags trap_ne 17d1 : f003 > beq skip1142 > trap ;failed not equal (non zero) 17d3 : 205b44 > jsr report_error > 17d6 : >skip1142 set_stat $ff > load_flag $ff 17d6 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 17d8 : 48 > pha ;use stack to load status 17d9 : 28 > plp 17da : a414 ldy zp1+1 17dc : 08 php ;test stores do not alter flags 17dd : 98 tya 17de : 49c3 eor #$c3 17e0 : a8 tay 17e1 : 28 plp 17e2 : 8c0402 sty abst+1 17e5 : 08 php ;flags after load/store sequence 17e6 : 49c3 eor #$c3 17e8 : a8 tay 17e9 : c082 cpy #$82 ;test result trap_ne 17eb : f003 > beq skip1146 > trap ;failed not equal (non zero) 17ed : 205b44 > jsr report_error > 17f0 : >skip1146 17f0 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 17f1 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 17f3 : cd1d02 cmp fLDx+1 ;test flags trap_ne 17f6 : f003 > beq skip1149 > trap ;failed not equal (non zero) 17f8 : 205b44 > jsr report_error > 17fb : >skip1149 set_stat $ff > load_flag $ff 17fb : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 17fd : 48 > pha ;use stack to load status 17fe : 28 > plp 17ff : a415 ldy zp1+2 1801 : 08 php ;test stores do not alter flags 1802 : 98 tya 1803 : 49c3 eor #$c3 1805 : a8 tay 1806 : 28 plp 1807 : 8c0502 sty abst+2 180a : 08 php ;flags after load/store sequence 180b : 49c3 eor #$c3 180d : a8 tay 180e : c041 cpy #$41 ;test result trap_ne 1810 : f003 > beq skip1153 > trap ;failed not equal (non zero) 1812 : 205b44 > jsr report_error > 1815 : >skip1153 1815 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1816 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1818 : cd1e02 cmp fLDx+2 ;test flags trap_ne 181b : f003 > beq skip1156 > trap ;failed not equal (non zero) 181d : 205b44 > jsr report_error > 1820 : >skip1156 set_stat $ff > load_flag $ff 1820 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1822 : 48 > pha ;use stack to load status 1823 : 28 > plp 1824 : a416 ldy zp1+3 1826 : 08 php ;test stores do not alter flags 1827 : 98 tya 1828 : 49c3 eor #$c3 182a : a8 tay 182b : 28 plp 182c : 8c0602 sty abst+3 182f : 08 php ;flags after load/store sequence 1830 : 49c3 eor #$c3 1832 : a8 tay 1833 : c000 cpy #0 ;test result trap_ne 1835 : f003 > beq skip1160 > trap ;failed not equal (non zero) 1837 : 205b44 > jsr report_error > 183a : >skip1160 183a : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 183b : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 183d : cd1f02 cmp fLDx+3 ;test flags trap_ne 1840 : f003 > beq skip1163 > trap ;failed not equal (non zero) 1842 : 205b44 > jsr report_error > 1845 : >skip1163 set_stat 0 > load_flag 0 1845 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1847 : 48 > pha ;use stack to load status 1848 : 28 > plp 1849 : ac1702 ldy abs1 184c : 08 php ;test stores do not alter flags 184d : 98 tya 184e : 49c3 eor #$c3 1850 : a8 tay 1851 : 28 plp 1852 : 840c sty zpt 1854 : 08 php ;flags after load/store sequence 1855 : 49c3 eor #$c3 1857 : a8 tay 1858 : c413 cpy zp1 ;test result trap_ne 185a : f003 > beq skip1167 > trap ;failed not equal (non zero) 185c : 205b44 > jsr report_error > 185f : >skip1167 185f : 68 pla ;load status eor_flag 0 1860 : 4930 > eor #0|fao ;invert expected flags + always on bits 1862 : cd1c02 cmp fLDx ;test flags trap_ne 1865 : f003 > beq skip1170 > trap ;failed not equal (non zero) 1867 : 205b44 > jsr report_error > 186a : >skip1170 set_stat 0 > load_flag 0 186a : a900 > lda #0 ;allow test to change I-flag (no mask) > 186c : 48 > pha ;use stack to load status 186d : 28 > plp 186e : ac1802 ldy abs1+1 1871 : 08 php ;test stores do not alter flags 1872 : 98 tya 1873 : 49c3 eor #$c3 1875 : a8 tay 1876 : 28 plp 1877 : 840d sty zpt+1 1879 : 08 php ;flags after load/store sequence 187a : 49c3 eor #$c3 187c : a8 tay 187d : c414 cpy zp1+1 ;test result trap_ne 187f : f003 > beq skip1174 > trap ;failed not equal (non zero) 1881 : 205b44 > jsr report_error > 1884 : >skip1174 1884 : 68 pla ;load status eor_flag 0 1885 : 4930 > eor #0|fao ;invert expected flags + always on bits 1887 : cd1d02 cmp fLDx+1 ;test flags trap_ne 188a : f003 > beq skip1177 > trap ;failed not equal (non zero) 188c : 205b44 > jsr report_error > 188f : >skip1177 set_stat 0 > load_flag 0 188f : a900 > lda #0 ;allow test to change I-flag (no mask) > 1891 : 48 > pha ;use stack to load status 1892 : 28 > plp 1893 : ac1902 ldy abs1+2 1896 : 08 php ;test stores do not alter flags 1897 : 98 tya 1898 : 49c3 eor #$c3 189a : a8 tay 189b : 28 plp 189c : 840e sty zpt+2 189e : 08 php ;flags after load/store sequence 189f : 49c3 eor #$c3 18a1 : a8 tay 18a2 : c415 cpy zp1+2 ;test result trap_ne 18a4 : f003 > beq skip1181 > trap ;failed not equal (non zero) 18a6 : 205b44 > jsr report_error > 18a9 : >skip1181 18a9 : 68 pla ;load status eor_flag 0 18aa : 4930 > eor #0|fao ;invert expected flags + always on bits 18ac : cd1e02 cmp fLDx+2 ;test flags trap_ne 18af : f003 > beq skip1184 > trap ;failed not equal (non zero) 18b1 : 205b44 > jsr report_error > 18b4 : >skip1184 set_stat 0 > load_flag 0 18b4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 18b6 : 48 > pha ;use stack to load status 18b7 : 28 > plp 18b8 : ac1a02 ldy abs1+3 18bb : 08 php ;test stores do not alter flags 18bc : 98 tya 18bd : 49c3 eor #$c3 18bf : a8 tay 18c0 : 28 plp 18c1 : 840f sty zpt+3 18c3 : 08 php ;flags after load/store sequence 18c4 : 49c3 eor #$c3 18c6 : a8 tay 18c7 : c416 cpy zp1+3 ;test result trap_ne 18c9 : f003 > beq skip1188 > trap ;failed not equal (non zero) 18cb : 205b44 > jsr report_error > 18ce : >skip1188 18ce : 68 pla ;load status eor_flag 0 18cf : 4930 > eor #0|fao ;invert expected flags + always on bits 18d1 : cd1f02 cmp fLDx+3 ;test flags trap_ne 18d4 : f003 > beq skip1191 > trap ;failed not equal (non zero) 18d6 : 205b44 > jsr report_error > 18d9 : >skip1191 set_stat $ff > load_flag $ff 18d9 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 18db : 48 > pha ;use stack to load status 18dc : 28 > plp 18dd : ac1702 ldy abs1 18e0 : 08 php ;test stores do not alter flags 18e1 : 98 tya 18e2 : 49c3 eor #$c3 18e4 : a8 tay 18e5 : 28 plp 18e6 : 840c sty zpt 18e8 : 08 php ;flags after load/store sequence 18e9 : 49c3 eor #$c3 18eb : a8 tay 18ec : c513 cmp zp1 ;test result trap_ne 18ee : f003 > beq skip1195 > trap ;failed not equal (non zero) 18f0 : 205b44 > jsr report_error > 18f3 : >skip1195 18f3 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 18f4 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 18f6 : cd1c02 cmp fLDx ;test flags trap_ne 18f9 : f003 > beq skip1198 > trap ;failed not equal (non zero) 18fb : 205b44 > jsr report_error > 18fe : >skip1198 set_stat $ff > load_flag $ff 18fe : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1900 : 48 > pha ;use stack to load status 1901 : 28 > plp 1902 : ac1802 ldy abs1+1 1905 : 08 php ;test stores do not alter flags 1906 : 98 tya 1907 : 49c3 eor #$c3 1909 : a8 tay 190a : 28 plp 190b : 840d sty zpt+1 190d : 08 php ;flags after load/store sequence 190e : 49c3 eor #$c3 1910 : a8 tay 1911 : c514 cmp zp1+1 ;test result trap_ne 1913 : f003 > beq skip1202 > trap ;failed not equal (non zero) 1915 : 205b44 > jsr report_error > 1918 : >skip1202 1918 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1919 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 191b : cd1d02 cmp fLDx+1 ;test flags trap_ne 191e : f003 > beq skip1205 > trap ;failed not equal (non zero) 1920 : 205b44 > jsr report_error > 1923 : >skip1205 set_stat $ff > load_flag $ff 1923 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1925 : 48 > pha ;use stack to load status 1926 : 28 > plp 1927 : ac1902 ldy abs1+2 192a : 08 php ;test stores do not alter flags 192b : 98 tya 192c : 49c3 eor #$c3 192e : a8 tay 192f : 28 plp 1930 : 840e sty zpt+2 1932 : 08 php ;flags after load/store sequence 1933 : 49c3 eor #$c3 1935 : a8 tay 1936 : c515 cmp zp1+2 ;test result trap_ne 1938 : f003 > beq skip1209 > trap ;failed not equal (non zero) 193a : 205b44 > jsr report_error > 193d : >skip1209 193d : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 193e : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1940 : cd1e02 cmp fLDx+2 ;test flags trap_ne 1943 : f003 > beq skip1212 > trap ;failed not equal (non zero) 1945 : 205b44 > jsr report_error > 1948 : >skip1212 set_stat $ff > load_flag $ff 1948 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 194a : 48 > pha ;use stack to load status 194b : 28 > plp 194c : ac1a02 ldy abs1+3 194f : 08 php ;test stores do not alter flags 1950 : 98 tya 1951 : 49c3 eor #$c3 1953 : a8 tay 1954 : 28 plp 1955 : 840f sty zpt+3 1957 : 08 php ;flags after load/store sequence 1958 : 49c3 eor #$c3 195a : a8 tay 195b : c516 cmp zp1+3 ;test result trap_ne 195d : f003 > beq skip1216 > trap ;failed not equal (non zero) 195f : 205b44 > jsr report_error > 1962 : >skip1216 1962 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1963 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1965 : cd1f02 cmp fLDx+3 ;test flags trap_ne 1968 : f003 > beq skip1219 > trap ;failed not equal (non zero) 196a : 205b44 > jsr report_error > 196d : >skip1219 set_stat 0 > load_flag 0 196d : a900 > lda #0 ;allow test to change I-flag (no mask) > 196f : 48 > pha ;use stack to load status 1970 : 28 > plp 1971 : a0c3 ldy #$c3 1973 : 08 php 1974 : cc1702 cpy abs1 ;test result trap_ne 1977 : f003 > beq skip1223 > trap ;failed not equal (non zero) 1979 : 205b44 > jsr report_error > 197c : >skip1223 197c : 68 pla ;load status eor_flag 0 197d : 4930 > eor #0|fao ;invert expected flags + always on bits 197f : cd1c02 cmp fLDx ;test flags trap_ne 1982 : f003 > beq skip1226 > trap ;failed not equal (non zero) 1984 : 205b44 > jsr report_error > 1987 : >skip1226 set_stat 0 > load_flag 0 1987 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1989 : 48 > pha ;use stack to load status 198a : 28 > plp 198b : a082 ldy #$82 198d : 08 php 198e : cc1802 cpy abs1+1 ;test result trap_ne 1991 : f003 > beq skip1230 > trap ;failed not equal (non zero) 1993 : 205b44 > jsr report_error > 1996 : >skip1230 1996 : 68 pla ;load status eor_flag 0 1997 : 4930 > eor #0|fao ;invert expected flags + always on bits 1999 : cd1d02 cmp fLDx+1 ;test flags trap_ne 199c : f003 > beq skip1233 > trap ;failed not equal (non zero) 199e : 205b44 > jsr report_error > 19a1 : >skip1233 set_stat 0 > load_flag 0 19a1 : a900 > lda #0 ;allow test to change I-flag (no mask) > 19a3 : 48 > pha ;use stack to load status 19a4 : 28 > plp 19a5 : a041 ldy #$41 19a7 : 08 php 19a8 : cc1902 cpy abs1+2 ;test result trap_ne 19ab : f003 > beq skip1237 > trap ;failed not equal (non zero) 19ad : 205b44 > jsr report_error > 19b0 : >skip1237 19b0 : 68 pla ;load status eor_flag 0 19b1 : 4930 > eor #0|fao ;invert expected flags + always on bits 19b3 : cd1e02 cmp fLDx+2 ;test flags trap_ne 19b6 : f003 > beq skip1240 > trap ;failed not equal (non zero) 19b8 : 205b44 > jsr report_error > 19bb : >skip1240 set_stat 0 > load_flag 0 19bb : a900 > lda #0 ;allow test to change I-flag (no mask) > 19bd : 48 > pha ;use stack to load status 19be : 28 > plp 19bf : a000 ldy #0 19c1 : 08 php 19c2 : cc1a02 cpy abs1+3 ;test result trap_ne 19c5 : f003 > beq skip1244 > trap ;failed not equal (non zero) 19c7 : 205b44 > jsr report_error > 19ca : >skip1244 19ca : 68 pla ;load status eor_flag 0 19cb : 4930 > eor #0|fao ;invert expected flags + always on bits 19cd : cd1f02 cmp fLDx+3 ;test flags trap_ne 19d0 : f003 > beq skip1247 > trap ;failed not equal (non zero) 19d2 : 205b44 > jsr report_error > 19d5 : >skip1247 set_stat $ff > load_flag $ff 19d5 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 19d7 : 48 > pha ;use stack to load status 19d8 : 28 > plp 19d9 : a0c3 ldy #$c3 19db : 08 php 19dc : cc1702 cpy abs1 ;test result trap_ne 19df : f003 > beq skip1251 > trap ;failed not equal (non zero) 19e1 : 205b44 > jsr report_error > 19e4 : >skip1251 19e4 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 19e5 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 19e7 : cd1c02 cmp fLDx ;test flags trap_ne 19ea : f003 > beq skip1254 > trap ;failed not equal (non zero) 19ec : 205b44 > jsr report_error > 19ef : >skip1254 set_stat $ff > load_flag $ff 19ef : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 19f1 : 48 > pha ;use stack to load status 19f2 : 28 > plp 19f3 : a082 ldy #$82 19f5 : 08 php 19f6 : cc1802 cpy abs1+1 ;test result trap_ne 19f9 : f003 > beq skip1258 > trap ;failed not equal (non zero) 19fb : 205b44 > jsr report_error > 19fe : >skip1258 19fe : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 19ff : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1a01 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1a04 : f003 > beq skip1261 > trap ;failed not equal (non zero) 1a06 : 205b44 > jsr report_error > 1a09 : >skip1261 set_stat $ff > load_flag $ff 1a09 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1a0b : 48 > pha ;use stack to load status 1a0c : 28 > plp 1a0d : a041 ldy #$41 1a0f : 08 php 1a10 : cc1902 cpy abs1+2 ;test result trap_ne 1a13 : f003 > beq skip1265 > trap ;failed not equal (non zero) 1a15 : 205b44 > jsr report_error > 1a18 : >skip1265 1a18 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1a19 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1a1b : cd1e02 cmp fLDx+2 ;test flags trap_ne 1a1e : f003 > beq skip1268 > trap ;failed not equal (non zero) 1a20 : 205b44 > jsr report_error > 1a23 : >skip1268 set_stat $ff > load_flag $ff 1a23 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1a25 : 48 > pha ;use stack to load status 1a26 : 28 > plp 1a27 : a000 ldy #0 1a29 : 08 php 1a2a : cc1a02 cpy abs1+3 ;test result trap_ne 1a2d : f003 > beq skip1272 > trap ;failed not equal (non zero) 1a2f : 205b44 > jsr report_error > 1a32 : >skip1272 1a32 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1a33 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1a35 : cd1f02 cmp fLDx+3 ;test flags trap_ne 1a38 : f003 > beq skip1275 > trap ;failed not equal (non zero) 1a3a : 205b44 > jsr report_error > 1a3d : >skip1275 1a3d : a000 ldy #0 1a3f : a50c lda zpt 1a41 : 49c3 eor #$c3 1a43 : c513 cmp zp1 trap_ne ;store to zp data 1a45 : f003 > beq skip1277 > trap ;failed not equal (non zero) 1a47 : 205b44 > jsr report_error > 1a4a : >skip1277 1a4a : 840c sty zpt ;clear 1a4c : ad0302 lda abst 1a4f : 49c3 eor #$c3 1a51 : cd1702 cmp abs1 trap_ne ;store to abs data 1a54 : f003 > beq skip1279 > trap ;failed not equal (non zero) 1a56 : 205b44 > jsr report_error > 1a59 : >skip1279 1a59 : 8c0302 sty abst ;clear 1a5c : a50d lda zpt+1 1a5e : 49c3 eor #$c3 1a60 : c514 cmp zp1+1 trap_ne ;store to zp+1 data 1a62 : f003 > beq skip1281 > trap ;failed not equal (non zero) 1a64 : 205b44 > jsr report_error > 1a67 : >skip1281 1a67 : 840d sty zpt+1 ;clear 1a69 : ad0402 lda abst+1 1a6c : 49c3 eor #$c3 1a6e : cd1802 cmp abs1+1 trap_ne ;store to abs+1 data 1a71 : f003 > beq skip1283 > trap ;failed not equal (non zero) 1a73 : 205b44 > jsr report_error > 1a76 : >skip1283 1a76 : 8c0402 sty abst+1 ;clear 1a79 : a50e lda zpt+2 1a7b : 49c3 eor #$c3 1a7d : c515 cmp zp1+2 trap_ne ;store to zp+2 data 1a7f : f003 > beq skip1285 > trap ;failed not equal (non zero) 1a81 : 205b44 > jsr report_error > 1a84 : >skip1285 1a84 : 840e sty zpt+2 ;clear 1a86 : ad0502 lda abst+2 1a89 : 49c3 eor #$c3 1a8b : cd1902 cmp abs1+2 trap_ne ;store to abs+2 data 1a8e : f003 > beq skip1287 > trap ;failed not equal (non zero) 1a90 : 205b44 > jsr report_error > 1a93 : >skip1287 1a93 : 8c0502 sty abst+2 ;clear 1a96 : a50f lda zpt+3 1a98 : 49c3 eor #$c3 1a9a : c516 cmp zp1+3 trap_ne ;store to zp+3 data 1a9c : f003 > beq skip1289 > trap ;failed not equal (non zero) 1a9e : 205b44 > jsr report_error > 1aa1 : >skip1289 1aa1 : 840f sty zpt+3 ;clear 1aa3 : ad0602 lda abst+3 1aa6 : 49c3 eor #$c3 1aa8 : cd1a02 cmp abs1+3 trap_ne ;store to abs+3 data 1aab : f003 > beq skip1291 > trap ;failed not equal (non zero) 1aad : 205b44 > jsr report_error > 1ab0 : >skip1291 1ab0 : 8c0602 sty abst+3 ;clear next_test 1ab3 : ad0002 > lda test_case ;previous test 1ab6 : c914 > cmp #test_num > trap_ne ;test is out of sequence 1ab8 : f003 > beq skip1294 > trap ;failed not equal (non zero) 1aba : 205b44 > jsr report_error > 1abd : >skip1294 > 0015 = >test_num = test_num + 1 1abd : a915 > lda #test_num ;*** next tests' number 1abf : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; testing load / store accumulator LDA / STA all addressing modes ; LDA / STA - zp,x / abs,x 1ac2 : a203 ldx #3 1ac4 : tldax set_stat 0 > load_flag 0 1ac4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1ac6 : 48 > pha ;use stack to load status 1ac7 : 28 > plp 1ac8 : b513 lda zp1,x 1aca : 08 php ;test stores do not alter flags 1acb : 49c3 eor #$c3 1acd : 28 plp 1ace : 9d0302 sta abst,x 1ad1 : 08 php ;flags after load/store sequence 1ad2 : 49c3 eor #$c3 1ad4 : dd1702 cmp abs1,x ;test result trap_ne 1ad7 : f003 > beq skip1298 > trap ;failed not equal (non zero) 1ad9 : 205b44 > jsr report_error > 1adc : >skip1298 1adc : 68 pla ;load status eor_flag 0 1add : 4930 > eor #0|fao ;invert expected flags + always on bits 1adf : dd1c02 cmp fLDx,x ;test flags trap_ne 1ae2 : f003 > beq skip1301 > trap ;failed not equal (non zero) 1ae4 : 205b44 > jsr report_error > 1ae7 : >skip1301 1ae7 : ca dex 1ae8 : 10da bpl tldax 1aea : a203 ldx #3 1aec : tldax1 set_stat $ff > load_flag $ff 1aec : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1aee : 48 > pha ;use stack to load status 1aef : 28 > plp 1af0 : b513 lda zp1,x 1af2 : 08 php ;test stores do not alter flags 1af3 : 49c3 eor #$c3 1af5 : 28 plp 1af6 : 9d0302 sta abst,x 1af9 : 08 php ;flags after load/store sequence 1afa : 49c3 eor #$c3 1afc : dd1702 cmp abs1,x ;test result trap_ne 1aff : f003 > beq skip1305 > trap ;failed not equal (non zero) 1b01 : 205b44 > jsr report_error > 1b04 : >skip1305 1b04 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1b05 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1b07 : dd1c02 cmp fLDx,x ;test flags trap_ne 1b0a : f003 > beq skip1308 > trap ;failed not equal (non zero) 1b0c : 205b44 > jsr report_error > 1b0f : >skip1308 1b0f : ca dex 1b10 : 10da bpl tldax1 1b12 : a203 ldx #3 1b14 : tldax2 set_stat 0 > load_flag 0 1b14 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1b16 : 48 > pha ;use stack to load status 1b17 : 28 > plp 1b18 : bd1702 lda abs1,x 1b1b : 08 php ;test stores do not alter flags 1b1c : 49c3 eor #$c3 1b1e : 28 plp 1b1f : 950c sta zpt,x 1b21 : 08 php ;flags after load/store sequence 1b22 : 49c3 eor #$c3 1b24 : d513 cmp zp1,x ;test result trap_ne 1b26 : f003 > beq skip1312 > trap ;failed not equal (non zero) 1b28 : 205b44 > jsr report_error > 1b2b : >skip1312 1b2b : 68 pla ;load status eor_flag 0 1b2c : 4930 > eor #0|fao ;invert expected flags + always on bits 1b2e : dd1c02 cmp fLDx,x ;test flags trap_ne 1b31 : f003 > beq skip1315 > trap ;failed not equal (non zero) 1b33 : 205b44 > jsr report_error > 1b36 : >skip1315 1b36 : ca dex 1b37 : 10db bpl tldax2 1b39 : a203 ldx #3 1b3b : tldax3 set_stat $ff > load_flag $ff 1b3b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1b3d : 48 > pha ;use stack to load status 1b3e : 28 > plp 1b3f : bd1702 lda abs1,x 1b42 : 08 php ;test stores do not alter flags 1b43 : 49c3 eor #$c3 1b45 : 28 plp 1b46 : 950c sta zpt,x 1b48 : 08 php ;flags after load/store sequence 1b49 : 49c3 eor #$c3 1b4b : d513 cmp zp1,x ;test result trap_ne 1b4d : f003 > beq skip1319 > trap ;failed not equal (non zero) 1b4f : 205b44 > jsr report_error > 1b52 : >skip1319 1b52 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1b53 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1b55 : dd1c02 cmp fLDx,x ;test flags trap_ne 1b58 : f003 > beq skip1322 > trap ;failed not equal (non zero) 1b5a : 205b44 > jsr report_error > 1b5d : >skip1322 1b5d : ca dex 1b5e : 10db bpl tldax3 1b60 : a203 ldx #3 ;testing store result 1b62 : a000 ldy #0 1b64 : b50c tstax lda zpt,x 1b66 : 49c3 eor #$c3 1b68 : d513 cmp zp1,x trap_ne ;store to zp,x data 1b6a : f003 > beq skip1324 > trap ;failed not equal (non zero) 1b6c : 205b44 > jsr report_error > 1b6f : >skip1324 1b6f : 940c sty zpt,x ;clear 1b71 : bd0302 lda abst,x 1b74 : 49c3 eor #$c3 1b76 : dd1702 cmp abs1,x trap_ne ;store to abs,x data 1b79 : f003 > beq skip1326 > trap ;failed not equal (non zero) 1b7b : 205b44 > jsr report_error > 1b7e : >skip1326 1b7e : 8a txa 1b7f : 9d0302 sta abst,x ;clear 1b82 : ca dex 1b83 : 10df bpl tstax next_test 1b85 : ad0002 > lda test_case ;previous test 1b88 : c915 > cmp #test_num > trap_ne ;test is out of sequence 1b8a : f003 > beq skip1329 > trap ;failed not equal (non zero) 1b8c : 205b44 > jsr report_error > 1b8f : >skip1329 > 0016 = >test_num = test_num + 1 1b8f : a916 > lda #test_num ;*** next tests' number 1b91 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; LDA / STA - (zp),y / abs,y / (zp,x) 1b94 : a003 ldy #3 1b96 : tlday set_stat 0 > load_flag 0 1b96 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1b98 : 48 > pha ;use stack to load status 1b99 : 28 > plp 1b9a : b124 lda (ind1),y 1b9c : 08 php ;test stores do not alter flags 1b9d : 49c3 eor #$c3 1b9f : 28 plp 1ba0 : 990302 sta abst,y 1ba3 : 08 php ;flags after load/store sequence 1ba4 : 49c3 eor #$c3 1ba6 : d91702 cmp abs1,y ;test result trap_ne 1ba9 : f003 > beq skip1333 > trap ;failed not equal (non zero) 1bab : 205b44 > jsr report_error > 1bae : >skip1333 1bae : 68 pla ;load status eor_flag 0 1baf : 4930 > eor #0|fao ;invert expected flags + always on bits 1bb1 : d91c02 cmp fLDx,y ;test flags trap_ne 1bb4 : f003 > beq skip1336 > trap ;failed not equal (non zero) 1bb6 : 205b44 > jsr report_error > 1bb9 : >skip1336 1bb9 : 88 dey 1bba : 10da bpl tlday 1bbc : a003 ldy #3 1bbe : tlday1 set_stat $ff > load_flag $ff 1bbe : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1bc0 : 48 > pha ;use stack to load status 1bc1 : 28 > plp 1bc2 : b124 lda (ind1),y 1bc4 : 08 php ;test stores do not alter flags 1bc5 : 49c3 eor #$c3 1bc7 : 28 plp 1bc8 : 990302 sta abst,y 1bcb : 08 php ;flags after load/store sequence 1bcc : 49c3 eor #$c3 1bce : d91702 cmp abs1,y ;test result trap_ne 1bd1 : f003 > beq skip1340 > trap ;failed not equal (non zero) 1bd3 : 205b44 > jsr report_error > 1bd6 : >skip1340 1bd6 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1bd7 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1bd9 : d91c02 cmp fLDx,y ;test flags trap_ne 1bdc : f003 > beq skip1343 > trap ;failed not equal (non zero) 1bde : 205b44 > jsr report_error > 1be1 : >skip1343 1be1 : 88 dey 1be2 : 10da bpl tlday1 1be4 : a003 ldy #3 ;testing store result 1be6 : a200 ldx #0 1be8 : b90302 tstay lda abst,y 1beb : 49c3 eor #$c3 1bed : d91702 cmp abs1,y trap_ne ;store to abs data 1bf0 : f003 > beq skip1345 > trap ;failed not equal (non zero) 1bf2 : 205b44 > jsr report_error > 1bf5 : >skip1345 1bf5 : 8a txa 1bf6 : 990302 sta abst,y ;clear 1bf9 : 88 dey 1bfa : 10ec bpl tstay 1bfc : a003 ldy #3 1bfe : tlday2 set_stat 0 > load_flag 0 1bfe : a900 > lda #0 ;allow test to change I-flag (no mask) > 1c00 : 48 > pha ;use stack to load status 1c01 : 28 > plp 1c02 : b91702 lda abs1,y 1c05 : 08 php ;test stores do not alter flags 1c06 : 49c3 eor #$c3 1c08 : 28 plp 1c09 : 9130 sta (indt),y 1c0b : 08 php ;flags after load/store sequence 1c0c : 49c3 eor #$c3 1c0e : d124 cmp (ind1),y ;test result trap_ne 1c10 : f003 > beq skip1349 > trap ;failed not equal (non zero) 1c12 : 205b44 > jsr report_error > 1c15 : >skip1349 1c15 : 68 pla ;load status eor_flag 0 1c16 : 4930 > eor #0|fao ;invert expected flags + always on bits 1c18 : d91c02 cmp fLDx,y ;test flags trap_ne 1c1b : f003 > beq skip1352 > trap ;failed not equal (non zero) 1c1d : 205b44 > jsr report_error > 1c20 : >skip1352 1c20 : 88 dey 1c21 : 10db bpl tlday2 1c23 : a003 ldy #3 1c25 : tlday3 set_stat $ff > load_flag $ff 1c25 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1c27 : 48 > pha ;use stack to load status 1c28 : 28 > plp 1c29 : b91702 lda abs1,y 1c2c : 08 php ;test stores do not alter flags 1c2d : 49c3 eor #$c3 1c2f : 28 plp 1c30 : 9130 sta (indt),y 1c32 : 08 php ;flags after load/store sequence 1c33 : 49c3 eor #$c3 1c35 : d124 cmp (ind1),y ;test result trap_ne 1c37 : f003 > beq skip1356 > trap ;failed not equal (non zero) 1c39 : 205b44 > jsr report_error > 1c3c : >skip1356 1c3c : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1c3d : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1c3f : d91c02 cmp fLDx,y ;test flags trap_ne 1c42 : f003 > beq skip1359 > trap ;failed not equal (non zero) 1c44 : 205b44 > jsr report_error > 1c47 : >skip1359 1c47 : 88 dey 1c48 : 10db bpl tlday3 1c4a : a003 ldy #3 ;testing store result 1c4c : a200 ldx #0 1c4e : b90302 tstay1 lda abst,y 1c51 : 49c3 eor #$c3 1c53 : d91702 cmp abs1,y trap_ne ;store to abs data 1c56 : f003 > beq skip1361 > trap ;failed not equal (non zero) 1c58 : 205b44 > jsr report_error > 1c5b : >skip1361 1c5b : 8a txa 1c5c : 990302 sta abst,y ;clear 1c5f : 88 dey 1c60 : 10ec bpl tstay1 1c62 : a206 ldx #6 1c64 : a003 ldy #3 1c66 : tldax4 set_stat 0 > load_flag 0 1c66 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1c68 : 48 > pha ;use stack to load status 1c69 : 28 > plp 1c6a : a124 lda (ind1,x) 1c6c : 08 php ;test stores do not alter flags 1c6d : 49c3 eor #$c3 1c6f : 28 plp 1c70 : 8130 sta (indt,x) 1c72 : 08 php ;flags after load/store sequence 1c73 : 49c3 eor #$c3 1c75 : d91702 cmp abs1,y ;test result trap_ne 1c78 : f003 > beq skip1365 > trap ;failed not equal (non zero) 1c7a : 205b44 > jsr report_error > 1c7d : >skip1365 1c7d : 68 pla ;load status eor_flag 0 1c7e : 4930 > eor #0|fao ;invert expected flags + always on bits 1c80 : d91c02 cmp fLDx,y ;test flags trap_ne 1c83 : f003 > beq skip1368 > trap ;failed not equal (non zero) 1c85 : 205b44 > jsr report_error > 1c88 : >skip1368 1c88 : ca dex 1c89 : ca dex 1c8a : 88 dey 1c8b : 10d9 bpl tldax4 1c8d : a206 ldx #6 1c8f : a003 ldy #3 1c91 : tldax5 set_stat $ff > load_flag $ff 1c91 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1c93 : 48 > pha ;use stack to load status 1c94 : 28 > plp 1c95 : a124 lda (ind1,x) 1c97 : 08 php ;test stores do not alter flags 1c98 : 49c3 eor #$c3 1c9a : 28 plp 1c9b : 8130 sta (indt,x) 1c9d : 08 php ;flags after load/store sequence 1c9e : 49c3 eor #$c3 1ca0 : d91702 cmp abs1,y ;test result trap_ne 1ca3 : f003 > beq skip1372 > trap ;failed not equal (non zero) 1ca5 : 205b44 > jsr report_error > 1ca8 : >skip1372 1ca8 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1ca9 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1cab : d91c02 cmp fLDx,y ;test flags trap_ne 1cae : f003 > beq skip1375 > trap ;failed not equal (non zero) 1cb0 : 205b44 > jsr report_error > 1cb3 : >skip1375 1cb3 : ca dex 1cb4 : ca dex 1cb5 : 88 dey 1cb6 : 10d9 bpl tldax5 1cb8 : a003 ldy #3 ;testing store result 1cba : a200 ldx #0 1cbc : b90302 tstay2 lda abst,y 1cbf : 49c3 eor #$c3 1cc1 : d91702 cmp abs1,y trap_ne ;store to abs data 1cc4 : f003 > beq skip1377 > trap ;failed not equal (non zero) 1cc6 : 205b44 > jsr report_error > 1cc9 : >skip1377 1cc9 : 8a txa 1cca : 990302 sta abst,y ;clear 1ccd : 88 dey 1cce : 10ec bpl tstay2 next_test 1cd0 : ad0002 > lda test_case ;previous test 1cd3 : c916 > cmp #test_num > trap_ne ;test is out of sequence 1cd5 : f003 > beq skip1380 > trap ;failed not equal (non zero) 1cd7 : 205b44 > jsr report_error > 1cda : >skip1380 > 0017 = >test_num = test_num + 1 1cda : a917 > lda #test_num ;*** next tests' number 1cdc : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; indexed wraparound test (only zp should wrap) 1cdf : a2fd ldx #3+$fa 1ce1 : b519 tldax6 lda zp1-$fa&$ff,x ;wrap on indexed zp 1ce3 : 9d0901 sta abst-$fa,x ;no STX abs,x! 1ce6 : ca dex 1ce7 : e0fa cpx #$fa 1ce9 : b0f6 bcs tldax6 1ceb : a2fd ldx #3+$fa 1ced : bd1d01 tldax7 lda abs1-$fa,x ;no wrap on indexed abs 1cf0 : 9512 sta zpt-$fa&$ff,x 1cf2 : ca dex 1cf3 : e0fa cpx #$fa 1cf5 : b0f6 bcs tldax7 1cf7 : a203 ldx #3 ;testing wraparound result 1cf9 : a000 ldy #0 1cfb : b50c tstax1 lda zpt,x 1cfd : d513 cmp zp1,x trap_ne ;store to zp,x data 1cff : f003 > beq skip1382 > trap ;failed not equal (non zero) 1d01 : 205b44 > jsr report_error > 1d04 : >skip1382 1d04 : 940c sty zpt,x ;clear 1d06 : bd0302 lda abst,x 1d09 : dd1702 cmp abs1,x trap_ne ;store to abs,x data 1d0c : f003 > beq skip1384 > trap ;failed not equal (non zero) 1d0e : 205b44 > jsr report_error > 1d11 : >skip1384 1d11 : 8a txa 1d12 : 9d0302 sta abst,x ;clear 1d15 : ca dex 1d16 : 10e3 bpl tstax1 1d18 : a0fb ldy #3+$f8 1d1a : a2fe ldx #6+$f8 1d1c : a12c tlday4 lda (ind1-$f8&$ff,x) ;wrap on indexed zp indirect 1d1e : 990b01 sta abst-$f8,y 1d21 : ca dex 1d22 : ca dex 1d23 : 88 dey 1d24 : c0f8 cpy #$f8 1d26 : b0f4 bcs tlday4 1d28 : a003 ldy #3 ;testing wraparound result 1d2a : a200 ldx #0 1d2c : b90302 tstay4 lda abst,y 1d2f : d91702 cmp abs1,y trap_ne ;store to abs data 1d32 : f003 > beq skip1386 > trap ;failed not equal (non zero) 1d34 : 205b44 > jsr report_error > 1d37 : >skip1386 1d37 : 8a txa 1d38 : 990302 sta abst,y ;clear 1d3b : 88 dey 1d3c : 10ee bpl tstay4 1d3e : a0fb ldy #3+$f8 1d40 : b91f01 tlday5 lda abs1-$f8,y ;no wrap on indexed abs 1d43 : 9138 sta (inwt),y 1d45 : 88 dey 1d46 : c0f8 cpy #$f8 1d48 : b0f6 bcs tlday5 1d4a : a003 ldy #3 ;testing wraparound result 1d4c : a200 ldx #0 1d4e : b90302 tstay5 lda abst,y 1d51 : d91702 cmp abs1,y trap_ne ;store to abs data 1d54 : f003 > beq skip1388 > trap ;failed not equal (non zero) 1d56 : 205b44 > jsr report_error > 1d59 : >skip1388 1d59 : 8a txa 1d5a : 990302 sta abst,y ;clear 1d5d : 88 dey 1d5e : 10ee bpl tstay5 1d60 : a0fb ldy #3+$f8 1d62 : a2fe ldx #6+$f8 1d64 : b12e tlday6 lda (inw1),y ;no wrap on zp indirect indexed 1d66 : 8138 sta (indt-$f8&$ff,x) 1d68 : ca dex 1d69 : ca dex 1d6a : 88 dey 1d6b : c0f8 cpy #$f8 1d6d : b0f5 bcs tlday6 1d6f : a003 ldy #3 ;testing wraparound result 1d71 : a200 ldx #0 1d73 : b90302 tstay6 lda abst,y 1d76 : d91702 cmp abs1,y trap_ne ;store to abs data 1d79 : f003 > beq skip1390 > trap ;failed not equal (non zero) 1d7b : 205b44 > jsr report_error > 1d7e : >skip1390 1d7e : 8a txa 1d7f : 990302 sta abst,y ;clear 1d82 : 88 dey 1d83 : 10ee bpl tstay6 next_test 1d85 : ad0002 > lda test_case ;previous test 1d88 : c917 > cmp #test_num > trap_ne ;test is out of sequence 1d8a : f003 > beq skip1393 > trap ;failed not equal (non zero) 1d8c : 205b44 > jsr report_error > 1d8f : >skip1393 > 0018 = >test_num = test_num + 1 1d8f : a918 > lda #test_num ;*** next tests' number 1d91 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; LDA / STA - zp / abs / # set_stat 0 > load_flag 0 1d94 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1d96 : 48 > pha ;use stack to load status 1d97 : 28 > plp 1d98 : a513 lda zp1 1d9a : 08 php ;test stores do not alter flags 1d9b : 49c3 eor #$c3 1d9d : 28 plp 1d9e : 8d0302 sta abst 1da1 : 08 php ;flags after load/store sequence 1da2 : 49c3 eor #$c3 1da4 : c9c3 cmp #$c3 ;test result trap_ne 1da6 : f003 > beq skip1397 > trap ;failed not equal (non zero) 1da8 : 205b44 > jsr report_error > 1dab : >skip1397 1dab : 68 pla ;load status eor_flag 0 1dac : 4930 > eor #0|fao ;invert expected flags + always on bits 1dae : cd1c02 cmp fLDx ;test flags trap_ne 1db1 : f003 > beq skip1400 > trap ;failed not equal (non zero) 1db3 : 205b44 > jsr report_error > 1db6 : >skip1400 set_stat 0 > load_flag 0 1db6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1db8 : 48 > pha ;use stack to load status 1db9 : 28 > plp 1dba : a514 lda zp1+1 1dbc : 08 php ;test stores do not alter flags 1dbd : 49c3 eor #$c3 1dbf : 28 plp 1dc0 : 8d0402 sta abst+1 1dc3 : 08 php ;flags after load/store sequence 1dc4 : 49c3 eor #$c3 1dc6 : c982 cmp #$82 ;test result trap_ne 1dc8 : f003 > beq skip1404 > trap ;failed not equal (non zero) 1dca : 205b44 > jsr report_error > 1dcd : >skip1404 1dcd : 68 pla ;load status eor_flag 0 1dce : 4930 > eor #0|fao ;invert expected flags + always on bits 1dd0 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1dd3 : f003 > beq skip1407 > trap ;failed not equal (non zero) 1dd5 : 205b44 > jsr report_error > 1dd8 : >skip1407 set_stat 0 > load_flag 0 1dd8 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1dda : 48 > pha ;use stack to load status 1ddb : 28 > plp 1ddc : a515 lda zp1+2 1dde : 08 php ;test stores do not alter flags 1ddf : 49c3 eor #$c3 1de1 : 28 plp 1de2 : 8d0502 sta abst+2 1de5 : 08 php ;flags after load/store sequence 1de6 : 49c3 eor #$c3 1de8 : c941 cmp #$41 ;test result trap_ne 1dea : f003 > beq skip1411 > trap ;failed not equal (non zero) 1dec : 205b44 > jsr report_error > 1def : >skip1411 1def : 68 pla ;load status eor_flag 0 1df0 : 4930 > eor #0|fao ;invert expected flags + always on bits 1df2 : cd1e02 cmp fLDx+2 ;test flags trap_ne 1df5 : f003 > beq skip1414 > trap ;failed not equal (non zero) 1df7 : 205b44 > jsr report_error > 1dfa : >skip1414 set_stat 0 > load_flag 0 1dfa : a900 > lda #0 ;allow test to change I-flag (no mask) > 1dfc : 48 > pha ;use stack to load status 1dfd : 28 > plp 1dfe : a516 lda zp1+3 1e00 : 08 php ;test stores do not alter flags 1e01 : 49c3 eor #$c3 1e03 : 28 plp 1e04 : 8d0602 sta abst+3 1e07 : 08 php ;flags after load/store sequence 1e08 : 49c3 eor #$c3 1e0a : c900 cmp #0 ;test result trap_ne 1e0c : f003 > beq skip1418 > trap ;failed not equal (non zero) 1e0e : 205b44 > jsr report_error > 1e11 : >skip1418 1e11 : 68 pla ;load status eor_flag 0 1e12 : 4930 > eor #0|fao ;invert expected flags + always on bits 1e14 : cd1f02 cmp fLDx+3 ;test flags trap_ne 1e17 : f003 > beq skip1421 > trap ;failed not equal (non zero) 1e19 : 205b44 > jsr report_error > 1e1c : >skip1421 set_stat $ff > load_flag $ff 1e1c : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1e1e : 48 > pha ;use stack to load status 1e1f : 28 > plp 1e20 : a513 lda zp1 1e22 : 08 php ;test stores do not alter flags 1e23 : 49c3 eor #$c3 1e25 : 28 plp 1e26 : 8d0302 sta abst 1e29 : 08 php ;flags after load/store sequence 1e2a : 49c3 eor #$c3 1e2c : c9c3 cmp #$c3 ;test result trap_ne 1e2e : f003 > beq skip1425 > trap ;failed not equal (non zero) 1e30 : 205b44 > jsr report_error > 1e33 : >skip1425 1e33 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1e34 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1e36 : cd1c02 cmp fLDx ;test flags trap_ne 1e39 : f003 > beq skip1428 > trap ;failed not equal (non zero) 1e3b : 205b44 > jsr report_error > 1e3e : >skip1428 set_stat $ff > load_flag $ff 1e3e : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1e40 : 48 > pha ;use stack to load status 1e41 : 28 > plp 1e42 : a514 lda zp1+1 1e44 : 08 php ;test stores do not alter flags 1e45 : 49c3 eor #$c3 1e47 : 28 plp 1e48 : 8d0402 sta abst+1 1e4b : 08 php ;flags after load/store sequence 1e4c : 49c3 eor #$c3 1e4e : c982 cmp #$82 ;test result trap_ne 1e50 : f003 > beq skip1432 > trap ;failed not equal (non zero) 1e52 : 205b44 > jsr report_error > 1e55 : >skip1432 1e55 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1e56 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1e58 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1e5b : f003 > beq skip1435 > trap ;failed not equal (non zero) 1e5d : 205b44 > jsr report_error > 1e60 : >skip1435 set_stat $ff > load_flag $ff 1e60 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1e62 : 48 > pha ;use stack to load status 1e63 : 28 > plp 1e64 : a515 lda zp1+2 1e66 : 08 php ;test stores do not alter flags 1e67 : 49c3 eor #$c3 1e69 : 28 plp 1e6a : 8d0502 sta abst+2 1e6d : 08 php ;flags after load/store sequence 1e6e : 49c3 eor #$c3 1e70 : c941 cmp #$41 ;test result trap_ne 1e72 : f003 > beq skip1439 > trap ;failed not equal (non zero) 1e74 : 205b44 > jsr report_error > 1e77 : >skip1439 1e77 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1e78 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1e7a : cd1e02 cmp fLDx+2 ;test flags trap_ne 1e7d : f003 > beq skip1442 > trap ;failed not equal (non zero) 1e7f : 205b44 > jsr report_error > 1e82 : >skip1442 set_stat $ff > load_flag $ff 1e82 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1e84 : 48 > pha ;use stack to load status 1e85 : 28 > plp 1e86 : a516 lda zp1+3 1e88 : 08 php ;test stores do not alter flags 1e89 : 49c3 eor #$c3 1e8b : 28 plp 1e8c : 8d0602 sta abst+3 1e8f : 08 php ;flags after load/store sequence 1e90 : 49c3 eor #$c3 1e92 : c900 cmp #0 ;test result trap_ne 1e94 : f003 > beq skip1446 > trap ;failed not equal (non zero) 1e96 : 205b44 > jsr report_error > 1e99 : >skip1446 1e99 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1e9a : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1e9c : cd1f02 cmp fLDx+3 ;test flags trap_ne 1e9f : f003 > beq skip1449 > trap ;failed not equal (non zero) 1ea1 : 205b44 > jsr report_error > 1ea4 : >skip1449 set_stat 0 > load_flag 0 1ea4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1ea6 : 48 > pha ;use stack to load status 1ea7 : 28 > plp 1ea8 : ad1702 lda abs1 1eab : 08 php ;test stores do not alter flags 1eac : 49c3 eor #$c3 1eae : 28 plp 1eaf : 850c sta zpt 1eb1 : 08 php ;flags after load/store sequence 1eb2 : 49c3 eor #$c3 1eb4 : c513 cmp zp1 ;test result trap_ne 1eb6 : f003 > beq skip1453 > trap ;failed not equal (non zero) 1eb8 : 205b44 > jsr report_error > 1ebb : >skip1453 1ebb : 68 pla ;load status eor_flag 0 1ebc : 4930 > eor #0|fao ;invert expected flags + always on bits 1ebe : cd1c02 cmp fLDx ;test flags trap_ne 1ec1 : f003 > beq skip1456 > trap ;failed not equal (non zero) 1ec3 : 205b44 > jsr report_error > 1ec6 : >skip1456 set_stat 0 > load_flag 0 1ec6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1ec8 : 48 > pha ;use stack to load status 1ec9 : 28 > plp 1eca : ad1802 lda abs1+1 1ecd : 08 php ;test stores do not alter flags 1ece : 49c3 eor #$c3 1ed0 : 28 plp 1ed1 : 850d sta zpt+1 1ed3 : 08 php ;flags after load/store sequence 1ed4 : 49c3 eor #$c3 1ed6 : c514 cmp zp1+1 ;test result trap_ne 1ed8 : f003 > beq skip1460 > trap ;failed not equal (non zero) 1eda : 205b44 > jsr report_error > 1edd : >skip1460 1edd : 68 pla ;load status eor_flag 0 1ede : 4930 > eor #0|fao ;invert expected flags + always on bits 1ee0 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1ee3 : f003 > beq skip1463 > trap ;failed not equal (non zero) 1ee5 : 205b44 > jsr report_error > 1ee8 : >skip1463 set_stat 0 > load_flag 0 1ee8 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1eea : 48 > pha ;use stack to load status 1eeb : 28 > plp 1eec : ad1902 lda abs1+2 1eef : 08 php ;test stores do not alter flags 1ef0 : 49c3 eor #$c3 1ef2 : 28 plp 1ef3 : 850e sta zpt+2 1ef5 : 08 php ;flags after load/store sequence 1ef6 : 49c3 eor #$c3 1ef8 : c515 cmp zp1+2 ;test result trap_ne 1efa : f003 > beq skip1467 > trap ;failed not equal (non zero) 1efc : 205b44 > jsr report_error > 1eff : >skip1467 1eff : 68 pla ;load status eor_flag 0 1f00 : 4930 > eor #0|fao ;invert expected flags + always on bits 1f02 : cd1e02 cmp fLDx+2 ;test flags trap_ne 1f05 : f003 > beq skip1470 > trap ;failed not equal (non zero) 1f07 : 205b44 > jsr report_error > 1f0a : >skip1470 set_stat 0 > load_flag 0 1f0a : a900 > lda #0 ;allow test to change I-flag (no mask) > 1f0c : 48 > pha ;use stack to load status 1f0d : 28 > plp 1f0e : ad1a02 lda abs1+3 1f11 : 08 php ;test stores do not alter flags 1f12 : 49c3 eor #$c3 1f14 : 28 plp 1f15 : 850f sta zpt+3 1f17 : 08 php ;flags after load/store sequence 1f18 : 49c3 eor #$c3 1f1a : c516 cmp zp1+3 ;test result trap_ne 1f1c : f003 > beq skip1474 > trap ;failed not equal (non zero) 1f1e : 205b44 > jsr report_error > 1f21 : >skip1474 1f21 : 68 pla ;load status eor_flag 0 1f22 : 4930 > eor #0|fao ;invert expected flags + always on bits 1f24 : cd1f02 cmp fLDx+3 ;test flags trap_ne 1f27 : f003 > beq skip1477 > trap ;failed not equal (non zero) 1f29 : 205b44 > jsr report_error > 1f2c : >skip1477 set_stat $ff > load_flag $ff 1f2c : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1f2e : 48 > pha ;use stack to load status 1f2f : 28 > plp 1f30 : ad1702 lda abs1 1f33 : 08 php ;test stores do not alter flags 1f34 : 49c3 eor #$c3 1f36 : 28 plp 1f37 : 850c sta zpt 1f39 : 08 php ;flags after load/store sequence 1f3a : 49c3 eor #$c3 1f3c : c513 cmp zp1 ;test result trap_ne 1f3e : f003 > beq skip1481 > trap ;failed not equal (non zero) 1f40 : 205b44 > jsr report_error > 1f43 : >skip1481 1f43 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1f44 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1f46 : cd1c02 cmp fLDx ;test flags trap_ne 1f49 : f003 > beq skip1484 > trap ;failed not equal (non zero) 1f4b : 205b44 > jsr report_error > 1f4e : >skip1484 set_stat $ff > load_flag $ff 1f4e : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1f50 : 48 > pha ;use stack to load status 1f51 : 28 > plp 1f52 : ad1802 lda abs1+1 1f55 : 08 php ;test stores do not alter flags 1f56 : 49c3 eor #$c3 1f58 : 28 plp 1f59 : 850d sta zpt+1 1f5b : 08 php ;flags after load/store sequence 1f5c : 49c3 eor #$c3 1f5e : c514 cmp zp1+1 ;test result trap_ne 1f60 : f003 > beq skip1488 > trap ;failed not equal (non zero) 1f62 : 205b44 > jsr report_error > 1f65 : >skip1488 1f65 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1f66 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1f68 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1f6b : f003 > beq skip1491 > trap ;failed not equal (non zero) 1f6d : 205b44 > jsr report_error > 1f70 : >skip1491 set_stat $ff > load_flag $ff 1f70 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1f72 : 48 > pha ;use stack to load status 1f73 : 28 > plp 1f74 : ad1902 lda abs1+2 1f77 : 08 php ;test stores do not alter flags 1f78 : 49c3 eor #$c3 1f7a : 28 plp 1f7b : 850e sta zpt+2 1f7d : 08 php ;flags after load/store sequence 1f7e : 49c3 eor #$c3 1f80 : c515 cmp zp1+2 ;test result trap_ne 1f82 : f003 > beq skip1495 > trap ;failed not equal (non zero) 1f84 : 205b44 > jsr report_error > 1f87 : >skip1495 1f87 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1f88 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1f8a : cd1e02 cmp fLDx+2 ;test flags trap_ne 1f8d : f003 > beq skip1498 > trap ;failed not equal (non zero) 1f8f : 205b44 > jsr report_error > 1f92 : >skip1498 set_stat $ff > load_flag $ff 1f92 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 1f94 : 48 > pha ;use stack to load status 1f95 : 28 > plp 1f96 : ad1a02 lda abs1+3 1f99 : 08 php ;test stores do not alter flags 1f9a : 49c3 eor #$c3 1f9c : 28 plp 1f9d : 850f sta zpt+3 1f9f : 08 php ;flags after load/store sequence 1fa0 : 49c3 eor #$c3 1fa2 : c516 cmp zp1+3 ;test result trap_ne 1fa4 : f003 > beq skip1502 > trap ;failed not equal (non zero) 1fa6 : 205b44 > jsr report_error > 1fa9 : >skip1502 1fa9 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 1faa : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 1fac : cd1f02 cmp fLDx+3 ;test flags trap_ne 1faf : f003 > beq skip1505 > trap ;failed not equal (non zero) 1fb1 : 205b44 > jsr report_error > 1fb4 : >skip1505 set_stat 0 > load_flag 0 1fb4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1fb6 : 48 > pha ;use stack to load status 1fb7 : 28 > plp 1fb8 : a9c3 lda #$c3 1fba : 08 php 1fbb : cd1702 cmp abs1 ;test result trap_ne 1fbe : f003 > beq skip1509 > trap ;failed not equal (non zero) 1fc0 : 205b44 > jsr report_error > 1fc3 : >skip1509 1fc3 : 68 pla ;load status eor_flag 0 1fc4 : 4930 > eor #0|fao ;invert expected flags + always on bits 1fc6 : cd1c02 cmp fLDx ;test flags trap_ne 1fc9 : f003 > beq skip1512 > trap ;failed not equal (non zero) 1fcb : 205b44 > jsr report_error > 1fce : >skip1512 set_stat 0 > load_flag 0 1fce : a900 > lda #0 ;allow test to change I-flag (no mask) > 1fd0 : 48 > pha ;use stack to load status 1fd1 : 28 > plp 1fd2 : a982 lda #$82 1fd4 : 08 php 1fd5 : cd1802 cmp abs1+1 ;test result trap_ne 1fd8 : f003 > beq skip1516 > trap ;failed not equal (non zero) 1fda : 205b44 > jsr report_error > 1fdd : >skip1516 1fdd : 68 pla ;load status eor_flag 0 1fde : 4930 > eor #0|fao ;invert expected flags + always on bits 1fe0 : cd1d02 cmp fLDx+1 ;test flags trap_ne 1fe3 : f003 > beq skip1519 > trap ;failed not equal (non zero) 1fe5 : 205b44 > jsr report_error > 1fe8 : >skip1519 set_stat 0 > load_flag 0 1fe8 : a900 > lda #0 ;allow test to change I-flag (no mask) > 1fea : 48 > pha ;use stack to load status 1feb : 28 > plp 1fec : a941 lda #$41 1fee : 08 php 1fef : cd1902 cmp abs1+2 ;test result trap_ne 1ff2 : f003 > beq skip1523 > trap ;failed not equal (non zero) 1ff4 : 205b44 > jsr report_error > 1ff7 : >skip1523 1ff7 : 68 pla ;load status eor_flag 0 1ff8 : 4930 > eor #0|fao ;invert expected flags + always on bits 1ffa : cd1e02 cmp fLDx+2 ;test flags trap_ne 1ffd : f003 > beq skip1526 > trap ;failed not equal (non zero) 1fff : 205b44 > jsr report_error > 2002 : >skip1526 set_stat 0 > load_flag 0 2002 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2004 : 48 > pha ;use stack to load status 2005 : 28 > plp 2006 : a900 lda #0 2008 : 08 php 2009 : cd1a02 cmp abs1+3 ;test result trap_ne 200c : f003 > beq skip1530 > trap ;failed not equal (non zero) 200e : 205b44 > jsr report_error > 2011 : >skip1530 2011 : 68 pla ;load status eor_flag 0 2012 : 4930 > eor #0|fao ;invert expected flags + always on bits 2014 : cd1f02 cmp fLDx+3 ;test flags trap_ne 2017 : f003 > beq skip1533 > trap ;failed not equal (non zero) 2019 : 205b44 > jsr report_error > 201c : >skip1533 set_stat $ff > load_flag $ff 201c : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 201e : 48 > pha ;use stack to load status 201f : 28 > plp 2020 : a9c3 lda #$c3 2022 : 08 php 2023 : cd1702 cmp abs1 ;test result trap_ne 2026 : f003 > beq skip1537 > trap ;failed not equal (non zero) 2028 : 205b44 > jsr report_error > 202b : >skip1537 202b : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 202c : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 202e : cd1c02 cmp fLDx ;test flags trap_ne 2031 : f003 > beq skip1540 > trap ;failed not equal (non zero) 2033 : 205b44 > jsr report_error > 2036 : >skip1540 set_stat $ff > load_flag $ff 2036 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2038 : 48 > pha ;use stack to load status 2039 : 28 > plp 203a : a982 lda #$82 203c : 08 php 203d : cd1802 cmp abs1+1 ;test result trap_ne 2040 : f003 > beq skip1544 > trap ;failed not equal (non zero) 2042 : 205b44 > jsr report_error > 2045 : >skip1544 2045 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 2046 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 2048 : cd1d02 cmp fLDx+1 ;test flags trap_ne 204b : f003 > beq skip1547 > trap ;failed not equal (non zero) 204d : 205b44 > jsr report_error > 2050 : >skip1547 set_stat $ff > load_flag $ff 2050 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2052 : 48 > pha ;use stack to load status 2053 : 28 > plp 2054 : a941 lda #$41 2056 : 08 php 2057 : cd1902 cmp abs1+2 ;test result trap_ne 205a : f003 > beq skip1551 > trap ;failed not equal (non zero) 205c : 205b44 > jsr report_error > 205f : >skip1551 205f : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 2060 : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 2062 : cd1e02 cmp fLDx+2 ;test flags trap_ne 2065 : f003 > beq skip1554 > trap ;failed not equal (non zero) 2067 : 205b44 > jsr report_error > 206a : >skip1554 set_stat $ff > load_flag $ff 206a : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 206c : 48 > pha ;use stack to load status 206d : 28 > plp 206e : a900 lda #0 2070 : 08 php 2071 : cd1a02 cmp abs1+3 ;test result trap_ne 2074 : f003 > beq skip1558 > trap ;failed not equal (non zero) 2076 : 205b44 > jsr report_error > 2079 : >skip1558 2079 : 68 pla ;load status eor_flag lo~fnz ;mask bits not altered 207a : 497d > eor #lo~fnz |fao ;invert expected flags + always on bits 207c : cd1f02 cmp fLDx+3 ;test flags trap_ne 207f : f003 > beq skip1561 > trap ;failed not equal (non zero) 2081 : 205b44 > jsr report_error > 2084 : >skip1561 2084 : a200 ldx #0 2086 : a50c lda zpt 2088 : 49c3 eor #$c3 208a : c513 cmp zp1 trap_ne ;store to zp data 208c : f003 > beq skip1563 > trap ;failed not equal (non zero) 208e : 205b44 > jsr report_error > 2091 : >skip1563 2091 : 860c stx zpt ;clear 2093 : ad0302 lda abst 2096 : 49c3 eor #$c3 2098 : cd1702 cmp abs1 trap_ne ;store to abs data 209b : f003 > beq skip1565 > trap ;failed not equal (non zero) 209d : 205b44 > jsr report_error > 20a0 : >skip1565 20a0 : 8e0302 stx abst ;clear 20a3 : a50d lda zpt+1 20a5 : 49c3 eor #$c3 20a7 : c514 cmp zp1+1 trap_ne ;store to zp data 20a9 : f003 > beq skip1567 > trap ;failed not equal (non zero) 20ab : 205b44 > jsr report_error > 20ae : >skip1567 20ae : 860d stx zpt+1 ;clear 20b0 : ad0402 lda abst+1 20b3 : 49c3 eor #$c3 20b5 : cd1802 cmp abs1+1 trap_ne ;store to abs data 20b8 : f003 > beq skip1569 > trap ;failed not equal (non zero) 20ba : 205b44 > jsr report_error > 20bd : >skip1569 20bd : 8e0402 stx abst+1 ;clear 20c0 : a50e lda zpt+2 20c2 : 49c3 eor #$c3 20c4 : c515 cmp zp1+2 trap_ne ;store to zp data 20c6 : f003 > beq skip1571 > trap ;failed not equal (non zero) 20c8 : 205b44 > jsr report_error > 20cb : >skip1571 20cb : 860e stx zpt+2 ;clear 20cd : ad0502 lda abst+2 20d0 : 49c3 eor #$c3 20d2 : cd1902 cmp abs1+2 trap_ne ;store to abs data 20d5 : f003 > beq skip1573 > trap ;failed not equal (non zero) 20d7 : 205b44 > jsr report_error > 20da : >skip1573 20da : 8e0502 stx abst+2 ;clear 20dd : a50f lda zpt+3 20df : 49c3 eor #$c3 20e1 : c516 cmp zp1+3 trap_ne ;store to zp data 20e3 : f003 > beq skip1575 > trap ;failed not equal (non zero) 20e5 : 205b44 > jsr report_error > 20e8 : >skip1575 20e8 : 860f stx zpt+3 ;clear 20ea : ad0602 lda abst+3 20ed : 49c3 eor #$c3 20ef : cd1a02 cmp abs1+3 trap_ne ;store to abs data 20f2 : f003 > beq skip1577 > trap ;failed not equal (non zero) 20f4 : 205b44 > jsr report_error > 20f7 : >skip1577 20f7 : 8e0602 stx abst+3 ;clear next_test 20fa : ad0002 > lda test_case ;previous test 20fd : c918 > cmp #test_num > trap_ne ;test is out of sequence 20ff : f003 > beq skip1580 > trap ;failed not equal (non zero) 2101 : 205b44 > jsr report_error > 2104 : >skip1580 > 0019 = >test_num = test_num + 1 2104 : a919 > lda #test_num ;*** next tests' number 2106 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; testing bit test & compares BIT CPX CPY CMP all addressing modes ; BIT - zp / abs set_a $ff,0 > load_flag 0 2109 : a900 > lda #0 ;allow test to change I-flag (no mask) > 210b : 48 > pha ;use stack to load status 210c : a9ff > lda #$ff ;precharge accu 210e : 28 > plp 210f : 2416 bit zp1+3 ;00 - should set Z / clear NV tst_a $ff,fz 2111 : 08 > php ;save flags 2112 : c9ff > cmp #$ff ;test result > trap_ne 2114 : f003 > beq skip1585 > trap ;failed not equal (non zero) 2116 : 205b44 > jsr report_error > 2119 : >skip1585 > 2119 : 68 > pla ;load status 211a : 48 > pha > cmp_flag fz 211b : c932 > cmp #(fz |fao)&m8 ;expected flags + always on bits > > trap_ne 211d : f003 > beq skip1588 > trap ;failed not equal (non zero) 211f : 205b44 > jsr report_error > 2122 : >skip1588 > 2122 : 28 > plp ;restore status set_a 1,0 > load_flag 0 2123 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2125 : 48 > pha ;use stack to load status 2126 : a901 > lda #1 ;precharge accu 2128 : 28 > plp 2129 : 2415 bit zp1+2 ;41 - should set V (M6) / clear NZ tst_a 1,fv 212b : 08 > php ;save flags 212c : c901 > cmp #1 ;test result > trap_ne 212e : f003 > beq skip1593 > trap ;failed not equal (non zero) 2130 : 205b44 > jsr report_error > 2133 : >skip1593 > 2133 : 68 > pla ;load status 2134 : 48 > pha > cmp_flag fv 2135 : c970 > cmp #(fv|fao)&m8 ;expected flags + always on bits > > trap_ne 2137 : f003 > beq skip1596 > trap ;failed not equal (non zero) 2139 : 205b44 > jsr report_error > 213c : >skip1596 > 213c : 28 > plp ;restore status set_a 1,0 > load_flag 0 213d : a900 > lda #0 ;allow test to change I-flag (no mask) > 213f : 48 > pha ;use stack to load status 2140 : a901 > lda #1 ;precharge accu 2142 : 28 > plp 2143 : 2414 bit zp1+1 ;82 - should set N (M7) & Z / clear V tst_a 1,fnz 2145 : 08 > php ;save flags 2146 : c901 > cmp #1 ;test result > trap_ne 2148 : f003 > beq skip1601 > trap ;failed not equal (non zero) 214a : 205b44 > jsr report_error > 214d : >skip1601 > 214d : 68 > pla ;load status 214e : 48 > pha > cmp_flag fnz 214f : c9b2 > cmp #(fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2151 : f003 > beq skip1604 > trap ;failed not equal (non zero) 2153 : 205b44 > jsr report_error > 2156 : >skip1604 > 2156 : 28 > plp ;restore status set_a 1,0 > load_flag 0 2157 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2159 : 48 > pha ;use stack to load status 215a : a901 > lda #1 ;precharge accu 215c : 28 > plp 215d : 2413 bit zp1 ;c3 - should set N (M7) & V (M6) / clear Z tst_a 1,fnv 215f : 08 > php ;save flags 2160 : c901 > cmp #1 ;test result > trap_ne 2162 : f003 > beq skip1609 > trap ;failed not equal (non zero) 2164 : 205b44 > jsr report_error > 2167 : >skip1609 > 2167 : 68 > pla ;load status 2168 : 48 > pha > cmp_flag fnv 2169 : c9f0 > cmp #(fnv|fao)&m8 ;expected flags + always on bits > > trap_ne 216b : f003 > beq skip1612 > trap ;failed not equal (non zero) 216d : 205b44 > jsr report_error > 2170 : >skip1612 > 2170 : 28 > plp ;restore status set_a $ff,$ff > load_flag $ff 2171 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2173 : 48 > pha ;use stack to load status 2174 : a9ff > lda #$ff ;precharge accu 2176 : 28 > plp 2177 : 2416 bit zp1+3 ;00 - should set Z / clear NV tst_a $ff,~fnv 2179 : 08 > php ;save flags 217a : c9ff > cmp #$ff ;test result > trap_ne 217c : f003 > beq skip1617 > trap ;failed not equal (non zero) 217e : 205b44 > jsr report_error > 2181 : >skip1617 > 2181 : 68 > pla ;load status 2182 : 48 > pha > cmp_flag ~fnv 2183 : c93f > cmp #(~fnv |fao)&m8 ;expected flags + always on bits > > trap_ne 2185 : f003 > beq skip1620 > trap ;failed not equal (non zero) 2187 : 205b44 > jsr report_error > 218a : >skip1620 > 218a : 28 > plp ;restore status set_a 1,$ff > load_flag $ff 218b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 218d : 48 > pha ;use stack to load status 218e : a901 > lda #1 ;precharge accu 2190 : 28 > plp 2191 : 2415 bit zp1+2 ;41 - should set V (M6) / clear NZ tst_a 1,~fnz 2193 : 08 > php ;save flags 2194 : c901 > cmp #1 ;test result > trap_ne 2196 : f003 > beq skip1625 > trap ;failed not equal (non zero) 2198 : 205b44 > jsr report_error > 219b : >skip1625 > 219b : 68 > pla ;load status 219c : 48 > pha > cmp_flag ~fnz 219d : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 219f : f003 > beq skip1628 > trap ;failed not equal (non zero) 21a1 : 205b44 > jsr report_error > 21a4 : >skip1628 > 21a4 : 28 > plp ;restore status set_a 1,$ff > load_flag $ff 21a5 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 21a7 : 48 > pha ;use stack to load status 21a8 : a901 > lda #1 ;precharge accu 21aa : 28 > plp 21ab : 2414 bit zp1+1 ;82 - should set N (M7) & Z / clear V tst_a 1,~fv 21ad : 08 > php ;save flags 21ae : c901 > cmp #1 ;test result > trap_ne 21b0 : f003 > beq skip1633 > trap ;failed not equal (non zero) 21b2 : 205b44 > jsr report_error > 21b5 : >skip1633 > 21b5 : 68 > pla ;load status 21b6 : 48 > pha > cmp_flag ~fv 21b7 : c9bf > cmp #(~fv|fao)&m8 ;expected flags + always on bits > > trap_ne 21b9 : f003 > beq skip1636 > trap ;failed not equal (non zero) 21bb : 205b44 > jsr report_error > 21be : >skip1636 > 21be : 28 > plp ;restore status set_a 1,$ff > load_flag $ff 21bf : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 21c1 : 48 > pha ;use stack to load status 21c2 : a901 > lda #1 ;precharge accu 21c4 : 28 > plp 21c5 : 2413 bit zp1 ;c3 - should set N (M7) & V (M6) / clear Z tst_a 1,~fz 21c7 : 08 > php ;save flags 21c8 : c901 > cmp #1 ;test result > trap_ne 21ca : f003 > beq skip1641 > trap ;failed not equal (non zero) 21cc : 205b44 > jsr report_error > 21cf : >skip1641 > 21cf : 68 > pla ;load status 21d0 : 48 > pha > cmp_flag ~fz 21d1 : c9fd > cmp #(~fz|fao)&m8 ;expected flags + always on bits > > trap_ne 21d3 : f003 > beq skip1644 > trap ;failed not equal (non zero) 21d5 : 205b44 > jsr report_error > 21d8 : >skip1644 > 21d8 : 28 > plp ;restore status set_a $ff,0 > load_flag 0 21d9 : a900 > lda #0 ;allow test to change I-flag (no mask) > 21db : 48 > pha ;use stack to load status 21dc : a9ff > lda #$ff ;precharge accu 21de : 28 > plp 21df : 2c1a02 bit abs1+3 ;00 - should set Z / clear NV tst_a $ff,fz 21e2 : 08 > php ;save flags 21e3 : c9ff > cmp #$ff ;test result > trap_ne 21e5 : f003 > beq skip1649 > trap ;failed not equal (non zero) 21e7 : 205b44 > jsr report_error > 21ea : >skip1649 > 21ea : 68 > pla ;load status 21eb : 48 > pha > cmp_flag fz 21ec : c932 > cmp #(fz |fao)&m8 ;expected flags + always on bits > > trap_ne 21ee : f003 > beq skip1652 > trap ;failed not equal (non zero) 21f0 : 205b44 > jsr report_error > 21f3 : >skip1652 > 21f3 : 28 > plp ;restore status set_a 1,0 > load_flag 0 21f4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 21f6 : 48 > pha ;use stack to load status 21f7 : a901 > lda #1 ;precharge accu 21f9 : 28 > plp 21fa : 2c1902 bit abs1+2 ;41 - should set V (M6) / clear NZ tst_a 1,fv 21fd : 08 > php ;save flags 21fe : c901 > cmp #1 ;test result > trap_ne 2200 : f003 > beq skip1657 > trap ;failed not equal (non zero) 2202 : 205b44 > jsr report_error > 2205 : >skip1657 > 2205 : 68 > pla ;load status 2206 : 48 > pha > cmp_flag fv 2207 : c970 > cmp #(fv|fao)&m8 ;expected flags + always on bits > > trap_ne 2209 : f003 > beq skip1660 > trap ;failed not equal (non zero) 220b : 205b44 > jsr report_error > 220e : >skip1660 > 220e : 28 > plp ;restore status set_a 1,0 > load_flag 0 220f : a900 > lda #0 ;allow test to change I-flag (no mask) > 2211 : 48 > pha ;use stack to load status 2212 : a901 > lda #1 ;precharge accu 2214 : 28 > plp 2215 : 2c1802 bit abs1+1 ;82 - should set N (M7) & Z / clear V tst_a 1,fnz 2218 : 08 > php ;save flags 2219 : c901 > cmp #1 ;test result > trap_ne 221b : f003 > beq skip1665 > trap ;failed not equal (non zero) 221d : 205b44 > jsr report_error > 2220 : >skip1665 > 2220 : 68 > pla ;load status 2221 : 48 > pha > cmp_flag fnz 2222 : c9b2 > cmp #(fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2224 : f003 > beq skip1668 > trap ;failed not equal (non zero) 2226 : 205b44 > jsr report_error > 2229 : >skip1668 > 2229 : 28 > plp ;restore status set_a 1,0 > load_flag 0 222a : a900 > lda #0 ;allow test to change I-flag (no mask) > 222c : 48 > pha ;use stack to load status 222d : a901 > lda #1 ;precharge accu 222f : 28 > plp 2230 : 2c1702 bit abs1 ;c3 - should set N (M7) & V (M6) / clear Z tst_a 1,fnv 2233 : 08 > php ;save flags 2234 : c901 > cmp #1 ;test result > trap_ne 2236 : f003 > beq skip1673 > trap ;failed not equal (non zero) 2238 : 205b44 > jsr report_error > 223b : >skip1673 > 223b : 68 > pla ;load status 223c : 48 > pha > cmp_flag fnv 223d : c9f0 > cmp #(fnv|fao)&m8 ;expected flags + always on bits > > trap_ne 223f : f003 > beq skip1676 > trap ;failed not equal (non zero) 2241 : 205b44 > jsr report_error > 2244 : >skip1676 > 2244 : 28 > plp ;restore status set_a $ff,$ff > load_flag $ff 2245 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2247 : 48 > pha ;use stack to load status 2248 : a9ff > lda #$ff ;precharge accu 224a : 28 > plp 224b : 2c1a02 bit abs1+3 ;00 - should set Z / clear NV tst_a $ff,~fnv 224e : 08 > php ;save flags 224f : c9ff > cmp #$ff ;test result > trap_ne 2251 : f003 > beq skip1681 > trap ;failed not equal (non zero) 2253 : 205b44 > jsr report_error > 2256 : >skip1681 > 2256 : 68 > pla ;load status 2257 : 48 > pha > cmp_flag ~fnv 2258 : c93f > cmp #(~fnv |fao)&m8 ;expected flags + always on bits > > trap_ne 225a : f003 > beq skip1684 > trap ;failed not equal (non zero) 225c : 205b44 > jsr report_error > 225f : >skip1684 > 225f : 28 > plp ;restore status set_a 1,$ff > load_flag $ff 2260 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2262 : 48 > pha ;use stack to load status 2263 : a901 > lda #1 ;precharge accu 2265 : 28 > plp 2266 : 2c1902 bit abs1+2 ;41 - should set V (M6) / clear NZ tst_a 1,~fnz 2269 : 08 > php ;save flags 226a : c901 > cmp #1 ;test result > trap_ne 226c : f003 > beq skip1689 > trap ;failed not equal (non zero) 226e : 205b44 > jsr report_error > 2271 : >skip1689 > 2271 : 68 > pla ;load status 2272 : 48 > pha > cmp_flag ~fnz 2273 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2275 : f003 > beq skip1692 > trap ;failed not equal (non zero) 2277 : 205b44 > jsr report_error > 227a : >skip1692 > 227a : 28 > plp ;restore status set_a 1,$ff > load_flag $ff 227b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 227d : 48 > pha ;use stack to load status 227e : a901 > lda #1 ;precharge accu 2280 : 28 > plp 2281 : 2c1802 bit abs1+1 ;82 - should set N (M7) & Z / clear V tst_a 1,~fv 2284 : 08 > php ;save flags 2285 : c901 > cmp #1 ;test result > trap_ne 2287 : f003 > beq skip1697 > trap ;failed not equal (non zero) 2289 : 205b44 > jsr report_error > 228c : >skip1697 > 228c : 68 > pla ;load status 228d : 48 > pha > cmp_flag ~fv 228e : c9bf > cmp #(~fv|fao)&m8 ;expected flags + always on bits > > trap_ne 2290 : f003 > beq skip1700 > trap ;failed not equal (non zero) 2292 : 205b44 > jsr report_error > 2295 : >skip1700 > 2295 : 28 > plp ;restore status set_a 1,$ff > load_flag $ff 2296 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2298 : 48 > pha ;use stack to load status 2299 : a901 > lda #1 ;precharge accu 229b : 28 > plp 229c : 2c1702 bit abs1 ;c3 - should set N (M7) & V (M6) / clear Z tst_a 1,~fz 229f : 08 > php ;save flags 22a0 : c901 > cmp #1 ;test result > trap_ne 22a2 : f003 > beq skip1705 > trap ;failed not equal (non zero) 22a4 : 205b44 > jsr report_error > 22a7 : >skip1705 > 22a7 : 68 > pla ;load status 22a8 : 48 > pha > cmp_flag ~fz 22a9 : c9fd > cmp #(~fz|fao)&m8 ;expected flags + always on bits > > trap_ne 22ab : f003 > beq skip1708 > trap ;failed not equal (non zero) 22ad : 205b44 > jsr report_error > 22b0 : >skip1708 > 22b0 : 28 > plp ;restore status next_test 22b1 : ad0002 > lda test_case ;previous test 22b4 : c919 > cmp #test_num > trap_ne ;test is out of sequence 22b6 : f003 > beq skip1711 > trap ;failed not equal (non zero) 22b8 : 205b44 > jsr report_error > 22bb : >skip1711 > 001a = >test_num = test_num + 1 22bb : a91a > lda #test_num ;*** next tests' number 22bd : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; CPX - zp / abs / # set_x $80,0 > load_flag 0 22c0 : a900 > lda #0 ;allow test to change I-flag (no mask) > 22c2 : 48 > pha ;use stack to load status 22c3 : a280 > ldx #$80 ;precharge index x 22c5 : 28 > plp 22c6 : e417 cpx zp7f tst_stat fc 22c8 : 08 > php ;save status 22c9 : 68 > pla ;use stack to retrieve status 22ca : 48 > pha > cmp_flag fc 22cb : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 22cd : f003 > beq skip1717 > trap ;failed not equal (non zero) 22cf : 205b44 > jsr report_error > 22d2 : >skip1717 > 22d2 : 28 > plp ;restore status 22d3 : ca dex 22d4 : e417 cpx zp7f tst_stat fzc 22d6 : 08 > php ;save status 22d7 : 68 > pla ;use stack to retrieve status 22d8 : 48 > pha > cmp_flag fzc 22d9 : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 22db : f003 > beq skip1721 > trap ;failed not equal (non zero) 22dd : 205b44 > jsr report_error > 22e0 : >skip1721 > 22e0 : 28 > plp ;restore status 22e1 : ca dex 22e2 : e417 cpx zp7f tst_x $7e,fn 22e4 : 08 > php ;save flags 22e5 : e07e > cpx #$7e ;test result > trap_ne 22e7 : f003 > beq skip1724 > trap ;failed not equal (non zero) 22e9 : 205b44 > jsr report_error > 22ec : >skip1724 > 22ec : 68 > pla ;load status 22ed : 48 > pha > cmp_flag fn 22ee : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 22f0 : f003 > beq skip1727 > trap ;failed not equal (non zero) 22f2 : 205b44 > jsr report_error > 22f5 : >skip1727 > 22f5 : 28 > plp ;restore status set_x $80,$ff > load_flag $ff 22f6 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 22f8 : 48 > pha ;use stack to load status 22f9 : a280 > ldx #$80 ;precharge index x 22fb : 28 > plp 22fc : e417 cpx zp7f tst_stat ~fnz 22fe : 08 > php ;save status 22ff : 68 > pla ;use stack to retrieve status 2300 : 48 > pha > cmp_flag ~fnz 2301 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2303 : f003 > beq skip1733 > trap ;failed not equal (non zero) 2305 : 205b44 > jsr report_error > 2308 : >skip1733 > 2308 : 28 > plp ;restore status 2309 : ca dex 230a : e417 cpx zp7f tst_stat ~fn 230c : 08 > php ;save status 230d : 68 > pla ;use stack to retrieve status 230e : 48 > pha > cmp_flag ~fn 230f : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2311 : f003 > beq skip1737 > trap ;failed not equal (non zero) 2313 : 205b44 > jsr report_error > 2316 : >skip1737 > 2316 : 28 > plp ;restore status 2317 : ca dex 2318 : e417 cpx zp7f tst_x $7e,~fzc 231a : 08 > php ;save flags 231b : e07e > cpx #$7e ;test result > trap_ne 231d : f003 > beq skip1740 > trap ;failed not equal (non zero) 231f : 205b44 > jsr report_error > 2322 : >skip1740 > 2322 : 68 > pla ;load status 2323 : 48 > pha > cmp_flag ~fzc 2324 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2326 : f003 > beq skip1743 > trap ;failed not equal (non zero) 2328 : 205b44 > jsr report_error > 232b : >skip1743 > 232b : 28 > plp ;restore status set_x $80,0 > load_flag 0 232c : a900 > lda #0 ;allow test to change I-flag (no mask) > 232e : 48 > pha ;use stack to load status 232f : a280 > ldx #$80 ;precharge index x 2331 : 28 > plp 2332 : ec1b02 cpx abs7f tst_stat fc 2335 : 08 > php ;save status 2336 : 68 > pla ;use stack to retrieve status 2337 : 48 > pha > cmp_flag fc 2338 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 233a : f003 > beq skip1749 > trap ;failed not equal (non zero) 233c : 205b44 > jsr report_error > 233f : >skip1749 > 233f : 28 > plp ;restore status 2340 : ca dex 2341 : ec1b02 cpx abs7f tst_stat fzc 2344 : 08 > php ;save status 2345 : 68 > pla ;use stack to retrieve status 2346 : 48 > pha > cmp_flag fzc 2347 : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2349 : f003 > beq skip1753 > trap ;failed not equal (non zero) 234b : 205b44 > jsr report_error > 234e : >skip1753 > 234e : 28 > plp ;restore status 234f : ca dex 2350 : ec1b02 cpx abs7f tst_x $7e,fn 2353 : 08 > php ;save flags 2354 : e07e > cpx #$7e ;test result > trap_ne 2356 : f003 > beq skip1756 > trap ;failed not equal (non zero) 2358 : 205b44 > jsr report_error > 235b : >skip1756 > 235b : 68 > pla ;load status 235c : 48 > pha > cmp_flag fn 235d : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 235f : f003 > beq skip1759 > trap ;failed not equal (non zero) 2361 : 205b44 > jsr report_error > 2364 : >skip1759 > 2364 : 28 > plp ;restore status set_x $80,$ff > load_flag $ff 2365 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2367 : 48 > pha ;use stack to load status 2368 : a280 > ldx #$80 ;precharge index x 236a : 28 > plp 236b : ec1b02 cpx abs7f tst_stat ~fnz 236e : 08 > php ;save status 236f : 68 > pla ;use stack to retrieve status 2370 : 48 > pha > cmp_flag ~fnz 2371 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2373 : f003 > beq skip1765 > trap ;failed not equal (non zero) 2375 : 205b44 > jsr report_error > 2378 : >skip1765 > 2378 : 28 > plp ;restore status 2379 : ca dex 237a : ec1b02 cpx abs7f tst_stat ~fn 237d : 08 > php ;save status 237e : 68 > pla ;use stack to retrieve status 237f : 48 > pha > cmp_flag ~fn 2380 : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2382 : f003 > beq skip1769 > trap ;failed not equal (non zero) 2384 : 205b44 > jsr report_error > 2387 : >skip1769 > 2387 : 28 > plp ;restore status 2388 : ca dex 2389 : ec1b02 cpx abs7f tst_x $7e,~fzc 238c : 08 > php ;save flags 238d : e07e > cpx #$7e ;test result > trap_ne 238f : f003 > beq skip1772 > trap ;failed not equal (non zero) 2391 : 205b44 > jsr report_error > 2394 : >skip1772 > 2394 : 68 > pla ;load status 2395 : 48 > pha > cmp_flag ~fzc 2396 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2398 : f003 > beq skip1775 > trap ;failed not equal (non zero) 239a : 205b44 > jsr report_error > 239d : >skip1775 > 239d : 28 > plp ;restore status set_x $80,0 > load_flag 0 239e : a900 > lda #0 ;allow test to change I-flag (no mask) > 23a0 : 48 > pha ;use stack to load status 23a1 : a280 > ldx #$80 ;precharge index x 23a3 : 28 > plp 23a4 : e07f cpx #$7f tst_stat fc 23a6 : 08 > php ;save status 23a7 : 68 > pla ;use stack to retrieve status 23a8 : 48 > pha > cmp_flag fc 23a9 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 23ab : f003 > beq skip1781 > trap ;failed not equal (non zero) 23ad : 205b44 > jsr report_error > 23b0 : >skip1781 > 23b0 : 28 > plp ;restore status 23b1 : ca dex 23b2 : e07f cpx #$7f tst_stat fzc 23b4 : 08 > php ;save status 23b5 : 68 > pla ;use stack to retrieve status 23b6 : 48 > pha > cmp_flag fzc 23b7 : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 23b9 : f003 > beq skip1785 > trap ;failed not equal (non zero) 23bb : 205b44 > jsr report_error > 23be : >skip1785 > 23be : 28 > plp ;restore status 23bf : ca dex 23c0 : e07f cpx #$7f tst_x $7e,fn 23c2 : 08 > php ;save flags 23c3 : e07e > cpx #$7e ;test result > trap_ne 23c5 : f003 > beq skip1788 > trap ;failed not equal (non zero) 23c7 : 205b44 > jsr report_error > 23ca : >skip1788 > 23ca : 68 > pla ;load status 23cb : 48 > pha > cmp_flag fn 23cc : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 23ce : f003 > beq skip1791 > trap ;failed not equal (non zero) 23d0 : 205b44 > jsr report_error > 23d3 : >skip1791 > 23d3 : 28 > plp ;restore status set_x $80,$ff > load_flag $ff 23d4 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 23d6 : 48 > pha ;use stack to load status 23d7 : a280 > ldx #$80 ;precharge index x 23d9 : 28 > plp 23da : e07f cpx #$7f tst_stat ~fnz 23dc : 08 > php ;save status 23dd : 68 > pla ;use stack to retrieve status 23de : 48 > pha > cmp_flag ~fnz 23df : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 23e1 : f003 > beq skip1797 > trap ;failed not equal (non zero) 23e3 : 205b44 > jsr report_error > 23e6 : >skip1797 > 23e6 : 28 > plp ;restore status 23e7 : ca dex 23e8 : e07f cpx #$7f tst_stat ~fn 23ea : 08 > php ;save status 23eb : 68 > pla ;use stack to retrieve status 23ec : 48 > pha > cmp_flag ~fn 23ed : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 23ef : f003 > beq skip1801 > trap ;failed not equal (non zero) 23f1 : 205b44 > jsr report_error > 23f4 : >skip1801 > 23f4 : 28 > plp ;restore status 23f5 : ca dex 23f6 : e07f cpx #$7f tst_x $7e,~fzc 23f8 : 08 > php ;save flags 23f9 : e07e > cpx #$7e ;test result > trap_ne 23fb : f003 > beq skip1804 > trap ;failed not equal (non zero) 23fd : 205b44 > jsr report_error > 2400 : >skip1804 > 2400 : 68 > pla ;load status 2401 : 48 > pha > cmp_flag ~fzc 2402 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2404 : f003 > beq skip1807 > trap ;failed not equal (non zero) 2406 : 205b44 > jsr report_error > 2409 : >skip1807 > 2409 : 28 > plp ;restore status next_test 240a : ad0002 > lda test_case ;previous test 240d : c91a > cmp #test_num > trap_ne ;test is out of sequence 240f : f003 > beq skip1810 > trap ;failed not equal (non zero) 2411 : 205b44 > jsr report_error > 2414 : >skip1810 > 001b = >test_num = test_num + 1 2414 : a91b > lda #test_num ;*** next tests' number 2416 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; CPY - zp / abs / # set_y $80,0 > load_flag 0 2419 : a900 > lda #0 ;allow test to change I-flag (no mask) > 241b : 48 > pha ;use stack to load status 241c : a080 > ldy #$80 ;precharge index y 241e : 28 > plp 241f : c417 cpy zp7f tst_stat fc 2421 : 08 > php ;save status 2422 : 68 > pla ;use stack to retrieve status 2423 : 48 > pha > cmp_flag fc 2424 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 2426 : f003 > beq skip1816 > trap ;failed not equal (non zero) 2428 : 205b44 > jsr report_error > 242b : >skip1816 > 242b : 28 > plp ;restore status 242c : 88 dey 242d : c417 cpy zp7f tst_stat fzc 242f : 08 > php ;save status 2430 : 68 > pla ;use stack to retrieve status 2431 : 48 > pha > cmp_flag fzc 2432 : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2434 : f003 > beq skip1820 > trap ;failed not equal (non zero) 2436 : 205b44 > jsr report_error > 2439 : >skip1820 > 2439 : 28 > plp ;restore status 243a : 88 dey 243b : c417 cpy zp7f tst_y $7e,fn 243d : 08 > php ;save flags 243e : c07e > cpy #$7e ;test result > trap_ne 2440 : f003 > beq skip1823 > trap ;failed not equal (non zero) 2442 : 205b44 > jsr report_error > 2445 : >skip1823 > 2445 : 68 > pla ;load status 2446 : 48 > pha > cmp_flag fn 2447 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2449 : f003 > beq skip1826 > trap ;failed not equal (non zero) 244b : 205b44 > jsr report_error > 244e : >skip1826 > 244e : 28 > plp ;restore status set_y $80,$ff > load_flag $ff 244f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2451 : 48 > pha ;use stack to load status 2452 : a080 > ldy #$80 ;precharge index y 2454 : 28 > plp 2455 : c417 cpy zp7f tst_stat ~fnz 2457 : 08 > php ;save status 2458 : 68 > pla ;use stack to retrieve status 2459 : 48 > pha > cmp_flag ~fnz 245a : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 245c : f003 > beq skip1832 > trap ;failed not equal (non zero) 245e : 205b44 > jsr report_error > 2461 : >skip1832 > 2461 : 28 > plp ;restore status 2462 : 88 dey 2463 : c417 cpy zp7f tst_stat ~fn 2465 : 08 > php ;save status 2466 : 68 > pla ;use stack to retrieve status 2467 : 48 > pha > cmp_flag ~fn 2468 : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 246a : f003 > beq skip1836 > trap ;failed not equal (non zero) 246c : 205b44 > jsr report_error > 246f : >skip1836 > 246f : 28 > plp ;restore status 2470 : 88 dey 2471 : c417 cpy zp7f tst_y $7e,~fzc 2473 : 08 > php ;save flags 2474 : c07e > cpy #$7e ;test result > trap_ne 2476 : f003 > beq skip1839 > trap ;failed not equal (non zero) 2478 : 205b44 > jsr report_error > 247b : >skip1839 > 247b : 68 > pla ;load status 247c : 48 > pha > cmp_flag ~fzc 247d : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 247f : f003 > beq skip1842 > trap ;failed not equal (non zero) 2481 : 205b44 > jsr report_error > 2484 : >skip1842 > 2484 : 28 > plp ;restore status set_y $80,0 > load_flag 0 2485 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2487 : 48 > pha ;use stack to load status 2488 : a080 > ldy #$80 ;precharge index y 248a : 28 > plp 248b : cc1b02 cpy abs7f tst_stat fc 248e : 08 > php ;save status 248f : 68 > pla ;use stack to retrieve status 2490 : 48 > pha > cmp_flag fc 2491 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 2493 : f003 > beq skip1848 > trap ;failed not equal (non zero) 2495 : 205b44 > jsr report_error > 2498 : >skip1848 > 2498 : 28 > plp ;restore status 2499 : 88 dey 249a : cc1b02 cpy abs7f tst_stat fzc 249d : 08 > php ;save status 249e : 68 > pla ;use stack to retrieve status 249f : 48 > pha > cmp_flag fzc 24a0 : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 24a2 : f003 > beq skip1852 > trap ;failed not equal (non zero) 24a4 : 205b44 > jsr report_error > 24a7 : >skip1852 > 24a7 : 28 > plp ;restore status 24a8 : 88 dey 24a9 : cc1b02 cpy abs7f tst_y $7e,fn 24ac : 08 > php ;save flags 24ad : c07e > cpy #$7e ;test result > trap_ne 24af : f003 > beq skip1855 > trap ;failed not equal (non zero) 24b1 : 205b44 > jsr report_error > 24b4 : >skip1855 > 24b4 : 68 > pla ;load status 24b5 : 48 > pha > cmp_flag fn 24b6 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 24b8 : f003 > beq skip1858 > trap ;failed not equal (non zero) 24ba : 205b44 > jsr report_error > 24bd : >skip1858 > 24bd : 28 > plp ;restore status set_y $80,$ff > load_flag $ff 24be : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 24c0 : 48 > pha ;use stack to load status 24c1 : a080 > ldy #$80 ;precharge index y 24c3 : 28 > plp 24c4 : cc1b02 cpy abs7f tst_stat ~fnz 24c7 : 08 > php ;save status 24c8 : 68 > pla ;use stack to retrieve status 24c9 : 48 > pha > cmp_flag ~fnz 24ca : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 24cc : f003 > beq skip1864 > trap ;failed not equal (non zero) 24ce : 205b44 > jsr report_error > 24d1 : >skip1864 > 24d1 : 28 > plp ;restore status 24d2 : 88 dey 24d3 : cc1b02 cpy abs7f tst_stat ~fn 24d6 : 08 > php ;save status 24d7 : 68 > pla ;use stack to retrieve status 24d8 : 48 > pha > cmp_flag ~fn 24d9 : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 24db : f003 > beq skip1868 > trap ;failed not equal (non zero) 24dd : 205b44 > jsr report_error > 24e0 : >skip1868 > 24e0 : 28 > plp ;restore status 24e1 : 88 dey 24e2 : cc1b02 cpy abs7f tst_y $7e,~fzc 24e5 : 08 > php ;save flags 24e6 : c07e > cpy #$7e ;test result > trap_ne 24e8 : f003 > beq skip1871 > trap ;failed not equal (non zero) 24ea : 205b44 > jsr report_error > 24ed : >skip1871 > 24ed : 68 > pla ;load status 24ee : 48 > pha > cmp_flag ~fzc 24ef : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 24f1 : f003 > beq skip1874 > trap ;failed not equal (non zero) 24f3 : 205b44 > jsr report_error > 24f6 : >skip1874 > 24f6 : 28 > plp ;restore status set_y $80,0 > load_flag 0 24f7 : a900 > lda #0 ;allow test to change I-flag (no mask) > 24f9 : 48 > pha ;use stack to load status 24fa : a080 > ldy #$80 ;precharge index y 24fc : 28 > plp 24fd : c07f cpy #$7f tst_stat fc 24ff : 08 > php ;save status 2500 : 68 > pla ;use stack to retrieve status 2501 : 48 > pha > cmp_flag fc 2502 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 2504 : f003 > beq skip1880 > trap ;failed not equal (non zero) 2506 : 205b44 > jsr report_error > 2509 : >skip1880 > 2509 : 28 > plp ;restore status 250a : 88 dey 250b : c07f cpy #$7f tst_stat fzc 250d : 08 > php ;save status 250e : 68 > pla ;use stack to retrieve status 250f : 48 > pha > cmp_flag fzc 2510 : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2512 : f003 > beq skip1884 > trap ;failed not equal (non zero) 2514 : 205b44 > jsr report_error > 2517 : >skip1884 > 2517 : 28 > plp ;restore status 2518 : 88 dey 2519 : c07f cpy #$7f tst_y $7e,fn 251b : 08 > php ;save flags 251c : c07e > cpy #$7e ;test result > trap_ne 251e : f003 > beq skip1887 > trap ;failed not equal (non zero) 2520 : 205b44 > jsr report_error > 2523 : >skip1887 > 2523 : 68 > pla ;load status 2524 : 48 > pha > cmp_flag fn 2525 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2527 : f003 > beq skip1890 > trap ;failed not equal (non zero) 2529 : 205b44 > jsr report_error > 252c : >skip1890 > 252c : 28 > plp ;restore status set_y $80,$ff > load_flag $ff 252d : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 252f : 48 > pha ;use stack to load status 2530 : a080 > ldy #$80 ;precharge index y 2532 : 28 > plp 2533 : c07f cpy #$7f tst_stat ~fnz 2535 : 08 > php ;save status 2536 : 68 > pla ;use stack to retrieve status 2537 : 48 > pha > cmp_flag ~fnz 2538 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 253a : f003 > beq skip1896 > trap ;failed not equal (non zero) 253c : 205b44 > jsr report_error > 253f : >skip1896 > 253f : 28 > plp ;restore status 2540 : 88 dey 2541 : c07f cpy #$7f tst_stat ~fn 2543 : 08 > php ;save status 2544 : 68 > pla ;use stack to retrieve status 2545 : 48 > pha > cmp_flag ~fn 2546 : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2548 : f003 > beq skip1900 > trap ;failed not equal (non zero) 254a : 205b44 > jsr report_error > 254d : >skip1900 > 254d : 28 > plp ;restore status 254e : 88 dey 254f : c07f cpy #$7f tst_y $7e,~fzc 2551 : 08 > php ;save flags 2552 : c07e > cpy #$7e ;test result > trap_ne 2554 : f003 > beq skip1903 > trap ;failed not equal (non zero) 2556 : 205b44 > jsr report_error > 2559 : >skip1903 > 2559 : 68 > pla ;load status 255a : 48 > pha > cmp_flag ~fzc 255b : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 255d : f003 > beq skip1906 > trap ;failed not equal (non zero) 255f : 205b44 > jsr report_error > 2562 : >skip1906 > 2562 : 28 > plp ;restore status next_test 2563 : ad0002 > lda test_case ;previous test 2566 : c91b > cmp #test_num > trap_ne ;test is out of sequence 2568 : f003 > beq skip1909 > trap ;failed not equal (non zero) 256a : 205b44 > jsr report_error > 256d : >skip1909 > 001c = >test_num = test_num + 1 256d : a91c > lda #test_num ;*** next tests' number 256f : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; CMP - zp / abs / # set_a $80,0 > load_flag 0 2572 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2574 : 48 > pha ;use stack to load status 2575 : a980 > lda #$80 ;precharge accu 2577 : 28 > plp 2578 : c517 cmp zp7f tst_a $80,fc 257a : 08 > php ;save flags 257b : c980 > cmp #$80 ;test result > trap_ne 257d : f003 > beq skip1914 > trap ;failed not equal (non zero) 257f : 205b44 > jsr report_error > 2582 : >skip1914 > 2582 : 68 > pla ;load status 2583 : 48 > pha > cmp_flag fc 2584 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 2586 : f003 > beq skip1917 > trap ;failed not equal (non zero) 2588 : 205b44 > jsr report_error > 258b : >skip1917 > 258b : 28 > plp ;restore status set_a $7f,0 > load_flag 0 258c : a900 > lda #0 ;allow test to change I-flag (no mask) > 258e : 48 > pha ;use stack to load status 258f : a97f > lda #$7f ;precharge accu 2591 : 28 > plp 2592 : c517 cmp zp7f tst_a $7f,fzc 2594 : 08 > php ;save flags 2595 : c97f > cmp #$7f ;test result > trap_ne 2597 : f003 > beq skip1922 > trap ;failed not equal (non zero) 2599 : 205b44 > jsr report_error > 259c : >skip1922 > 259c : 68 > pla ;load status 259d : 48 > pha > cmp_flag fzc 259e : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 25a0 : f003 > beq skip1925 > trap ;failed not equal (non zero) 25a2 : 205b44 > jsr report_error > 25a5 : >skip1925 > 25a5 : 28 > plp ;restore status set_a $7e,0 > load_flag 0 25a6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 25a8 : 48 > pha ;use stack to load status 25a9 : a97e > lda #$7e ;precharge accu 25ab : 28 > plp 25ac : c517 cmp zp7f tst_a $7e,fn 25ae : 08 > php ;save flags 25af : c97e > cmp #$7e ;test result > trap_ne 25b1 : f003 > beq skip1930 > trap ;failed not equal (non zero) 25b3 : 205b44 > jsr report_error > 25b6 : >skip1930 > 25b6 : 68 > pla ;load status 25b7 : 48 > pha > cmp_flag fn 25b8 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 25ba : f003 > beq skip1933 > trap ;failed not equal (non zero) 25bc : 205b44 > jsr report_error > 25bf : >skip1933 > 25bf : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 25c0 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 25c2 : 48 > pha ;use stack to load status 25c3 : a980 > lda #$80 ;precharge accu 25c5 : 28 > plp 25c6 : c517 cmp zp7f tst_a $80,~fnz 25c8 : 08 > php ;save flags 25c9 : c980 > cmp #$80 ;test result > trap_ne 25cb : f003 > beq skip1938 > trap ;failed not equal (non zero) 25cd : 205b44 > jsr report_error > 25d0 : >skip1938 > 25d0 : 68 > pla ;load status 25d1 : 48 > pha > cmp_flag ~fnz 25d2 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 25d4 : f003 > beq skip1941 > trap ;failed not equal (non zero) 25d6 : 205b44 > jsr report_error > 25d9 : >skip1941 > 25d9 : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 25da : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 25dc : 48 > pha ;use stack to load status 25dd : a97f > lda #$7f ;precharge accu 25df : 28 > plp 25e0 : c517 cmp zp7f tst_a $7f,~fn 25e2 : 08 > php ;save flags 25e3 : c97f > cmp #$7f ;test result > trap_ne 25e5 : f003 > beq skip1946 > trap ;failed not equal (non zero) 25e7 : 205b44 > jsr report_error > 25ea : >skip1946 > 25ea : 68 > pla ;load status 25eb : 48 > pha > cmp_flag ~fn 25ec : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 25ee : f003 > beq skip1949 > trap ;failed not equal (non zero) 25f0 : 205b44 > jsr report_error > 25f3 : >skip1949 > 25f3 : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 25f4 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 25f6 : 48 > pha ;use stack to load status 25f7 : a97e > lda #$7e ;precharge accu 25f9 : 28 > plp 25fa : c517 cmp zp7f tst_a $7e,~fzc 25fc : 08 > php ;save flags 25fd : c97e > cmp #$7e ;test result > trap_ne 25ff : f003 > beq skip1954 > trap ;failed not equal (non zero) 2601 : 205b44 > jsr report_error > 2604 : >skip1954 > 2604 : 68 > pla ;load status 2605 : 48 > pha > cmp_flag ~fzc 2606 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2608 : f003 > beq skip1957 > trap ;failed not equal (non zero) 260a : 205b44 > jsr report_error > 260d : >skip1957 > 260d : 28 > plp ;restore status set_a $80,0 > load_flag 0 260e : a900 > lda #0 ;allow test to change I-flag (no mask) > 2610 : 48 > pha ;use stack to load status 2611 : a980 > lda #$80 ;precharge accu 2613 : 28 > plp 2614 : cd1b02 cmp abs7f tst_a $80,fc 2617 : 08 > php ;save flags 2618 : c980 > cmp #$80 ;test result > trap_ne 261a : f003 > beq skip1962 > trap ;failed not equal (non zero) 261c : 205b44 > jsr report_error > 261f : >skip1962 > 261f : 68 > pla ;load status 2620 : 48 > pha > cmp_flag fc 2621 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 2623 : f003 > beq skip1965 > trap ;failed not equal (non zero) 2625 : 205b44 > jsr report_error > 2628 : >skip1965 > 2628 : 28 > plp ;restore status set_a $7f,0 > load_flag 0 2629 : a900 > lda #0 ;allow test to change I-flag (no mask) > 262b : 48 > pha ;use stack to load status 262c : a97f > lda #$7f ;precharge accu 262e : 28 > plp 262f : cd1b02 cmp abs7f tst_a $7f,fzc 2632 : 08 > php ;save flags 2633 : c97f > cmp #$7f ;test result > trap_ne 2635 : f003 > beq skip1970 > trap ;failed not equal (non zero) 2637 : 205b44 > jsr report_error > 263a : >skip1970 > 263a : 68 > pla ;load status 263b : 48 > pha > cmp_flag fzc 263c : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 263e : f003 > beq skip1973 > trap ;failed not equal (non zero) 2640 : 205b44 > jsr report_error > 2643 : >skip1973 > 2643 : 28 > plp ;restore status set_a $7e,0 > load_flag 0 2644 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2646 : 48 > pha ;use stack to load status 2647 : a97e > lda #$7e ;precharge accu 2649 : 28 > plp 264a : cd1b02 cmp abs7f tst_a $7e,fn 264d : 08 > php ;save flags 264e : c97e > cmp #$7e ;test result > trap_ne 2650 : f003 > beq skip1978 > trap ;failed not equal (non zero) 2652 : 205b44 > jsr report_error > 2655 : >skip1978 > 2655 : 68 > pla ;load status 2656 : 48 > pha > cmp_flag fn 2657 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2659 : f003 > beq skip1981 > trap ;failed not equal (non zero) 265b : 205b44 > jsr report_error > 265e : >skip1981 > 265e : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 265f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2661 : 48 > pha ;use stack to load status 2662 : a980 > lda #$80 ;precharge accu 2664 : 28 > plp 2665 : cd1b02 cmp abs7f tst_a $80,~fnz 2668 : 08 > php ;save flags 2669 : c980 > cmp #$80 ;test result > trap_ne 266b : f003 > beq skip1986 > trap ;failed not equal (non zero) 266d : 205b44 > jsr report_error > 2670 : >skip1986 > 2670 : 68 > pla ;load status 2671 : 48 > pha > cmp_flag ~fnz 2672 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2674 : f003 > beq skip1989 > trap ;failed not equal (non zero) 2676 : 205b44 > jsr report_error > 2679 : >skip1989 > 2679 : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 267a : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 267c : 48 > pha ;use stack to load status 267d : a97f > lda #$7f ;precharge accu 267f : 28 > plp 2680 : cd1b02 cmp abs7f tst_a $7f,~fn 2683 : 08 > php ;save flags 2684 : c97f > cmp #$7f ;test result > trap_ne 2686 : f003 > beq skip1994 > trap ;failed not equal (non zero) 2688 : 205b44 > jsr report_error > 268b : >skip1994 > 268b : 68 > pla ;load status 268c : 48 > pha > cmp_flag ~fn 268d : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 268f : f003 > beq skip1997 > trap ;failed not equal (non zero) 2691 : 205b44 > jsr report_error > 2694 : >skip1997 > 2694 : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 2695 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2697 : 48 > pha ;use stack to load status 2698 : a97e > lda #$7e ;precharge accu 269a : 28 > plp 269b : cd1b02 cmp abs7f tst_a $7e,~fzc 269e : 08 > php ;save flags 269f : c97e > cmp #$7e ;test result > trap_ne 26a1 : f003 > beq skip2002 > trap ;failed not equal (non zero) 26a3 : 205b44 > jsr report_error > 26a6 : >skip2002 > 26a6 : 68 > pla ;load status 26a7 : 48 > pha > cmp_flag ~fzc 26a8 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 26aa : f003 > beq skip2005 > trap ;failed not equal (non zero) 26ac : 205b44 > jsr report_error > 26af : >skip2005 > 26af : 28 > plp ;restore status set_a $80,0 > load_flag 0 26b0 : a900 > lda #0 ;allow test to change I-flag (no mask) > 26b2 : 48 > pha ;use stack to load status 26b3 : a980 > lda #$80 ;precharge accu 26b5 : 28 > plp 26b6 : c97f cmp #$7f tst_a $80,fc 26b8 : 08 > php ;save flags 26b9 : c980 > cmp #$80 ;test result > trap_ne 26bb : f003 > beq skip2010 > trap ;failed not equal (non zero) 26bd : 205b44 > jsr report_error > 26c0 : >skip2010 > 26c0 : 68 > pla ;load status 26c1 : 48 > pha > cmp_flag fc 26c2 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 26c4 : f003 > beq skip2013 > trap ;failed not equal (non zero) 26c6 : 205b44 > jsr report_error > 26c9 : >skip2013 > 26c9 : 28 > plp ;restore status set_a $7f,0 > load_flag 0 26ca : a900 > lda #0 ;allow test to change I-flag (no mask) > 26cc : 48 > pha ;use stack to load status 26cd : a97f > lda #$7f ;precharge accu 26cf : 28 > plp 26d0 : c97f cmp #$7f tst_a $7f,fzc 26d2 : 08 > php ;save flags 26d3 : c97f > cmp #$7f ;test result > trap_ne 26d5 : f003 > beq skip2018 > trap ;failed not equal (non zero) 26d7 : 205b44 > jsr report_error > 26da : >skip2018 > 26da : 68 > pla ;load status 26db : 48 > pha > cmp_flag fzc 26dc : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 26de : f003 > beq skip2021 > trap ;failed not equal (non zero) 26e0 : 205b44 > jsr report_error > 26e3 : >skip2021 > 26e3 : 28 > plp ;restore status set_a $7e,0 > load_flag 0 26e4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 26e6 : 48 > pha ;use stack to load status 26e7 : a97e > lda #$7e ;precharge accu 26e9 : 28 > plp 26ea : c97f cmp #$7f tst_a $7e,fn 26ec : 08 > php ;save flags 26ed : c97e > cmp #$7e ;test result > trap_ne 26ef : f003 > beq skip2026 > trap ;failed not equal (non zero) 26f1 : 205b44 > jsr report_error > 26f4 : >skip2026 > 26f4 : 68 > pla ;load status 26f5 : 48 > pha > cmp_flag fn 26f6 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 26f8 : f003 > beq skip2029 > trap ;failed not equal (non zero) 26fa : 205b44 > jsr report_error > 26fd : >skip2029 > 26fd : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 26fe : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2700 : 48 > pha ;use stack to load status 2701 : a980 > lda #$80 ;precharge accu 2703 : 28 > plp 2704 : c97f cmp #$7f tst_a $80,~fnz 2706 : 08 > php ;save flags 2707 : c980 > cmp #$80 ;test result > trap_ne 2709 : f003 > beq skip2034 > trap ;failed not equal (non zero) 270b : 205b44 > jsr report_error > 270e : >skip2034 > 270e : 68 > pla ;load status 270f : 48 > pha > cmp_flag ~fnz 2710 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2712 : f003 > beq skip2037 > trap ;failed not equal (non zero) 2714 : 205b44 > jsr report_error > 2717 : >skip2037 > 2717 : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 2718 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 271a : 48 > pha ;use stack to load status 271b : a97f > lda #$7f ;precharge accu 271d : 28 > plp 271e : c97f cmp #$7f tst_a $7f,~fn 2720 : 08 > php ;save flags 2721 : c97f > cmp #$7f ;test result > trap_ne 2723 : f003 > beq skip2042 > trap ;failed not equal (non zero) 2725 : 205b44 > jsr report_error > 2728 : >skip2042 > 2728 : 68 > pla ;load status 2729 : 48 > pha > cmp_flag ~fn 272a : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 272c : f003 > beq skip2045 > trap ;failed not equal (non zero) 272e : 205b44 > jsr report_error > 2731 : >skip2045 > 2731 : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 2732 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2734 : 48 > pha ;use stack to load status 2735 : a97e > lda #$7e ;precharge accu 2737 : 28 > plp 2738 : c97f cmp #$7f tst_a $7e,~fzc 273a : 08 > php ;save flags 273b : c97e > cmp #$7e ;test result > trap_ne 273d : f003 > beq skip2050 > trap ;failed not equal (non zero) 273f : 205b44 > jsr report_error > 2742 : >skip2050 > 2742 : 68 > pla ;load status 2743 : 48 > pha > cmp_flag ~fzc 2744 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2746 : f003 > beq skip2053 > trap ;failed not equal (non zero) 2748 : 205b44 > jsr report_error > 274b : >skip2053 > 274b : 28 > plp ;restore status 274c : a204 ldx #4 ;with indexing by X set_a $80,0 > load_flag 0 274e : a900 > lda #0 ;allow test to change I-flag (no mask) > 2750 : 48 > pha ;use stack to load status 2751 : a980 > lda #$80 ;precharge accu 2753 : 28 > plp 2754 : d513 cmp zp1,x tst_a $80,fc 2756 : 08 > php ;save flags 2757 : c980 > cmp #$80 ;test result > trap_ne 2759 : f003 > beq skip2058 > trap ;failed not equal (non zero) 275b : 205b44 > jsr report_error > 275e : >skip2058 > 275e : 68 > pla ;load status 275f : 48 > pha > cmp_flag fc 2760 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 2762 : f003 > beq skip2061 > trap ;failed not equal (non zero) 2764 : 205b44 > jsr report_error > 2767 : >skip2061 > 2767 : 28 > plp ;restore status set_a $7f,0 > load_flag 0 2768 : a900 > lda #0 ;allow test to change I-flag (no mask) > 276a : 48 > pha ;use stack to load status 276b : a97f > lda #$7f ;precharge accu 276d : 28 > plp 276e : d513 cmp zp1,x tst_a $7f,fzc 2770 : 08 > php ;save flags 2771 : c97f > cmp #$7f ;test result > trap_ne 2773 : f003 > beq skip2066 > trap ;failed not equal (non zero) 2775 : 205b44 > jsr report_error > 2778 : >skip2066 > 2778 : 68 > pla ;load status 2779 : 48 > pha > cmp_flag fzc 277a : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 277c : f003 > beq skip2069 > trap ;failed not equal (non zero) 277e : 205b44 > jsr report_error > 2781 : >skip2069 > 2781 : 28 > plp ;restore status set_a $7e,0 > load_flag 0 2782 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2784 : 48 > pha ;use stack to load status 2785 : a97e > lda #$7e ;precharge accu 2787 : 28 > plp 2788 : d513 cmp zp1,x tst_a $7e,fn 278a : 08 > php ;save flags 278b : c97e > cmp #$7e ;test result > trap_ne 278d : f003 > beq skip2074 > trap ;failed not equal (non zero) 278f : 205b44 > jsr report_error > 2792 : >skip2074 > 2792 : 68 > pla ;load status 2793 : 48 > pha > cmp_flag fn 2794 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2796 : f003 > beq skip2077 > trap ;failed not equal (non zero) 2798 : 205b44 > jsr report_error > 279b : >skip2077 > 279b : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 279c : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 279e : 48 > pha ;use stack to load status 279f : a980 > lda #$80 ;precharge accu 27a1 : 28 > plp 27a2 : d513 cmp zp1,x tst_a $80,~fnz 27a4 : 08 > php ;save flags 27a5 : c980 > cmp #$80 ;test result > trap_ne 27a7 : f003 > beq skip2082 > trap ;failed not equal (non zero) 27a9 : 205b44 > jsr report_error > 27ac : >skip2082 > 27ac : 68 > pla ;load status 27ad : 48 > pha > cmp_flag ~fnz 27ae : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 27b0 : f003 > beq skip2085 > trap ;failed not equal (non zero) 27b2 : 205b44 > jsr report_error > 27b5 : >skip2085 > 27b5 : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 27b6 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 27b8 : 48 > pha ;use stack to load status 27b9 : a97f > lda #$7f ;precharge accu 27bb : 28 > plp 27bc : d513 cmp zp1,x tst_a $7f,~fn 27be : 08 > php ;save flags 27bf : c97f > cmp #$7f ;test result > trap_ne 27c1 : f003 > beq skip2090 > trap ;failed not equal (non zero) 27c3 : 205b44 > jsr report_error > 27c6 : >skip2090 > 27c6 : 68 > pla ;load status 27c7 : 48 > pha > cmp_flag ~fn 27c8 : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 27ca : f003 > beq skip2093 > trap ;failed not equal (non zero) 27cc : 205b44 > jsr report_error > 27cf : >skip2093 > 27cf : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 27d0 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 27d2 : 48 > pha ;use stack to load status 27d3 : a97e > lda #$7e ;precharge accu 27d5 : 28 > plp 27d6 : d513 cmp zp1,x tst_a $7e,~fzc 27d8 : 08 > php ;save flags 27d9 : c97e > cmp #$7e ;test result > trap_ne 27db : f003 > beq skip2098 > trap ;failed not equal (non zero) 27dd : 205b44 > jsr report_error > 27e0 : >skip2098 > 27e0 : 68 > pla ;load status 27e1 : 48 > pha > cmp_flag ~fzc 27e2 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 27e4 : f003 > beq skip2101 > trap ;failed not equal (non zero) 27e6 : 205b44 > jsr report_error > 27e9 : >skip2101 > 27e9 : 28 > plp ;restore status set_a $80,0 > load_flag 0 27ea : a900 > lda #0 ;allow test to change I-flag (no mask) > 27ec : 48 > pha ;use stack to load status 27ed : a980 > lda #$80 ;precharge accu 27ef : 28 > plp 27f0 : dd1702 cmp abs1,x tst_a $80,fc 27f3 : 08 > php ;save flags 27f4 : c980 > cmp #$80 ;test result > trap_ne 27f6 : f003 > beq skip2106 > trap ;failed not equal (non zero) 27f8 : 205b44 > jsr report_error > 27fb : >skip2106 > 27fb : 68 > pla ;load status 27fc : 48 > pha > cmp_flag fc 27fd : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 27ff : f003 > beq skip2109 > trap ;failed not equal (non zero) 2801 : 205b44 > jsr report_error > 2804 : >skip2109 > 2804 : 28 > plp ;restore status set_a $7f,0 > load_flag 0 2805 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2807 : 48 > pha ;use stack to load status 2808 : a97f > lda #$7f ;precharge accu 280a : 28 > plp 280b : dd1702 cmp abs1,x tst_a $7f,fzc 280e : 08 > php ;save flags 280f : c97f > cmp #$7f ;test result > trap_ne 2811 : f003 > beq skip2114 > trap ;failed not equal (non zero) 2813 : 205b44 > jsr report_error > 2816 : >skip2114 > 2816 : 68 > pla ;load status 2817 : 48 > pha > cmp_flag fzc 2818 : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 281a : f003 > beq skip2117 > trap ;failed not equal (non zero) 281c : 205b44 > jsr report_error > 281f : >skip2117 > 281f : 28 > plp ;restore status set_a $7e,0 > load_flag 0 2820 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2822 : 48 > pha ;use stack to load status 2823 : a97e > lda #$7e ;precharge accu 2825 : 28 > plp 2826 : dd1702 cmp abs1,x tst_a $7e,fn 2829 : 08 > php ;save flags 282a : c97e > cmp #$7e ;test result > trap_ne 282c : f003 > beq skip2122 > trap ;failed not equal (non zero) 282e : 205b44 > jsr report_error > 2831 : >skip2122 > 2831 : 68 > pla ;load status 2832 : 48 > pha > cmp_flag fn 2833 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2835 : f003 > beq skip2125 > trap ;failed not equal (non zero) 2837 : 205b44 > jsr report_error > 283a : >skip2125 > 283a : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 283b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 283d : 48 > pha ;use stack to load status 283e : a980 > lda #$80 ;precharge accu 2840 : 28 > plp 2841 : dd1702 cmp abs1,x tst_a $80,~fnz 2844 : 08 > php ;save flags 2845 : c980 > cmp #$80 ;test result > trap_ne 2847 : f003 > beq skip2130 > trap ;failed not equal (non zero) 2849 : 205b44 > jsr report_error > 284c : >skip2130 > 284c : 68 > pla ;load status 284d : 48 > pha > cmp_flag ~fnz 284e : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2850 : f003 > beq skip2133 > trap ;failed not equal (non zero) 2852 : 205b44 > jsr report_error > 2855 : >skip2133 > 2855 : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 2856 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2858 : 48 > pha ;use stack to load status 2859 : a97f > lda #$7f ;precharge accu 285b : 28 > plp 285c : dd1702 cmp abs1,x tst_a $7f,~fn 285f : 08 > php ;save flags 2860 : c97f > cmp #$7f ;test result > trap_ne 2862 : f003 > beq skip2138 > trap ;failed not equal (non zero) 2864 : 205b44 > jsr report_error > 2867 : >skip2138 > 2867 : 68 > pla ;load status 2868 : 48 > pha > cmp_flag ~fn 2869 : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 286b : f003 > beq skip2141 > trap ;failed not equal (non zero) 286d : 205b44 > jsr report_error > 2870 : >skip2141 > 2870 : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 2871 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2873 : 48 > pha ;use stack to load status 2874 : a97e > lda #$7e ;precharge accu 2876 : 28 > plp 2877 : dd1702 cmp abs1,x tst_a $7e,~fzc 287a : 08 > php ;save flags 287b : c97e > cmp #$7e ;test result > trap_ne 287d : f003 > beq skip2146 > trap ;failed not equal (non zero) 287f : 205b44 > jsr report_error > 2882 : >skip2146 > 2882 : 68 > pla ;load status 2883 : 48 > pha > cmp_flag ~fzc 2884 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2886 : f003 > beq skip2149 > trap ;failed not equal (non zero) 2888 : 205b44 > jsr report_error > 288b : >skip2149 > 288b : 28 > plp ;restore status 288c : a004 ldy #4 ;with indexing by Y 288e : a208 ldx #8 ;with indexed indirect set_a $80,0 > load_flag 0 2890 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2892 : 48 > pha ;use stack to load status 2893 : a980 > lda #$80 ;precharge accu 2895 : 28 > plp 2896 : d91702 cmp abs1,y tst_a $80,fc 2899 : 08 > php ;save flags 289a : c980 > cmp #$80 ;test result > trap_ne 289c : f003 > beq skip2154 > trap ;failed not equal (non zero) 289e : 205b44 > jsr report_error > 28a1 : >skip2154 > 28a1 : 68 > pla ;load status 28a2 : 48 > pha > cmp_flag fc 28a3 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 28a5 : f003 > beq skip2157 > trap ;failed not equal (non zero) 28a7 : 205b44 > jsr report_error > 28aa : >skip2157 > 28aa : 28 > plp ;restore status set_a $7f,0 > load_flag 0 28ab : a900 > lda #0 ;allow test to change I-flag (no mask) > 28ad : 48 > pha ;use stack to load status 28ae : a97f > lda #$7f ;precharge accu 28b0 : 28 > plp 28b1 : d91702 cmp abs1,y tst_a $7f,fzc 28b4 : 08 > php ;save flags 28b5 : c97f > cmp #$7f ;test result > trap_ne 28b7 : f003 > beq skip2162 > trap ;failed not equal (non zero) 28b9 : 205b44 > jsr report_error > 28bc : >skip2162 > 28bc : 68 > pla ;load status 28bd : 48 > pha > cmp_flag fzc 28be : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 28c0 : f003 > beq skip2165 > trap ;failed not equal (non zero) 28c2 : 205b44 > jsr report_error > 28c5 : >skip2165 > 28c5 : 28 > plp ;restore status set_a $7e,0 > load_flag 0 28c6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 28c8 : 48 > pha ;use stack to load status 28c9 : a97e > lda #$7e ;precharge accu 28cb : 28 > plp 28cc : d91702 cmp abs1,y tst_a $7e,fn 28cf : 08 > php ;save flags 28d0 : c97e > cmp #$7e ;test result > trap_ne 28d2 : f003 > beq skip2170 > trap ;failed not equal (non zero) 28d4 : 205b44 > jsr report_error > 28d7 : >skip2170 > 28d7 : 68 > pla ;load status 28d8 : 48 > pha > cmp_flag fn 28d9 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 28db : f003 > beq skip2173 > trap ;failed not equal (non zero) 28dd : 205b44 > jsr report_error > 28e0 : >skip2173 > 28e0 : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 28e1 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 28e3 : 48 > pha ;use stack to load status 28e4 : a980 > lda #$80 ;precharge accu 28e6 : 28 > plp 28e7 : d91702 cmp abs1,y tst_a $80,~fnz 28ea : 08 > php ;save flags 28eb : c980 > cmp #$80 ;test result > trap_ne 28ed : f003 > beq skip2178 > trap ;failed not equal (non zero) 28ef : 205b44 > jsr report_error > 28f2 : >skip2178 > 28f2 : 68 > pla ;load status 28f3 : 48 > pha > cmp_flag ~fnz 28f4 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 28f6 : f003 > beq skip2181 > trap ;failed not equal (non zero) 28f8 : 205b44 > jsr report_error > 28fb : >skip2181 > 28fb : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 28fc : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 28fe : 48 > pha ;use stack to load status 28ff : a97f > lda #$7f ;precharge accu 2901 : 28 > plp 2902 : d91702 cmp abs1,y tst_a $7f,~fn 2905 : 08 > php ;save flags 2906 : c97f > cmp #$7f ;test result > trap_ne 2908 : f003 > beq skip2186 > trap ;failed not equal (non zero) 290a : 205b44 > jsr report_error > 290d : >skip2186 > 290d : 68 > pla ;load status 290e : 48 > pha > cmp_flag ~fn 290f : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2911 : f003 > beq skip2189 > trap ;failed not equal (non zero) 2913 : 205b44 > jsr report_error > 2916 : >skip2189 > 2916 : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 2917 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2919 : 48 > pha ;use stack to load status 291a : a97e > lda #$7e ;precharge accu 291c : 28 > plp 291d : d91702 cmp abs1,y tst_a $7e,~fzc 2920 : 08 > php ;save flags 2921 : c97e > cmp #$7e ;test result > trap_ne 2923 : f003 > beq skip2194 > trap ;failed not equal (non zero) 2925 : 205b44 > jsr report_error > 2928 : >skip2194 > 2928 : 68 > pla ;load status 2929 : 48 > pha > cmp_flag ~fzc 292a : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 292c : f003 > beq skip2197 > trap ;failed not equal (non zero) 292e : 205b44 > jsr report_error > 2931 : >skip2197 > 2931 : 28 > plp ;restore status set_a $80,0 > load_flag 0 2932 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2934 : 48 > pha ;use stack to load status 2935 : a980 > lda #$80 ;precharge accu 2937 : 28 > plp 2938 : c124 cmp (ind1,x) tst_a $80,fc 293a : 08 > php ;save flags 293b : c980 > cmp #$80 ;test result > trap_ne 293d : f003 > beq skip2202 > trap ;failed not equal (non zero) 293f : 205b44 > jsr report_error > 2942 : >skip2202 > 2942 : 68 > pla ;load status 2943 : 48 > pha > cmp_flag fc 2944 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 2946 : f003 > beq skip2205 > trap ;failed not equal (non zero) 2948 : 205b44 > jsr report_error > 294b : >skip2205 > 294b : 28 > plp ;restore status set_a $7f,0 > load_flag 0 294c : a900 > lda #0 ;allow test to change I-flag (no mask) > 294e : 48 > pha ;use stack to load status 294f : a97f > lda #$7f ;precharge accu 2951 : 28 > plp 2952 : c124 cmp (ind1,x) tst_a $7f,fzc 2954 : 08 > php ;save flags 2955 : c97f > cmp #$7f ;test result > trap_ne 2957 : f003 > beq skip2210 > trap ;failed not equal (non zero) 2959 : 205b44 > jsr report_error > 295c : >skip2210 > 295c : 68 > pla ;load status 295d : 48 > pha > cmp_flag fzc 295e : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2960 : f003 > beq skip2213 > trap ;failed not equal (non zero) 2962 : 205b44 > jsr report_error > 2965 : >skip2213 > 2965 : 28 > plp ;restore status set_a $7e,0 > load_flag 0 2966 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2968 : 48 > pha ;use stack to load status 2969 : a97e > lda #$7e ;precharge accu 296b : 28 > plp 296c : c124 cmp (ind1,x) tst_a $7e,fn 296e : 08 > php ;save flags 296f : c97e > cmp #$7e ;test result > trap_ne 2971 : f003 > beq skip2218 > trap ;failed not equal (non zero) 2973 : 205b44 > jsr report_error > 2976 : >skip2218 > 2976 : 68 > pla ;load status 2977 : 48 > pha > cmp_flag fn 2978 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 297a : f003 > beq skip2221 > trap ;failed not equal (non zero) 297c : 205b44 > jsr report_error > 297f : >skip2221 > 297f : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 2980 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2982 : 48 > pha ;use stack to load status 2983 : a980 > lda #$80 ;precharge accu 2985 : 28 > plp 2986 : c124 cmp (ind1,x) tst_a $80,~fnz 2988 : 08 > php ;save flags 2989 : c980 > cmp #$80 ;test result > trap_ne 298b : f003 > beq skip2226 > trap ;failed not equal (non zero) 298d : 205b44 > jsr report_error > 2990 : >skip2226 > 2990 : 68 > pla ;load status 2991 : 48 > pha > cmp_flag ~fnz 2992 : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2994 : f003 > beq skip2229 > trap ;failed not equal (non zero) 2996 : 205b44 > jsr report_error > 2999 : >skip2229 > 2999 : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 299a : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 299c : 48 > pha ;use stack to load status 299d : a97f > lda #$7f ;precharge accu 299f : 28 > plp 29a0 : c124 cmp (ind1,x) tst_a $7f,~fn 29a2 : 08 > php ;save flags 29a3 : c97f > cmp #$7f ;test result > trap_ne 29a5 : f003 > beq skip2234 > trap ;failed not equal (non zero) 29a7 : 205b44 > jsr report_error > 29aa : >skip2234 > 29aa : 68 > pla ;load status 29ab : 48 > pha > cmp_flag ~fn 29ac : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 29ae : f003 > beq skip2237 > trap ;failed not equal (non zero) 29b0 : 205b44 > jsr report_error > 29b3 : >skip2237 > 29b3 : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 29b4 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 29b6 : 48 > pha ;use stack to load status 29b7 : a97e > lda #$7e ;precharge accu 29b9 : 28 > plp 29ba : c124 cmp (ind1,x) tst_a $7e,~fzc 29bc : 08 > php ;save flags 29bd : c97e > cmp #$7e ;test result > trap_ne 29bf : f003 > beq skip2242 > trap ;failed not equal (non zero) 29c1 : 205b44 > jsr report_error > 29c4 : >skip2242 > 29c4 : 68 > pla ;load status 29c5 : 48 > pha > cmp_flag ~fzc 29c6 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 29c8 : f003 > beq skip2245 > trap ;failed not equal (non zero) 29ca : 205b44 > jsr report_error > 29cd : >skip2245 > 29cd : 28 > plp ;restore status set_a $80,0 > load_flag 0 29ce : a900 > lda #0 ;allow test to change I-flag (no mask) > 29d0 : 48 > pha ;use stack to load status 29d1 : a980 > lda #$80 ;precharge accu 29d3 : 28 > plp 29d4 : d124 cmp (ind1),y tst_a $80,fc 29d6 : 08 > php ;save flags 29d7 : c980 > cmp #$80 ;test result > trap_ne 29d9 : f003 > beq skip2250 > trap ;failed not equal (non zero) 29db : 205b44 > jsr report_error > 29de : >skip2250 > 29de : 68 > pla ;load status 29df : 48 > pha > cmp_flag fc 29e0 : c931 > cmp #(fc|fao)&m8 ;expected flags + always on bits > > trap_ne 29e2 : f003 > beq skip2253 > trap ;failed not equal (non zero) 29e4 : 205b44 > jsr report_error > 29e7 : >skip2253 > 29e7 : 28 > plp ;restore status set_a $7f,0 > load_flag 0 29e8 : a900 > lda #0 ;allow test to change I-flag (no mask) > 29ea : 48 > pha ;use stack to load status 29eb : a97f > lda #$7f ;precharge accu 29ed : 28 > plp 29ee : d124 cmp (ind1),y tst_a $7f,fzc 29f0 : 08 > php ;save flags 29f1 : c97f > cmp #$7f ;test result > trap_ne 29f3 : f003 > beq skip2258 > trap ;failed not equal (non zero) 29f5 : 205b44 > jsr report_error > 29f8 : >skip2258 > 29f8 : 68 > pla ;load status 29f9 : 48 > pha > cmp_flag fzc 29fa : c933 > cmp #(fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 29fc : f003 > beq skip2261 > trap ;failed not equal (non zero) 29fe : 205b44 > jsr report_error > 2a01 : >skip2261 > 2a01 : 28 > plp ;restore status set_a $7e,0 > load_flag 0 2a02 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2a04 : 48 > pha ;use stack to load status 2a05 : a97e > lda #$7e ;precharge accu 2a07 : 28 > plp 2a08 : d124 cmp (ind1),y tst_a $7e,fn 2a0a : 08 > php ;save flags 2a0b : c97e > cmp #$7e ;test result > trap_ne 2a0d : f003 > beq skip2266 > trap ;failed not equal (non zero) 2a0f : 205b44 > jsr report_error > 2a12 : >skip2266 > 2a12 : 68 > pla ;load status 2a13 : 48 > pha > cmp_flag fn 2a14 : c9b0 > cmp #(fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2a16 : f003 > beq skip2269 > trap ;failed not equal (non zero) 2a18 : 205b44 > jsr report_error > 2a1b : >skip2269 > 2a1b : 28 > plp ;restore status set_a $80,$ff > load_flag $ff 2a1c : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2a1e : 48 > pha ;use stack to load status 2a1f : a980 > lda #$80 ;precharge accu 2a21 : 28 > plp 2a22 : d124 cmp (ind1),y tst_a $80,~fnz 2a24 : 08 > php ;save flags 2a25 : c980 > cmp #$80 ;test result > trap_ne 2a27 : f003 > beq skip2274 > trap ;failed not equal (non zero) 2a29 : 205b44 > jsr report_error > 2a2c : >skip2274 > 2a2c : 68 > pla ;load status 2a2d : 48 > pha > cmp_flag ~fnz 2a2e : c97d > cmp #(~fnz|fao)&m8 ;expected flags + always on bits > > trap_ne 2a30 : f003 > beq skip2277 > trap ;failed not equal (non zero) 2a32 : 205b44 > jsr report_error > 2a35 : >skip2277 > 2a35 : 28 > plp ;restore status set_a $7f,$ff > load_flag $ff 2a36 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2a38 : 48 > pha ;use stack to load status 2a39 : a97f > lda #$7f ;precharge accu 2a3b : 28 > plp 2a3c : d124 cmp (ind1),y tst_a $7f,~fn 2a3e : 08 > php ;save flags 2a3f : c97f > cmp #$7f ;test result > trap_ne 2a41 : f003 > beq skip2282 > trap ;failed not equal (non zero) 2a43 : 205b44 > jsr report_error > 2a46 : >skip2282 > 2a46 : 68 > pla ;load status 2a47 : 48 > pha > cmp_flag ~fn 2a48 : c97f > cmp #(~fn|fao)&m8 ;expected flags + always on bits > > trap_ne 2a4a : f003 > beq skip2285 > trap ;failed not equal (non zero) 2a4c : 205b44 > jsr report_error > 2a4f : >skip2285 > 2a4f : 28 > plp ;restore status set_a $7e,$ff > load_flag $ff 2a50 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2a52 : 48 > pha ;use stack to load status 2a53 : a97e > lda #$7e ;precharge accu 2a55 : 28 > plp 2a56 : d124 cmp (ind1),y tst_a $7e,~fzc 2a58 : 08 > php ;save flags 2a59 : c97e > cmp #$7e ;test result > trap_ne 2a5b : f003 > beq skip2290 > trap ;failed not equal (non zero) 2a5d : 205b44 > jsr report_error > 2a60 : >skip2290 > 2a60 : 68 > pla ;load status 2a61 : 48 > pha > cmp_flag ~fzc 2a62 : c9fc > cmp #(~fzc|fao)&m8 ;expected flags + always on bits > > trap_ne 2a64 : f003 > beq skip2293 > trap ;failed not equal (non zero) 2a66 : 205b44 > jsr report_error > 2a69 : >skip2293 > 2a69 : 28 > plp ;restore status next_test 2a6a : ad0002 > lda test_case ;previous test 2a6d : c91c > cmp #test_num > trap_ne ;test is out of sequence 2a6f : f003 > beq skip2296 > trap ;failed not equal (non zero) 2a71 : 205b44 > jsr report_error > 2a74 : >skip2296 > 001d = >test_num = test_num + 1 2a74 : a91d > lda #test_num ;*** next tests' number 2a76 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; testing shifts - ASL LSR ROL ROR all addressing modes ; shifts - accumulator 2a79 : a203 ldx #3 2a7b : tasl set_ax zp1,0 > load_flag 0 2a7b : a900 > lda #0 ;allow test to change I-flag (no mask) > 2a7d : 48 > pha ;use stack to load status 2a7e : b513 > lda zp1,x ;precharge accu 2a80 : 28 > plp 2a81 : 0a asl a tst_ax rASL,fASL,0 2a82 : 08 > php ;save flags 2a83 : dd2002 > cmp rASL,x ;test result > trap_ne 2a86 : f003 > beq skip2301 > trap ;failed not equal (non zero) 2a88 : 205b44 > jsr report_error > 2a8b : >skip2301 > 2a8b : 68 > pla ;load status > eor_flag 0 2a8c : 4930 > eor #0|fao ;invert expected flags + always on bits > 2a8e : dd3002 > cmp fASL,x ;test flags > trap_ne ; 2a91 : f003 > beq skip2304 > trap ;failed not equal (non zero) 2a93 : 205b44 > jsr report_error > 2a96 : >skip2304 > 2a96 : ca dex 2a97 : 10e2 bpl tasl 2a99 : a203 ldx #3 2a9b : tasl1 set_ax zp1,$ff > load_flag $ff 2a9b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2a9d : 48 > pha ;use stack to load status 2a9e : b513 > lda zp1,x ;precharge accu 2aa0 : 28 > plp 2aa1 : 0a asl a tst_ax rASL,fASL,$ff-fnzc 2aa2 : 08 > php ;save flags 2aa3 : dd2002 > cmp rASL,x ;test result > trap_ne 2aa6 : f003 > beq skip2309 > trap ;failed not equal (non zero) 2aa8 : 205b44 > jsr report_error > 2aab : >skip2309 > 2aab : 68 > pla ;load status > eor_flag $ff-fnzc 2aac : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2aae : dd3002 > cmp fASL,x ;test flags > trap_ne ; 2ab1 : f003 > beq skip2312 > trap ;failed not equal (non zero) 2ab3 : 205b44 > jsr report_error > 2ab6 : >skip2312 > 2ab6 : ca dex 2ab7 : 10e2 bpl tasl1 2ab9 : a203 ldx #3 2abb : tlsr set_ax zp1,0 > load_flag 0 2abb : a900 > lda #0 ;allow test to change I-flag (no mask) > 2abd : 48 > pha ;use stack to load status 2abe : b513 > lda zp1,x ;precharge accu 2ac0 : 28 > plp 2ac1 : 4a lsr a tst_ax rLSR,fLSR,0 2ac2 : 08 > php ;save flags 2ac3 : dd2802 > cmp rLSR,x ;test result > trap_ne 2ac6 : f003 > beq skip2317 > trap ;failed not equal (non zero) 2ac8 : 205b44 > jsr report_error > 2acb : >skip2317 > 2acb : 68 > pla ;load status > eor_flag 0 2acc : 4930 > eor #0|fao ;invert expected flags + always on bits > 2ace : dd3802 > cmp fLSR,x ;test flags > trap_ne ; 2ad1 : f003 > beq skip2320 > trap ;failed not equal (non zero) 2ad3 : 205b44 > jsr report_error > 2ad6 : >skip2320 > 2ad6 : ca dex 2ad7 : 10e2 bpl tlsr 2ad9 : a203 ldx #3 2adb : tlsr1 set_ax zp1,$ff > load_flag $ff 2adb : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2add : 48 > pha ;use stack to load status 2ade : b513 > lda zp1,x ;precharge accu 2ae0 : 28 > plp 2ae1 : 4a lsr a tst_ax rLSR,fLSR,$ff-fnzc 2ae2 : 08 > php ;save flags 2ae3 : dd2802 > cmp rLSR,x ;test result > trap_ne 2ae6 : f003 > beq skip2325 > trap ;failed not equal (non zero) 2ae8 : 205b44 > jsr report_error > 2aeb : >skip2325 > 2aeb : 68 > pla ;load status > eor_flag $ff-fnzc 2aec : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2aee : dd3802 > cmp fLSR,x ;test flags > trap_ne ; 2af1 : f003 > beq skip2328 > trap ;failed not equal (non zero) 2af3 : 205b44 > jsr report_error > 2af6 : >skip2328 > 2af6 : ca dex 2af7 : 10e2 bpl tlsr1 2af9 : a203 ldx #3 2afb : trol set_ax zp1,0 > load_flag 0 2afb : a900 > lda #0 ;allow test to change I-flag (no mask) > 2afd : 48 > pha ;use stack to load status 2afe : b513 > lda zp1,x ;precharge accu 2b00 : 28 > plp 2b01 : 2a rol a tst_ax rROL,fROL,0 2b02 : 08 > php ;save flags 2b03 : dd2002 > cmp rROL,x ;test result > trap_ne 2b06 : f003 > beq skip2333 > trap ;failed not equal (non zero) 2b08 : 205b44 > jsr report_error > 2b0b : >skip2333 > 2b0b : 68 > pla ;load status > eor_flag 0 2b0c : 4930 > eor #0|fao ;invert expected flags + always on bits > 2b0e : dd3002 > cmp fROL,x ;test flags > trap_ne ; 2b11 : f003 > beq skip2336 > trap ;failed not equal (non zero) 2b13 : 205b44 > jsr report_error > 2b16 : >skip2336 > 2b16 : ca dex 2b17 : 10e2 bpl trol 2b19 : a203 ldx #3 2b1b : trol1 set_ax zp1,$ff-fc > load_flag $ff-fc 2b1b : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 2b1d : 48 > pha ;use stack to load status 2b1e : b513 > lda zp1,x ;precharge accu 2b20 : 28 > plp 2b21 : 2a rol a tst_ax rROL,fROL,$ff-fnzc 2b22 : 08 > php ;save flags 2b23 : dd2002 > cmp rROL,x ;test result > trap_ne 2b26 : f003 > beq skip2341 > trap ;failed not equal (non zero) 2b28 : 205b44 > jsr report_error > 2b2b : >skip2341 > 2b2b : 68 > pla ;load status > eor_flag $ff-fnzc 2b2c : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2b2e : dd3002 > cmp fROL,x ;test flags > trap_ne ; 2b31 : f003 > beq skip2344 > trap ;failed not equal (non zero) 2b33 : 205b44 > jsr report_error > 2b36 : >skip2344 > 2b36 : ca dex 2b37 : 10e2 bpl trol1 2b39 : a203 ldx #3 2b3b : trolc set_ax zp1,fc > load_flag fc 2b3b : a901 > lda #fc ;allow test to change I-flag (no mask) > 2b3d : 48 > pha ;use stack to load status 2b3e : b513 > lda zp1,x ;precharge accu 2b40 : 28 > plp 2b41 : 2a rol a tst_ax rROLc,fROLc,0 2b42 : 08 > php ;save flags 2b43 : dd2402 > cmp rROLc,x ;test result > trap_ne 2b46 : f003 > beq skip2349 > trap ;failed not equal (non zero) 2b48 : 205b44 > jsr report_error > 2b4b : >skip2349 > 2b4b : 68 > pla ;load status > eor_flag 0 2b4c : 4930 > eor #0|fao ;invert expected flags + always on bits > 2b4e : dd3402 > cmp fROLc,x ;test flags > trap_ne ; 2b51 : f003 > beq skip2352 > trap ;failed not equal (non zero) 2b53 : 205b44 > jsr report_error > 2b56 : >skip2352 > 2b56 : ca dex 2b57 : 10e2 bpl trolc 2b59 : a203 ldx #3 2b5b : trolc1 set_ax zp1,$ff > load_flag $ff 2b5b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2b5d : 48 > pha ;use stack to load status 2b5e : b513 > lda zp1,x ;precharge accu 2b60 : 28 > plp 2b61 : 2a rol a tst_ax rROLc,fROLc,$ff-fnzc 2b62 : 08 > php ;save flags 2b63 : dd2402 > cmp rROLc,x ;test result > trap_ne 2b66 : f003 > beq skip2357 > trap ;failed not equal (non zero) 2b68 : 205b44 > jsr report_error > 2b6b : >skip2357 > 2b6b : 68 > pla ;load status > eor_flag $ff-fnzc 2b6c : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2b6e : dd3402 > cmp fROLc,x ;test flags > trap_ne ; 2b71 : f003 > beq skip2360 > trap ;failed not equal (non zero) 2b73 : 205b44 > jsr report_error > 2b76 : >skip2360 > 2b76 : ca dex 2b77 : 10e2 bpl trolc1 2b79 : a203 ldx #3 2b7b : tror set_ax zp1,0 > load_flag 0 2b7b : a900 > lda #0 ;allow test to change I-flag (no mask) > 2b7d : 48 > pha ;use stack to load status 2b7e : b513 > lda zp1,x ;precharge accu 2b80 : 28 > plp 2b81 : 6a ror a tst_ax rROR,fROR,0 2b82 : 08 > php ;save flags 2b83 : dd2802 > cmp rROR,x ;test result > trap_ne 2b86 : f003 > beq skip2365 > trap ;failed not equal (non zero) 2b88 : 205b44 > jsr report_error > 2b8b : >skip2365 > 2b8b : 68 > pla ;load status > eor_flag 0 2b8c : 4930 > eor #0|fao ;invert expected flags + always on bits > 2b8e : dd3802 > cmp fROR,x ;test flags > trap_ne ; 2b91 : f003 > beq skip2368 > trap ;failed not equal (non zero) 2b93 : 205b44 > jsr report_error > 2b96 : >skip2368 > 2b96 : ca dex 2b97 : 10e2 bpl tror 2b99 : a203 ldx #3 2b9b : tror1 set_ax zp1,$ff-fc > load_flag $ff-fc 2b9b : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 2b9d : 48 > pha ;use stack to load status 2b9e : b513 > lda zp1,x ;precharge accu 2ba0 : 28 > plp 2ba1 : 6a ror a tst_ax rROR,fROR,$ff-fnzc 2ba2 : 08 > php ;save flags 2ba3 : dd2802 > cmp rROR,x ;test result > trap_ne 2ba6 : f003 > beq skip2373 > trap ;failed not equal (non zero) 2ba8 : 205b44 > jsr report_error > 2bab : >skip2373 > 2bab : 68 > pla ;load status > eor_flag $ff-fnzc 2bac : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2bae : dd3802 > cmp fROR,x ;test flags > trap_ne ; 2bb1 : f003 > beq skip2376 > trap ;failed not equal (non zero) 2bb3 : 205b44 > jsr report_error > 2bb6 : >skip2376 > 2bb6 : ca dex 2bb7 : 10e2 bpl tror1 2bb9 : a203 ldx #3 2bbb : trorc set_ax zp1,fc > load_flag fc 2bbb : a901 > lda #fc ;allow test to change I-flag (no mask) > 2bbd : 48 > pha ;use stack to load status 2bbe : b513 > lda zp1,x ;precharge accu 2bc0 : 28 > plp 2bc1 : 6a ror a tst_ax rRORc,fRORc,0 2bc2 : 08 > php ;save flags 2bc3 : dd2c02 > cmp rRORc,x ;test result > trap_ne 2bc6 : f003 > beq skip2381 > trap ;failed not equal (non zero) 2bc8 : 205b44 > jsr report_error > 2bcb : >skip2381 > 2bcb : 68 > pla ;load status > eor_flag 0 2bcc : 4930 > eor #0|fao ;invert expected flags + always on bits > 2bce : dd3c02 > cmp fRORc,x ;test flags > trap_ne ; 2bd1 : f003 > beq skip2384 > trap ;failed not equal (non zero) 2bd3 : 205b44 > jsr report_error > 2bd6 : >skip2384 > 2bd6 : ca dex 2bd7 : 10e2 bpl trorc 2bd9 : a203 ldx #3 2bdb : trorc1 set_ax zp1,$ff > load_flag $ff 2bdb : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2bdd : 48 > pha ;use stack to load status 2bde : b513 > lda zp1,x ;precharge accu 2be0 : 28 > plp 2be1 : 6a ror a tst_ax rRORc,fRORc,$ff-fnzc 2be2 : 08 > php ;save flags 2be3 : dd2c02 > cmp rRORc,x ;test result > trap_ne 2be6 : f003 > beq skip2389 > trap ;failed not equal (non zero) 2be8 : 205b44 > jsr report_error > 2beb : >skip2389 > 2beb : 68 > pla ;load status > eor_flag $ff-fnzc 2bec : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2bee : dd3c02 > cmp fRORc,x ;test flags > trap_ne ; 2bf1 : f003 > beq skip2392 > trap ;failed not equal (non zero) 2bf3 : 205b44 > jsr report_error > 2bf6 : >skip2392 > 2bf6 : ca dex 2bf7 : 10e2 bpl trorc1 next_test 2bf9 : ad0002 > lda test_case ;previous test 2bfc : c91d > cmp #test_num > trap_ne ;test is out of sequence 2bfe : f003 > beq skip2395 > trap ;failed not equal (non zero) 2c00 : 205b44 > jsr report_error > 2c03 : >skip2395 > 001e = >test_num = test_num + 1 2c03 : a91e > lda #test_num ;*** next tests' number 2c05 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; shifts - zeropage 2c08 : a203 ldx #3 2c0a : tasl2 set_z zp1,0 > load_flag 0 2c0a : a900 > lda #0 ;allow test to change I-flag (no mask) > 2c0c : 48 > pha ;use stack to load status 2c0d : b513 > lda zp1,x ;load to zeropage 2c0f : 850c > sta zpt 2c11 : 28 > plp 2c12 : 060c asl zpt tst_z rASL,fASL,0 2c14 : 08 > php ;save flags 2c15 : a50c > lda zpt 2c17 : dd2002 > cmp rASL,x ;test result > trap_ne 2c1a : f003 > beq skip2400 > trap ;failed not equal (non zero) 2c1c : 205b44 > jsr report_error > 2c1f : >skip2400 > 2c1f : 68 > pla ;load status > eor_flag 0 2c20 : 4930 > eor #0|fao ;invert expected flags + always on bits > 2c22 : dd3002 > cmp fASL,x ;test flags > trap_ne 2c25 : f003 > beq skip2403 > trap ;failed not equal (non zero) 2c27 : 205b44 > jsr report_error > 2c2a : >skip2403 > 2c2a : ca dex 2c2b : 10dd bpl tasl2 2c2d : a203 ldx #3 2c2f : tasl3 set_z zp1,$ff > load_flag $ff 2c2f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2c31 : 48 > pha ;use stack to load status 2c32 : b513 > lda zp1,x ;load to zeropage 2c34 : 850c > sta zpt 2c36 : 28 > plp 2c37 : 060c asl zpt tst_z rASL,fASL,$ff-fnzc 2c39 : 08 > php ;save flags 2c3a : a50c > lda zpt 2c3c : dd2002 > cmp rASL,x ;test result > trap_ne 2c3f : f003 > beq skip2408 > trap ;failed not equal (non zero) 2c41 : 205b44 > jsr report_error > 2c44 : >skip2408 > 2c44 : 68 > pla ;load status > eor_flag $ff-fnzc 2c45 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2c47 : dd3002 > cmp fASL,x ;test flags > trap_ne 2c4a : f003 > beq skip2411 > trap ;failed not equal (non zero) 2c4c : 205b44 > jsr report_error > 2c4f : >skip2411 > 2c4f : ca dex 2c50 : 10dd bpl tasl3 2c52 : a203 ldx #3 2c54 : tlsr2 set_z zp1,0 > load_flag 0 2c54 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2c56 : 48 > pha ;use stack to load status 2c57 : b513 > lda zp1,x ;load to zeropage 2c59 : 850c > sta zpt 2c5b : 28 > plp 2c5c : 460c lsr zpt tst_z rLSR,fLSR,0 2c5e : 08 > php ;save flags 2c5f : a50c > lda zpt 2c61 : dd2802 > cmp rLSR,x ;test result > trap_ne 2c64 : f003 > beq skip2416 > trap ;failed not equal (non zero) 2c66 : 205b44 > jsr report_error > 2c69 : >skip2416 > 2c69 : 68 > pla ;load status > eor_flag 0 2c6a : 4930 > eor #0|fao ;invert expected flags + always on bits > 2c6c : dd3802 > cmp fLSR,x ;test flags > trap_ne 2c6f : f003 > beq skip2419 > trap ;failed not equal (non zero) 2c71 : 205b44 > jsr report_error > 2c74 : >skip2419 > 2c74 : ca dex 2c75 : 10dd bpl tlsr2 2c77 : a203 ldx #3 2c79 : tlsr3 set_z zp1,$ff > load_flag $ff 2c79 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2c7b : 48 > pha ;use stack to load status 2c7c : b513 > lda zp1,x ;load to zeropage 2c7e : 850c > sta zpt 2c80 : 28 > plp 2c81 : 460c lsr zpt tst_z rLSR,fLSR,$ff-fnzc 2c83 : 08 > php ;save flags 2c84 : a50c > lda zpt 2c86 : dd2802 > cmp rLSR,x ;test result > trap_ne 2c89 : f003 > beq skip2424 > trap ;failed not equal (non zero) 2c8b : 205b44 > jsr report_error > 2c8e : >skip2424 > 2c8e : 68 > pla ;load status > eor_flag $ff-fnzc 2c8f : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2c91 : dd3802 > cmp fLSR,x ;test flags > trap_ne 2c94 : f003 > beq skip2427 > trap ;failed not equal (non zero) 2c96 : 205b44 > jsr report_error > 2c99 : >skip2427 > 2c99 : ca dex 2c9a : 10dd bpl tlsr3 2c9c : a203 ldx #3 2c9e : trol2 set_z zp1,0 > load_flag 0 2c9e : a900 > lda #0 ;allow test to change I-flag (no mask) > 2ca0 : 48 > pha ;use stack to load status 2ca1 : b513 > lda zp1,x ;load to zeropage 2ca3 : 850c > sta zpt 2ca5 : 28 > plp 2ca6 : 260c rol zpt tst_z rROL,fROL,0 2ca8 : 08 > php ;save flags 2ca9 : a50c > lda zpt 2cab : dd2002 > cmp rROL,x ;test result > trap_ne 2cae : f003 > beq skip2432 > trap ;failed not equal (non zero) 2cb0 : 205b44 > jsr report_error > 2cb3 : >skip2432 > 2cb3 : 68 > pla ;load status > eor_flag 0 2cb4 : 4930 > eor #0|fao ;invert expected flags + always on bits > 2cb6 : dd3002 > cmp fROL,x ;test flags > trap_ne 2cb9 : f003 > beq skip2435 > trap ;failed not equal (non zero) 2cbb : 205b44 > jsr report_error > 2cbe : >skip2435 > 2cbe : ca dex 2cbf : 10dd bpl trol2 2cc1 : a203 ldx #3 2cc3 : trol3 set_z zp1,$ff-fc > load_flag $ff-fc 2cc3 : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 2cc5 : 48 > pha ;use stack to load status 2cc6 : b513 > lda zp1,x ;load to zeropage 2cc8 : 850c > sta zpt 2cca : 28 > plp 2ccb : 260c rol zpt tst_z rROL,fROL,$ff-fnzc 2ccd : 08 > php ;save flags 2cce : a50c > lda zpt 2cd0 : dd2002 > cmp rROL,x ;test result > trap_ne 2cd3 : f003 > beq skip2440 > trap ;failed not equal (non zero) 2cd5 : 205b44 > jsr report_error > 2cd8 : >skip2440 > 2cd8 : 68 > pla ;load status > eor_flag $ff-fnzc 2cd9 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2cdb : dd3002 > cmp fROL,x ;test flags > trap_ne 2cde : f003 > beq skip2443 > trap ;failed not equal (non zero) 2ce0 : 205b44 > jsr report_error > 2ce3 : >skip2443 > 2ce3 : ca dex 2ce4 : 10dd bpl trol3 2ce6 : a203 ldx #3 2ce8 : trolc2 set_z zp1,fc > load_flag fc 2ce8 : a901 > lda #fc ;allow test to change I-flag (no mask) > 2cea : 48 > pha ;use stack to load status 2ceb : b513 > lda zp1,x ;load to zeropage 2ced : 850c > sta zpt 2cef : 28 > plp 2cf0 : 260c rol zpt tst_z rROLc,fROLc,0 2cf2 : 08 > php ;save flags 2cf3 : a50c > lda zpt 2cf5 : dd2402 > cmp rROLc,x ;test result > trap_ne 2cf8 : f003 > beq skip2448 > trap ;failed not equal (non zero) 2cfa : 205b44 > jsr report_error > 2cfd : >skip2448 > 2cfd : 68 > pla ;load status > eor_flag 0 2cfe : 4930 > eor #0|fao ;invert expected flags + always on bits > 2d00 : dd3402 > cmp fROLc,x ;test flags > trap_ne 2d03 : f003 > beq skip2451 > trap ;failed not equal (non zero) 2d05 : 205b44 > jsr report_error > 2d08 : >skip2451 > 2d08 : ca dex 2d09 : 10dd bpl trolc2 2d0b : a203 ldx #3 2d0d : trolc3 set_z zp1,$ff > load_flag $ff 2d0d : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2d0f : 48 > pha ;use stack to load status 2d10 : b513 > lda zp1,x ;load to zeropage 2d12 : 850c > sta zpt 2d14 : 28 > plp 2d15 : 260c rol zpt tst_z rROLc,fROLc,$ff-fnzc 2d17 : 08 > php ;save flags 2d18 : a50c > lda zpt 2d1a : dd2402 > cmp rROLc,x ;test result > trap_ne 2d1d : f003 > beq skip2456 > trap ;failed not equal (non zero) 2d1f : 205b44 > jsr report_error > 2d22 : >skip2456 > 2d22 : 68 > pla ;load status > eor_flag $ff-fnzc 2d23 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2d25 : dd3402 > cmp fROLc,x ;test flags > trap_ne 2d28 : f003 > beq skip2459 > trap ;failed not equal (non zero) 2d2a : 205b44 > jsr report_error > 2d2d : >skip2459 > 2d2d : ca dex 2d2e : 10dd bpl trolc3 2d30 : a203 ldx #3 2d32 : tror2 set_z zp1,0 > load_flag 0 2d32 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2d34 : 48 > pha ;use stack to load status 2d35 : b513 > lda zp1,x ;load to zeropage 2d37 : 850c > sta zpt 2d39 : 28 > plp 2d3a : 660c ror zpt tst_z rROR,fROR,0 2d3c : 08 > php ;save flags 2d3d : a50c > lda zpt 2d3f : dd2802 > cmp rROR,x ;test result > trap_ne 2d42 : f003 > beq skip2464 > trap ;failed not equal (non zero) 2d44 : 205b44 > jsr report_error > 2d47 : >skip2464 > 2d47 : 68 > pla ;load status > eor_flag 0 2d48 : 4930 > eor #0|fao ;invert expected flags + always on bits > 2d4a : dd3802 > cmp fROR,x ;test flags > trap_ne 2d4d : f003 > beq skip2467 > trap ;failed not equal (non zero) 2d4f : 205b44 > jsr report_error > 2d52 : >skip2467 > 2d52 : ca dex 2d53 : 10dd bpl tror2 2d55 : a203 ldx #3 2d57 : tror3 set_z zp1,$ff-fc > load_flag $ff-fc 2d57 : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 2d59 : 48 > pha ;use stack to load status 2d5a : b513 > lda zp1,x ;load to zeropage 2d5c : 850c > sta zpt 2d5e : 28 > plp 2d5f : 660c ror zpt tst_z rROR,fROR,$ff-fnzc 2d61 : 08 > php ;save flags 2d62 : a50c > lda zpt 2d64 : dd2802 > cmp rROR,x ;test result > trap_ne 2d67 : f003 > beq skip2472 > trap ;failed not equal (non zero) 2d69 : 205b44 > jsr report_error > 2d6c : >skip2472 > 2d6c : 68 > pla ;load status > eor_flag $ff-fnzc 2d6d : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2d6f : dd3802 > cmp fROR,x ;test flags > trap_ne 2d72 : f003 > beq skip2475 > trap ;failed not equal (non zero) 2d74 : 205b44 > jsr report_error > 2d77 : >skip2475 > 2d77 : ca dex 2d78 : 10dd bpl tror3 2d7a : a203 ldx #3 2d7c : trorc2 set_z zp1,fc > load_flag fc 2d7c : a901 > lda #fc ;allow test to change I-flag (no mask) > 2d7e : 48 > pha ;use stack to load status 2d7f : b513 > lda zp1,x ;load to zeropage 2d81 : 850c > sta zpt 2d83 : 28 > plp 2d84 : 660c ror zpt tst_z rRORc,fRORc,0 2d86 : 08 > php ;save flags 2d87 : a50c > lda zpt 2d89 : dd2c02 > cmp rRORc,x ;test result > trap_ne 2d8c : f003 > beq skip2480 > trap ;failed not equal (non zero) 2d8e : 205b44 > jsr report_error > 2d91 : >skip2480 > 2d91 : 68 > pla ;load status > eor_flag 0 2d92 : 4930 > eor #0|fao ;invert expected flags + always on bits > 2d94 : dd3c02 > cmp fRORc,x ;test flags > trap_ne 2d97 : f003 > beq skip2483 > trap ;failed not equal (non zero) 2d99 : 205b44 > jsr report_error > 2d9c : >skip2483 > 2d9c : ca dex 2d9d : 10dd bpl trorc2 2d9f : a203 ldx #3 2da1 : trorc3 set_z zp1,$ff > load_flag $ff 2da1 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2da3 : 48 > pha ;use stack to load status 2da4 : b513 > lda zp1,x ;load to zeropage 2da6 : 850c > sta zpt 2da8 : 28 > plp 2da9 : 660c ror zpt tst_z rRORc,fRORc,$ff-fnzc 2dab : 08 > php ;save flags 2dac : a50c > lda zpt 2dae : dd2c02 > cmp rRORc,x ;test result > trap_ne 2db1 : f003 > beq skip2488 > trap ;failed not equal (non zero) 2db3 : 205b44 > jsr report_error > 2db6 : >skip2488 > 2db6 : 68 > pla ;load status > eor_flag $ff-fnzc 2db7 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2db9 : dd3c02 > cmp fRORc,x ;test flags > trap_ne 2dbc : f003 > beq skip2491 > trap ;failed not equal (non zero) 2dbe : 205b44 > jsr report_error > 2dc1 : >skip2491 > 2dc1 : ca dex 2dc2 : 10dd bpl trorc3 next_test 2dc4 : ad0002 > lda test_case ;previous test 2dc7 : c91e > cmp #test_num > trap_ne ;test is out of sequence 2dc9 : f003 > beq skip2494 > trap ;failed not equal (non zero) 2dcb : 205b44 > jsr report_error > 2dce : >skip2494 > 001f = >test_num = test_num + 1 2dce : a91f > lda #test_num ;*** next tests' number 2dd0 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; shifts - absolute 2dd3 : a203 ldx #3 2dd5 : tasl4 set_abs zp1,0 > load_flag 0 2dd5 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2dd7 : 48 > pha ;use stack to load status 2dd8 : b513 > lda zp1,x ;load to memory 2dda : 8d0302 > sta abst 2ddd : 28 > plp 2dde : 0e0302 asl abst tst_abs rASL,fASL,0 2de1 : 08 > php ;save flags 2de2 : ad0302 > lda abst 2de5 : dd2002 > cmp rASL,x ;test result > trap_ne 2de8 : f003 > beq skip2499 > trap ;failed not equal (non zero) 2dea : 205b44 > jsr report_error > 2ded : >skip2499 > 2ded : 68 > pla ;load status > eor_flag 0 2dee : 4930 > eor #0|fao ;invert expected flags + always on bits > 2df0 : dd3002 > cmp fASL,x ;test flags > trap_ne 2df3 : f003 > beq skip2502 > trap ;failed not equal (non zero) 2df5 : 205b44 > jsr report_error > 2df8 : >skip2502 > 2df8 : ca dex 2df9 : 10da bpl tasl4 2dfb : a203 ldx #3 2dfd : tasl5 set_abs zp1,$ff > load_flag $ff 2dfd : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2dff : 48 > pha ;use stack to load status 2e00 : b513 > lda zp1,x ;load to memory 2e02 : 8d0302 > sta abst 2e05 : 28 > plp 2e06 : 0e0302 asl abst tst_abs rASL,fASL,$ff-fnzc 2e09 : 08 > php ;save flags 2e0a : ad0302 > lda abst 2e0d : dd2002 > cmp rASL,x ;test result > trap_ne 2e10 : f003 > beq skip2507 > trap ;failed not equal (non zero) 2e12 : 205b44 > jsr report_error > 2e15 : >skip2507 > 2e15 : 68 > pla ;load status > eor_flag $ff-fnzc 2e16 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2e18 : dd3002 > cmp fASL,x ;test flags > trap_ne 2e1b : f003 > beq skip2510 > trap ;failed not equal (non zero) 2e1d : 205b44 > jsr report_error > 2e20 : >skip2510 > 2e20 : ca dex 2e21 : 10da bpl tasl5 2e23 : a203 ldx #3 2e25 : tlsr4 set_abs zp1,0 > load_flag 0 2e25 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2e27 : 48 > pha ;use stack to load status 2e28 : b513 > lda zp1,x ;load to memory 2e2a : 8d0302 > sta abst 2e2d : 28 > plp 2e2e : 4e0302 lsr abst tst_abs rLSR,fLSR,0 2e31 : 08 > php ;save flags 2e32 : ad0302 > lda abst 2e35 : dd2802 > cmp rLSR,x ;test result > trap_ne 2e38 : f003 > beq skip2515 > trap ;failed not equal (non zero) 2e3a : 205b44 > jsr report_error > 2e3d : >skip2515 > 2e3d : 68 > pla ;load status > eor_flag 0 2e3e : 4930 > eor #0|fao ;invert expected flags + always on bits > 2e40 : dd3802 > cmp fLSR,x ;test flags > trap_ne 2e43 : f003 > beq skip2518 > trap ;failed not equal (non zero) 2e45 : 205b44 > jsr report_error > 2e48 : >skip2518 > 2e48 : ca dex 2e49 : 10da bpl tlsr4 2e4b : a203 ldx #3 2e4d : tlsr5 set_abs zp1,$ff > load_flag $ff 2e4d : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2e4f : 48 > pha ;use stack to load status 2e50 : b513 > lda zp1,x ;load to memory 2e52 : 8d0302 > sta abst 2e55 : 28 > plp 2e56 : 4e0302 lsr abst tst_abs rLSR,fLSR,$ff-fnzc 2e59 : 08 > php ;save flags 2e5a : ad0302 > lda abst 2e5d : dd2802 > cmp rLSR,x ;test result > trap_ne 2e60 : f003 > beq skip2523 > trap ;failed not equal (non zero) 2e62 : 205b44 > jsr report_error > 2e65 : >skip2523 > 2e65 : 68 > pla ;load status > eor_flag $ff-fnzc 2e66 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2e68 : dd3802 > cmp fLSR,x ;test flags > trap_ne 2e6b : f003 > beq skip2526 > trap ;failed not equal (non zero) 2e6d : 205b44 > jsr report_error > 2e70 : >skip2526 > 2e70 : ca dex 2e71 : 10da bpl tlsr5 2e73 : a203 ldx #3 2e75 : trol4 set_abs zp1,0 > load_flag 0 2e75 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2e77 : 48 > pha ;use stack to load status 2e78 : b513 > lda zp1,x ;load to memory 2e7a : 8d0302 > sta abst 2e7d : 28 > plp 2e7e : 2e0302 rol abst tst_abs rROL,fROL,0 2e81 : 08 > php ;save flags 2e82 : ad0302 > lda abst 2e85 : dd2002 > cmp rROL,x ;test result > trap_ne 2e88 : f003 > beq skip2531 > trap ;failed not equal (non zero) 2e8a : 205b44 > jsr report_error > 2e8d : >skip2531 > 2e8d : 68 > pla ;load status > eor_flag 0 2e8e : 4930 > eor #0|fao ;invert expected flags + always on bits > 2e90 : dd3002 > cmp fROL,x ;test flags > trap_ne 2e93 : f003 > beq skip2534 > trap ;failed not equal (non zero) 2e95 : 205b44 > jsr report_error > 2e98 : >skip2534 > 2e98 : ca dex 2e99 : 10da bpl trol4 2e9b : a203 ldx #3 2e9d : trol5 set_abs zp1,$ff-fc > load_flag $ff-fc 2e9d : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 2e9f : 48 > pha ;use stack to load status 2ea0 : b513 > lda zp1,x ;load to memory 2ea2 : 8d0302 > sta abst 2ea5 : 28 > plp 2ea6 : 2e0302 rol abst tst_abs rROL,fROL,$ff-fnzc 2ea9 : 08 > php ;save flags 2eaa : ad0302 > lda abst 2ead : dd2002 > cmp rROL,x ;test result > trap_ne 2eb0 : f003 > beq skip2539 > trap ;failed not equal (non zero) 2eb2 : 205b44 > jsr report_error > 2eb5 : >skip2539 > 2eb5 : 68 > pla ;load status > eor_flag $ff-fnzc 2eb6 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2eb8 : dd3002 > cmp fROL,x ;test flags > trap_ne 2ebb : f003 > beq skip2542 > trap ;failed not equal (non zero) 2ebd : 205b44 > jsr report_error > 2ec0 : >skip2542 > 2ec0 : ca dex 2ec1 : 10da bpl trol5 2ec3 : a203 ldx #3 2ec5 : trolc4 set_abs zp1,fc > load_flag fc 2ec5 : a901 > lda #fc ;allow test to change I-flag (no mask) > 2ec7 : 48 > pha ;use stack to load status 2ec8 : b513 > lda zp1,x ;load to memory 2eca : 8d0302 > sta abst 2ecd : 28 > plp 2ece : 2e0302 rol abst tst_abs rROLc,fROLc,0 2ed1 : 08 > php ;save flags 2ed2 : ad0302 > lda abst 2ed5 : dd2402 > cmp rROLc,x ;test result > trap_ne 2ed8 : f003 > beq skip2547 > trap ;failed not equal (non zero) 2eda : 205b44 > jsr report_error > 2edd : >skip2547 > 2edd : 68 > pla ;load status > eor_flag 0 2ede : 4930 > eor #0|fao ;invert expected flags + always on bits > 2ee0 : dd3402 > cmp fROLc,x ;test flags > trap_ne 2ee3 : f003 > beq skip2550 > trap ;failed not equal (non zero) 2ee5 : 205b44 > jsr report_error > 2ee8 : >skip2550 > 2ee8 : ca dex 2ee9 : 10da bpl trolc4 2eeb : a203 ldx #3 2eed : trolc5 set_abs zp1,$ff > load_flag $ff 2eed : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2eef : 48 > pha ;use stack to load status 2ef0 : b513 > lda zp1,x ;load to memory 2ef2 : 8d0302 > sta abst 2ef5 : 28 > plp 2ef6 : 2e0302 rol abst tst_abs rROLc,fROLc,$ff-fnzc 2ef9 : 08 > php ;save flags 2efa : ad0302 > lda abst 2efd : dd2402 > cmp rROLc,x ;test result > trap_ne 2f00 : f003 > beq skip2555 > trap ;failed not equal (non zero) 2f02 : 205b44 > jsr report_error > 2f05 : >skip2555 > 2f05 : 68 > pla ;load status > eor_flag $ff-fnzc 2f06 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2f08 : dd3402 > cmp fROLc,x ;test flags > trap_ne 2f0b : f003 > beq skip2558 > trap ;failed not equal (non zero) 2f0d : 205b44 > jsr report_error > 2f10 : >skip2558 > 2f10 : ca dex 2f11 : 10da bpl trolc5 2f13 : a203 ldx #3 2f15 : tror4 set_abs zp1,0 > load_flag 0 2f15 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2f17 : 48 > pha ;use stack to load status 2f18 : b513 > lda zp1,x ;load to memory 2f1a : 8d0302 > sta abst 2f1d : 28 > plp 2f1e : 6e0302 ror abst tst_abs rROR,fROR,0 2f21 : 08 > php ;save flags 2f22 : ad0302 > lda abst 2f25 : dd2802 > cmp rROR,x ;test result > trap_ne 2f28 : f003 > beq skip2563 > trap ;failed not equal (non zero) 2f2a : 205b44 > jsr report_error > 2f2d : >skip2563 > 2f2d : 68 > pla ;load status > eor_flag 0 2f2e : 4930 > eor #0|fao ;invert expected flags + always on bits > 2f30 : dd3802 > cmp fROR,x ;test flags > trap_ne 2f33 : f003 > beq skip2566 > trap ;failed not equal (non zero) 2f35 : 205b44 > jsr report_error > 2f38 : >skip2566 > 2f38 : ca dex 2f39 : 10da bpl tror4 2f3b : a203 ldx #3 2f3d : tror5 set_abs zp1,$ff-fc > load_flag $ff-fc 2f3d : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 2f3f : 48 > pha ;use stack to load status 2f40 : b513 > lda zp1,x ;load to memory 2f42 : 8d0302 > sta abst 2f45 : 28 > plp 2f46 : 6e0302 ror abst tst_abs rROR,fROR,$ff-fnzc 2f49 : 08 > php ;save flags 2f4a : ad0302 > lda abst 2f4d : dd2802 > cmp rROR,x ;test result > trap_ne 2f50 : f003 > beq skip2571 > trap ;failed not equal (non zero) 2f52 : 205b44 > jsr report_error > 2f55 : >skip2571 > 2f55 : 68 > pla ;load status > eor_flag $ff-fnzc 2f56 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2f58 : dd3802 > cmp fROR,x ;test flags > trap_ne 2f5b : f003 > beq skip2574 > trap ;failed not equal (non zero) 2f5d : 205b44 > jsr report_error > 2f60 : >skip2574 > 2f60 : ca dex 2f61 : 10da bpl tror5 2f63 : a203 ldx #3 2f65 : trorc4 set_abs zp1,fc > load_flag fc 2f65 : a901 > lda #fc ;allow test to change I-flag (no mask) > 2f67 : 48 > pha ;use stack to load status 2f68 : b513 > lda zp1,x ;load to memory 2f6a : 8d0302 > sta abst 2f6d : 28 > plp 2f6e : 6e0302 ror abst tst_abs rRORc,fRORc,0 2f71 : 08 > php ;save flags 2f72 : ad0302 > lda abst 2f75 : dd2c02 > cmp rRORc,x ;test result > trap_ne 2f78 : f003 > beq skip2579 > trap ;failed not equal (non zero) 2f7a : 205b44 > jsr report_error > 2f7d : >skip2579 > 2f7d : 68 > pla ;load status > eor_flag 0 2f7e : 4930 > eor #0|fao ;invert expected flags + always on bits > 2f80 : dd3c02 > cmp fRORc,x ;test flags > trap_ne 2f83 : f003 > beq skip2582 > trap ;failed not equal (non zero) 2f85 : 205b44 > jsr report_error > 2f88 : >skip2582 > 2f88 : ca dex 2f89 : 10da bpl trorc4 2f8b : a203 ldx #3 2f8d : trorc5 set_abs zp1,$ff > load_flag $ff 2f8d : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2f8f : 48 > pha ;use stack to load status 2f90 : b513 > lda zp1,x ;load to memory 2f92 : 8d0302 > sta abst 2f95 : 28 > plp 2f96 : 6e0302 ror abst tst_abs rRORc,fRORc,$ff-fnzc 2f99 : 08 > php ;save flags 2f9a : ad0302 > lda abst 2f9d : dd2c02 > cmp rRORc,x ;test result > trap_ne 2fa0 : f003 > beq skip2587 > trap ;failed not equal (non zero) 2fa2 : 205b44 > jsr report_error > 2fa5 : >skip2587 > 2fa5 : 68 > pla ;load status > eor_flag $ff-fnzc 2fa6 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 2fa8 : dd3c02 > cmp fRORc,x ;test flags > trap_ne 2fab : f003 > beq skip2590 > trap ;failed not equal (non zero) 2fad : 205b44 > jsr report_error > 2fb0 : >skip2590 > 2fb0 : ca dex 2fb1 : 10da bpl trorc5 next_test 2fb3 : ad0002 > lda test_case ;previous test 2fb6 : c91f > cmp #test_num > trap_ne ;test is out of sequence 2fb8 : f003 > beq skip2593 > trap ;failed not equal (non zero) 2fba : 205b44 > jsr report_error > 2fbd : >skip2593 > 0020 = >test_num = test_num + 1 2fbd : a920 > lda #test_num ;*** next tests' number 2fbf : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; shifts - zp indexed 2fc2 : a203 ldx #3 2fc4 : tasl6 set_zx zp1,0 > load_flag 0 2fc4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 2fc6 : 48 > pha ;use stack to load status 2fc7 : b513 > lda zp1,x ;load to indexed zeropage 2fc9 : 950c > sta zpt,x 2fcb : 28 > plp 2fcc : 160c asl zpt,x tst_zx rASL,fASL,0 2fce : 08 > php ;save flags 2fcf : b50c > lda zpt,x 2fd1 : dd2002 > cmp rASL,x ;test result > trap_ne 2fd4 : f003 > beq skip2598 > trap ;failed not equal (non zero) 2fd6 : 205b44 > jsr report_error > 2fd9 : >skip2598 > 2fd9 : 68 > pla ;load status > eor_flag 0 2fda : 4930 > eor #0|fao ;invert expected flags + always on bits > 2fdc : dd3002 > cmp fASL,x ;test flags > trap_ne 2fdf : f003 > beq skip2601 > trap ;failed not equal (non zero) 2fe1 : 205b44 > jsr report_error > 2fe4 : >skip2601 > 2fe4 : ca dex 2fe5 : 10dd bpl tasl6 2fe7 : a203 ldx #3 2fe9 : tasl7 set_zx zp1,$ff > load_flag $ff 2fe9 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 2feb : 48 > pha ;use stack to load status 2fec : b513 > lda zp1,x ;load to indexed zeropage 2fee : 950c > sta zpt,x 2ff0 : 28 > plp 2ff1 : 160c asl zpt,x tst_zx rASL,fASL,$ff-fnzc 2ff3 : 08 > php ;save flags 2ff4 : b50c > lda zpt,x 2ff6 : dd2002 > cmp rASL,x ;test result > trap_ne 2ff9 : f003 > beq skip2606 > trap ;failed not equal (non zero) 2ffb : 205b44 > jsr report_error > 2ffe : >skip2606 > 2ffe : 68 > pla ;load status > eor_flag $ff-fnzc 2fff : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3001 : dd3002 > cmp fASL,x ;test flags > trap_ne 3004 : f003 > beq skip2609 > trap ;failed not equal (non zero) 3006 : 205b44 > jsr report_error > 3009 : >skip2609 > 3009 : ca dex 300a : 10dd bpl tasl7 300c : a203 ldx #3 300e : tlsr6 set_zx zp1,0 > load_flag 0 300e : a900 > lda #0 ;allow test to change I-flag (no mask) > 3010 : 48 > pha ;use stack to load status 3011 : b513 > lda zp1,x ;load to indexed zeropage 3013 : 950c > sta zpt,x 3015 : 28 > plp 3016 : 560c lsr zpt,x tst_zx rLSR,fLSR,0 3018 : 08 > php ;save flags 3019 : b50c > lda zpt,x 301b : dd2802 > cmp rLSR,x ;test result > trap_ne 301e : f003 > beq skip2614 > trap ;failed not equal (non zero) 3020 : 205b44 > jsr report_error > 3023 : >skip2614 > 3023 : 68 > pla ;load status > eor_flag 0 3024 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3026 : dd3802 > cmp fLSR,x ;test flags > trap_ne 3029 : f003 > beq skip2617 > trap ;failed not equal (non zero) 302b : 205b44 > jsr report_error > 302e : >skip2617 > 302e : ca dex 302f : 10dd bpl tlsr6 3031 : a203 ldx #3 3033 : tlsr7 set_zx zp1,$ff > load_flag $ff 3033 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3035 : 48 > pha ;use stack to load status 3036 : b513 > lda zp1,x ;load to indexed zeropage 3038 : 950c > sta zpt,x 303a : 28 > plp 303b : 560c lsr zpt,x tst_zx rLSR,fLSR,$ff-fnzc 303d : 08 > php ;save flags 303e : b50c > lda zpt,x 3040 : dd2802 > cmp rLSR,x ;test result > trap_ne 3043 : f003 > beq skip2622 > trap ;failed not equal (non zero) 3045 : 205b44 > jsr report_error > 3048 : >skip2622 > 3048 : 68 > pla ;load status > eor_flag $ff-fnzc 3049 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 304b : dd3802 > cmp fLSR,x ;test flags > trap_ne 304e : f003 > beq skip2625 > trap ;failed not equal (non zero) 3050 : 205b44 > jsr report_error > 3053 : >skip2625 > 3053 : ca dex 3054 : 10dd bpl tlsr7 3056 : a203 ldx #3 3058 : trol6 set_zx zp1,0 > load_flag 0 3058 : a900 > lda #0 ;allow test to change I-flag (no mask) > 305a : 48 > pha ;use stack to load status 305b : b513 > lda zp1,x ;load to indexed zeropage 305d : 950c > sta zpt,x 305f : 28 > plp 3060 : 360c rol zpt,x tst_zx rROL,fROL,0 3062 : 08 > php ;save flags 3063 : b50c > lda zpt,x 3065 : dd2002 > cmp rROL,x ;test result > trap_ne 3068 : f003 > beq skip2630 > trap ;failed not equal (non zero) 306a : 205b44 > jsr report_error > 306d : >skip2630 > 306d : 68 > pla ;load status > eor_flag 0 306e : 4930 > eor #0|fao ;invert expected flags + always on bits > 3070 : dd3002 > cmp fROL,x ;test flags > trap_ne 3073 : f003 > beq skip2633 > trap ;failed not equal (non zero) 3075 : 205b44 > jsr report_error > 3078 : >skip2633 > 3078 : ca dex 3079 : 10dd bpl trol6 307b : a203 ldx #3 307d : trol7 set_zx zp1,$ff-fc > load_flag $ff-fc 307d : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 307f : 48 > pha ;use stack to load status 3080 : b513 > lda zp1,x ;load to indexed zeropage 3082 : 950c > sta zpt,x 3084 : 28 > plp 3085 : 360c rol zpt,x tst_zx rROL,fROL,$ff-fnzc 3087 : 08 > php ;save flags 3088 : b50c > lda zpt,x 308a : dd2002 > cmp rROL,x ;test result > trap_ne 308d : f003 > beq skip2638 > trap ;failed not equal (non zero) 308f : 205b44 > jsr report_error > 3092 : >skip2638 > 3092 : 68 > pla ;load status > eor_flag $ff-fnzc 3093 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3095 : dd3002 > cmp fROL,x ;test flags > trap_ne 3098 : f003 > beq skip2641 > trap ;failed not equal (non zero) 309a : 205b44 > jsr report_error > 309d : >skip2641 > 309d : ca dex 309e : 10dd bpl trol7 30a0 : a203 ldx #3 30a2 : trolc6 set_zx zp1,fc > load_flag fc 30a2 : a901 > lda #fc ;allow test to change I-flag (no mask) > 30a4 : 48 > pha ;use stack to load status 30a5 : b513 > lda zp1,x ;load to indexed zeropage 30a7 : 950c > sta zpt,x 30a9 : 28 > plp 30aa : 360c rol zpt,x tst_zx rROLc,fROLc,0 30ac : 08 > php ;save flags 30ad : b50c > lda zpt,x 30af : dd2402 > cmp rROLc,x ;test result > trap_ne 30b2 : f003 > beq skip2646 > trap ;failed not equal (non zero) 30b4 : 205b44 > jsr report_error > 30b7 : >skip2646 > 30b7 : 68 > pla ;load status > eor_flag 0 30b8 : 4930 > eor #0|fao ;invert expected flags + always on bits > 30ba : dd3402 > cmp fROLc,x ;test flags > trap_ne 30bd : f003 > beq skip2649 > trap ;failed not equal (non zero) 30bf : 205b44 > jsr report_error > 30c2 : >skip2649 > 30c2 : ca dex 30c3 : 10dd bpl trolc6 30c5 : a203 ldx #3 30c7 : trolc7 set_zx zp1,$ff > load_flag $ff 30c7 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 30c9 : 48 > pha ;use stack to load status 30ca : b513 > lda zp1,x ;load to indexed zeropage 30cc : 950c > sta zpt,x 30ce : 28 > plp 30cf : 360c rol zpt,x tst_zx rROLc,fROLc,$ff-fnzc 30d1 : 08 > php ;save flags 30d2 : b50c > lda zpt,x 30d4 : dd2402 > cmp rROLc,x ;test result > trap_ne 30d7 : f003 > beq skip2654 > trap ;failed not equal (non zero) 30d9 : 205b44 > jsr report_error > 30dc : >skip2654 > 30dc : 68 > pla ;load status > eor_flag $ff-fnzc 30dd : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 30df : dd3402 > cmp fROLc,x ;test flags > trap_ne 30e2 : f003 > beq skip2657 > trap ;failed not equal (non zero) 30e4 : 205b44 > jsr report_error > 30e7 : >skip2657 > 30e7 : ca dex 30e8 : 10dd bpl trolc7 30ea : a203 ldx #3 30ec : tror6 set_zx zp1,0 > load_flag 0 30ec : a900 > lda #0 ;allow test to change I-flag (no mask) > 30ee : 48 > pha ;use stack to load status 30ef : b513 > lda zp1,x ;load to indexed zeropage 30f1 : 950c > sta zpt,x 30f3 : 28 > plp 30f4 : 760c ror zpt,x tst_zx rROR,fROR,0 30f6 : 08 > php ;save flags 30f7 : b50c > lda zpt,x 30f9 : dd2802 > cmp rROR,x ;test result > trap_ne 30fc : f003 > beq skip2662 > trap ;failed not equal (non zero) 30fe : 205b44 > jsr report_error > 3101 : >skip2662 > 3101 : 68 > pla ;load status > eor_flag 0 3102 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3104 : dd3802 > cmp fROR,x ;test flags > trap_ne 3107 : f003 > beq skip2665 > trap ;failed not equal (non zero) 3109 : 205b44 > jsr report_error > 310c : >skip2665 > 310c : ca dex 310d : 10dd bpl tror6 310f : a203 ldx #3 3111 : tror7 set_zx zp1,$ff-fc > load_flag $ff-fc 3111 : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 3113 : 48 > pha ;use stack to load status 3114 : b513 > lda zp1,x ;load to indexed zeropage 3116 : 950c > sta zpt,x 3118 : 28 > plp 3119 : 760c ror zpt,x tst_zx rROR,fROR,$ff-fnzc 311b : 08 > php ;save flags 311c : b50c > lda zpt,x 311e : dd2802 > cmp rROR,x ;test result > trap_ne 3121 : f003 > beq skip2670 > trap ;failed not equal (non zero) 3123 : 205b44 > jsr report_error > 3126 : >skip2670 > 3126 : 68 > pla ;load status > eor_flag $ff-fnzc 3127 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3129 : dd3802 > cmp fROR,x ;test flags > trap_ne 312c : f003 > beq skip2673 > trap ;failed not equal (non zero) 312e : 205b44 > jsr report_error > 3131 : >skip2673 > 3131 : ca dex 3132 : 10dd bpl tror7 3134 : a203 ldx #3 3136 : trorc6 set_zx zp1,fc > load_flag fc 3136 : a901 > lda #fc ;allow test to change I-flag (no mask) > 3138 : 48 > pha ;use stack to load status 3139 : b513 > lda zp1,x ;load to indexed zeropage 313b : 950c > sta zpt,x 313d : 28 > plp 313e : 760c ror zpt,x tst_zx rRORc,fRORc,0 3140 : 08 > php ;save flags 3141 : b50c > lda zpt,x 3143 : dd2c02 > cmp rRORc,x ;test result > trap_ne 3146 : f003 > beq skip2678 > trap ;failed not equal (non zero) 3148 : 205b44 > jsr report_error > 314b : >skip2678 > 314b : 68 > pla ;load status > eor_flag 0 314c : 4930 > eor #0|fao ;invert expected flags + always on bits > 314e : dd3c02 > cmp fRORc,x ;test flags > trap_ne 3151 : f003 > beq skip2681 > trap ;failed not equal (non zero) 3153 : 205b44 > jsr report_error > 3156 : >skip2681 > 3156 : ca dex 3157 : 10dd bpl trorc6 3159 : a203 ldx #3 315b : trorc7 set_zx zp1,$ff > load_flag $ff 315b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 315d : 48 > pha ;use stack to load status 315e : b513 > lda zp1,x ;load to indexed zeropage 3160 : 950c > sta zpt,x 3162 : 28 > plp 3163 : 760c ror zpt,x tst_zx rRORc,fRORc,$ff-fnzc 3165 : 08 > php ;save flags 3166 : b50c > lda zpt,x 3168 : dd2c02 > cmp rRORc,x ;test result > trap_ne 316b : f003 > beq skip2686 > trap ;failed not equal (non zero) 316d : 205b44 > jsr report_error > 3170 : >skip2686 > 3170 : 68 > pla ;load status > eor_flag $ff-fnzc 3171 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3173 : dd3c02 > cmp fRORc,x ;test flags > trap_ne 3176 : f003 > beq skip2689 > trap ;failed not equal (non zero) 3178 : 205b44 > jsr report_error > 317b : >skip2689 > 317b : ca dex 317c : 10dd bpl trorc7 next_test 317e : ad0002 > lda test_case ;previous test 3181 : c920 > cmp #test_num > trap_ne ;test is out of sequence 3183 : f003 > beq skip2692 > trap ;failed not equal (non zero) 3185 : 205b44 > jsr report_error > 3188 : >skip2692 > 0021 = >test_num = test_num + 1 3188 : a921 > lda #test_num ;*** next tests' number 318a : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; shifts - abs indexed 318d : a203 ldx #3 318f : tasl8 set_absx zp1,0 > load_flag 0 318f : a900 > lda #0 ;allow test to change I-flag (no mask) > 3191 : 48 > pha ;use stack to load status 3192 : b513 > lda zp1,x ;load to indexed memory 3194 : 9d0302 > sta abst,x 3197 : 28 > plp 3198 : 1e0302 asl abst,x tst_absx rASL,fASL,0 319b : 08 > php ;save flags 319c : bd0302 > lda abst,x 319f : dd2002 > cmp rASL,x ;test result > trap_ne 31a2 : f003 > beq skip2697 > trap ;failed not equal (non zero) 31a4 : 205b44 > jsr report_error > 31a7 : >skip2697 > 31a7 : 68 > pla ;load status > eor_flag 0 31a8 : 4930 > eor #0|fao ;invert expected flags + always on bits > 31aa : dd3002 > cmp fASL,x ;test flags > trap_ne 31ad : f003 > beq skip2700 > trap ;failed not equal (non zero) 31af : 205b44 > jsr report_error > 31b2 : >skip2700 > 31b2 : ca dex 31b3 : 10da bpl tasl8 31b5 : a203 ldx #3 31b7 : tasl9 set_absx zp1,$ff > load_flag $ff 31b7 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 31b9 : 48 > pha ;use stack to load status 31ba : b513 > lda zp1,x ;load to indexed memory 31bc : 9d0302 > sta abst,x 31bf : 28 > plp 31c0 : 1e0302 asl abst,x tst_absx rASL,fASL,$ff-fnzc 31c3 : 08 > php ;save flags 31c4 : bd0302 > lda abst,x 31c7 : dd2002 > cmp rASL,x ;test result > trap_ne 31ca : f003 > beq skip2705 > trap ;failed not equal (non zero) 31cc : 205b44 > jsr report_error > 31cf : >skip2705 > 31cf : 68 > pla ;load status > eor_flag $ff-fnzc 31d0 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 31d2 : dd3002 > cmp fASL,x ;test flags > trap_ne 31d5 : f003 > beq skip2708 > trap ;failed not equal (non zero) 31d7 : 205b44 > jsr report_error > 31da : >skip2708 > 31da : ca dex 31db : 10da bpl tasl9 31dd : a203 ldx #3 31df : tlsr8 set_absx zp1,0 > load_flag 0 31df : a900 > lda #0 ;allow test to change I-flag (no mask) > 31e1 : 48 > pha ;use stack to load status 31e2 : b513 > lda zp1,x ;load to indexed memory 31e4 : 9d0302 > sta abst,x 31e7 : 28 > plp 31e8 : 5e0302 lsr abst,x tst_absx rLSR,fLSR,0 31eb : 08 > php ;save flags 31ec : bd0302 > lda abst,x 31ef : dd2802 > cmp rLSR,x ;test result > trap_ne 31f2 : f003 > beq skip2713 > trap ;failed not equal (non zero) 31f4 : 205b44 > jsr report_error > 31f7 : >skip2713 > 31f7 : 68 > pla ;load status > eor_flag 0 31f8 : 4930 > eor #0|fao ;invert expected flags + always on bits > 31fa : dd3802 > cmp fLSR,x ;test flags > trap_ne 31fd : f003 > beq skip2716 > trap ;failed not equal (non zero) 31ff : 205b44 > jsr report_error > 3202 : >skip2716 > 3202 : ca dex 3203 : 10da bpl tlsr8 3205 : a203 ldx #3 3207 : tlsr9 set_absx zp1,$ff > load_flag $ff 3207 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3209 : 48 > pha ;use stack to load status 320a : b513 > lda zp1,x ;load to indexed memory 320c : 9d0302 > sta abst,x 320f : 28 > plp 3210 : 5e0302 lsr abst,x tst_absx rLSR,fLSR,$ff-fnzc 3213 : 08 > php ;save flags 3214 : bd0302 > lda abst,x 3217 : dd2802 > cmp rLSR,x ;test result > trap_ne 321a : f003 > beq skip2721 > trap ;failed not equal (non zero) 321c : 205b44 > jsr report_error > 321f : >skip2721 > 321f : 68 > pla ;load status > eor_flag $ff-fnzc 3220 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3222 : dd3802 > cmp fLSR,x ;test flags > trap_ne 3225 : f003 > beq skip2724 > trap ;failed not equal (non zero) 3227 : 205b44 > jsr report_error > 322a : >skip2724 > 322a : ca dex 322b : 10da bpl tlsr9 322d : a203 ldx #3 322f : trol8 set_absx zp1,0 > load_flag 0 322f : a900 > lda #0 ;allow test to change I-flag (no mask) > 3231 : 48 > pha ;use stack to load status 3232 : b513 > lda zp1,x ;load to indexed memory 3234 : 9d0302 > sta abst,x 3237 : 28 > plp 3238 : 3e0302 rol abst,x tst_absx rROL,fROL,0 323b : 08 > php ;save flags 323c : bd0302 > lda abst,x 323f : dd2002 > cmp rROL,x ;test result > trap_ne 3242 : f003 > beq skip2729 > trap ;failed not equal (non zero) 3244 : 205b44 > jsr report_error > 3247 : >skip2729 > 3247 : 68 > pla ;load status > eor_flag 0 3248 : 4930 > eor #0|fao ;invert expected flags + always on bits > 324a : dd3002 > cmp fROL,x ;test flags > trap_ne 324d : f003 > beq skip2732 > trap ;failed not equal (non zero) 324f : 205b44 > jsr report_error > 3252 : >skip2732 > 3252 : ca dex 3253 : 10da bpl trol8 3255 : a203 ldx #3 3257 : trol9 set_absx zp1,$ff-fc > load_flag $ff-fc 3257 : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 3259 : 48 > pha ;use stack to load status 325a : b513 > lda zp1,x ;load to indexed memory 325c : 9d0302 > sta abst,x 325f : 28 > plp 3260 : 3e0302 rol abst,x tst_absx rROL,fROL,$ff-fnzc 3263 : 08 > php ;save flags 3264 : bd0302 > lda abst,x 3267 : dd2002 > cmp rROL,x ;test result > trap_ne 326a : f003 > beq skip2737 > trap ;failed not equal (non zero) 326c : 205b44 > jsr report_error > 326f : >skip2737 > 326f : 68 > pla ;load status > eor_flag $ff-fnzc 3270 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3272 : dd3002 > cmp fROL,x ;test flags > trap_ne 3275 : f003 > beq skip2740 > trap ;failed not equal (non zero) 3277 : 205b44 > jsr report_error > 327a : >skip2740 > 327a : ca dex 327b : 10da bpl trol9 327d : a203 ldx #3 327f : trolc8 set_absx zp1,fc > load_flag fc 327f : a901 > lda #fc ;allow test to change I-flag (no mask) > 3281 : 48 > pha ;use stack to load status 3282 : b513 > lda zp1,x ;load to indexed memory 3284 : 9d0302 > sta abst,x 3287 : 28 > plp 3288 : 3e0302 rol abst,x tst_absx rROLc,fROLc,0 328b : 08 > php ;save flags 328c : bd0302 > lda abst,x 328f : dd2402 > cmp rROLc,x ;test result > trap_ne 3292 : f003 > beq skip2745 > trap ;failed not equal (non zero) 3294 : 205b44 > jsr report_error > 3297 : >skip2745 > 3297 : 68 > pla ;load status > eor_flag 0 3298 : 4930 > eor #0|fao ;invert expected flags + always on bits > 329a : dd3402 > cmp fROLc,x ;test flags > trap_ne 329d : f003 > beq skip2748 > trap ;failed not equal (non zero) 329f : 205b44 > jsr report_error > 32a2 : >skip2748 > 32a2 : ca dex 32a3 : 10da bpl trolc8 32a5 : a203 ldx #3 32a7 : trolc9 set_absx zp1,$ff > load_flag $ff 32a7 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 32a9 : 48 > pha ;use stack to load status 32aa : b513 > lda zp1,x ;load to indexed memory 32ac : 9d0302 > sta abst,x 32af : 28 > plp 32b0 : 3e0302 rol abst,x tst_absx rROLc,fROLc,$ff-fnzc 32b3 : 08 > php ;save flags 32b4 : bd0302 > lda abst,x 32b7 : dd2402 > cmp rROLc,x ;test result > trap_ne 32ba : f003 > beq skip2753 > trap ;failed not equal (non zero) 32bc : 205b44 > jsr report_error > 32bf : >skip2753 > 32bf : 68 > pla ;load status > eor_flag $ff-fnzc 32c0 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 32c2 : dd3402 > cmp fROLc,x ;test flags > trap_ne 32c5 : f003 > beq skip2756 > trap ;failed not equal (non zero) 32c7 : 205b44 > jsr report_error > 32ca : >skip2756 > 32ca : ca dex 32cb : 10da bpl trolc9 32cd : a203 ldx #3 32cf : tror8 set_absx zp1,0 > load_flag 0 32cf : a900 > lda #0 ;allow test to change I-flag (no mask) > 32d1 : 48 > pha ;use stack to load status 32d2 : b513 > lda zp1,x ;load to indexed memory 32d4 : 9d0302 > sta abst,x 32d7 : 28 > plp 32d8 : 7e0302 ror abst,x tst_absx rROR,fROR,0 32db : 08 > php ;save flags 32dc : bd0302 > lda abst,x 32df : dd2802 > cmp rROR,x ;test result > trap_ne 32e2 : f003 > beq skip2761 > trap ;failed not equal (non zero) 32e4 : 205b44 > jsr report_error > 32e7 : >skip2761 > 32e7 : 68 > pla ;load status > eor_flag 0 32e8 : 4930 > eor #0|fao ;invert expected flags + always on bits > 32ea : dd3802 > cmp fROR,x ;test flags > trap_ne 32ed : f003 > beq skip2764 > trap ;failed not equal (non zero) 32ef : 205b44 > jsr report_error > 32f2 : >skip2764 > 32f2 : ca dex 32f3 : 10da bpl tror8 32f5 : a203 ldx #3 32f7 : tror9 set_absx zp1,$ff-fc > load_flag $ff-fc 32f7 : a9fe > lda #$ff-fc ;allow test to change I-flag (no mask) > 32f9 : 48 > pha ;use stack to load status 32fa : b513 > lda zp1,x ;load to indexed memory 32fc : 9d0302 > sta abst,x 32ff : 28 > plp 3300 : 7e0302 ror abst,x tst_absx rROR,fROR,$ff-fnzc 3303 : 08 > php ;save flags 3304 : bd0302 > lda abst,x 3307 : dd2802 > cmp rROR,x ;test result > trap_ne 330a : f003 > beq skip2769 > trap ;failed not equal (non zero) 330c : 205b44 > jsr report_error > 330f : >skip2769 > 330f : 68 > pla ;load status > eor_flag $ff-fnzc 3310 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3312 : dd3802 > cmp fROR,x ;test flags > trap_ne 3315 : f003 > beq skip2772 > trap ;failed not equal (non zero) 3317 : 205b44 > jsr report_error > 331a : >skip2772 > 331a : ca dex 331b : 10da bpl tror9 331d : a203 ldx #3 331f : trorc8 set_absx zp1,fc > load_flag fc 331f : a901 > lda #fc ;allow test to change I-flag (no mask) > 3321 : 48 > pha ;use stack to load status 3322 : b513 > lda zp1,x ;load to indexed memory 3324 : 9d0302 > sta abst,x 3327 : 28 > plp 3328 : 7e0302 ror abst,x tst_absx rRORc,fRORc,0 332b : 08 > php ;save flags 332c : bd0302 > lda abst,x 332f : dd2c02 > cmp rRORc,x ;test result > trap_ne 3332 : f003 > beq skip2777 > trap ;failed not equal (non zero) 3334 : 205b44 > jsr report_error > 3337 : >skip2777 > 3337 : 68 > pla ;load status > eor_flag 0 3338 : 4930 > eor #0|fao ;invert expected flags + always on bits > 333a : dd3c02 > cmp fRORc,x ;test flags > trap_ne 333d : f003 > beq skip2780 > trap ;failed not equal (non zero) 333f : 205b44 > jsr report_error > 3342 : >skip2780 > 3342 : ca dex 3343 : 10da bpl trorc8 3345 : a203 ldx #3 3347 : trorc9 set_absx zp1,$ff > load_flag $ff 3347 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3349 : 48 > pha ;use stack to load status 334a : b513 > lda zp1,x ;load to indexed memory 334c : 9d0302 > sta abst,x 334f : 28 > plp 3350 : 7e0302 ror abst,x tst_absx rRORc,fRORc,$ff-fnzc 3353 : 08 > php ;save flags 3354 : bd0302 > lda abst,x 3357 : dd2c02 > cmp rRORc,x ;test result > trap_ne 335a : f003 > beq skip2785 > trap ;failed not equal (non zero) 335c : 205b44 > jsr report_error > 335f : >skip2785 > 335f : 68 > pla ;load status > eor_flag $ff-fnzc 3360 : 497c > eor #$ff-fnzc|fao ;invert expected flags + always on bits > 3362 : dd3c02 > cmp fRORc,x ;test flags > trap_ne 3365 : f003 > beq skip2788 > trap ;failed not equal (non zero) 3367 : 205b44 > jsr report_error > 336a : >skip2788 > 336a : ca dex 336b : 10da bpl trorc9 next_test 336d : ad0002 > lda test_case ;previous test 3370 : c921 > cmp #test_num > trap_ne ;test is out of sequence 3372 : f003 > beq skip2791 > trap ;failed not equal (non zero) 3374 : 205b44 > jsr report_error > 3377 : >skip2791 > 0022 = >test_num = test_num + 1 3377 : a922 > lda #test_num ;*** next tests' number 3379 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; testing memory increment/decrement - INC DEC all addressing modes ; zeropage 337c : a200 ldx #0 337e : a97e lda #$7e 3380 : 850c sta zpt 3382 : tinc set_stat 0 > load_flag 0 3382 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3384 : 48 > pha ;use stack to load status 3385 : 28 > plp 3386 : e60c inc zpt tst_z rINC,fINC,0 3388 : 08 > php ;save flags 3389 : a50c > lda zpt 338b : dd4002 > cmp rINC,x ;test result > trap_ne 338e : f003 > beq skip2796 > trap ;failed not equal (non zero) 3390 : 205b44 > jsr report_error > 3393 : >skip2796 > 3393 : 68 > pla ;load status > eor_flag 0 3394 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3396 : dd4502 > cmp fINC,x ;test flags > trap_ne 3399 : f003 > beq skip2799 > trap ;failed not equal (non zero) 339b : 205b44 > jsr report_error > 339e : >skip2799 > 339e : e8 inx 339f : e002 cpx #2 33a1 : d004 bne tinc1 33a3 : a9fe lda #$fe 33a5 : 850c sta zpt 33a7 : e005 tinc1 cpx #5 33a9 : d0d7 bne tinc 33ab : ca dex 33ac : e60c inc zpt 33ae : tdec set_stat 0 > load_flag 0 33ae : a900 > lda #0 ;allow test to change I-flag (no mask) > 33b0 : 48 > pha ;use stack to load status 33b1 : 28 > plp 33b2 : c60c dec zpt tst_z rINC,fINC,0 33b4 : 08 > php ;save flags 33b5 : a50c > lda zpt 33b7 : dd4002 > cmp rINC,x ;test result > trap_ne 33ba : f003 > beq skip2804 > trap ;failed not equal (non zero) 33bc : 205b44 > jsr report_error > 33bf : >skip2804 > 33bf : 68 > pla ;load status > eor_flag 0 33c0 : 4930 > eor #0|fao ;invert expected flags + always on bits > 33c2 : dd4502 > cmp fINC,x ;test flags > trap_ne 33c5 : f003 > beq skip2807 > trap ;failed not equal (non zero) 33c7 : 205b44 > jsr report_error > 33ca : >skip2807 > 33ca : ca dex 33cb : 300a bmi tdec1 33cd : e001 cpx #1 33cf : d0dd bne tdec 33d1 : a981 lda #$81 33d3 : 850c sta zpt 33d5 : d0d7 bne tdec 33d7 : tdec1 33d7 : a200 ldx #0 33d9 : a97e lda #$7e 33db : 850c sta zpt 33dd : tinc10 set_stat $ff > load_flag $ff 33dd : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 33df : 48 > pha ;use stack to load status 33e0 : 28 > plp 33e1 : e60c inc zpt tst_z rINC,fINC,$ff-fnz 33e3 : 08 > php ;save flags 33e4 : a50c > lda zpt 33e6 : dd4002 > cmp rINC,x ;test result > trap_ne 33e9 : f003 > beq skip2812 > trap ;failed not equal (non zero) 33eb : 205b44 > jsr report_error > 33ee : >skip2812 > 33ee : 68 > pla ;load status > eor_flag $ff-fnz 33ef : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 33f1 : dd4502 > cmp fINC,x ;test flags > trap_ne 33f4 : f003 > beq skip2815 > trap ;failed not equal (non zero) 33f6 : 205b44 > jsr report_error > 33f9 : >skip2815 > 33f9 : e8 inx 33fa : e002 cpx #2 33fc : d004 bne tinc11 33fe : a9fe lda #$fe 3400 : 850c sta zpt 3402 : e005 tinc11 cpx #5 3404 : d0d7 bne tinc10 3406 : ca dex 3407 : e60c inc zpt 3409 : tdec10 set_stat $ff > load_flag $ff 3409 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 340b : 48 > pha ;use stack to load status 340c : 28 > plp 340d : c60c dec zpt tst_z rINC,fINC,$ff-fnz 340f : 08 > php ;save flags 3410 : a50c > lda zpt 3412 : dd4002 > cmp rINC,x ;test result > trap_ne 3415 : f003 > beq skip2820 > trap ;failed not equal (non zero) 3417 : 205b44 > jsr report_error > 341a : >skip2820 > 341a : 68 > pla ;load status > eor_flag $ff-fnz 341b : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 341d : dd4502 > cmp fINC,x ;test flags > trap_ne 3420 : f003 > beq skip2823 > trap ;failed not equal (non zero) 3422 : 205b44 > jsr report_error > 3425 : >skip2823 > 3425 : ca dex 3426 : 300a bmi tdec11 3428 : e001 cpx #1 342a : d0dd bne tdec10 342c : a981 lda #$81 342e : 850c sta zpt 3430 : d0d7 bne tdec10 3432 : tdec11 next_test 3432 : ad0002 > lda test_case ;previous test 3435 : c922 > cmp #test_num > trap_ne ;test is out of sequence 3437 : f003 > beq skip2826 > trap ;failed not equal (non zero) 3439 : 205b44 > jsr report_error > 343c : >skip2826 > 0023 = >test_num = test_num + 1 343c : a923 > lda #test_num ;*** next tests' number 343e : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; absolute memory 3441 : a200 ldx #0 3443 : a97e lda #$7e 3445 : 8d0302 sta abst 3448 : tinc2 set_stat 0 > load_flag 0 3448 : a900 > lda #0 ;allow test to change I-flag (no mask) > 344a : 48 > pha ;use stack to load status 344b : 28 > plp 344c : ee0302 inc abst tst_abs rINC,fINC,0 344f : 08 > php ;save flags 3450 : ad0302 > lda abst 3453 : dd4002 > cmp rINC,x ;test result > trap_ne 3456 : f003 > beq skip2831 > trap ;failed not equal (non zero) 3458 : 205b44 > jsr report_error > 345b : >skip2831 > 345b : 68 > pla ;load status > eor_flag 0 345c : 4930 > eor #0|fao ;invert expected flags + always on bits > 345e : dd4502 > cmp fINC,x ;test flags > trap_ne 3461 : f003 > beq skip2834 > trap ;failed not equal (non zero) 3463 : 205b44 > jsr report_error > 3466 : >skip2834 > 3466 : e8 inx 3467 : e002 cpx #2 3469 : d005 bne tinc3 346b : a9fe lda #$fe 346d : 8d0302 sta abst 3470 : e005 tinc3 cpx #5 3472 : d0d4 bne tinc2 3474 : ca dex 3475 : ee0302 inc abst 3478 : tdec2 set_stat 0 > load_flag 0 3478 : a900 > lda #0 ;allow test to change I-flag (no mask) > 347a : 48 > pha ;use stack to load status 347b : 28 > plp 347c : ce0302 dec abst tst_abs rINC,fINC,0 347f : 08 > php ;save flags 3480 : ad0302 > lda abst 3483 : dd4002 > cmp rINC,x ;test result > trap_ne 3486 : f003 > beq skip2839 > trap ;failed not equal (non zero) 3488 : 205b44 > jsr report_error > 348b : >skip2839 > 348b : 68 > pla ;load status > eor_flag 0 348c : 4930 > eor #0|fao ;invert expected flags + always on bits > 348e : dd4502 > cmp fINC,x ;test flags > trap_ne 3491 : f003 > beq skip2842 > trap ;failed not equal (non zero) 3493 : 205b44 > jsr report_error > 3496 : >skip2842 > 3496 : ca dex 3497 : 300b bmi tdec3 3499 : e001 cpx #1 349b : d0db bne tdec2 349d : a981 lda #$81 349f : 8d0302 sta abst 34a2 : d0d4 bne tdec2 34a4 : tdec3 34a4 : a200 ldx #0 34a6 : a97e lda #$7e 34a8 : 8d0302 sta abst 34ab : tinc12 set_stat $ff > load_flag $ff 34ab : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 34ad : 48 > pha ;use stack to load status 34ae : 28 > plp 34af : ee0302 inc abst tst_abs rINC,fINC,$ff-fnz 34b2 : 08 > php ;save flags 34b3 : ad0302 > lda abst 34b6 : dd4002 > cmp rINC,x ;test result > trap_ne 34b9 : f003 > beq skip2847 > trap ;failed not equal (non zero) 34bb : 205b44 > jsr report_error > 34be : >skip2847 > 34be : 68 > pla ;load status > eor_flag $ff-fnz 34bf : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 34c1 : dd4502 > cmp fINC,x ;test flags > trap_ne 34c4 : f003 > beq skip2850 > trap ;failed not equal (non zero) 34c6 : 205b44 > jsr report_error > 34c9 : >skip2850 > 34c9 : e8 inx 34ca : e002 cpx #2 34cc : d005 bne tinc13 34ce : a9fe lda #$fe 34d0 : 8d0302 sta abst 34d3 : e005 tinc13 cpx #5 34d5 : d0d4 bne tinc12 34d7 : ca dex 34d8 : ee0302 inc abst 34db : tdec12 set_stat $ff > load_flag $ff 34db : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 34dd : 48 > pha ;use stack to load status 34de : 28 > plp 34df : ce0302 dec abst tst_abs rINC,fINC,$ff-fnz 34e2 : 08 > php ;save flags 34e3 : ad0302 > lda abst 34e6 : dd4002 > cmp rINC,x ;test result > trap_ne 34e9 : f003 > beq skip2855 > trap ;failed not equal (non zero) 34eb : 205b44 > jsr report_error > 34ee : >skip2855 > 34ee : 68 > pla ;load status > eor_flag $ff-fnz 34ef : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 34f1 : dd4502 > cmp fINC,x ;test flags > trap_ne 34f4 : f003 > beq skip2858 > trap ;failed not equal (non zero) 34f6 : 205b44 > jsr report_error > 34f9 : >skip2858 > 34f9 : ca dex 34fa : 300b bmi tdec13 34fc : e001 cpx #1 34fe : d0db bne tdec12 3500 : a981 lda #$81 3502 : 8d0302 sta abst 3505 : d0d4 bne tdec12 3507 : tdec13 next_test 3507 : ad0002 > lda test_case ;previous test 350a : c923 > cmp #test_num > trap_ne ;test is out of sequence 350c : f003 > beq skip2861 > trap ;failed not equal (non zero) 350e : 205b44 > jsr report_error > 3511 : >skip2861 > 0024 = >test_num = test_num + 1 3511 : a924 > lda #test_num ;*** next tests' number 3513 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; zeropage indexed 3516 : a200 ldx #0 3518 : a97e lda #$7e 351a : 950c tinc4 sta zpt,x set_stat 0 > load_flag 0 351c : a900 > lda #0 ;allow test to change I-flag (no mask) > 351e : 48 > pha ;use stack to load status 351f : 28 > plp 3520 : f60c inc zpt,x tst_zx rINC,fINC,0 3522 : 08 > php ;save flags 3523 : b50c > lda zpt,x 3525 : dd4002 > cmp rINC,x ;test result > trap_ne 3528 : f003 > beq skip2866 > trap ;failed not equal (non zero) 352a : 205b44 > jsr report_error > 352d : >skip2866 > 352d : 68 > pla ;load status > eor_flag 0 352e : 4930 > eor #0|fao ;invert expected flags + always on bits > 3530 : dd4502 > cmp fINC,x ;test flags > trap_ne 3533 : f003 > beq skip2869 > trap ;failed not equal (non zero) 3535 : 205b44 > jsr report_error > 3538 : >skip2869 > 3538 : b50c lda zpt,x 353a : e8 inx 353b : e002 cpx #2 353d : d002 bne tinc5 353f : a9fe lda #$fe 3541 : e005 tinc5 cpx #5 3543 : d0d5 bne tinc4 3545 : ca dex 3546 : a902 lda #2 3548 : 950c tdec4 sta zpt,x set_stat 0 > load_flag 0 354a : a900 > lda #0 ;allow test to change I-flag (no mask) > 354c : 48 > pha ;use stack to load status 354d : 28 > plp 354e : d60c dec zpt,x tst_zx rINC,fINC,0 3550 : 08 > php ;save flags 3551 : b50c > lda zpt,x 3553 : dd4002 > cmp rINC,x ;test result > trap_ne 3556 : f003 > beq skip2874 > trap ;failed not equal (non zero) 3558 : 205b44 > jsr report_error > 355b : >skip2874 > 355b : 68 > pla ;load status > eor_flag 0 355c : 4930 > eor #0|fao ;invert expected flags + always on bits > 355e : dd4502 > cmp fINC,x ;test flags > trap_ne 3561 : f003 > beq skip2877 > trap ;failed not equal (non zero) 3563 : 205b44 > jsr report_error > 3566 : >skip2877 > 3566 : b50c lda zpt,x 3568 : ca dex 3569 : 3008 bmi tdec5 356b : e001 cpx #1 356d : d0d9 bne tdec4 356f : a981 lda #$81 3571 : d0d5 bne tdec4 3573 : tdec5 3573 : a200 ldx #0 3575 : a97e lda #$7e 3577 : 950c tinc14 sta zpt,x set_stat $ff > load_flag $ff 3579 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 357b : 48 > pha ;use stack to load status 357c : 28 > plp 357d : f60c inc zpt,x tst_zx rINC,fINC,$ff-fnz 357f : 08 > php ;save flags 3580 : b50c > lda zpt,x 3582 : dd4002 > cmp rINC,x ;test result > trap_ne 3585 : f003 > beq skip2882 > trap ;failed not equal (non zero) 3587 : 205b44 > jsr report_error > 358a : >skip2882 > 358a : 68 > pla ;load status > eor_flag $ff-fnz 358b : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 358d : dd4502 > cmp fINC,x ;test flags > trap_ne 3590 : f003 > beq skip2885 > trap ;failed not equal (non zero) 3592 : 205b44 > jsr report_error > 3595 : >skip2885 > 3595 : b50c lda zpt,x 3597 : e8 inx 3598 : e002 cpx #2 359a : d002 bne tinc15 359c : a9fe lda #$fe 359e : e005 tinc15 cpx #5 35a0 : d0d5 bne tinc14 35a2 : ca dex 35a3 : a902 lda #2 35a5 : 950c tdec14 sta zpt,x set_stat $ff > load_flag $ff 35a7 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 35a9 : 48 > pha ;use stack to load status 35aa : 28 > plp 35ab : d60c dec zpt,x tst_zx rINC,fINC,$ff-fnz 35ad : 08 > php ;save flags 35ae : b50c > lda zpt,x 35b0 : dd4002 > cmp rINC,x ;test result > trap_ne 35b3 : f003 > beq skip2890 > trap ;failed not equal (non zero) 35b5 : 205b44 > jsr report_error > 35b8 : >skip2890 > 35b8 : 68 > pla ;load status > eor_flag $ff-fnz 35b9 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 35bb : dd4502 > cmp fINC,x ;test flags > trap_ne 35be : f003 > beq skip2893 > trap ;failed not equal (non zero) 35c0 : 205b44 > jsr report_error > 35c3 : >skip2893 > 35c3 : b50c lda zpt,x 35c5 : ca dex 35c6 : 3008 bmi tdec15 35c8 : e001 cpx #1 35ca : d0d9 bne tdec14 35cc : a981 lda #$81 35ce : d0d5 bne tdec14 35d0 : tdec15 next_test 35d0 : ad0002 > lda test_case ;previous test 35d3 : c924 > cmp #test_num > trap_ne ;test is out of sequence 35d5 : f003 > beq skip2896 > trap ;failed not equal (non zero) 35d7 : 205b44 > jsr report_error > 35da : >skip2896 > 0025 = >test_num = test_num + 1 35da : a925 > lda #test_num ;*** next tests' number 35dc : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; memory indexed 35df : a200 ldx #0 35e1 : a97e lda #$7e 35e3 : 9d0302 tinc6 sta abst,x set_stat 0 > load_flag 0 35e6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 35e8 : 48 > pha ;use stack to load status 35e9 : 28 > plp 35ea : fe0302 inc abst,x tst_absx rINC,fINC,0 35ed : 08 > php ;save flags 35ee : bd0302 > lda abst,x 35f1 : dd4002 > cmp rINC,x ;test result > trap_ne 35f4 : f003 > beq skip2901 > trap ;failed not equal (non zero) 35f6 : 205b44 > jsr report_error > 35f9 : >skip2901 > 35f9 : 68 > pla ;load status > eor_flag 0 35fa : 4930 > eor #0|fao ;invert expected flags + always on bits > 35fc : dd4502 > cmp fINC,x ;test flags > trap_ne 35ff : f003 > beq skip2904 > trap ;failed not equal (non zero) 3601 : 205b44 > jsr report_error > 3604 : >skip2904 > 3604 : bd0302 lda abst,x 3607 : e8 inx 3608 : e002 cpx #2 360a : d002 bne tinc7 360c : a9fe lda #$fe 360e : e005 tinc7 cpx #5 3610 : d0d1 bne tinc6 3612 : ca dex 3613 : a902 lda #2 3615 : 9d0302 tdec6 sta abst,x set_stat 0 > load_flag 0 3618 : a900 > lda #0 ;allow test to change I-flag (no mask) > 361a : 48 > pha ;use stack to load status 361b : 28 > plp 361c : de0302 dec abst,x tst_absx rINC,fINC,0 361f : 08 > php ;save flags 3620 : bd0302 > lda abst,x 3623 : dd4002 > cmp rINC,x ;test result > trap_ne 3626 : f003 > beq skip2909 > trap ;failed not equal (non zero) 3628 : 205b44 > jsr report_error > 362b : >skip2909 > 362b : 68 > pla ;load status > eor_flag 0 362c : 4930 > eor #0|fao ;invert expected flags + always on bits > 362e : dd4502 > cmp fINC,x ;test flags > trap_ne 3631 : f003 > beq skip2912 > trap ;failed not equal (non zero) 3633 : 205b44 > jsr report_error > 3636 : >skip2912 > 3636 : bd0302 lda abst,x 3639 : ca dex 363a : 3008 bmi tdec7 363c : e001 cpx #1 363e : d0d5 bne tdec6 3640 : a981 lda #$81 3642 : d0d1 bne tdec6 3644 : tdec7 3644 : a200 ldx #0 3646 : a97e lda #$7e 3648 : 9d0302 tinc16 sta abst,x set_stat $ff > load_flag $ff 364b : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 364d : 48 > pha ;use stack to load status 364e : 28 > plp 364f : fe0302 inc abst,x tst_absx rINC,fINC,$ff-fnz 3652 : 08 > php ;save flags 3653 : bd0302 > lda abst,x 3656 : dd4002 > cmp rINC,x ;test result > trap_ne 3659 : f003 > beq skip2917 > trap ;failed not equal (non zero) 365b : 205b44 > jsr report_error > 365e : >skip2917 > 365e : 68 > pla ;load status > eor_flag $ff-fnz 365f : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3661 : dd4502 > cmp fINC,x ;test flags > trap_ne 3664 : f003 > beq skip2920 > trap ;failed not equal (non zero) 3666 : 205b44 > jsr report_error > 3669 : >skip2920 > 3669 : bd0302 lda abst,x 366c : e8 inx 366d : e002 cpx #2 366f : d002 bne tinc17 3671 : a9fe lda #$fe 3673 : e005 tinc17 cpx #5 3675 : d0d1 bne tinc16 3677 : ca dex 3678 : a902 lda #2 367a : 9d0302 tdec16 sta abst,x set_stat $ff > load_flag $ff 367d : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 367f : 48 > pha ;use stack to load status 3680 : 28 > plp 3681 : de0302 dec abst,x tst_absx rINC,fINC,$ff-fnz 3684 : 08 > php ;save flags 3685 : bd0302 > lda abst,x 3688 : dd4002 > cmp rINC,x ;test result > trap_ne 368b : f003 > beq skip2925 > trap ;failed not equal (non zero) 368d : 205b44 > jsr report_error > 3690 : >skip2925 > 3690 : 68 > pla ;load status > eor_flag $ff-fnz 3691 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3693 : dd4502 > cmp fINC,x ;test flags > trap_ne 3696 : f003 > beq skip2928 > trap ;failed not equal (non zero) 3698 : 205b44 > jsr report_error > 369b : >skip2928 > 369b : bd0302 lda abst,x 369e : ca dex 369f : 3008 bmi tdec17 36a1 : e001 cpx #1 36a3 : d0d5 bne tdec16 36a5 : a981 lda #$81 36a7 : d0d1 bne tdec16 36a9 : tdec17 next_test 36a9 : ad0002 > lda test_case ;previous test 36ac : c925 > cmp #test_num > trap_ne ;test is out of sequence 36ae : f003 > beq skip2931 > trap ;failed not equal (non zero) 36b0 : 205b44 > jsr report_error > 36b3 : >skip2931 > 0026 = >test_num = test_num + 1 36b3 : a926 > lda #test_num ;*** next tests' number 36b5 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; testing logical instructions - AND EOR ORA all addressing modes ; AND 36b8 : a203 ldx #3 ;immediate 36ba : b51c tand lda zpAN,x 36bc : 8d0902 sta ex_andi+1 ;set AND # operand set_ax absANa,0 > load_flag 0 36bf : a900 > lda #0 ;allow test to change I-flag (no mask) > 36c1 : 48 > pha ;use stack to load status 36c2 : bd5a02 > lda absANa,x ;precharge accu 36c5 : 28 > plp 36c6 : 200802 jsr ex_andi ;execute AND # in RAM tst_ax absrlo,absflo,0 36c9 : 08 > php ;save flags 36ca : dd6202 > cmp absrlo,x ;test result > trap_ne 36cd : f003 > beq skip2936 > trap ;failed not equal (non zero) 36cf : 205b44 > jsr report_error > 36d2 : >skip2936 > 36d2 : 68 > pla ;load status > eor_flag 0 36d3 : 4930 > eor #0|fao ;invert expected flags + always on bits > 36d5 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 36d8 : f003 > beq skip2939 > trap ;failed not equal (non zero) 36da : 205b44 > jsr report_error > 36dd : >skip2939 > 36dd : ca dex 36de : 10da bpl tand 36e0 : a203 ldx #3 36e2 : b51c tand1 lda zpAN,x 36e4 : 8d0902 sta ex_andi+1 ;set AND # operand set_ax absANa,$ff > load_flag $ff 36e7 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 36e9 : 48 > pha ;use stack to load status 36ea : bd5a02 > lda absANa,x ;precharge accu 36ed : 28 > plp 36ee : 200802 jsr ex_andi ;execute AND # in RAM tst_ax absrlo,absflo,$ff-fnz 36f1 : 08 > php ;save flags 36f2 : dd6202 > cmp absrlo,x ;test result > trap_ne 36f5 : f003 > beq skip2944 > trap ;failed not equal (non zero) 36f7 : 205b44 > jsr report_error > 36fa : >skip2944 > 36fa : 68 > pla ;load status > eor_flag $ff-fnz 36fb : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 36fd : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3700 : f003 > beq skip2947 > trap ;failed not equal (non zero) 3702 : 205b44 > jsr report_error > 3705 : >skip2947 > 3705 : ca dex 3706 : 10da bpl tand1 3708 : a203 ldx #3 ;zp 370a : b51c tand2 lda zpAN,x 370c : 850c sta zpt set_ax absANa,0 > load_flag 0 370e : a900 > lda #0 ;allow test to change I-flag (no mask) > 3710 : 48 > pha ;use stack to load status 3711 : bd5a02 > lda absANa,x ;precharge accu 3714 : 28 > plp 3715 : 250c and zpt tst_ax absrlo,absflo,0 3717 : 08 > php ;save flags 3718 : dd6202 > cmp absrlo,x ;test result > trap_ne 371b : f003 > beq skip2952 > trap ;failed not equal (non zero) 371d : 205b44 > jsr report_error > 3720 : >skip2952 > 3720 : 68 > pla ;load status > eor_flag 0 3721 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3723 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3726 : f003 > beq skip2955 > trap ;failed not equal (non zero) 3728 : 205b44 > jsr report_error > 372b : >skip2955 > 372b : ca dex 372c : 10dc bpl tand2 372e : a203 ldx #3 3730 : b51c tand3 lda zpAN,x 3732 : 850c sta zpt set_ax absANa,$ff > load_flag $ff 3734 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3736 : 48 > pha ;use stack to load status 3737 : bd5a02 > lda absANa,x ;precharge accu 373a : 28 > plp 373b : 250c and zpt tst_ax absrlo,absflo,$ff-fnz 373d : 08 > php ;save flags 373e : dd6202 > cmp absrlo,x ;test result > trap_ne 3741 : f003 > beq skip2960 > trap ;failed not equal (non zero) 3743 : 205b44 > jsr report_error > 3746 : >skip2960 > 3746 : 68 > pla ;load status > eor_flag $ff-fnz 3747 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3749 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 374c : f003 > beq skip2963 > trap ;failed not equal (non zero) 374e : 205b44 > jsr report_error > 3751 : >skip2963 > 3751 : ca dex 3752 : 10dc bpl tand3 3754 : a203 ldx #3 ;abs 3756 : b51c tand4 lda zpAN,x 3758 : 8d0302 sta abst set_ax absANa,0 > load_flag 0 375b : a900 > lda #0 ;allow test to change I-flag (no mask) > 375d : 48 > pha ;use stack to load status 375e : bd5a02 > lda absANa,x ;precharge accu 3761 : 28 > plp 3762 : 2d0302 and abst tst_ax absrlo,absflo,0 3765 : 08 > php ;save flags 3766 : dd6202 > cmp absrlo,x ;test result > trap_ne 3769 : f003 > beq skip2968 > trap ;failed not equal (non zero) 376b : 205b44 > jsr report_error > 376e : >skip2968 > 376e : 68 > pla ;load status > eor_flag 0 376f : 4930 > eor #0|fao ;invert expected flags + always on bits > 3771 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3774 : f003 > beq skip2971 > trap ;failed not equal (non zero) 3776 : 205b44 > jsr report_error > 3779 : >skip2971 > 3779 : ca dex 377a : 10da bpl tand4 377c : a203 ldx #3 377e : b51c tand5 lda zpAN,x 3780 : 8d0302 sta abst set_ax absANa,$ff > load_flag $ff 3783 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3785 : 48 > pha ;use stack to load status 3786 : bd5a02 > lda absANa,x ;precharge accu 3789 : 28 > plp 378a : 2d0302 and abst tst_ax absrlo,absflo,$ff-fnz 378d : 08 > php ;save flags 378e : dd6202 > cmp absrlo,x ;test result > trap_ne 3791 : f003 > beq skip2976 > trap ;failed not equal (non zero) 3793 : 205b44 > jsr report_error > 3796 : >skip2976 > 3796 : 68 > pla ;load status > eor_flag $ff-fnz 3797 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3799 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 379c : f003 > beq skip2979 > trap ;failed not equal (non zero) 379e : 205b44 > jsr report_error > 37a1 : >skip2979 > 37a1 : ca dex 37a2 : 1002 bpl tand6 37a4 : a203 ldx #3 ;zp,x 37a6 : tand6 set_ax absANa,0 > load_flag 0 37a6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 37a8 : 48 > pha ;use stack to load status 37a9 : bd5a02 > lda absANa,x ;precharge accu 37ac : 28 > plp 37ad : 351c and zpAN,x tst_ax absrlo,absflo,0 37af : 08 > php ;save flags 37b0 : dd6202 > cmp absrlo,x ;test result > trap_ne 37b3 : f003 > beq skip2984 > trap ;failed not equal (non zero) 37b5 : 205b44 > jsr report_error > 37b8 : >skip2984 > 37b8 : 68 > pla ;load status > eor_flag 0 37b9 : 4930 > eor #0|fao ;invert expected flags + always on bits > 37bb : dd6602 > cmp absflo,x ;test flags > trap_ne ; 37be : f003 > beq skip2987 > trap ;failed not equal (non zero) 37c0 : 205b44 > jsr report_error > 37c3 : >skip2987 > 37c3 : ca dex 37c4 : 10e0 bpl tand6 37c6 : a203 ldx #3 37c8 : tand7 set_ax absANa,$ff > load_flag $ff 37c8 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 37ca : 48 > pha ;use stack to load status 37cb : bd5a02 > lda absANa,x ;precharge accu 37ce : 28 > plp 37cf : 351c and zpAN,x tst_ax absrlo,absflo,$ff-fnz 37d1 : 08 > php ;save flags 37d2 : dd6202 > cmp absrlo,x ;test result > trap_ne 37d5 : f003 > beq skip2992 > trap ;failed not equal (non zero) 37d7 : 205b44 > jsr report_error > 37da : >skip2992 > 37da : 68 > pla ;load status > eor_flag $ff-fnz 37db : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 37dd : dd6602 > cmp absflo,x ;test flags > trap_ne ; 37e0 : f003 > beq skip2995 > trap ;failed not equal (non zero) 37e2 : 205b44 > jsr report_error > 37e5 : >skip2995 > 37e5 : ca dex 37e6 : 10e0 bpl tand7 37e8 : a203 ldx #3 ;abs,x 37ea : tand8 set_ax absANa,0 > load_flag 0 37ea : a900 > lda #0 ;allow test to change I-flag (no mask) > 37ec : 48 > pha ;use stack to load status 37ed : bd5a02 > lda absANa,x ;precharge accu 37f0 : 28 > plp 37f1 : 3d4e02 and absAN,x tst_ax absrlo,absflo,0 37f4 : 08 > php ;save flags 37f5 : dd6202 > cmp absrlo,x ;test result > trap_ne 37f8 : f003 > beq skip3000 > trap ;failed not equal (non zero) 37fa : 205b44 > jsr report_error > 37fd : >skip3000 > 37fd : 68 > pla ;load status > eor_flag 0 37fe : 4930 > eor #0|fao ;invert expected flags + always on bits > 3800 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3803 : f003 > beq skip3003 > trap ;failed not equal (non zero) 3805 : 205b44 > jsr report_error > 3808 : >skip3003 > 3808 : ca dex 3809 : 10df bpl tand8 380b : a203 ldx #3 380d : tand9 set_ax absANa,$ff > load_flag $ff 380d : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 380f : 48 > pha ;use stack to load status 3810 : bd5a02 > lda absANa,x ;precharge accu 3813 : 28 > plp 3814 : 3d4e02 and absAN,x tst_ax absrlo,absflo,$ff-fnz 3817 : 08 > php ;save flags 3818 : dd6202 > cmp absrlo,x ;test result > trap_ne 381b : f003 > beq skip3008 > trap ;failed not equal (non zero) 381d : 205b44 > jsr report_error > 3820 : >skip3008 > 3820 : 68 > pla ;load status > eor_flag $ff-fnz 3821 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3823 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3826 : f003 > beq skip3011 > trap ;failed not equal (non zero) 3828 : 205b44 > jsr report_error > 382b : >skip3011 > 382b : ca dex 382c : 10df bpl tand9 382e : a003 ldy #3 ;abs,y 3830 : tand10 set_ay absANa,0 > load_flag 0 3830 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3832 : 48 > pha ;use stack to load status 3833 : b95a02 > lda absANa,y ;precharge accu 3836 : 28 > plp 3837 : 394e02 and absAN,y tst_ay absrlo,absflo,0 383a : 08 > php ;save flags 383b : d96202 > cmp absrlo,y ;test result > trap_ne ; 383e : f003 > beq skip3016 > trap ;failed not equal (non zero) 3840 : 205b44 > jsr report_error > 3843 : >skip3016 > 3843 : 68 > pla ;load status > eor_flag 0 3844 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3846 : d96602 > cmp absflo,y ;test flags > trap_ne 3849 : f003 > beq skip3019 > trap ;failed not equal (non zero) 384b : 205b44 > jsr report_error > 384e : >skip3019 > 384e : 88 dey 384f : 10df bpl tand10 3851 : a003 ldy #3 3853 : tand11 set_ay absANa,$ff > load_flag $ff 3853 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3855 : 48 > pha ;use stack to load status 3856 : b95a02 > lda absANa,y ;precharge accu 3859 : 28 > plp 385a : 394e02 and absAN,y tst_ay absrlo,absflo,$ff-fnz 385d : 08 > php ;save flags 385e : d96202 > cmp absrlo,y ;test result > trap_ne ; 3861 : f003 > beq skip3024 > trap ;failed not equal (non zero) 3863 : 205b44 > jsr report_error > 3866 : >skip3024 > 3866 : 68 > pla ;load status > eor_flag $ff-fnz 3867 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3869 : d96602 > cmp absflo,y ;test flags > trap_ne 386c : f003 > beq skip3027 > trap ;failed not equal (non zero) 386e : 205b44 > jsr report_error > 3871 : >skip3027 > 3871 : 88 dey 3872 : 10df bpl tand11 3874 : a206 ldx #6 ;(zp,x) 3876 : a003 ldy #3 3878 : tand12 set_ay absANa,0 > load_flag 0 3878 : a900 > lda #0 ;allow test to change I-flag (no mask) > 387a : 48 > pha ;use stack to load status 387b : b95a02 > lda absANa,y ;precharge accu 387e : 28 > plp 387f : 213a and (indAN,x) tst_ay absrlo,absflo,0 3881 : 08 > php ;save flags 3882 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3885 : f003 > beq skip3032 > trap ;failed not equal (non zero) 3887 : 205b44 > jsr report_error > 388a : >skip3032 > 388a : 68 > pla ;load status > eor_flag 0 388b : 4930 > eor #0|fao ;invert expected flags + always on bits > 388d : d96602 > cmp absflo,y ;test flags > trap_ne 3890 : f003 > beq skip3035 > trap ;failed not equal (non zero) 3892 : 205b44 > jsr report_error > 3895 : >skip3035 > 3895 : ca dex 3896 : ca dex 3897 : 88 dey 3898 : 10de bpl tand12 389a : a206 ldx #6 389c : a003 ldy #3 389e : tand13 set_ay absANa,$ff > load_flag $ff 389e : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 38a0 : 48 > pha ;use stack to load status 38a1 : b95a02 > lda absANa,y ;precharge accu 38a4 : 28 > plp 38a5 : 213a and (indAN,x) tst_ay absrlo,absflo,$ff-fnz 38a7 : 08 > php ;save flags 38a8 : d96202 > cmp absrlo,y ;test result > trap_ne ; 38ab : f003 > beq skip3040 > trap ;failed not equal (non zero) 38ad : 205b44 > jsr report_error > 38b0 : >skip3040 > 38b0 : 68 > pla ;load status > eor_flag $ff-fnz 38b1 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 38b3 : d96602 > cmp absflo,y ;test flags > trap_ne 38b6 : f003 > beq skip3043 > trap ;failed not equal (non zero) 38b8 : 205b44 > jsr report_error > 38bb : >skip3043 > 38bb : ca dex 38bc : ca dex 38bd : 88 dey 38be : 10de bpl tand13 38c0 : a003 ldy #3 ;(zp),y 38c2 : tand14 set_ay absANa,0 > load_flag 0 38c2 : a900 > lda #0 ;allow test to change I-flag (no mask) > 38c4 : 48 > pha ;use stack to load status 38c5 : b95a02 > lda absANa,y ;precharge accu 38c8 : 28 > plp 38c9 : 313a and (indAN),y tst_ay absrlo,absflo,0 38cb : 08 > php ;save flags 38cc : d96202 > cmp absrlo,y ;test result > trap_ne ; 38cf : f003 > beq skip3048 > trap ;failed not equal (non zero) 38d1 : 205b44 > jsr report_error > 38d4 : >skip3048 > 38d4 : 68 > pla ;load status > eor_flag 0 38d5 : 4930 > eor #0|fao ;invert expected flags + always on bits > 38d7 : d96602 > cmp absflo,y ;test flags > trap_ne 38da : f003 > beq skip3051 > trap ;failed not equal (non zero) 38dc : 205b44 > jsr report_error > 38df : >skip3051 > 38df : 88 dey 38e0 : 10e0 bpl tand14 38e2 : a003 ldy #3 38e4 : tand15 set_ay absANa,$ff > load_flag $ff 38e4 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 38e6 : 48 > pha ;use stack to load status 38e7 : b95a02 > lda absANa,y ;precharge accu 38ea : 28 > plp 38eb : 313a and (indAN),y tst_ay absrlo,absflo,$ff-fnz 38ed : 08 > php ;save flags 38ee : d96202 > cmp absrlo,y ;test result > trap_ne ; 38f1 : f003 > beq skip3056 > trap ;failed not equal (non zero) 38f3 : 205b44 > jsr report_error > 38f6 : >skip3056 > 38f6 : 68 > pla ;load status > eor_flag $ff-fnz 38f7 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 38f9 : d96602 > cmp absflo,y ;test flags > trap_ne 38fc : f003 > beq skip3059 > trap ;failed not equal (non zero) 38fe : 205b44 > jsr report_error > 3901 : >skip3059 > 3901 : 88 dey 3902 : 10e0 bpl tand15 next_test 3904 : ad0002 > lda test_case ;previous test 3907 : c926 > cmp #test_num > trap_ne ;test is out of sequence 3909 : f003 > beq skip3062 > trap ;failed not equal (non zero) 390b : 205b44 > jsr report_error > 390e : >skip3062 > 0027 = >test_num = test_num + 1 390e : a927 > lda #test_num ;*** next tests' number 3910 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; EOR 3913 : a203 ldx #3 ;immediate - self modifying code 3915 : b520 teor lda zpEO,x 3917 : 8d0c02 sta ex_eori+1 ;set EOR # operand set_ax absEOa,0 > load_flag 0 391a : a900 > lda #0 ;allow test to change I-flag (no mask) > 391c : 48 > pha ;use stack to load status 391d : bd5e02 > lda absEOa,x ;precharge accu 3920 : 28 > plp 3921 : 200b02 jsr ex_eori ;execute EOR # in RAM tst_ax absrlo,absflo,0 3924 : 08 > php ;save flags 3925 : dd6202 > cmp absrlo,x ;test result > trap_ne 3928 : f003 > beq skip3067 > trap ;failed not equal (non zero) 392a : 205b44 > jsr report_error > 392d : >skip3067 > 392d : 68 > pla ;load status > eor_flag 0 392e : 4930 > eor #0|fao ;invert expected flags + always on bits > 3930 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3933 : f003 > beq skip3070 > trap ;failed not equal (non zero) 3935 : 205b44 > jsr report_error > 3938 : >skip3070 > 3938 : ca dex 3939 : 10da bpl teor 393b : a203 ldx #3 393d : b520 teor1 lda zpEO,x 393f : 8d0c02 sta ex_eori+1 ;set EOR # operand set_ax absEOa,$ff > load_flag $ff 3942 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3944 : 48 > pha ;use stack to load status 3945 : bd5e02 > lda absEOa,x ;precharge accu 3948 : 28 > plp 3949 : 200b02 jsr ex_eori ;execute EOR # in RAM tst_ax absrlo,absflo,$ff-fnz 394c : 08 > php ;save flags 394d : dd6202 > cmp absrlo,x ;test result > trap_ne 3950 : f003 > beq skip3075 > trap ;failed not equal (non zero) 3952 : 205b44 > jsr report_error > 3955 : >skip3075 > 3955 : 68 > pla ;load status > eor_flag $ff-fnz 3956 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3958 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 395b : f003 > beq skip3078 > trap ;failed not equal (non zero) 395d : 205b44 > jsr report_error > 3960 : >skip3078 > 3960 : ca dex 3961 : 10da bpl teor1 3963 : a203 ldx #3 ;zp 3965 : b520 teor2 lda zpEO,x 3967 : 850c sta zpt set_ax absEOa,0 > load_flag 0 3969 : a900 > lda #0 ;allow test to change I-flag (no mask) > 396b : 48 > pha ;use stack to load status 396c : bd5e02 > lda absEOa,x ;precharge accu 396f : 28 > plp 3970 : 450c eor zpt tst_ax absrlo,absflo,0 3972 : 08 > php ;save flags 3973 : dd6202 > cmp absrlo,x ;test result > trap_ne 3976 : f003 > beq skip3083 > trap ;failed not equal (non zero) 3978 : 205b44 > jsr report_error > 397b : >skip3083 > 397b : 68 > pla ;load status > eor_flag 0 397c : 4930 > eor #0|fao ;invert expected flags + always on bits > 397e : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3981 : f003 > beq skip3086 > trap ;failed not equal (non zero) 3983 : 205b44 > jsr report_error > 3986 : >skip3086 > 3986 : ca dex 3987 : 10dc bpl teor2 3989 : a203 ldx #3 398b : b520 teor3 lda zpEO,x 398d : 850c sta zpt set_ax absEOa,$ff > load_flag $ff 398f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3991 : 48 > pha ;use stack to load status 3992 : bd5e02 > lda absEOa,x ;precharge accu 3995 : 28 > plp 3996 : 450c eor zpt tst_ax absrlo,absflo,$ff-fnz 3998 : 08 > php ;save flags 3999 : dd6202 > cmp absrlo,x ;test result > trap_ne 399c : f003 > beq skip3091 > trap ;failed not equal (non zero) 399e : 205b44 > jsr report_error > 39a1 : >skip3091 > 39a1 : 68 > pla ;load status > eor_flag $ff-fnz 39a2 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 39a4 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 39a7 : f003 > beq skip3094 > trap ;failed not equal (non zero) 39a9 : 205b44 > jsr report_error > 39ac : >skip3094 > 39ac : ca dex 39ad : 10dc bpl teor3 39af : a203 ldx #3 ;abs 39b1 : b520 teor4 lda zpEO,x 39b3 : 8d0302 sta abst set_ax absEOa,0 > load_flag 0 39b6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 39b8 : 48 > pha ;use stack to load status 39b9 : bd5e02 > lda absEOa,x ;precharge accu 39bc : 28 > plp 39bd : 4d0302 eor abst tst_ax absrlo,absflo,0 39c0 : 08 > php ;save flags 39c1 : dd6202 > cmp absrlo,x ;test result > trap_ne 39c4 : f003 > beq skip3099 > trap ;failed not equal (non zero) 39c6 : 205b44 > jsr report_error > 39c9 : >skip3099 > 39c9 : 68 > pla ;load status > eor_flag 0 39ca : 4930 > eor #0|fao ;invert expected flags + always on bits > 39cc : dd6602 > cmp absflo,x ;test flags > trap_ne ; 39cf : f003 > beq skip3102 > trap ;failed not equal (non zero) 39d1 : 205b44 > jsr report_error > 39d4 : >skip3102 > 39d4 : ca dex 39d5 : 10da bpl teor4 39d7 : a203 ldx #3 39d9 : b520 teor5 lda zpEO,x 39db : 8d0302 sta abst set_ax absEOa,$ff > load_flag $ff 39de : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 39e0 : 48 > pha ;use stack to load status 39e1 : bd5e02 > lda absEOa,x ;precharge accu 39e4 : 28 > plp 39e5 : 4d0302 eor abst tst_ax absrlo,absflo,$ff-fnz 39e8 : 08 > php ;save flags 39e9 : dd6202 > cmp absrlo,x ;test result > trap_ne 39ec : f003 > beq skip3107 > trap ;failed not equal (non zero) 39ee : 205b44 > jsr report_error > 39f1 : >skip3107 > 39f1 : 68 > pla ;load status > eor_flag $ff-fnz 39f2 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 39f4 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 39f7 : f003 > beq skip3110 > trap ;failed not equal (non zero) 39f9 : 205b44 > jsr report_error > 39fc : >skip3110 > 39fc : ca dex 39fd : 1002 bpl teor6 39ff : a203 ldx #3 ;zp,x 3a01 : teor6 set_ax absEOa,0 > load_flag 0 3a01 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3a03 : 48 > pha ;use stack to load status 3a04 : bd5e02 > lda absEOa,x ;precharge accu 3a07 : 28 > plp 3a08 : 5520 eor zpEO,x tst_ax absrlo,absflo,0 3a0a : 08 > php ;save flags 3a0b : dd6202 > cmp absrlo,x ;test result > trap_ne 3a0e : f003 > beq skip3115 > trap ;failed not equal (non zero) 3a10 : 205b44 > jsr report_error > 3a13 : >skip3115 > 3a13 : 68 > pla ;load status > eor_flag 0 3a14 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3a16 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3a19 : f003 > beq skip3118 > trap ;failed not equal (non zero) 3a1b : 205b44 > jsr report_error > 3a1e : >skip3118 > 3a1e : ca dex 3a1f : 10e0 bpl teor6 3a21 : a203 ldx #3 3a23 : teor7 set_ax absEOa,$ff > load_flag $ff 3a23 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3a25 : 48 > pha ;use stack to load status 3a26 : bd5e02 > lda absEOa,x ;precharge accu 3a29 : 28 > plp 3a2a : 5520 eor zpEO,x tst_ax absrlo,absflo,$ff-fnz 3a2c : 08 > php ;save flags 3a2d : dd6202 > cmp absrlo,x ;test result > trap_ne 3a30 : f003 > beq skip3123 > trap ;failed not equal (non zero) 3a32 : 205b44 > jsr report_error > 3a35 : >skip3123 > 3a35 : 68 > pla ;load status > eor_flag $ff-fnz 3a36 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3a38 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3a3b : f003 > beq skip3126 > trap ;failed not equal (non zero) 3a3d : 205b44 > jsr report_error > 3a40 : >skip3126 > 3a40 : ca dex 3a41 : 10e0 bpl teor7 3a43 : a203 ldx #3 ;abs,x 3a45 : teor8 set_ax absEOa,0 > load_flag 0 3a45 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3a47 : 48 > pha ;use stack to load status 3a48 : bd5e02 > lda absEOa,x ;precharge accu 3a4b : 28 > plp 3a4c : 5d5202 eor absEO,x tst_ax absrlo,absflo,0 3a4f : 08 > php ;save flags 3a50 : dd6202 > cmp absrlo,x ;test result > trap_ne 3a53 : f003 > beq skip3131 > trap ;failed not equal (non zero) 3a55 : 205b44 > jsr report_error > 3a58 : >skip3131 > 3a58 : 68 > pla ;load status > eor_flag 0 3a59 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3a5b : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3a5e : f003 > beq skip3134 > trap ;failed not equal (non zero) 3a60 : 205b44 > jsr report_error > 3a63 : >skip3134 > 3a63 : ca dex 3a64 : 10df bpl teor8 3a66 : a203 ldx #3 3a68 : teor9 set_ax absEOa,$ff > load_flag $ff 3a68 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3a6a : 48 > pha ;use stack to load status 3a6b : bd5e02 > lda absEOa,x ;precharge accu 3a6e : 28 > plp 3a6f : 5d5202 eor absEO,x tst_ax absrlo,absflo,$ff-fnz 3a72 : 08 > php ;save flags 3a73 : dd6202 > cmp absrlo,x ;test result > trap_ne 3a76 : f003 > beq skip3139 > trap ;failed not equal (non zero) 3a78 : 205b44 > jsr report_error > 3a7b : >skip3139 > 3a7b : 68 > pla ;load status > eor_flag $ff-fnz 3a7c : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3a7e : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3a81 : f003 > beq skip3142 > trap ;failed not equal (non zero) 3a83 : 205b44 > jsr report_error > 3a86 : >skip3142 > 3a86 : ca dex 3a87 : 10df bpl teor9 3a89 : a003 ldy #3 ;abs,y 3a8b : teor10 set_ay absEOa,0 > load_flag 0 3a8b : a900 > lda #0 ;allow test to change I-flag (no mask) > 3a8d : 48 > pha ;use stack to load status 3a8e : b95e02 > lda absEOa,y ;precharge accu 3a91 : 28 > plp 3a92 : 595202 eor absEO,y tst_ay absrlo,absflo,0 3a95 : 08 > php ;save flags 3a96 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3a99 : f003 > beq skip3147 > trap ;failed not equal (non zero) 3a9b : 205b44 > jsr report_error > 3a9e : >skip3147 > 3a9e : 68 > pla ;load status > eor_flag 0 3a9f : 4930 > eor #0|fao ;invert expected flags + always on bits > 3aa1 : d96602 > cmp absflo,y ;test flags > trap_ne 3aa4 : f003 > beq skip3150 > trap ;failed not equal (non zero) 3aa6 : 205b44 > jsr report_error > 3aa9 : >skip3150 > 3aa9 : 88 dey 3aaa : 10df bpl teor10 3aac : a003 ldy #3 3aae : teor11 set_ay absEOa,$ff > load_flag $ff 3aae : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3ab0 : 48 > pha ;use stack to load status 3ab1 : b95e02 > lda absEOa,y ;precharge accu 3ab4 : 28 > plp 3ab5 : 595202 eor absEO,y tst_ay absrlo,absflo,$ff-fnz 3ab8 : 08 > php ;save flags 3ab9 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3abc : f003 > beq skip3155 > trap ;failed not equal (non zero) 3abe : 205b44 > jsr report_error > 3ac1 : >skip3155 > 3ac1 : 68 > pla ;load status > eor_flag $ff-fnz 3ac2 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3ac4 : d96602 > cmp absflo,y ;test flags > trap_ne 3ac7 : f003 > beq skip3158 > trap ;failed not equal (non zero) 3ac9 : 205b44 > jsr report_error > 3acc : >skip3158 > 3acc : 88 dey 3acd : 10df bpl teor11 3acf : a206 ldx #6 ;(zp,x) 3ad1 : a003 ldy #3 3ad3 : teor12 set_ay absEOa,0 > load_flag 0 3ad3 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3ad5 : 48 > pha ;use stack to load status 3ad6 : b95e02 > lda absEOa,y ;precharge accu 3ad9 : 28 > plp 3ada : 4142 eor (indEO,x) tst_ay absrlo,absflo,0 3adc : 08 > php ;save flags 3add : d96202 > cmp absrlo,y ;test result > trap_ne ; 3ae0 : f003 > beq skip3163 > trap ;failed not equal (non zero) 3ae2 : 205b44 > jsr report_error > 3ae5 : >skip3163 > 3ae5 : 68 > pla ;load status > eor_flag 0 3ae6 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3ae8 : d96602 > cmp absflo,y ;test flags > trap_ne 3aeb : f003 > beq skip3166 > trap ;failed not equal (non zero) 3aed : 205b44 > jsr report_error > 3af0 : >skip3166 > 3af0 : ca dex 3af1 : ca dex 3af2 : 88 dey 3af3 : 10de bpl teor12 3af5 : a206 ldx #6 3af7 : a003 ldy #3 3af9 : teor13 set_ay absEOa,$ff > load_flag $ff 3af9 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3afb : 48 > pha ;use stack to load status 3afc : b95e02 > lda absEOa,y ;precharge accu 3aff : 28 > plp 3b00 : 4142 eor (indEO,x) tst_ay absrlo,absflo,$ff-fnz 3b02 : 08 > php ;save flags 3b03 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3b06 : f003 > beq skip3171 > trap ;failed not equal (non zero) 3b08 : 205b44 > jsr report_error > 3b0b : >skip3171 > 3b0b : 68 > pla ;load status > eor_flag $ff-fnz 3b0c : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3b0e : d96602 > cmp absflo,y ;test flags > trap_ne 3b11 : f003 > beq skip3174 > trap ;failed not equal (non zero) 3b13 : 205b44 > jsr report_error > 3b16 : >skip3174 > 3b16 : ca dex 3b17 : ca dex 3b18 : 88 dey 3b19 : 10de bpl teor13 3b1b : a003 ldy #3 ;(zp),y 3b1d : teor14 set_ay absEOa,0 > load_flag 0 3b1d : a900 > lda #0 ;allow test to change I-flag (no mask) > 3b1f : 48 > pha ;use stack to load status 3b20 : b95e02 > lda absEOa,y ;precharge accu 3b23 : 28 > plp 3b24 : 5142 eor (indEO),y tst_ay absrlo,absflo,0 3b26 : 08 > php ;save flags 3b27 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3b2a : f003 > beq skip3179 > trap ;failed not equal (non zero) 3b2c : 205b44 > jsr report_error > 3b2f : >skip3179 > 3b2f : 68 > pla ;load status > eor_flag 0 3b30 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3b32 : d96602 > cmp absflo,y ;test flags > trap_ne 3b35 : f003 > beq skip3182 > trap ;failed not equal (non zero) 3b37 : 205b44 > jsr report_error > 3b3a : >skip3182 > 3b3a : 88 dey 3b3b : 10e0 bpl teor14 3b3d : a003 ldy #3 3b3f : teor15 set_ay absEOa,$ff > load_flag $ff 3b3f : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3b41 : 48 > pha ;use stack to load status 3b42 : b95e02 > lda absEOa,y ;precharge accu 3b45 : 28 > plp 3b46 : 5142 eor (indEO),y tst_ay absrlo,absflo,$ff-fnz 3b48 : 08 > php ;save flags 3b49 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3b4c : f003 > beq skip3187 > trap ;failed not equal (non zero) 3b4e : 205b44 > jsr report_error > 3b51 : >skip3187 > 3b51 : 68 > pla ;load status > eor_flag $ff-fnz 3b52 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3b54 : d96602 > cmp absflo,y ;test flags > trap_ne 3b57 : f003 > beq skip3190 > trap ;failed not equal (non zero) 3b59 : 205b44 > jsr report_error > 3b5c : >skip3190 > 3b5c : 88 dey 3b5d : 10e0 bpl teor15 next_test 3b5f : ad0002 > lda test_case ;previous test 3b62 : c927 > cmp #test_num > trap_ne ;test is out of sequence 3b64 : f003 > beq skip3193 > trap ;failed not equal (non zero) 3b66 : 205b44 > jsr report_error > 3b69 : >skip3193 > 0028 = >test_num = test_num + 1 3b69 : a928 > lda #test_num ;*** next tests' number 3b6b : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; OR 3b6e : a203 ldx #3 ;immediate - self modifying code 3b70 : b518 tora lda zpOR,x 3b72 : 8d0f02 sta ex_orai+1 ;set ORA # operand set_ax absORa,0 > load_flag 0 3b75 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3b77 : 48 > pha ;use stack to load status 3b78 : bd5602 > lda absORa,x ;precharge accu 3b7b : 28 > plp 3b7c : 200e02 jsr ex_orai ;execute ORA # in RAM tst_ax absrlo,absflo,0 3b7f : 08 > php ;save flags 3b80 : dd6202 > cmp absrlo,x ;test result > trap_ne 3b83 : f003 > beq skip3198 > trap ;failed not equal (non zero) 3b85 : 205b44 > jsr report_error > 3b88 : >skip3198 > 3b88 : 68 > pla ;load status > eor_flag 0 3b89 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3b8b : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3b8e : f003 > beq skip3201 > trap ;failed not equal (non zero) 3b90 : 205b44 > jsr report_error > 3b93 : >skip3201 > 3b93 : ca dex 3b94 : 10da bpl tora 3b96 : a203 ldx #3 3b98 : b518 tora1 lda zpOR,x 3b9a : 8d0f02 sta ex_orai+1 ;set ORA # operand set_ax absORa,$ff > load_flag $ff 3b9d : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3b9f : 48 > pha ;use stack to load status 3ba0 : bd5602 > lda absORa,x ;precharge accu 3ba3 : 28 > plp 3ba4 : 200e02 jsr ex_orai ;execute ORA # in RAM tst_ax absrlo,absflo,$ff-fnz 3ba7 : 08 > php ;save flags 3ba8 : dd6202 > cmp absrlo,x ;test result > trap_ne 3bab : f003 > beq skip3206 > trap ;failed not equal (non zero) 3bad : 205b44 > jsr report_error > 3bb0 : >skip3206 > 3bb0 : 68 > pla ;load status > eor_flag $ff-fnz 3bb1 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3bb3 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3bb6 : f003 > beq skip3209 > trap ;failed not equal (non zero) 3bb8 : 205b44 > jsr report_error > 3bbb : >skip3209 > 3bbb : ca dex 3bbc : 10da bpl tora1 3bbe : a203 ldx #3 ;zp 3bc0 : b518 tora2 lda zpOR,x 3bc2 : 850c sta zpt set_ax absORa,0 > load_flag 0 3bc4 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3bc6 : 48 > pha ;use stack to load status 3bc7 : bd5602 > lda absORa,x ;precharge accu 3bca : 28 > plp 3bcb : 050c ora zpt tst_ax absrlo,absflo,0 3bcd : 08 > php ;save flags 3bce : dd6202 > cmp absrlo,x ;test result > trap_ne 3bd1 : f003 > beq skip3214 > trap ;failed not equal (non zero) 3bd3 : 205b44 > jsr report_error > 3bd6 : >skip3214 > 3bd6 : 68 > pla ;load status > eor_flag 0 3bd7 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3bd9 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3bdc : f003 > beq skip3217 > trap ;failed not equal (non zero) 3bde : 205b44 > jsr report_error > 3be1 : >skip3217 > 3be1 : ca dex 3be2 : 10dc bpl tora2 3be4 : a203 ldx #3 3be6 : b518 tora3 lda zpOR,x 3be8 : 850c sta zpt set_ax absORa,$ff > load_flag $ff 3bea : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3bec : 48 > pha ;use stack to load status 3bed : bd5602 > lda absORa,x ;precharge accu 3bf0 : 28 > plp 3bf1 : 050c ora zpt tst_ax absrlo,absflo,$ff-fnz 3bf3 : 08 > php ;save flags 3bf4 : dd6202 > cmp absrlo,x ;test result > trap_ne 3bf7 : f003 > beq skip3222 > trap ;failed not equal (non zero) 3bf9 : 205b44 > jsr report_error > 3bfc : >skip3222 > 3bfc : 68 > pla ;load status > eor_flag $ff-fnz 3bfd : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3bff : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3c02 : f003 > beq skip3225 > trap ;failed not equal (non zero) 3c04 : 205b44 > jsr report_error > 3c07 : >skip3225 > 3c07 : ca dex 3c08 : 10dc bpl tora3 3c0a : a203 ldx #3 ;abs 3c0c : b518 tora4 lda zpOR,x 3c0e : 8d0302 sta abst set_ax absORa,0 > load_flag 0 3c11 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3c13 : 48 > pha ;use stack to load status 3c14 : bd5602 > lda absORa,x ;precharge accu 3c17 : 28 > plp 3c18 : 0d0302 ora abst tst_ax absrlo,absflo,0 3c1b : 08 > php ;save flags 3c1c : dd6202 > cmp absrlo,x ;test result > trap_ne 3c1f : f003 > beq skip3230 > trap ;failed not equal (non zero) 3c21 : 205b44 > jsr report_error > 3c24 : >skip3230 > 3c24 : 68 > pla ;load status > eor_flag 0 3c25 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3c27 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3c2a : f003 > beq skip3233 > trap ;failed not equal (non zero) 3c2c : 205b44 > jsr report_error > 3c2f : >skip3233 > 3c2f : ca dex 3c30 : 10da bpl tora4 3c32 : a203 ldx #3 3c34 : b518 tora5 lda zpOR,x 3c36 : 8d0302 sta abst set_ax absORa,$ff > load_flag $ff 3c39 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3c3b : 48 > pha ;use stack to load status 3c3c : bd5602 > lda absORa,x ;precharge accu 3c3f : 28 > plp 3c40 : 0d0302 ora abst tst_ax absrlo,absflo,$ff-fnz 3c43 : 08 > php ;save flags 3c44 : dd6202 > cmp absrlo,x ;test result > trap_ne 3c47 : f003 > beq skip3238 > trap ;failed not equal (non zero) 3c49 : 205b44 > jsr report_error > 3c4c : >skip3238 > 3c4c : 68 > pla ;load status > eor_flag $ff-fnz 3c4d : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3c4f : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3c52 : f003 > beq skip3241 > trap ;failed not equal (non zero) 3c54 : 205b44 > jsr report_error > 3c57 : >skip3241 > 3c57 : ca dex 3c58 : 1002 bpl tora6 3c5a : a203 ldx #3 ;zp,x 3c5c : tora6 set_ax absORa,0 > load_flag 0 3c5c : a900 > lda #0 ;allow test to change I-flag (no mask) > 3c5e : 48 > pha ;use stack to load status 3c5f : bd5602 > lda absORa,x ;precharge accu 3c62 : 28 > plp 3c63 : 1518 ora zpOR,x tst_ax absrlo,absflo,0 3c65 : 08 > php ;save flags 3c66 : dd6202 > cmp absrlo,x ;test result > trap_ne 3c69 : f003 > beq skip3246 > trap ;failed not equal (non zero) 3c6b : 205b44 > jsr report_error > 3c6e : >skip3246 > 3c6e : 68 > pla ;load status > eor_flag 0 3c6f : 4930 > eor #0|fao ;invert expected flags + always on bits > 3c71 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3c74 : f003 > beq skip3249 > trap ;failed not equal (non zero) 3c76 : 205b44 > jsr report_error > 3c79 : >skip3249 > 3c79 : ca dex 3c7a : 10e0 bpl tora6 3c7c : a203 ldx #3 3c7e : tora7 set_ax absORa,$ff > load_flag $ff 3c7e : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3c80 : 48 > pha ;use stack to load status 3c81 : bd5602 > lda absORa,x ;precharge accu 3c84 : 28 > plp 3c85 : 1518 ora zpOR,x tst_ax absrlo,absflo,$ff-fnz 3c87 : 08 > php ;save flags 3c88 : dd6202 > cmp absrlo,x ;test result > trap_ne 3c8b : f003 > beq skip3254 > trap ;failed not equal (non zero) 3c8d : 205b44 > jsr report_error > 3c90 : >skip3254 > 3c90 : 68 > pla ;load status > eor_flag $ff-fnz 3c91 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3c93 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3c96 : f003 > beq skip3257 > trap ;failed not equal (non zero) 3c98 : 205b44 > jsr report_error > 3c9b : >skip3257 > 3c9b : ca dex 3c9c : 10e0 bpl tora7 3c9e : a203 ldx #3 ;abs,x 3ca0 : tora8 set_ax absORa,0 > load_flag 0 3ca0 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3ca2 : 48 > pha ;use stack to load status 3ca3 : bd5602 > lda absORa,x ;precharge accu 3ca6 : 28 > plp 3ca7 : 1d4a02 ora absOR,x tst_ax absrlo,absflo,0 3caa : 08 > php ;save flags 3cab : dd6202 > cmp absrlo,x ;test result > trap_ne 3cae : f003 > beq skip3262 > trap ;failed not equal (non zero) 3cb0 : 205b44 > jsr report_error > 3cb3 : >skip3262 > 3cb3 : 68 > pla ;load status > eor_flag 0 3cb4 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3cb6 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3cb9 : f003 > beq skip3265 > trap ;failed not equal (non zero) 3cbb : 205b44 > jsr report_error > 3cbe : >skip3265 > 3cbe : ca dex 3cbf : 10df bpl tora8 3cc1 : a203 ldx #3 3cc3 : tora9 set_ax absORa,$ff > load_flag $ff 3cc3 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3cc5 : 48 > pha ;use stack to load status 3cc6 : bd5602 > lda absORa,x ;precharge accu 3cc9 : 28 > plp 3cca : 1d4a02 ora absOR,x tst_ax absrlo,absflo,$ff-fnz 3ccd : 08 > php ;save flags 3cce : dd6202 > cmp absrlo,x ;test result > trap_ne 3cd1 : f003 > beq skip3270 > trap ;failed not equal (non zero) 3cd3 : 205b44 > jsr report_error > 3cd6 : >skip3270 > 3cd6 : 68 > pla ;load status > eor_flag $ff-fnz 3cd7 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3cd9 : dd6602 > cmp absflo,x ;test flags > trap_ne ; 3cdc : f003 > beq skip3273 > trap ;failed not equal (non zero) 3cde : 205b44 > jsr report_error > 3ce1 : >skip3273 > 3ce1 : ca dex 3ce2 : 10df bpl tora9 3ce4 : a003 ldy #3 ;abs,y 3ce6 : tora10 set_ay absORa,0 > load_flag 0 3ce6 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3ce8 : 48 > pha ;use stack to load status 3ce9 : b95602 > lda absORa,y ;precharge accu 3cec : 28 > plp 3ced : 194a02 ora absOR,y tst_ay absrlo,absflo,0 3cf0 : 08 > php ;save flags 3cf1 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3cf4 : f003 > beq skip3278 > trap ;failed not equal (non zero) 3cf6 : 205b44 > jsr report_error > 3cf9 : >skip3278 > 3cf9 : 68 > pla ;load status > eor_flag 0 3cfa : 4930 > eor #0|fao ;invert expected flags + always on bits > 3cfc : d96602 > cmp absflo,y ;test flags > trap_ne 3cff : f003 > beq skip3281 > trap ;failed not equal (non zero) 3d01 : 205b44 > jsr report_error > 3d04 : >skip3281 > 3d04 : 88 dey 3d05 : 10df bpl tora10 3d07 : a003 ldy #3 3d09 : tora11 set_ay absORa,$ff > load_flag $ff 3d09 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3d0b : 48 > pha ;use stack to load status 3d0c : b95602 > lda absORa,y ;precharge accu 3d0f : 28 > plp 3d10 : 194a02 ora absOR,y tst_ay absrlo,absflo,$ff-fnz 3d13 : 08 > php ;save flags 3d14 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3d17 : f003 > beq skip3286 > trap ;failed not equal (non zero) 3d19 : 205b44 > jsr report_error > 3d1c : >skip3286 > 3d1c : 68 > pla ;load status > eor_flag $ff-fnz 3d1d : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3d1f : d96602 > cmp absflo,y ;test flags > trap_ne 3d22 : f003 > beq skip3289 > trap ;failed not equal (non zero) 3d24 : 205b44 > jsr report_error > 3d27 : >skip3289 > 3d27 : 88 dey 3d28 : 10df bpl tora11 3d2a : a206 ldx #6 ;(zp,x) 3d2c : a003 ldy #3 3d2e : tora12 set_ay absORa,0 > load_flag 0 3d2e : a900 > lda #0 ;allow test to change I-flag (no mask) > 3d30 : 48 > pha ;use stack to load status 3d31 : b95602 > lda absORa,y ;precharge accu 3d34 : 28 > plp 3d35 : 014a ora (indOR,x) tst_ay absrlo,absflo,0 3d37 : 08 > php ;save flags 3d38 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3d3b : f003 > beq skip3294 > trap ;failed not equal (non zero) 3d3d : 205b44 > jsr report_error > 3d40 : >skip3294 > 3d40 : 68 > pla ;load status > eor_flag 0 3d41 : 4930 > eor #0|fao ;invert expected flags + always on bits > 3d43 : d96602 > cmp absflo,y ;test flags > trap_ne 3d46 : f003 > beq skip3297 > trap ;failed not equal (non zero) 3d48 : 205b44 > jsr report_error > 3d4b : >skip3297 > 3d4b : ca dex 3d4c : ca dex 3d4d : 88 dey 3d4e : 10de bpl tora12 3d50 : a206 ldx #6 3d52 : a003 ldy #3 3d54 : tora13 set_ay absORa,$ff > load_flag $ff 3d54 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3d56 : 48 > pha ;use stack to load status 3d57 : b95602 > lda absORa,y ;precharge accu 3d5a : 28 > plp 3d5b : 014a ora (indOR,x) tst_ay absrlo,absflo,$ff-fnz 3d5d : 08 > php ;save flags 3d5e : d96202 > cmp absrlo,y ;test result > trap_ne ; 3d61 : f003 > beq skip3302 > trap ;failed not equal (non zero) 3d63 : 205b44 > jsr report_error > 3d66 : >skip3302 > 3d66 : 68 > pla ;load status > eor_flag $ff-fnz 3d67 : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3d69 : d96602 > cmp absflo,y ;test flags > trap_ne 3d6c : f003 > beq skip3305 > trap ;failed not equal (non zero) 3d6e : 205b44 > jsr report_error > 3d71 : >skip3305 > 3d71 : ca dex 3d72 : ca dex 3d73 : 88 dey 3d74 : 10de bpl tora13 3d76 : a003 ldy #3 ;(zp),y 3d78 : tora14 set_ay absORa,0 > load_flag 0 3d78 : a900 > lda #0 ;allow test to change I-flag (no mask) > 3d7a : 48 > pha ;use stack to load status 3d7b : b95602 > lda absORa,y ;precharge accu 3d7e : 28 > plp 3d7f : 114a ora (indOR),y tst_ay absrlo,absflo,0 3d81 : 08 > php ;save flags 3d82 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3d85 : f003 > beq skip3310 > trap ;failed not equal (non zero) 3d87 : 205b44 > jsr report_error > 3d8a : >skip3310 > 3d8a : 68 > pla ;load status > eor_flag 0 3d8b : 4930 > eor #0|fao ;invert expected flags + always on bits > 3d8d : d96602 > cmp absflo,y ;test flags > trap_ne 3d90 : f003 > beq skip3313 > trap ;failed not equal (non zero) 3d92 : 205b44 > jsr report_error > 3d95 : >skip3313 > 3d95 : 88 dey 3d96 : 10e0 bpl tora14 3d98 : a003 ldy #3 3d9a : tora15 set_ay absORa,$ff > load_flag $ff 3d9a : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 3d9c : 48 > pha ;use stack to load status 3d9d : b95602 > lda absORa,y ;precharge accu 3da0 : 28 > plp 3da1 : 114a ora (indOR),y tst_ay absrlo,absflo,$ff-fnz 3da3 : 08 > php ;save flags 3da4 : d96202 > cmp absrlo,y ;test result > trap_ne ; 3da7 : f003 > beq skip3318 > trap ;failed not equal (non zero) 3da9 : 205b44 > jsr report_error > 3dac : >skip3318 > 3dac : 68 > pla ;load status > eor_flag $ff-fnz 3dad : 497d > eor #$ff-fnz|fao ;invert expected flags + always on bits > 3daf : d96602 > cmp absflo,y ;test flags > trap_ne 3db2 : f003 > beq skip3321 > trap ;failed not equal (non zero) 3db4 : 205b44 > jsr report_error > 3db7 : >skip3321 > 3db7 : 88 dey 3db8 : 10e0 bpl tora15 if I_flag = 3 3dba : 58 cli endif next_test 3dbb : ad0002 > lda test_case ;previous test 3dbe : c928 > cmp #test_num > trap_ne ;test is out of sequence 3dc0 : f003 > beq skip3324 > trap ;failed not equal (non zero) 3dc2 : 205b44 > jsr report_error > 3dc5 : >skip3324 > 0029 = >test_num = test_num + 1 3dc5 : a929 > lda #test_num ;*** next tests' number 3dc7 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; full binary add/subtract test ; iterates through all combinations of operands and carry input ; uses increments/decrements to predict result & result flags 3dca : d8 cld 3dcb : a20e ldx #ad2 ;for indexed test 3dcd : a0ff ldy #$ff ;max range 3dcf : a900 lda #0 ;start with adding zeroes & no carry 3dd1 : 850c sta adfc ;carry in - for diag 3dd3 : 850d sta ad1 ;operand 1 - accumulator 3dd5 : 850e sta ad2 ;operand 2 - memory or immediate 3dd7 : 8d0302 sta ada2 ;non zp 3dda : 850f sta adrl ;expected result bits 0-7 3ddc : 8510 sta adrh ;expected result bit 8 (carry out) 3dde : a9ff lda #$ff ;complemented operand 2 for subtract 3de0 : 8512 sta sb2 3de2 : 8d0402 sta sba2 ;non zp 3de5 : a902 lda #2 ;expected Z-flag 3de7 : 8511 sta adrf 3de9 : 18 tadd clc ;test with carry clear 3dea : 20df40 jsr chkadd 3ded : e60c inc adfc ;now with carry 3def : e60f inc adrl ;result +1 3df1 : 08 php ;save N & Z from low result 3df2 : 08 php 3df3 : 68 pla ;accu holds expected flags 3df4 : 2982 and #$82 ;mask N & Z 3df6 : 28 plp 3df7 : d002 bne tadd1 3df9 : e610 inc adrh ;result bit 8 - carry 3dfb : 0510 tadd1 ora adrh ;merge C to expected flags 3dfd : 8511 sta adrf ;save expected flags except overflow 3dff : 38 sec ;test with carry set 3e00 : 20df40 jsr chkadd 3e03 : c60c dec adfc ;same for operand +1 but no carry 3e05 : e60d inc ad1 3e07 : d0e0 bne tadd ;iterate op1 3e09 : a900 lda #0 ;preset result to op2 when op1 = 0 3e0b : 8510 sta adrh 3e0d : ee0302 inc ada2 3e10 : e60e inc ad2 3e12 : 08 php ;save NZ as operand 2 becomes the new result 3e13 : 68 pla 3e14 : 2982 and #$82 ;mask N00000Z0 3e16 : 8511 sta adrf ;no need to check carry as we are adding to 0 3e18 : c612 dec sb2 ;complement subtract operand 2 3e1a : ce0402 dec sba2 3e1d : a50e lda ad2 3e1f : 850f sta adrl 3e21 : d0c6 bne tadd ;iterate op2 if disable_decimal < 1 next_test 3e23 : ad0002 > lda test_case ;previous test 3e26 : c929 > cmp #test_num > trap_ne ;test is out of sequence 3e28 : f003 > beq skip3327 > trap ;failed not equal (non zero) 3e2a : 205b44 > jsr report_error > 3e2d : >skip3327 > 002a = >test_num = test_num + 1 3e2d : a92a > lda #test_num ;*** next tests' number 3e2f : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; decimal add/subtract test ; *** WARNING - tests documented behavior only! *** ; only valid BCD operands are tested, N V Z flags are ignored ; iterates through all valid combinations of operands and carry input ; uses increments/decrements to predict result & carry flag 3e32 : f8 sed 3e33 : a20e ldx #ad2 ;for indexed test 3e35 : a0ff ldy #$ff ;max range 3e37 : a999 lda #$99 ;start with adding 99 to 99 with carry 3e39 : 850d sta ad1 ;operand 1 - accumulator 3e3b : 850e sta ad2 ;operand 2 - memory or immediate 3e3d : 8d0302 sta ada2 ;non zp 3e40 : 850f sta adrl ;expected result bits 0-7 3e42 : a901 lda #1 ;set carry in & out 3e44 : 850c sta adfc ;carry in - for diag 3e46 : 8510 sta adrh ;expected result bit 8 (carry out) 3e48 : a900 lda #0 ;complemented operand 2 for subtract 3e4a : 8512 sta sb2 3e4c : 8d0402 sta sba2 ;non zp 3e4f : 38 tdad sec ;test with carry set 3e50 : 204c3f jsr chkdad 3e53 : c60c dec adfc ;now with carry clear 3e55 : a50f lda adrl ;decimal adjust result 3e57 : d008 bne tdad1 ;skip clear carry & preset result 99 (9A-1) 3e59 : c610 dec adrh 3e5b : a999 lda #$99 3e5d : 850f sta adrl 3e5f : d012 bne tdad3 3e61 : 290f tdad1 and #$f ;lower nibble mask 3e63 : d00c bne tdad2 ;no decimal adjust needed 3e65 : c60f dec adrl ;decimal adjust (?0-6) 3e67 : c60f dec adrl 3e69 : c60f dec adrl 3e6b : c60f dec adrl 3e6d : c60f dec adrl 3e6f : c60f dec adrl 3e71 : c60f tdad2 dec adrl ;result -1 3e73 : 18 tdad3 clc ;test with carry clear 3e74 : 204c3f jsr chkdad 3e77 : e60c inc adfc ;same for operand -1 but with carry 3e79 : a50d lda ad1 ;decimal adjust operand 1 3e7b : f015 beq tdad5 ;iterate operand 2 3e7d : 290f and #$f ;lower nibble mask 3e7f : d00c bne tdad4 ;skip decimal adjust 3e81 : c60d dec ad1 ;decimal adjust (?0-6) 3e83 : c60d dec ad1 3e85 : c60d dec ad1 3e87 : c60d dec ad1 3e89 : c60d dec ad1 3e8b : c60d dec ad1 3e8d : c60d tdad4 dec ad1 ;operand 1 -1 3e8f : 4c4f3e jmp tdad ;iterate op1 3e92 : a999 tdad5 lda #$99 ;precharge op1 max 3e94 : 850d sta ad1 3e96 : a50e lda ad2 ;decimal adjust operand 2 3e98 : f030 beq tdad7 ;end of iteration 3e9a : 290f and #$f ;lower nibble mask 3e9c : d018 bne tdad6 ;skip decimal adjust 3e9e : c60e dec ad2 ;decimal adjust (?0-6) 3ea0 : c60e dec ad2 3ea2 : c60e dec ad2 3ea4 : c60e dec ad2 3ea6 : c60e dec ad2 3ea8 : c60e dec ad2 3eaa : e612 inc sb2 ;complemented decimal adjust for subtract (?9+6) 3eac : e612 inc sb2 3eae : e612 inc sb2 3eb0 : e612 inc sb2 3eb2 : e612 inc sb2 3eb4 : e612 inc sb2 3eb6 : c60e tdad6 dec ad2 ;operand 2 -1 3eb8 : e612 inc sb2 ;complemented operand for subtract 3eba : a512 lda sb2 3ebc : 8d0402 sta sba2 ;copy as non zp operand 3ebf : a50e lda ad2 3ec1 : 8d0302 sta ada2 ;copy as non zp operand 3ec4 : 850f sta adrl ;new result since op1+carry=00+carry +op2=op2 3ec6 : e610 inc adrh ;result carry 3ec8 : d085 bne tdad ;iterate op2 3eca : tdad7 next_test 3eca : ad0002 > lda test_case ;previous test 3ecd : c92a > cmp #test_num > trap_ne ;test is out of sequence 3ecf : f003 > beq skip3330 > trap ;failed not equal (non zero) 3ed1 : 205b44 > jsr report_error > 3ed4 : >skip3330 > 002b = >test_num = test_num + 1 3ed4 : a92b > lda #test_num ;*** next tests' number 3ed6 : 8d0002 > sta test_case > ;check_ram ;uncomment to find altered RAM after each test ; decimal/binary switch test ; tests CLD, SED, PLP, RTI to properly switch between decimal & binary opcode ; tables 3ed9 : 18 clc 3eda : d8 cld 3edb : 08 php 3edc : a955 lda #$55 3ede : 6955 adc #$55 3ee0 : c9aa cmp #$aa trap_ne ;expected binary result after cld 3ee2 : f003 > beq skip3332 > trap ;failed not equal (non zero) 3ee4 : 205b44 > jsr report_error > 3ee7 : >skip3332 3ee7 : 18 clc 3ee8 : f8 sed 3ee9 : 08 php 3eea : a955 lda #$55 3eec : 6955 adc #$55 3eee : c910 cmp #$10 trap_ne ;expected decimal result after sed 3ef0 : f003 > beq skip3334 > trap ;failed not equal (non zero) 3ef2 : 205b44 > jsr report_error > 3ef5 : >skip3334 3ef5 : d8 cld 3ef6 : 28 plp 3ef7 : a955 lda #$55 3ef9 : 6955 adc #$55 3efb : c910 cmp #$10 trap_ne ;expected decimal result after plp D=1 3efd : f003 > beq skip3336 > trap ;failed not equal (non zero) 3eff : 205b44 > jsr report_error > 3f02 : >skip3336 3f02 : 28 plp 3f03 : a955 lda #$55 3f05 : 6955 adc #$55 3f07 : c9aa cmp #$aa trap_ne ;expected binary result after plp D=0 3f09 : f003 > beq skip3338 > trap ;failed not equal (non zero) 3f0b : 205b44 > jsr report_error > 3f0e : >skip3338 3f0e : 18 clc 3f0f : a93f lda #hi bin_rti_ret ;emulated interrupt for rti 3f11 : 48 pha 3f12 : a92c lda #lo bin_rti_ret 3f14 : 48 pha 3f15 : 08 php 3f16 : f8 sed 3f17 : a93f lda #hi dec_rti_ret ;emulated interrupt for rti 3f19 : 48 pha 3f1a : a920 lda #lo dec_rti_ret 3f1c : 48 pha 3f1d : 08 php 3f1e : d8 cld 3f1f : 40 rti 3f20 : dec_rti_ret 3f20 : a955 lda #$55 3f22 : 6955 adc #$55 3f24 : c910 cmp #$10 trap_ne ;expected decimal result after rti D=1 3f26 : f003 > beq skip3340 > trap ;failed not equal (non zero) 3f28 : 205b44 > jsr report_error > 3f2b : >skip3340 3f2b : 40 rti 3f2c : bin_rti_ret 3f2c : a955 lda #$55 3f2e : 6955 adc #$55 3f30 : c9aa cmp #$aa trap_ne ;expected binary result after rti D=0 3f32 : f003 > beq skip3342 > trap ;failed not equal (non zero) 3f34 : 205b44 > jsr report_error > 3f37 : >skip3342 endif 3f37 : ad0002 lda test_case 3f3a : c92b cmp #test_num trap_ne ;previous test is out of sequence 3f3c : f003 > beq skip3344 > trap ;failed not equal (non zero) 3f3e : 205b44 > jsr report_error > 3f41 : >skip3344 3f41 : a9f0 lda #$f0 ;mark opcode testing complete 3f43 : 8d0002 sta test_case ; final RAM integrity test ; verifies that none of the previous tests has altered RAM outside of the ; designated write areas. check_ram > ;RAM check disabled - RAM size not set ; *** DEBUG INFO *** ; to debug checksum errors uncomment check_ram in the next_test macro to ; narrow down the responsible opcode. ; may give false errors when monitor, OS or other background activity is ; allowed during previous tests. ; S U C C E S S ************************************************ ; ------------- success ;if you get here everything went well 3f46 : 202445 > jsr report_success ; ------------- ; S U C C E S S ************************************************ 3f49 : 4c0004 jmp start ;run again if disable_decimal < 1 ; core subroutine of the decimal add/subtract test ; *** WARNING - tests documented behavior only! *** ; only valid BCD operands are tested, N V Z flags are ignored ; iterates through all valid combinations of operands and carry input ; uses increments/decrements to predict result & carry flag 3f4c : chkdad ; decimal ADC / SBC zp 3f4c : 08 php ;save carry for subtract 3f4d : a50d lda ad1 3f4f : 650e adc ad2 ;perform add 3f51 : 08 php 3f52 : c50f cmp adrl ;check result trap_ne ;bad result 3f54 : f003 > beq skip3348 > trap ;failed not equal (non zero) 3f56 : 205b44 > jsr report_error > 3f59 : >skip3348 3f59 : 68 pla ;check flags 3f5a : 2901 and #1 ;mask carry 3f5c : c510 cmp adrh trap_ne ;bad carry 3f5e : f003 > beq skip3350 > trap ;failed not equal (non zero) 3f60 : 205b44 > jsr report_error > 3f63 : >skip3350 3f63 : 28 plp 3f64 : 08 php ;save carry for next add 3f65 : a50d lda ad1 3f67 : e512 sbc sb2 ;perform subtract 3f69 : 08 php 3f6a : c50f cmp adrl ;check result trap_ne ;bad result 3f6c : f003 > beq skip3352 > trap ;failed not equal (non zero) 3f6e : 205b44 > jsr report_error > 3f71 : >skip3352 3f71 : 68 pla ;check flags 3f72 : 2901 and #1 ;mask carry 3f74 : c510 cmp adrh trap_ne ;bad flags 3f76 : f003 > beq skip3354 > trap ;failed not equal (non zero) 3f78 : 205b44 > jsr report_error > 3f7b : >skip3354 3f7b : 28 plp ; decimal ADC / SBC abs 3f7c : 08 php ;save carry for subtract 3f7d : a50d lda ad1 3f7f : 6d0302 adc ada2 ;perform add 3f82 : 08 php 3f83 : c50f cmp adrl ;check result trap_ne ;bad result 3f85 : f003 > beq skip3356 > trap ;failed not equal (non zero) 3f87 : 205b44 > jsr report_error > 3f8a : >skip3356 3f8a : 68 pla ;check flags 3f8b : 2901 and #1 ;mask carry 3f8d : c510 cmp adrh trap_ne ;bad carry 3f8f : f003 > beq skip3358 > trap ;failed not equal (non zero) 3f91 : 205b44 > jsr report_error > 3f94 : >skip3358 3f94 : 28 plp 3f95 : 08 php ;save carry for next add 3f96 : a50d lda ad1 3f98 : ed0402 sbc sba2 ;perform subtract 3f9b : 08 php 3f9c : c50f cmp adrl ;check result trap_ne ;bad result 3f9e : f003 > beq skip3360 > trap ;failed not equal (non zero) 3fa0 : 205b44 > jsr report_error > 3fa3 : >skip3360 3fa3 : 68 pla ;check flags 3fa4 : 2901 and #1 ;mask carry 3fa6 : c510 cmp adrh trap_ne ;bad carry 3fa8 : f003 > beq skip3362 > trap ;failed not equal (non zero) 3faa : 205b44 > jsr report_error > 3fad : >skip3362 3fad : 28 plp ; decimal ADC / SBC # 3fae : 08 php ;save carry for subtract 3faf : a50e lda ad2 3fb1 : 8d1202 sta ex_adci+1 ;set ADC # operand 3fb4 : a50d lda ad1 3fb6 : 201102 jsr ex_adci ;execute ADC # in RAM 3fb9 : 08 php 3fba : c50f cmp adrl ;check result trap_ne ;bad result 3fbc : f003 > beq skip3364 > trap ;failed not equal (non zero) 3fbe : 205b44 > jsr report_error > 3fc1 : >skip3364 3fc1 : 68 pla ;check flags 3fc2 : 2901 and #1 ;mask carry 3fc4 : c510 cmp adrh trap_ne ;bad carry 3fc6 : f003 > beq skip3366 > trap ;failed not equal (non zero) 3fc8 : 205b44 > jsr report_error > 3fcb : >skip3366 3fcb : 28 plp 3fcc : 08 php ;save carry for next add 3fcd : a512 lda sb2 3fcf : 8d1502 sta ex_sbci+1 ;set SBC # operand 3fd2 : a50d lda ad1 3fd4 : 201402 jsr ex_sbci ;execute SBC # in RAM 3fd7 : 08 php 3fd8 : c50f cmp adrl ;check result trap_ne ;bad result 3fda : f003 > beq skip3368 > trap ;failed not equal (non zero) 3fdc : 205b44 > jsr report_error > 3fdf : >skip3368 3fdf : 68 pla ;check flags 3fe0 : 2901 and #1 ;mask carry 3fe2 : c510 cmp adrh trap_ne ;bad carry 3fe4 : f003 > beq skip3370 > trap ;failed not equal (non zero) 3fe6 : 205b44 > jsr report_error > 3fe9 : >skip3370 3fe9 : 28 plp ; decimal ADC / SBC zp,x 3fea : 08 php ;save carry for subtract 3feb : a50d lda ad1 3fed : 7500 adc 0,x ;perform add 3fef : 08 php 3ff0 : c50f cmp adrl ;check result trap_ne ;bad result 3ff2 : f003 > beq skip3372 > trap ;failed not equal (non zero) 3ff4 : 205b44 > jsr report_error > 3ff7 : >skip3372 3ff7 : 68 pla ;check flags 3ff8 : 2901 and #1 ;mask carry 3ffa : c510 cmp adrh trap_ne ;bad carry 3ffc : f003 > beq skip3374 > trap ;failed not equal (non zero) 3ffe : 205b44 > jsr report_error > 4001 : >skip3374 4001 : 28 plp 4002 : 08 php ;save carry for next add 4003 : a50d lda ad1 4005 : f504 sbc sb2-ad2,x ;perform subtract 4007 : 08 php 4008 : c50f cmp adrl ;check result trap_ne ;bad result 400a : f003 > beq skip3376 > trap ;failed not equal (non zero) 400c : 205b44 > jsr report_error > 400f : >skip3376 400f : 68 pla ;check flags 4010 : 2901 and #1 ;mask carry 4012 : c510 cmp adrh trap_ne ;bad carry 4014 : f003 > beq skip3378 > trap ;failed not equal (non zero) 4016 : 205b44 > jsr report_error > 4019 : >skip3378 4019 : 28 plp ; decimal ADC / SBC abs,x 401a : 08 php ;save carry for subtract 401b : a50d lda ad1 401d : 7df501 adc ada2-ad2,x ;perform add 4020 : 08 php 4021 : c50f cmp adrl ;check result trap_ne ;bad result 4023 : f003 > beq skip3380 > trap ;failed not equal (non zero) 4025 : 205b44 > jsr report_error > 4028 : >skip3380 4028 : 68 pla ;check flags 4029 : 2901 and #1 ;mask carry 402b : c510 cmp adrh trap_ne ;bad carry 402d : f003 > beq skip3382 > trap ;failed not equal (non zero) 402f : 205b44 > jsr report_error > 4032 : >skip3382 4032 : 28 plp 4033 : 08 php ;save carry for next add 4034 : a50d lda ad1 4036 : fdf601 sbc sba2-ad2,x ;perform subtract 4039 : 08 php 403a : c50f cmp adrl ;check result trap_ne ;bad result 403c : f003 > beq skip3384 > trap ;failed not equal (non zero) 403e : 205b44 > jsr report_error > 4041 : >skip3384 4041 : 68 pla ;check flags 4042 : 2901 and #1 ;mask carry 4044 : c510 cmp adrh trap_ne ;bad carry 4046 : f003 > beq skip3386 > trap ;failed not equal (non zero) 4048 : 205b44 > jsr report_error > 404b : >skip3386 404b : 28 plp ; decimal ADC / SBC abs,y 404c : 08 php ;save carry for subtract 404d : a50d lda ad1 404f : 790401 adc ada2-$ff,y ;perform add 4052 : 08 php 4053 : c50f cmp adrl ;check result trap_ne ;bad result 4055 : f003 > beq skip3388 > trap ;failed not equal (non zero) 4057 : 205b44 > jsr report_error > 405a : >skip3388 405a : 68 pla ;check flags 405b : 2901 and #1 ;mask carry 405d : c510 cmp adrh trap_ne ;bad carry 405f : f003 > beq skip3390 > trap ;failed not equal (non zero) 4061 : 205b44 > jsr report_error > 4064 : >skip3390 4064 : 28 plp 4065 : 08 php ;save carry for next add 4066 : a50d lda ad1 4068 : f90501 sbc sba2-$ff,y ;perform subtract 406b : 08 php 406c : c50f cmp adrl ;check result trap_ne ;bad result 406e : f003 > beq skip3392 > trap ;failed not equal (non zero) 4070 : 205b44 > jsr report_error > 4073 : >skip3392 4073 : 68 pla ;check flags 4074 : 2901 and #1 ;mask carry 4076 : c510 cmp adrh trap_ne ;bad carry 4078 : f003 > beq skip3394 > trap ;failed not equal (non zero) 407a : 205b44 > jsr report_error > 407d : >skip3394 407d : 28 plp ; decimal ADC / SBC (zp,x) 407e : 08 php ;save carry for subtract 407f : a50d lda ad1 4081 : 6144 adc (lo adi2-ad2,x) ;perform add 4083 : 08 php 4084 : c50f cmp adrl ;check result trap_ne ;bad result 4086 : f003 > beq skip3396 > trap ;failed not equal (non zero) 4088 : 205b44 > jsr report_error > 408b : >skip3396 408b : 68 pla ;check flags 408c : 2901 and #1 ;mask carry 408e : c510 cmp adrh trap_ne ;bad carry 4090 : f003 > beq skip3398 > trap ;failed not equal (non zero) 4092 : 205b44 > jsr report_error > 4095 : >skip3398 4095 : 28 plp 4096 : 08 php ;save carry for next add 4097 : a50d lda ad1 4099 : e146 sbc (lo sbi2-ad2,x) ;perform subtract 409b : 08 php 409c : c50f cmp adrl ;check result trap_ne ;bad result 409e : f003 > beq skip3400 > trap ;failed not equal (non zero) 40a0 : 205b44 > jsr report_error > 40a3 : >skip3400 40a3 : 68 pla ;check flags 40a4 : 2901 and #1 ;mask carry 40a6 : c510 cmp adrh trap_ne ;bad carry 40a8 : f003 > beq skip3402 > trap ;failed not equal (non zero) 40aa : 205b44 > jsr report_error > 40ad : >skip3402 40ad : 28 plp ; decimal ADC / SBC (abs),y 40ae : 08 php ;save carry for subtract 40af : a50d lda ad1 40b1 : 7156 adc (adiy2),y ;perform add 40b3 : 08 php 40b4 : c50f cmp adrl ;check result trap_ne ;bad result 40b6 : f003 > beq skip3404 > trap ;failed not equal (non zero) 40b8 : 205b44 > jsr report_error > 40bb : >skip3404 40bb : 68 pla ;check flags 40bc : 2901 and #1 ;mask carry 40be : c510 cmp adrh trap_ne ;bad carry 40c0 : f003 > beq skip3406 > trap ;failed not equal (non zero) 40c2 : 205b44 > jsr report_error > 40c5 : >skip3406 40c5 : 28 plp 40c6 : 08 php ;save carry for next add 40c7 : a50d lda ad1 40c9 : f158 sbc (sbiy2),y ;perform subtract 40cb : 08 php 40cc : c50f cmp adrl ;check result trap_ne ;bad result 40ce : f003 > beq skip3408 > trap ;failed not equal (non zero) 40d0 : 205b44 > jsr report_error > 40d3 : >skip3408 40d3 : 68 pla ;check flags 40d4 : 2901 and #1 ;mask carry 40d6 : c510 cmp adrh trap_ne ;bad carry 40d8 : f003 > beq skip3410 > trap ;failed not equal (non zero) 40da : 205b44 > jsr report_error > 40dd : >skip3410 40dd : 28 plp 40de : 60 rts endif ; core subroutine of the full binary add/subtract test ; iterates through all combinations of operands and carry input ; uses increments/decrements to predict result & result flags 40df : a511 chkadd lda adrf ;add V-flag if overflow 40e1 : 2983 and #$83 ;keep N-----ZC / clear V 40e3 : 48 pha 40e4 : a50d lda ad1 ;test sign unequal between operands 40e6 : 450e eor ad2 40e8 : 300a bmi ckad1 ;no overflow possible - operands have different sign 40ea : a50d lda ad1 ;test sign equal between operands and result 40ec : 450f eor adrl 40ee : 1004 bpl ckad1 ;no overflow occured - operand and result have same sign 40f0 : 68 pla 40f1 : 0940 ora #$40 ;set V 40f3 : 48 pha 40f4 : 68 ckad1 pla 40f5 : 8511 sta adrf ;save expected flags ; binary ADC / SBC zp 40f7 : 08 php ;save carry for subtract 40f8 : a50d lda ad1 40fa : 650e adc ad2 ;perform add 40fc : 08 php 40fd : c50f cmp adrl ;check result trap_ne ;bad result 40ff : f003 > beq skip3412 > trap ;failed not equal (non zero) 4101 : 205b44 > jsr report_error > 4104 : >skip3412 4104 : 68 pla ;check flags 4105 : 29c3 and #$c3 ;mask NV----ZC 4107 : c511 cmp adrf trap_ne ;bad flags 4109 : f003 > beq skip3414 > trap ;failed not equal (non zero) 410b : 205b44 > jsr report_error > 410e : >skip3414 410e : 28 plp 410f : 08 php ;save carry for next add 4110 : a50d lda ad1 4112 : e512 sbc sb2 ;perform subtract 4114 : 08 php 4115 : c50f cmp adrl ;check result trap_ne ;bad result 4117 : f003 > beq skip3416 > trap ;failed not equal (non zero) 4119 : 205b44 > jsr report_error > 411c : >skip3416 411c : 68 pla ;check flags 411d : 29c3 and #$c3 ;mask NV----ZC 411f : c511 cmp adrf trap_ne ;bad flags 4121 : f003 > beq skip3418 > trap ;failed not equal (non zero) 4123 : 205b44 > jsr report_error > 4126 : >skip3418 4126 : 28 plp ; binary ADC / SBC abs 4127 : 08 php ;save carry for subtract 4128 : a50d lda ad1 412a : 6d0302 adc ada2 ;perform add 412d : 08 php 412e : c50f cmp adrl ;check result trap_ne ;bad result 4130 : f003 > beq skip3420 > trap ;failed not equal (non zero) 4132 : 205b44 > jsr report_error > 4135 : >skip3420 4135 : 68 pla ;check flags 4136 : 29c3 and #$c3 ;mask NV----ZC 4138 : c511 cmp adrf trap_ne ;bad flags 413a : f003 > beq skip3422 > trap ;failed not equal (non zero) 413c : 205b44 > jsr report_error > 413f : >skip3422 413f : 28 plp 4140 : 08 php ;save carry for next add 4141 : a50d lda ad1 4143 : ed0402 sbc sba2 ;perform subtract 4146 : 08 php 4147 : c50f cmp adrl ;check result trap_ne ;bad result 4149 : f003 > beq skip3424 > trap ;failed not equal (non zero) 414b : 205b44 > jsr report_error > 414e : >skip3424 414e : 68 pla ;check flags 414f : 29c3 and #$c3 ;mask NV----ZC 4151 : c511 cmp adrf trap_ne ;bad flags 4153 : f003 > beq skip3426 > trap ;failed not equal (non zero) 4155 : 205b44 > jsr report_error > 4158 : >skip3426 4158 : 28 plp ; binary ADC / SBC # 4159 : 08 php ;save carry for subtract 415a : a50e lda ad2 415c : 8d1202 sta ex_adci+1 ;set ADC # operand 415f : a50d lda ad1 4161 : 201102 jsr ex_adci ;execute ADC # in RAM 4164 : 08 php 4165 : c50f cmp adrl ;check result trap_ne ;bad result 4167 : f003 > beq skip3428 > trap ;failed not equal (non zero) 4169 : 205b44 > jsr report_error > 416c : >skip3428 416c : 68 pla ;check flags 416d : 29c3 and #$c3 ;mask NV----ZC 416f : c511 cmp adrf trap_ne ;bad flags 4171 : f003 > beq skip3430 > trap ;failed not equal (non zero) 4173 : 205b44 > jsr report_error > 4176 : >skip3430 4176 : 28 plp 4177 : 08 php ;save carry for next add 4178 : a512 lda sb2 417a : 8d1502 sta ex_sbci+1 ;set SBC # operand 417d : a50d lda ad1 417f : 201402 jsr ex_sbci ;execute SBC # in RAM 4182 : 08 php 4183 : c50f cmp adrl ;check result trap_ne ;bad result 4185 : f003 > beq skip3432 > trap ;failed not equal (non zero) 4187 : 205b44 > jsr report_error > 418a : >skip3432 418a : 68 pla ;check flags 418b : 29c3 and #$c3 ;mask NV----ZC 418d : c511 cmp adrf trap_ne ;bad flags 418f : f003 > beq skip3434 > trap ;failed not equal (non zero) 4191 : 205b44 > jsr report_error > 4194 : >skip3434 4194 : 28 plp ; binary ADC / SBC zp,x 4195 : 08 php ;save carry for subtract 4196 : a50d lda ad1 4198 : 7500 adc 0,x ;perform add 419a : 08 php 419b : c50f cmp adrl ;check result trap_ne ;bad result 419d : f003 > beq skip3436 > trap ;failed not equal (non zero) 419f : 205b44 > jsr report_error > 41a2 : >skip3436 41a2 : 68 pla ;check flags 41a3 : 29c3 and #$c3 ;mask NV----ZC 41a5 : c511 cmp adrf trap_ne ;bad flags 41a7 : f003 > beq skip3438 > trap ;failed not equal (non zero) 41a9 : 205b44 > jsr report_error > 41ac : >skip3438 41ac : 28 plp 41ad : 08 php ;save carry for next add 41ae : a50d lda ad1 41b0 : f504 sbc sb2-ad2,x ;perform subtract 41b2 : 08 php 41b3 : c50f cmp adrl ;check result trap_ne ;bad result 41b5 : f003 > beq skip3440 > trap ;failed not equal (non zero) 41b7 : 205b44 > jsr report_error > 41ba : >skip3440 41ba : 68 pla ;check flags 41bb : 29c3 and #$c3 ;mask NV----ZC 41bd : c511 cmp adrf trap_ne ;bad flags 41bf : f003 > beq skip3442 > trap ;failed not equal (non zero) 41c1 : 205b44 > jsr report_error > 41c4 : >skip3442 41c4 : 28 plp ; binary ADC / SBC abs,x 41c5 : 08 php ;save carry for subtract 41c6 : a50d lda ad1 41c8 : 7df501 adc ada2-ad2,x ;perform add 41cb : 08 php 41cc : c50f cmp adrl ;check result trap_ne ;bad result 41ce : f003 > beq skip3444 > trap ;failed not equal (non zero) 41d0 : 205b44 > jsr report_error > 41d3 : >skip3444 41d3 : 68 pla ;check flags 41d4 : 29c3 and #$c3 ;mask NV----ZC 41d6 : c511 cmp adrf trap_ne ;bad flags 41d8 : f003 > beq skip3446 > trap ;failed not equal (non zero) 41da : 205b44 > jsr report_error > 41dd : >skip3446 41dd : 28 plp 41de : 08 php ;save carry for next add 41df : a50d lda ad1 41e1 : fdf601 sbc sba2-ad2,x ;perform subtract 41e4 : 08 php 41e5 : c50f cmp adrl ;check result trap_ne ;bad result 41e7 : f003 > beq skip3448 > trap ;failed not equal (non zero) 41e9 : 205b44 > jsr report_error > 41ec : >skip3448 41ec : 68 pla ;check flags 41ed : 29c3 and #$c3 ;mask NV----ZC 41ef : c511 cmp adrf trap_ne ;bad flags 41f1 : f003 > beq skip3450 > trap ;failed not equal (non zero) 41f3 : 205b44 > jsr report_error > 41f6 : >skip3450 41f6 : 28 plp ; binary ADC / SBC abs,y 41f7 : 08 php ;save carry for subtract 41f8 : a50d lda ad1 41fa : 790401 adc ada2-$ff,y ;perform add 41fd : 08 php 41fe : c50f cmp adrl ;check result trap_ne ;bad result 4200 : f003 > beq skip3452 > trap ;failed not equal (non zero) 4202 : 205b44 > jsr report_error > 4205 : >skip3452 4205 : 68 pla ;check flags 4206 : 29c3 and #$c3 ;mask NV----ZC 4208 : c511 cmp adrf trap_ne ;bad flags 420a : f003 > beq skip3454 > trap ;failed not equal (non zero) 420c : 205b44 > jsr report_error > 420f : >skip3454 420f : 28 plp 4210 : 08 php ;save carry for next add 4211 : a50d lda ad1 4213 : f90501 sbc sba2-$ff,y ;perform subtract 4216 : 08 php 4217 : c50f cmp adrl ;check result trap_ne ;bad result 4219 : f003 > beq skip3456 > trap ;failed not equal (non zero) 421b : 205b44 > jsr report_error > 421e : >skip3456 421e : 68 pla ;check flags 421f : 29c3 and #$c3 ;mask NV----ZC 4221 : c511 cmp adrf trap_ne ;bad flags 4223 : f003 > beq skip3458 > trap ;failed not equal (non zero) 4225 : 205b44 > jsr report_error > 4228 : >skip3458 4228 : 28 plp ; binary ADC / SBC (zp,x) 4229 : 08 php ;save carry for subtract 422a : a50d lda ad1 422c : 6144 adc (lo adi2-ad2,x) ;perform add 422e : 08 php 422f : c50f cmp adrl ;check result trap_ne ;bad result 4231 : f003 > beq skip3460 > trap ;failed not equal (non zero) 4233 : 205b44 > jsr report_error > 4236 : >skip3460 4236 : 68 pla ;check flags 4237 : 29c3 and #$c3 ;mask NV----ZC 4239 : c511 cmp adrf trap_ne ;bad flags 423b : f003 > beq skip3462 > trap ;failed not equal (non zero) 423d : 205b44 > jsr report_error > 4240 : >skip3462 4240 : 28 plp 4241 : 08 php ;save carry for next add 4242 : a50d lda ad1 4244 : e146 sbc (lo sbi2-ad2,x) ;perform subtract 4246 : 08 php 4247 : c50f cmp adrl ;check result trap_ne ;bad result 4249 : f003 > beq skip3464 > trap ;failed not equal (non zero) 424b : 205b44 > jsr report_error > 424e : >skip3464 424e : 68 pla ;check flags 424f : 29c3 and #$c3 ;mask NV----ZC 4251 : c511 cmp adrf trap_ne ;bad flags 4253 : f003 > beq skip3466 > trap ;failed not equal (non zero) 4255 : 205b44 > jsr report_error > 4258 : >skip3466 4258 : 28 plp ; binary ADC / SBC (abs),y 4259 : 08 php ;save carry for subtract 425a : a50d lda ad1 425c : 7156 adc (adiy2),y ;perform add 425e : 08 php 425f : c50f cmp adrl ;check result trap_ne ;bad result 4261 : f003 > beq skip3468 > trap ;failed not equal (non zero) 4263 : 205b44 > jsr report_error > 4266 : >skip3468 4266 : 68 pla ;check flags 4267 : 29c3 and #$c3 ;mask NV----ZC 4269 : c511 cmp adrf trap_ne ;bad flags 426b : f003 > beq skip3470 > trap ;failed not equal (non zero) 426d : 205b44 > jsr report_error > 4270 : >skip3470 4270 : 28 plp 4271 : 08 php ;save carry for next add 4272 : a50d lda ad1 4274 : f158 sbc (sbiy2),y ;perform subtract 4276 : 08 php 4277 : c50f cmp adrl ;check result trap_ne ;bad result 4279 : f003 > beq skip3472 > trap ;failed not equal (non zero) 427b : 205b44 > jsr report_error > 427e : >skip3472 427e : 68 pla ;check flags 427f : 29c3 and #$c3 ;mask NV----ZC 4281 : c511 cmp adrf trap_ne ;bad flags 4283 : f003 > beq skip3474 > trap ;failed not equal (non zero) 4285 : 205b44 > jsr report_error > 4288 : >skip3474 4288 : 28 plp 4289 : 60 rts ; target for the jump absolute test 428a : 88 dey 428b : 88 dey 428c : test_far 428c : 08 php ;either SP or Y count will fail, if we do not hit 428d : 88 dey 428e : 88 dey 428f : 88 dey 4290 : 28 plp trap_cs ;flags loaded? 4291 : 9003 > bcc skip3476 > trap ;failed carry set 4293 : 205b44 > jsr report_error > 4296 : >skip3476 trap_vs 4296 : 5003 > bvc skip3478 > trap ;failed overflow set 4298 : 205b44 > jsr report_error > 429b : >skip3478 trap_mi 429b : 1003 > bpl skip3480 > trap ;failed minus (bit 7 set) 429d : 205b44 > jsr report_error > 42a0 : >skip3480 trap_eq 42a0 : d003 > bne skip3482 > trap ;failed equal (zero) 42a2 : 205b44 > jsr report_error > 42a5 : >skip3482 42a5 : c946 cmp #'F' ;registers loaded? trap_ne 42a7 : f003 > beq skip3484 > trap ;failed not equal (non zero) 42a9 : 205b44 > jsr report_error > 42ac : >skip3484 42ac : e041 cpx #'A' trap_ne 42ae : f003 > beq skip3486 > trap ;failed not equal (non zero) 42b0 : 205b44 > jsr report_error > 42b3 : >skip3486 42b3 : c04f cpy #('R'-3) trap_ne 42b5 : f003 > beq skip3488 > trap ;failed not equal (non zero) 42b7 : 205b44 > jsr report_error > 42ba : >skip3488 42ba : 48 pha ;save a,x 42bb : 8a txa 42bc : 48 pha 42bd : ba tsx 42be : e0fd cpx #$fd ;check SP trap_ne 42c0 : f003 > beq skip3490 > trap ;failed not equal (non zero) 42c2 : 205b44 > jsr report_error > 42c5 : >skip3490 42c5 : 68 pla ;restore x 42c6 : aa tax set_stat $ff > load_flag $ff 42c7 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 42c9 : 48 > pha ;use stack to load status 42ca : 28 > plp 42cb : 68 pla ;restore a 42cc : e8 inx ;return registers with modifications 42cd : 49aa eor #$aa ;N=1, V=1, Z=0, C=1 42cf : 4cf309 jmp far_ret ; target for the jump indirect test align 42d2 : db42 ptr_tst_ind dw test_ind 42d4 : 7b0a ptr_ind_ret dw ind_ret trap ;runover protection 42d6 : 205b44 > jsr report_error 42d9 : 88 dey 42da : 88 dey 42db : test_ind 42db : 08 php ;either SP or Y count will fail, if we do not hit 42dc : 88 dey 42dd : 88 dey 42de : 88 dey 42df : 28 plp trap_cs ;flags loaded? 42e0 : 9003 > bcc skip3495 > trap ;failed carry set 42e2 : 205b44 > jsr report_error > 42e5 : >skip3495 trap_vs 42e5 : 5003 > bvc skip3497 > trap ;failed overflow set 42e7 : 205b44 > jsr report_error > 42ea : >skip3497 trap_mi 42ea : 1003 > bpl skip3499 > trap ;failed minus (bit 7 set) 42ec : 205b44 > jsr report_error > 42ef : >skip3499 trap_eq 42ef : d003 > bne skip3501 > trap ;failed equal (zero) 42f1 : 205b44 > jsr report_error > 42f4 : >skip3501 42f4 : c949 cmp #'I' ;registers loaded? trap_ne 42f6 : f003 > beq skip3503 > trap ;failed not equal (non zero) 42f8 : 205b44 > jsr report_error > 42fb : >skip3503 42fb : e04e cpx #'N' trap_ne 42fd : f003 > beq skip3505 > trap ;failed not equal (non zero) 42ff : 205b44 > jsr report_error > 4302 : >skip3505 4302 : c041 cpy #('D'-3) trap_ne 4304 : f003 > beq skip3507 > trap ;failed not equal (non zero) 4306 : 205b44 > jsr report_error > 4309 : >skip3507 4309 : 48 pha ;save a,x 430a : 8a txa 430b : 48 pha 430c : ba tsx 430d : e0fd cpx #$fd ;check SP trap_ne 430f : f003 > beq skip3509 > trap ;failed not equal (non zero) 4311 : 205b44 > jsr report_error > 4314 : >skip3509 4314 : 68 pla ;restore x 4315 : aa tax set_stat $ff > load_flag $ff 4316 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 4318 : 48 > pha ;use stack to load status 4319 : 28 > plp 431a : 68 pla ;restore a 431b : e8 inx ;return registers with modifications 431c : 49aa eor #$aa ;N=1, V=1, Z=0, C=1 431e : 6cd442 jmp (ptr_ind_ret) trap ;runover protection 4321 : 205b44 > jsr report_error 4324 : 4c0004 jmp start ;catastrophic error - cannot continue ; target for the jump subroutine test 4327 : 88 dey 4328 : 88 dey 4329 : test_jsr 4329 : 08 php ;either SP or Y count will fail, if we do not hit 432a : 88 dey 432b : 88 dey 432c : 88 dey 432d : 28 plp trap_cs ;flags loaded? 432e : 9003 > bcc skip3514 > trap ;failed carry set 4330 : 205b44 > jsr report_error > 4333 : >skip3514 trap_vs 4333 : 5003 > bvc skip3516 > trap ;failed overflow set 4335 : 205b44 > jsr report_error > 4338 : >skip3516 trap_mi 4338 : 1003 > bpl skip3518 > trap ;failed minus (bit 7 set) 433a : 205b44 > jsr report_error > 433d : >skip3518 trap_eq 433d : d003 > bne skip3520 > trap ;failed equal (zero) 433f : 205b44 > jsr report_error > 4342 : >skip3520 4342 : c94a cmp #'J' ;registers loaded? trap_ne 4344 : f003 > beq skip3522 > trap ;failed not equal (non zero) 4346 : 205b44 > jsr report_error > 4349 : >skip3522 4349 : e053 cpx #'S' trap_ne 434b : f003 > beq skip3524 > trap ;failed not equal (non zero) 434d : 205b44 > jsr report_error > 4350 : >skip3524 4350 : c04f cpy #('R'-3) trap_ne 4352 : f003 > beq skip3526 > trap ;failed not equal (non zero) 4354 : 205b44 > jsr report_error > 4357 : >skip3526 4357 : 48 pha ;save a,x 4358 : 8a txa 4359 : 48 pha 435a : ba tsx ;sp -4? (return addr,a,x) 435b : e0fb cpx #$fb trap_ne 435d : f003 > beq skip3528 > trap ;failed not equal (non zero) 435f : 205b44 > jsr report_error > 4362 : >skip3528 4362 : adff01 lda $1ff ;propper return on stack 4365 : c90a cmp #hi(jsr_ret) trap_ne 4367 : f003 > beq skip3530 > trap ;failed not equal (non zero) 4369 : 205b44 > jsr report_error > 436c : >skip3530 436c : adfe01 lda $1fe 436f : c9cc cmp #lo(jsr_ret) trap_ne 4371 : f003 > beq skip3532 > trap ;failed not equal (non zero) 4373 : 205b44 > jsr report_error > 4376 : >skip3532 set_stat $ff > load_flag $ff 4376 : a9ff > lda #$ff ;allow test to change I-flag (no mask) > 4378 : 48 > pha ;use stack to load status 4379 : 28 > plp 437a : 68 pla ;pull x,a 437b : aa tax 437c : 68 pla 437d : e8 inx ;return registers with modifications 437e : 49aa eor #$aa ;N=1, V=1, Z=0, C=1 4380 : 60 rts trap ;runover protection 4381 : 205b44 > jsr report_error 4384 : 4c0004 jmp start ;catastrophic error - cannot continue ;trap in case of unexpected IRQ, NMI, BRK, RESET - BRK test target 4387 : nmi_trap trap ;check stack for conditions at NMI 4387 : 205b44 > jsr report_error 438a : 4c0004 jmp start ;catastrophic error - cannot continue 438d : res_trap trap ;unexpected RESET 438d : 205b44 > jsr report_error 4390 : 4c0004 jmp start ;catastrophic error - cannot continue 4393 : 88 dey 4394 : 88 dey 4395 : irq_trap ;BRK test or unextpected BRK or IRQ 4395 : 08 php ;either SP or Y count will fail, if we do not hit 4396 : 88 dey 4397 : 88 dey 4398 : 88 dey ;next traps could be caused by unexpected BRK or IRQ ;check stack for BREAK and originating location ;possible jump/branch into weeds (uninitialized space) 4399 : c9bd cmp #$ff-'B' ;BRK pass 2 registers loaded? 439b : f05a beq break2 439d : c942 cmp #'B' ;BRK pass 1 registers loaded? trap_ne 439f : f003 > beq skip3539 > trap ;failed not equal (non zero) 43a1 : 205b44 > jsr report_error > 43a4 : >skip3539 43a4 : e052 cpx #'R' trap_ne 43a6 : f003 > beq skip3541 > trap ;failed not equal (non zero) 43a8 : 205b44 > jsr report_error > 43ab : >skip3541 43ab : c048 cpy #'K'-3 trap_ne 43ad : f003 > beq skip3543 > trap ;failed not equal (non zero) 43af : 205b44 > jsr report_error > 43b2 : >skip3543 43b2 : 850a sta irq_a ;save registers during break test 43b4 : 860b stx irq_x 43b6 : ba tsx ;test break on stack 43b7 : bd0201 lda $102,x cmp_flag 0 ;break test should have B=1 & unused=1 on stack 43ba : c930 > cmp #(0 |fao)&m8 ;expected flags + always on bits trap_ne ; - no break flag on stack 43bc : f003 > beq skip3546 > trap ;failed not equal (non zero) 43be : 205b44 > jsr report_error > 43c1 : >skip3546 43c1 : 68 pla cmp_flag intdis ;should have added interrupt disable 43c2 : c934 > cmp #(intdis |fao)&m8 ;expected flags + always on bits trap_ne 43c4 : f003 > beq skip3549 > trap ;failed not equal (non zero) 43c6 : 205b44 > jsr report_error > 43c9 : >skip3549 43c9 : ba tsx 43ca : e0fc cpx #$fc ;sp -3? (return addr, flags) trap_ne 43cc : f003 > beq skip3551 > trap ;failed not equal (non zero) 43ce : 205b44 > jsr report_error > 43d1 : >skip3551 43d1 : adff01 lda $1ff ;propper return on stack 43d4 : c90b cmp #hi(brk_ret0) trap_ne 43d6 : f003 > beq skip3553 > trap ;failed not equal (non zero) 43d8 : 205b44 > jsr report_error > 43db : >skip3553 43db : adfe01 lda $1fe 43de : c91e cmp #lo(brk_ret0) trap_ne 43e0 : f003 > beq skip3555 > trap ;failed not equal (non zero) 43e2 : 205b44 > jsr report_error > 43e5 : >skip3555 load_flag $ff 43e5 : a9ff > lda #$ff ;allow test to change I-flag (no mask) 43e7 : 48 pha 43e8 : a60b ldx irq_x 43ea : e8 inx ;return registers with modifications 43eb : a50a lda irq_a 43ed : 49aa eor #$aa 43ef : 28 plp ;N=1, V=1, Z=1, C=1 but original flags should be restored 43f0 : 40 rti trap ;runover protection 43f1 : 205b44 > jsr report_error 43f4 : 4c0004 jmp start ;catastrophic error - cannot continue 43f7 : break2 ;BRK pass 2 43f7 : e0ad cpx #$ff-'R' trap_ne 43f9 : f003 > beq skip3559 > trap ;failed not equal (non zero) 43fb : 205b44 > jsr report_error > 43fe : >skip3559 43fe : c0b1 cpy #$ff-'K'-3 trap_ne 4400 : f003 > beq skip3561 > trap ;failed not equal (non zero) 4402 : 205b44 > jsr report_error > 4405 : >skip3561 4405 : 850a sta irq_a ;save registers during break test 4407 : 860b stx irq_x 4409 : ba tsx ;test break on stack 440a : bd0201 lda $102,x cmp_flag $ff ;break test should have B=1 440d : c9ff > cmp #($ff |fao)&m8 ;expected flags + always on bits trap_ne ; - no break flag on stack 440f : f003 > beq skip3564 > trap ;failed not equal (non zero) 4411 : 205b44 > jsr report_error > 4414 : >skip3564 4414 : 68 pla 4415 : 0908 ora #decmode ;ignore decmode cleared if 65c02 cmp_flag $ff ;actual passed flags 4417 : c9ff > cmp #($ff |fao)&m8 ;expected flags + always on bits trap_ne 4419 : f003 > beq skip3567 > trap ;failed not equal (non zero) 441b : 205b44 > jsr report_error > 441e : >skip3567 441e : ba tsx 441f : e0fc cpx #$fc ;sp -3? (return addr, flags) trap_ne 4421 : f003 > beq skip3569 > trap ;failed not equal (non zero) 4423 : 205b44 > jsr report_error > 4426 : >skip3569 4426 : adff01 lda $1ff ;propper return on stack 4429 : c90b cmp #hi(brk_ret1) trap_ne 442b : f003 > beq skip3571 > trap ;failed not equal (non zero) 442d : 205b44 > jsr report_error > 4430 : >skip3571 4430 : adfe01 lda $1fe 4433 : c953 cmp #lo(brk_ret1) trap_ne 4435 : f003 > beq skip3573 > trap ;failed not equal (non zero) 4437 : 205b44 > jsr report_error > 443a : >skip3573 load_flag intdis 443a : a904 > lda #intdis ;allow test to change I-flag (no mask) 443c : 48 pha 443d : a60b ldx irq_x 443f : e8 inx ;return registers with modifications 4440 : a50a lda irq_a 4442 : 49aa eor #$aa 4444 : 28 plp ;N=0, V=0, Z=0, C=0 but original flags should be restored 4445 : 40 rti trap ;runover protection 4446 : 205b44 > jsr report_error 4449 : 4c0004 jmp start ;catastrophic error - cannot continue if report = 1 include "report.i65" ;**** report 6502 funtional test errors to standard I/O **** ; ;this include file is part of the 6502 functional tests ;it is used when you configure report = 1 in the tests ; ;to adopt the standard output vectors of your test environment ;you must modify the rchar and rget subroutines in this include ; ;I/O hardware may have to be initialized in report_init ;print message macro - \1 = message location rprt macro ldx #0 lda \1 loop\? jsr rchar inx lda \1,x bne loop\? endm ;initialize I/O as required (example: configure & enable ACIA) 444c : report_init ;nothing to initialize rprt rmsg_start 444c : a200 > ldx #0 444e : ad6945 > lda rmsg_start 4451 : >loop3577 4451 : 206545 > jsr rchar 4454 : e8 > inx 4455 : bd6945 > lda rmsg_start,x 4458 : d0f7 > bne loop3577 445a : 60 rts ;show stack (with saved registers), zeropage and absolute memory workspace ;after an error was trapped in the test program 445b : report_error ;save registers 445b : 08 php 445c : 48 pha 445d : 8a txa 445e : 48 pha 445f : 98 tya 4460 : 48 pha 4461 : d8 cld ;show stack with index to registers at error rprt rmsg_stack 4462 : a200 > ldx #0 4464 : ad7d45 > lda rmsg_stack 4467 : >loop3578 4467 : 206545 > jsr rchar 446a : e8 > inx 446b : bd7d45 > lda rmsg_stack,x 446e : d0f7 > bne loop3578 4470 : ba tsx 4471 : e8 inx 4472 : a901 lda #1 ;address high 4474 : 205145 jsr rhex 4477 : 8a txa ;address low 4478 : 205145 jsr rhex 447b : 204d45 rstack jsr rspace 447e : bd0001 lda $100,x ;stack data 4481 : 205145 jsr rhex 4484 : e8 inx 4485 : d0f4 bne rstack 4487 : 204445 jsr rcrlf ;new line ;show zero page workspace 448a : a900 lda #0 448c : 205145 jsr rhex 448f : a90c lda #zpt 4491 : aa tax 4492 : 205145 jsr rhex 4495 : 204d45 rzp jsr rspace 4498 : b500 lda 0,x 449a : 205145 jsr rhex 449d : e8 inx 449e : e013 cpx #zp_bss 44a0 : d0f3 bne rzp 44a2 : 204445 jsr rcrlf ;show absolute workspace 44a5 : a902 lda #hi(data_segment) 44a7 : 205145 jsr rhex 44aa : a900 lda #lo(data_segment) 44ac : 205145 jsr rhex 44af : a200 ldx #0 44b1 : 204d45 rabs jsr rspace 44b4 : bd0002 lda data_segment,x 44b7 : 205145 jsr rhex 44ba : e8 inx 44bb : e008 cpx #(data_bss-data_segment) 44bd : d0f2 bne rabs ;ask to continue rprt rmsg_cont 44bf : a200 > ldx #0 44c1 : ad9945 > lda rmsg_cont 44c4 : >loop3579 44c4 : 206545 > jsr rchar 44c7 : e8 > inx 44c8 : bd9945 > lda rmsg_cont,x 44cb : d0f7 > bne loop3579 44cd : 203a45 rerr1 jsr rget 44d0 : c953 cmp #'S' 44d2 : f00b beq rskip 44d4 : c943 cmp #'C' 44d6 : d0f5 bne rerr1 ;restore registers 44d8 : 68 pla 44d9 : a8 tay 44da : 68 pla 44db : aa tax 44dc : 68 pla 44dd : 28 plp 44de : 60 rts ;skip the current test 44df : a9f0 rskip lda #$f0 ;already end of tests? 44e1 : cd0002 cmp test_case 44e4 : f0e7 beq rerr1 ;skip is not available 44e6 : a2ff ldx #$ff ;clear stack 44e8 : 9a txs 44e9 : ee0002 inc test_case ;next test 44ec : a900 lda #lo(start) ;find begin of test 44ee : 850c sta zpt 44f0 : a904 lda #hi(start) 44f2 : 850d sta zpt+1 44f4 : a004 rskipl1 ldy #4 ;search pattern 44f6 : b10c rskipl2 lda (zpt),y ;next byte 44f8 : d91f45 cmp rmark,y 44fb : d00a bne rskipnx ;no match 44fd : 88 dey 44fe : 300f bmi rskipf ;found pattern 4500 : c001 cpy #1 ;skip immediate value 4502 : d0f2 bne rskipl2 4504 : 88 dey 4505 : f0ef beq rskipl2 4507 : e60c rskipnx inc zpt ;next RAM location 4509 : d0e9 bne rskipl1 450b : e60d inc zpt+1 450d : d0e5 bne rskipl1 450f : a001 rskipf ldy #1 ;pattern found - check test number 4511 : b10c lda (zpt),y ;test number 4513 : c9f0 cmp #$f0 ;end of last test? 4515 : f005 beq rskipe ;ask to rerun all 4517 : cd0002 cmp test_case ;is next test? 451a : d0eb bne rskipnx ;continue searching 451c : 6c0c00 rskipe jmp (zpt) ;start next test or rerun at end of tests 451f : a900 rmark lda #0 ;begin of test search pattern 4521 : 8d0002 sta test_case ;show test has ended, ask to repeat 4524 : report_success if rep_int = 1 rprt rmsg_priority lda data_segment ;show interrupt sequence jsr rhex jsr rspace lda data_segment+1 jsr rhex jsr rspace lda data_segment+2 jsr rhex endif rprt rmsg_success 4524 : a200 > ldx #0 4526 : adcb45 > lda rmsg_success 4529 : >loop3580 4529 : 206545 > jsr rchar 452c : e8 > inx 452d : bdcb45 > lda rmsg_success,x 4530 : d0f7 > bne loop3580 4532 : 203a45 rsuc1 jsr rget 4535 : c952 cmp #'R' 4537 : d0f9 bne rsuc1 4539 : 60 rts ;input subroutine ;get a character from standard input ;adjust according to the needs in your test environment 453a : rget ;get character in A ;rget1 ; lda $bff1 ;wait RDRF ; and #8 ; beq rget1 ;not a real ACIA - so RDRF is not checked ; lda $bff0 ;read acia rx reg 453a : ad04f0 lda $f004 ;Kowalski simulator default ;the load can be replaced by a call to a kernal routine ; jsr $ffcf ;example: CHRIN for a C64 453d : c961 cmp #'a' ;lower case 453f : 9002 bcc rget1 4541 : 295f and #$5f ;convert to upper case 4543 : 60 rget1 rts ;output subroutines 4544 : a90a rcrlf lda #10 4546 : 206545 jsr rchar 4549 : a90d lda #13 454b : d018 bne rchar 454d : a920 rspace lda #' ' 454f : d014 bne rchar 4551 : 48 rhex pha ;report hex byte in A 4552 : 4a lsr a ;high nibble first 4553 : 4a lsr a 4554 : 4a lsr a 4555 : 4a lsr a 4556 : 205c45 jsr rnib 4559 : 68 pla ;now low nibble 455a : 290f and #$f 455c : 18 rnib clc ;report nibble in A 455d : 6930 adc #'0' ;make printable 0-9 455f : c93a cmp #'9'+1 4561 : 9002 bcc rchar 4563 : 6906 adc #6 ;make printable A-F ;send a character to standard output ;adjust according to the needs in your test environment ;register X needs to be preserved! 4565 : rchar ;report character in A ; pha ;wait TDRF ;rchar1 lda $bff1 ; and #$10 ; beq rchar1 ; pla ;not a real ACIA - so TDRF is not checked ; sta $bff0 ;write acia tx reg 4565 : 8d01f0 sta $f001 ;Kowalski simulator default ;the store can be replaced by a call to a kernal routine ; jsr $ffd2 ;example: CHROUT for a C64 4568 : 60 rts 4569 : rmsg_start 4569 : 0a0d5374617274.. db 10,13,"Started testing",10,13,0 457d : rmsg_stack 457d : 0a0d7265677320.. db 10,13,"regs Y X A PS PCLPCH",10,13,0 4599 : rmsg_cont 4599 : 0a0d7072657373.. db 10,13,"press C to continue or S to skip current test",10,13,0 45cb : rmsg_success 45cb : 0a0d416c6c2074.. db 10,13,"All tests completed, press R to repeat",10,13,0 if rep_int = 1 rmsg_priority db 10,13,"interrupt sequence (NMI IRQ BRK) ",0 endif endif ;copy of data to initialize BSS segment if load_data_direct != 1 zp_init zp1_ db $c3,$82,$41,0 ;test patterns for LDx BIT ROL ROR ASL LSR zp7f_ db $7f ;test pattern for compare ;logical zeropage operands zpOR_ db 0,$1f,$71,$80 ;test pattern for OR zpAN_ db $0f,$ff,$7f,$80 ;test pattern for AND zpEO_ db $ff,$0f,$8f,$8f ;test pattern for EOR ;indirect addressing pointers ind1_ dw abs1 ;indirect pointer to pattern in absolute memory dw abs1+1 dw abs1+2 dw abs1+3 dw abs7f inw1_ dw abs1-$f8 ;indirect pointer for wrap-test pattern indt_ dw abst ;indirect pointer to store area in absolute memory dw abst+1 dw abst+2 dw abst+3 inwt_ dw abst-$f8 ;indirect pointer for wrap-test store indAN_ dw absAN ;indirect pointer to AND pattern in absolute memory dw absAN+1 dw absAN+2 dw absAN+3 indEO_ dw absEO ;indirect pointer to EOR pattern in absolute memory dw absEO+1 dw absEO+2 dw absEO+3 indOR_ dw absOR ;indirect pointer to OR pattern in absolute memory dw absOR+1 dw absOR+2 dw absOR+3 ;add/subtract indirect pointers adi2_ dw ada2 ;indirect pointer to operand 2 in absolute memory sbi2_ dw sba2 ;indirect pointer to complemented operand 2 (SBC) adiy2_ dw ada2-$ff ;with offset for indirect indexed sbiy2_ dw sba2-$ff zp_end if (zp_end - zp_init) != (zp_bss_end - zp_bss) ;force assembler error if size is different ERROR ERROR ERROR ;mismatch between bss and zeropage data endif data_init ex_and_ and #0 ;execute immediate opcodes rts ex_eor_ eor #0 ;execute immediate opcodes rts ex_ora_ ora #0 ;execute immediate opcodes rts ex_adc_ adc #0 ;execute immediate opcodes rts ex_sbc_ sbc #0 ;execute immediate opcodes rts abs1_ db $c3,$82,$41,0 ;test patterns for LDx BIT ROL ROR ASL LSR abs7f_ db $7f ;test pattern for compare ;loads fLDx_ db fn,fn,0,fz ;expected flags for load ;shifts rASL_ ;expected result ASL & ROL -carry rROL_ db $86,$04,$82,0 ; " rROLc_ db $87,$05,$83,1 ;expected result ROL +carry rLSR_ ;expected result LSR & ROR -carry rROR_ db $61,$41,$20,0 ; " rRORc_ db $e1,$c1,$a0,$80 ;expected result ROR +carry fASL_ ;expected flags for shifts fROL_ db fnc,fc,fn,fz ;no carry in fROLc_ db fnc,fc,fn,0 ;carry in fLSR_ fROR_ db fc,0,fc,fz ;no carry in fRORc_ db fnc,fn,fnc,fn ;carry in ;increments (decrements) rINC_ db $7f,$80,$ff,0,1 ;expected result for INC/DEC fINC_ db 0,fn,fn,fz,0 ;expected flags for INC/DEC ;logical memory operand absOR_ db 0,$1f,$71,$80 ;test pattern for OR absAN_ db $0f,$ff,$7f,$80 ;test pattern for AND absEO_ db $ff,$0f,$8f,$8f ;test pattern for EOR ;logical accu operand absORa_ db 0,$f1,$1f,0 ;test pattern for OR absANa_ db $f0,$ff,$ff,$ff ;test pattern for AND absEOa_ db $ff,$f0,$f0,$0f ;test pattern for EOR ;logical results absrlo_ db 0,$ff,$7f,$80 absflo_ db fz,fn,0,fn data_end if (data_end - data_init) != (data_bss_end - data_bss) ;force assembler error if size is different ERROR ERROR ERROR ;mismatch between bss and data endif vec_init dw nmi_trap dw res_trap dw irq_trap vec_bss equ $fffa endif ;end of RAM init data if (load_data_direct = 1) & (ROM_vectors = 1) fffa = org $fffa ;vectors fffa : 8743 dw nmi_trap fffc : 8d43 dw res_trap fffe : 9543 dw irq_trap endif fffa = end start No errors in pass 2.