    OPT --syntax=abf
    DEVICE zxspectrum48, $7FFF

    ; helper macro to convet "word?" to string at "str?" address
    MACRO val2hex word?, str?
        ld      hl,word?
        ld      de,str?
        call    toHexWord
    ENDM

    STRUCT SAVED_REGS
bc      DW      0
de      DW      0
hl      DW      0
af      DW      0
pc      DW      0
    ENDS


    ORG     $8000

code_start:
        jr      test_start

    ; first LDIR+RET at $8002
ldir_code_80:
        ldir
        ret
ldir_code_88:   EQU     $8802
ldir_code_A0:   EQU     $A002
ldir_code_A8:   EQU     $A802

    ; main test code setting it up and doing four tests + printing results
test_start:
        call    $0DAF       ; ROM CLS

    ; write LDIR+RET also at: $8802, $A002, $A802
        ld      hl,(ldir_code_80)
        ld      a,(ldir_code_80+2)
        ld      (ldir_code_88),hl
        ld      (ldir_code_88+2),a
        ld      (ldir_code_A0),hl
        ld      (ldir_code_A0+2),a
        ld      (ldir_code_A8),hl
        ld      (ldir_code_A8+2),a

    ; setup IM2 handler: fill the im2 table with im2isr address, enable IM2
        di
        ld      hl,im2tab
        ld      a,h
        ld      i,a
        ld      de,im2tab+1
        ld      bc,256
        ld      a,low im2isr
        ld      (hl),a
        ldir
        im      2
        ei

    ; test code - calling the LDIR and timing the IM2 interrupt to happen during the block instruction
.next_test:
        halt                ; zx128 70908 T vs zx48 69888 T per frame (IM2 handler takes around 300T)
        ld      a,(.ra)
        and     7
        out     (254),a     ; change BORDER based on ".ra" value
        ld      bc,2500
        call    delay       ; delay for extra 65kT, im2 handler is about 300T, to have about ~5k T remaining for LDIR
                            ; also sets flags to ZF=1, CF=0, SF=0 (`or c` with zero result)
        ld      hl,$C000
        ld      de,$C000
.ra+1   ld      a,$a1
.call+2 call    ldir_code_80    ; interrupt during LDIR (total LDIR takes ~52500 T)

    ; im_saved_regs contains snapshot of bc,de,hl,af DURING LDIR - preserve it
        ld      hl,im_saved_regs
        ld      de,in_ldir_regs
        ld      bc,SAVED_REGS
        ldir

    ; convert saved registers to text and print them at screen
        val2hex (in_ldir_regs.af), out_txt.af
        val2hex (in_ldir_regs.pc), out_txt.pc

        ld      de,out_txt
        ld      bc,out_txt.l
        call    $203C       ; PRINT text

    ; advance to next round of test ($8002 -> $8802 -> $A002 -> $A802)
        ld      a,(.call)
        or      $10
        add     a,$08
        and     $A8
        ld      (.call),a   ; update call to LDIR
        ld      de,out_txt.atpc
        call    toHexByte   ; update text address
        ld      hl,out_txt.rega
        inc     (hl)        ; update text about A content
        ld      hl,.ra
        inc     (hl)        ; update the A content itself + use it to stop test after A4++
        ld      a,$A5
        cp      (hl)
        jr      nz,.next_test

    ; print "expected F values" text
        ld      de,expected_txt
        ld      bc,expected_txt.l
        call    $203C       ; PRINT text

    ; restore IM1 ROM mode and return to BASIC
        di
        ld      a,$3F
        ld      i,a
        im      1
        ei
        ld      a,7
        out     (254),a
        ret

; BC = delay, final delay is (BC + 1) * 26 T
delay:
        push    bc
.loop:
        dec     bc
        ld      a,b
        or      c
        jr      nz,.loop
        pop     bc
        ret

; HL = value to convert, DE = memory to write ASCII form to
toHexWord:
        ld      a,h
        call    toHexByte
        ld      a,l
toHexByte:
        push    af
        .4 rrca
        call    toHexDigit
        pop     af
toHexDigit:
        and     $0f
        ; Convert nibble to ASCII
        cp      10
        sbc     a,$69
        daa
        ld      (de),a
        inc     de
        ret

out_txt:
        DB  "IM2 during LDIR at "
.atpc:  DB  "8002, A=A"
.rega:  DB  "1:",13
        DB  "PC: "
.pc:    DB  "???? AF: "
.af:    DB  "????",13,13
.l:     EQU $-out_txt

expected_txt:
        DB  "Expected F values: 44 4C 64 6C", 13
.l:     EQU $-expected_txt

im_saved_regs:      SAVED_REGS
in_ldir_regs:       SAVED_REGS

    ; IM2 interrupt handler (must start at specific $xyxy address)
    IF low $ < high $
        DS high $ - low $, 0    ; pad to $xyxy address for im2isr
    ELSE
        DS (high $ - low $) + 257, 0    ; pad to $xyxy address for im2isr
    ENDIF
im2isr:
        ASSERT low im2isr == high im2isr
        push    af,,hl,,de,,bc
        ld      hl,0
        add     hl,sp
        ld      de,im_saved_regs
        ld      bc,SAVED_REGS
        ldir
        pop     bc,,de,,hl,,af
        ei
        ret

im2tab: EQU     ($ + 255) & $FF00
        ASSERT im2tab < $8700

code_end:

    ;; produce SNA file with test code
        SAVESNA "z80bltst.sna", code_start

    ;; produce TAP file with the test code
        DEFINE tape_file "z80bltst.tap"
        DEFINE prog_name "z80bltst"

CODE        EQU     $AF
USR         EQU     $C0
LOAD        EQU     $EF
CLEAR       EQU     $FD
RANDOMIZE   EQU     $F9

        ORG     $5C00
baszac: DB      0,1     ;; Line number
        DW      linlen  ;; Line length
linzac: DB      CLEAR,'8',$0E,0,0
        DW      code_start-1
        DB      0,':'
        DB      LOAD,'"'
codnam: DS      10,' '
        ORG     codnam
        DB      prog_name
        ORG     codnam+10
        DB      '"',CODE,':'
        DB      RANDOMIZE,USR,'8',$0E,0,0
        DW      code_start
        DB      0,$0D
linlen  EQU     $-linzac
baslen  EQU     $-baszac

        EMPTYTAP tape_file
        SAVETAP  tape_file,BASIC,prog_name,baszac,baslen,1
        SAVETAP  tape_file,CODE,prog_name,code_start,code_end-code_start,code_start
