    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:
    ld      a,6
    out     (254),a     ; yellow border during test

    ; 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

    ; first part of test, do one of the block instructions with interrupt happening inside the block
    halt                ; zx128 70908 T vs zx48 69888 T per frame
    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
    ld      a,$a1
    ldir                ; 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
    ld      a,$a2
    ldir

    ; second part of test, just wait for interrupt to store registers after finished LDIR
    halt
    ; im_saved_regs contains snapshot of bc,de,hl,af AFTER previous LDIR - preserve it
    ld      hl,im_saved_regs
    ld      de,after_ldir_regs
    ld      bc,SAVED_REGS
    ld      a,$a3
    ldir

    ; convert saved registers to text and print them at screen
    ld      a,1
    out     (254),a     ; blue border to signal end of test

    ; convert stored values to hexanumber string
    val2hex (in_ldir_regs.bc), out_txt.bc1
    val2hex (in_ldir_regs.de), out_txt.de1
    val2hex (in_ldir_regs.hl), out_txt.hl1
    val2hex (in_ldir_regs.af), out_txt.af1
    val2hex (in_ldir_regs.pc), out_txt.pc1

    val2hex (after_ldir_regs.bc), out_txt.bc2
    val2hex (after_ldir_regs.de), out_txt.de2
    val2hex (after_ldir_regs.hl), out_txt.hl2
    val2hex (after_ldir_regs.af), out_txt.af2
    val2hex (after_ldir_regs.pc), out_txt.pc2

    call    $0DAF       ; ROM CLS
    ld      de,out_txt
    ld      bc,out_txt.l
    call    $203C       ; PRINT final text

    ; restore IM1 ROM mode and return to BASIC
    di
    ld      a,$3F
    ld      i,a
    im      1
    ei
    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 nybble to ASCII
    cp      10
    sbc     a,$69
    daa
    ld      (de),a
    inc     de
    ret

out_txt:
        DB  "During LDIR (C000->C000 2500x):",13
        DB  "BC: "
.bc1:   DB  "???? DE: "
.de1:   DB  "???? HL: "
.hl1:   DB  "????",13,"AF: "
.af1:   DB  "???? PC: "
.pc1:   DB  "????",13,13
        DB  "After LDIR (8???->8??? 8x A=A2):",13
        DB  "BC: "
.bc2:   DB  "???? DE: "
.de2:   DB  "???? HL: "
.hl2:   DB  "????",13,"AF: "
.af2:   DB  "???? PC: "
.pc2:   DB  "????",13,13
.l:     EQU $-out_txt

im_saved_regs:      SAVED_REGS
in_ldir_regs:       SAVED_REGS
after_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
code_end:

im2tab:     EQU     ($ + 255) & $FF00

    ;; 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
