;------------------------------------------------------
; ZROM v1.0
;------------------------------------------------------
; a small debugger that can sit at the top of memory.
; to initialize:
;   JSR 0xF500
; to invoke:
;   INT 0x1e (or INT 30)
;------------------------------------------------------

; bootup code for playing inside an emulator:
org 0
jsr init
int debugger_int
brk

debugger_int = 30

org 0xf500

;-- find & initialize keyboard & monitor
:init
  hwn j
  set i, 0
:init.1
  hwq i
  ife a, lem_hi
    ife b, lem_lo
      set [lem_int], i
  ife a, keyboard_hi
    ife b, keyboard_lo
      set [keyboard_int], i
  add i, 1
  ifg j, i
    bra init.1
; set text mode
  set [text_ptr], textbuf
  set [text_end], textbuf
  add [text_end], 0x180
  set [color], bg_color
  bor [color], 0xf0
  jsr clear
; logo
  set [cursor_ptr], [text_ptr]
  set a, logo
  jsr outstr
; set font, border, framebuffer
  set x, [lem_int]
  set a, lem.map_font
  set b, font_data
  hwi x
  set a, lem.set_border
  set b, bg_color
  hwi x
  set a, lem.map_screen
  set b, [text_ptr]
  hwi x
; set up interrupts
  iag [old_ia]
  ife [old_ia], 0
    set [old_ia], exit
  ias entry
  iaq 0
  ret
:logo dat p"\xff\x80\x81 \xfezrom 1.0\xff\n\n\z"

lem_lo = 0x7349
lem_hi = 0xf615
keyboard_lo = 0x30cf
keyboard_hi = 0x7406

;-- interrupt handler
:entry
  ife a, debugger_int
    jmp debugger
  jmp [old_ia]
:exit
  rfi 0

;-------------------------------------------------
; library routines promise only to preserve X Y Z
;-------------------------------------------------

;-- clear screen to current bg color
:clear
  set i, [text_ptr]
  set a, [text_end]
  set c, [color]
  shl c, 8
  add c, 0x20
:clear.1
  sti [i], c
  ifg a, i
    bra clear.1
  set [cursor_ptr], [text_ptr]
  ret

;-- loop J times waiting for a key, to place in I (trash: I J)
:strobe
  set push, a
  set push, c
  set a, keyboard.get_key
:strobe.1
  hwi [keyboard_int]
  sub j, 1
  ife c, 0
    ifg j, 0
      bra strobe.1
  set i, c
  set c, pop
  set a, pop
  ret

;-- blink cursor & block for next key -> I (trash: I J)
:getch
  set j, [cursor_ptr]
  set push, [j]
  set i, [color]
  shl i, 8
  bor i, cursor
  set [j], i
  set j, blink_rate
  jsr strobe
  set j, [cursor_ptr]
  set [j], pop
  ifn i, 0
    ret
  set j, blink_rate
  jsr strobe
  ife i, 0
    bra getch
  ret

;-- newline (trash: I J)
:newline
  set i, [cursor_ptr]
  and i, 0xffe0
  add i, 0x20
  set [cursor_ptr], i
  ifl i, [text_end]
    ret
;-- scroll one line down (trash: I J)
:vscroll
  set i, [text_ptr]
  set j, i
  add j, 32
:vscroll.1
  sti [i], [j]
  ifl i, [text_end]
    bra vscroll.1
  sub [cursor_ptr], 32
  set i, 11
  ; fall through

;-- clear the line in I (trash: I J)
:clrline
  shl i, 5
  add i, [text_ptr]
  set j, [color]
  shl j, 8
  bor j, 0x20
  set push, j
  set j, 0
:clrline.1
  sti [i], peek
  ifl j, 32
    bra clrline.1
  set j, pop
  ret

;-- display char in I without moving the cursor (trash: I J)
:outch.inplace
  and i, 0x7f
  set j, [color]
  shl j, 8
  bor i, j
  set j, [cursor_ptr]
  set [j], i
  ret

;-- display char in I (trash: I J)
; to allow the control characters to mean something, use the high bit to indicate box chars.
:outch
  ifl i, 0xf0
    bra outch.2
  set j, [color]
  and j, 0xf
  and i, 0xf
  shl i, 4
  bor j, i
  set [color], j
  ret
:outch.2
  ife i, 10
    jmp newline
  jsr outch.inplace
  add [cursor_ptr], 1
  ife [cursor_ptr], [text_end]
    jmp vscroll
  ret

;-- print byte-packed string in A (trash: A B I J)
:outstr
  set b, 0xffff
;-- print byte-packed string in [A, B) (trash: A B I J)
:outstrn
  set i, [a]
  shr i, 8
  ife i, 0
    ret
  jsr outch
  set i, [a]
  and i, 0xff
  ife i, 0
    ret
  jsr outch
  add a, 1
  ife a, b
    ret
  bra outstrn

:go_y_x
  set c, [text_ptr]
  shl a, 5
  add c, a
  add c, b
  set [cursor_ptr], c
  ret

;-- set foreground color to I
:setfg
  and [color], 0x0f
  shl i, 4
  bor [color], i
  ret

;-- read a whole line into the line buffer. (trash: A I J)
;afterwards, A will point just past the end of the string.
:getline
  set a, linebuf
:getline.1
  jsr getch
  ife i, 0x11
    bra getline.out
  ife i, 0x10
    bra getline.bs
  ifl i, 32
    bra getline.1
  ifg i, 126
    bra getline.1
  ife a, linebuf_end
    bra getline.1
  set [a], i
  add a, 1
  jsr outch
  bra getline.1
:getline.bs
  ife a, linebuf
    bra getline.1
  sub a, 1
  sub [cursor_ptr], 1
  set i, ' '
  jsr outch.inplace
  jmp getline.1
:getline.out
  jsr newline
  ret

;-- display I as four hex chars (trash: I J)
:hexout
  set push, c
  set c, i
  shr i, 12
  jsr hexout1
  set i, c
  shr i, 8
  jsr hexout1
  set i, c
  shr i, 4
  jsr hexout1
  set i, c
  jsr hexout1
  set c, pop
  ret
:hexout1
  and i, 15
  add i, '0'
  ifg i, '9'
    add i, 7
  jmp outch

;-- parse a hex value from a string at [A, B). (trash: C I J)
;; on success, EX=0, J=value, A=position after value.
;; on failure, EX=1, A unchanged.
:parse.hex
  set i, [a]
  jsr parse.hex.digit
  ifn ex, 0
    ret
  set j, 0
  set c, a
  add c, 4  ; max value is 4 hexen
:parse.hex.1
  shl j, 4
  bor j, i
  add a, 1
  ife a, b
    ret
  ife a, c
    ret
  set i, [a]
  jsr parse.hex.digit
  ife ex, 0
    bra parse.hex.1
  set ex, 0
  ret

:parse.hex.digit
  ifg i, 0x2f
    ifl i, 0x3a
      bra parse.hex.digit.d
  ifg i, 0x40
    ifl i, 0x47
      add i, 0x20
  ifg i, 0x60
    ifl i, 0x67
      bra parse.hex.digit.a
  set ex, 1
  ret
:parse.hex.digit.d
  sub i, 0x30
  set ex, 0
  ret
:parse.hex.digit.a
  sub i, 0x57
  set ex, 0
  ret

;-- parse a register name from a char in I. (trash: C I J)
; if present, J=register index, EX=0.
; if not, EX > 0.
:reg.names dat p"ABCXYZIJ"
:parse.reg
  set j, reg.names
  set push, j
  add peek, 4
:parse.reg.1
  set c, [j]
  shl c, 8
  ife ex, i
    bra parse.reg.found
  shr c, 8
  ife c, i
    bra parse.reg.found
  add j, 1
  ifn j, peek
    bra parse.reg.1
  set ex, pop
  ret
:parse.reg.found
  sub j, reg.names
  shl j, 1
  ife c, i
    add j, 1
:parse.reg.out
  set i, pop
  ret

;-- determine if unpacked string [A, B) matches [X, Z). (trash: C I J)
; on success, I=pointer to just after the match in A.
:match.string
  set i, a
  set j, x
:match.string.loop
  set c, [j]
  shl c, 8
  ife ex, 0
    bra match.string.yes
  ife i, b
    bra match.string.no
  ifn ex, [i]
    bra match.string.no
  shr c, 8
  add i, 1
  ife c, 0
    bra match.string.yes
  ife i, b
    bra match.string.no
  ifn c, [i]
    bra match.string.no
  add j, 1
  add i, 1
  ife j, z
    bra match.string.yes
  bra match.string.loop
:match.string.no
  set ex, 1
  ret
:match.string.yes
  ret

;-- determine if an unpacked string in [A, B) is present in [X, Y). (trash: C X Y Z I J)
; stride length of [X, Y) is I.
; if found, EX=0, J=index, I=pointer to just after the match in A.
; if not found, EX=1.
:find.string
  set push, x
  set push, i
  set z, x
:find.string.1
  add z, peek
  jsr match.string
  ife ex, 0
    bra find.string.found
  ife z, y
    bra find.string.notfound
  set x, z
  bra find.string.1
:find.string.notfound
  set ex, pop
  set ex, pop
  ret
:find.string.found
  set c, pop
  set j, x
  sub j, pop
  div j, c
  ret

;-- turn the char in I to uppercase
:toupper
  ifg i, 0x60
    ifl i, 0x7b
      and i, 0xdf
  ret

;-- convert the string in [A, B) to uppercase (trash: I J)
:str.toupper
  set j, a
:str.toupper.1
  ife j, b
    ret
  set i, [j]
  jsr toupper
  sti [j], i
  bra str.toupper.1

:skip.ws.1
  add a, 1
;-- skip whitespace in [A, B)
:skip.ws
  ifn a, b
    ife [a], ' '
      bra skip.ws.1
  ret

;-- display a single space (trash: I J)
:space
  set i, ' '
  jmp outch

;-- display A spaces (trash: A I J)
:spaces
  ife a, 0
    ret
  jsr space
  sub a, 1
  bra spaces

;-- print "(addr): " from X
:prefix.addr
  set i, x
  jsr hexout
  set i, ':'
  jsr outch
  jmp space

;-- display an error message at position A (+1 for the prompt)
:dump.error
  sub a, linebuf
  add a, 1
  jsr spaces
  set i, 12
  jsr setfg
  set i, '^'
  jsr outch
  set i, '?'
  jsr outch
  set i, 15
  jsr setfg
  jmp newline

:dump.line.fixup
  set y, x
  add y, 3
;-- dump the contents of 4 words of memory
; X=start_addr, Y=end_addr
:dump.line
  ifl y, x
    bra dump.line.fixup
  ; limit to 4 at a time
  set c, 4
  set b, x
  jsr prefix.addr
:dump.line.1
  set i, [x]
  jsr hexout
  jsr space
  sub c, 1
  ife c, 0
    bra dump.line.3
  add x, 1
  ifg x, y
    bra dump.line.2
  bra dump.line.1
:dump.line.2
  set a, 5
  jsr spaces
  sub c, 1
  ifg c, 0
    bra dump.line.2
:dump.line.3
  jsr space
  set x, b
  set c, 4
:dump.line.4
  set i, [x]
  and i, 0xff7f  ; no blink
  set a, [cursor_ptr]
  set [a], i
  add [cursor_ptr], 1
  sub c, 1
  add x, 1
  ife c, 0
    bra dump.line.out
  ifg x, y
    bra dump.line.out
  bra dump.line.4
:dump.line.out
  jmp newline

;-- save/restore all the registers
:save.stack
  add sp, 1
  ; replace the A that was saved by the interrupt
  set peek, a
  set a, sp
  set sp, [saved_stack]
  set push, a  ; sp
  set push, b
  set push, c
  set push, x
  set push, y
  set push, z
  set push, i
  set push, j
  ; tricky ret
  sub a, 1
  jmp [a]
:restore.stack
  set [addr2], pop  ; ret
  set j, pop
  set i, pop
  set z, pop
  set y, pop
  set x, pop
  set c, pop
  set b, pop
  set [saved_stack], sp
  set sp, pop
  add [saved_stack], 1
  set a, peek
  ; tricky ret
  jmp [addr2]

;---------------------------
; debugger
;---------------------------
:debugger
  set [saved_stack], stack
  set a, peek
  jsr save.stack
  jsr repl
  jsr restore.stack
  jmp exit

prompt = 42
:repl
  set i, prompt
  jsr outch
  jsr getline
  set b, a
  set a, linebuf
  ife a, b
    jmp repl.blank
  set i, a
  add i, 1
  ifn i, b
    ife [i], '='
      jmp repl.setreg
  jsr parse.hex
  ifn ex, 0
    jmp repl.0arg
  set [addr1], j
  set [addr2], j
  ife a, b
    jmp repl.dump
  ifn [a], '-'
    jmp repl.1arg
  add a, 1
  ife a, b
    jmp repl.error
  jsr parse.hex
  ifn ex, 0
    jmp repl.error
; repl.2arg
  set [addr2], j
  ife a, b
    jmp repl.dump
  jmp repl.1or2arg
:repl.0arg
  set i, [a]
  jsr toupper
  ife i, 'Q'
    ret
  ife i, '?'
    jmp repl.help
  ife i, 'R'
    jmp dump.registers
  ife i, '!'
    jmp assembler
:repl.1arg
  set i, [a]
  jsr toupper
  ife i, ':'
    jmp repl.set
  ife i, 'X'
    jmp repl.execute
:repl.1or2arg
  set i, [a]
  jsr toupper
  ife i, 'L'
    jmp repl.disasm
  jmp repl.error
:repl.error
  jsr dump.error
  jmp repl
:repl.blank
:repl.dump
  set z, 0
:repl.dump.1
  ifg z, 10
    jmp repl
  set x, [addr1]
  set y, [addr2]
  jsr dump.line
  set [addr1], x
  add z, 1
  ifl [addr1], [addr2]
    bra repl.dump.1
  ife [addr1], [addr2]
    bra repl.dump.1
  jmp repl
:repl.set
  add a, 1
:repl.set.1
  ife a, b
    jmp repl
  jsr skip.ws
  jsr parse.hex
  ifn ex, 0
    jmp repl.error
  set push, a
  set a, [addr1]
  set [a], j
  add [addr1], 1
  set a, pop
  jmp repl.set.1
:repl.help
  set a, repl.help_str
  jsr outstr
  jmp repl
:repl.disasm
  set x, [addr1]
  set y, [addr2]
  set z, 0
  ifg [addr2], [addr1]
    bra repl.disasm.1
  set [addr2], 0xffff
:repl.disasm.1
  ifg z, 10
    jmp repl
  set x, [addr1]
  jsr disasm.line
  add z, 1
  set [addr1], x
  ifl [addr1], [addr2]
    bra repl.disasm.1
  ife [addr1], [addr2]
    bra repl.disasm.1
  ife [addr2], 0xffff
    set [addr2], [addr1]
  jmp repl
:repl.setreg
  set i, [a]
  jsr toupper
  jsr parse.reg
  ifn ex, 0
    jmp repl.error
  add a, 2
  ife a, b
    jmp repl.error
  set push, j
  jsr parse.hex
  ifn ex, 0
    jmp repl.error
  set x, pop
  set y, stack - 1
  sub y, x
  ; A is special
  ife x, 0
    set y, [stack - 1]
  set [y], j
  jmp repl
:repl.execute
  ; save repl's return address
  set [asm.flag], pop
  jsr restore.stack
  jsr [addr1]
  jsr save.stack
  set push, [asm.flag]
  jmp repl

;-- disassemble one operation and print it out. X=addr in/out
:disasm.line
  jsr prefix.addr
  set a, [x]
  and a, 0x1f
  set [disasm.opcode], a
  set a, [x]
  shr a, 5
  and a, 0x1f
  set [disasm.b], a
  set a, [x]
  shr a, 10
  set [disasm.a], a
  add x, 1
; decode opcode
  ife [disasm.opcode], 0
    jmp disasm.special
  set a, [disasm.opcode]
  sub a, 1
  shl a, 1
  add a, disasm.binop
  jsr outstr
  jsr space
  set y, [disasm.b]
  set b, 0
  jsr disasm.operand
  set i, ','
  jsr outch
  jsr space
  set y, [disasm.a]
  set b, 1
  jsr disasm.operand
  jmp newline
:disasm.special
  set a, [disasm.b]
  ifg a, 0x12
    set a, 0
  ifg a, 1
    ifl a, 7
      set a, 0
  ifg a, 1
    sub a, 5
  ifg a, 7
    ifl a, 11
      set a, 0
  ifg a, 7
    sub a, 3
  shl a, 1
  add a, disasm.specop
  jsr outstr
  jsr space
  set y, [disasm.a]
  ifn [disasm.b], 0
    jsr disasm.operand
  jmp newline

; operand in Y, mem in X
:disasm.dump.reg
  shr y, 1
  set i, [y+reg.names]
  ife ex, 0
    shr i, 8
  and i, 255
  jmp outch
:disasm.specreg
  dat p"POP\z"
  dat p"PUSH"
  dat p"PEEK"
  dat p"PICK"
  dat p"SP", 0
  dat p"PC", 0
  dat p"EX", 0
:disasm.specreg.end
:disasm.operand
  ifg y, 0x07
    bra disasm.operand.1
  jmp disasm.dump.reg
:disasm.operand.1
  ifg y, 0x17
    bra disasm.operand.3
  set i, '['
  jsr outch
  set push, y
  and y, 7
  jsr disasm.dump.reg
  set y, pop
  ifl y, 0x10
    bra disasm.operand.2
  set i, '+'
:disasm.operand.2a
  jsr outch
  set i, [x]
  jsr hexout
  add x, 1
:disasm.operand.2
  set i, ']'
  jmp outch
:disasm.operand.3
  ifg y, 0x1d
    bra disasm.operand.4
  sub y, 0x17
  ife b, y
    set y, 0
  mul y, 2
  set a, disasm.specreg
  add a, y
  set b, a
  add b, 2
  jsr outstrn
  ifn y, 0x1a
    ret
  set i, ' '
  jsr outch
  jmp disasm.operand.immed
:disasm.operand.4
  ifn y, 0x1e
    bra disasm.operand.5
  set i, '['
  jmp disasm.operand.2a  ; fixme
:disasm.operand.5
  ifn y, 0x1f
    bra disasm.operand.6
:disasm.operand.immed
  set i, [x]
  jsr hexout
  add x, 1
  ret
:disasm.operand.6
  set i, y
  sub i, 0x21
  jmp hexout

; new stack = SP B C X Y Z I J
; old stack = ... PC A
:dump.registers
  set z, [stack - 1]
  set x, 'A'
  set y, [z]
  jsr dump.register
  set x, 'X'
  set y, [stack - 4]
  jsr dump.register
  set x, 'I'
  set y, [stack - 7]
  jsr dump.register
  jsr space
  set i, 'P'
  jsr outch
  set x, 'C'
  add z, 1
  set y, [z]
  jsr dump.register.2
  jsr newline
  set x, 'B'
  set y, [stack - 2]
  jsr dump.register
  set x, 'Y'
  set y, [stack - 5]
  jsr dump.register
  set x, 'J'
  set y, [stack - 8]
  jsr dump.register
  jsr space
  set i, 'S'
  jsr outch
  set x, 'P'
  set y, [stack - 1]
  jsr dump.register.2
  jsr newline
  set x, 'C'
  set y, [stack - 3]
  jsr dump.register
  set x, 'Z'
  set y, [stack - 6]
  jsr dump.register
  jsr newline
  jmp repl
:dump.register
  jsr space
:dump.register.2
  set i, x
  jsr outch
  jsr equals
  set i, y
  jmp hexout
:equals
  set i, '='
  jmp outch

asm_prompt = '!'
:assembler
  set i, asm_prompt
  jsr outch
  jsr getline
  set b, a
  set a, linebuf
  ife a, b
    jmp repl
  jsr asm.line
  bra assembler

:asm.line
  jsr str.toupper
  jsr skip.ws
  ife a, b
    ret
  set [asm.flag], 0
  ife [a], '?'
    jmp asm.help
:asm.line.2
  ; look for binop
  set x, disasm.binop
  set y, disasm.binop.end
  set i, 2
  jsr find.string
  ife ex, 0
    jmp asm.binop
  set x, disasm.specop
  set y, disasm.specop.end
  set i, 2
  jsr find.string
  ife ex, 0
    jmp asm.specop
  ; assume there's an address prefixed, unless we already did that
  ife [asm.flag], 1
    jmp dump.error
  jsr parse.hex
  ife ex, 0
    ifn a, b
      ife [a], ':'
        bra asm.line.addr
  jmp dump.error
:asm.line.addr
  set [addr1], j
  add a, 1
  set [asm.flag], 1
  jsr skip.ws
  ife a, b
    jmp dump.error
  jmp asm.line.2

:asm.help
  set a, asm.help_str
  jmp outstr

:asm.opcode.setup
  set [disasm.opcode], j
  set a, i
  jsr skip.ws
  ife a, b
    bra asm.error
  set z, asm.b.immediate
  jsr assembler.operand
  ifn j, 0xffff
    ret
:asm.error
  ; drop jsr
  set ex, pop
:asm.error.1
  jmp dump.error

:asm.binop
  jsr asm.opcode.setup
  ife a, b
    bra asm.error.1
  ifn [a], ','
    jmp asm.error.1
  add a, 1
  set [disasm.b], j
  jsr skip.ws
  set z, asm.a.immediate
  jsr assembler.operand
  ife j, 0xffff
    bra asm.error.1
  set [disasm.a], j
  ; optimize immediate a in -1 to 30
  ifn j, 0x1f
    bra asm.binop.encode
  set i, [z]
  ife i, 0xffff
    set [disasm.a], 0x20
  ifg i, 0x1e
    bra asm.binop.encode
  set [disasm.a], i
  add [disasm.a], 0x21
:asm.binop.encode
  set x, [addr1]
  set j, x
  set c, [disasm.opcode]
  add c, 1
  set i, [disasm.b]
  shl i, 5
  bor c, i
  set i, [disasm.a]
  shl i, 10
  bor c, i
  sti [j], c
  set i, [disasm.a]
  jsr asm.check.immediate
  ifn ex, 0
    sti [j], [asm.a.immediate]
:asm.binop.out
  set i, [disasm.b]
  jsr asm.check.immediate
  ifn ex, 0
    sti [j], [asm.b.immediate]
  set [addr1], j
  jmp disasm.line

:asm.specop
  jsr asm.opcode.setup
  set i, j
  set [disasm.b], j
  set x, [addr1]
  set j, x
  set c, [disasm.opcode]
  ; fix up gaps
  ifg c, 1
    add c, 5
  ifg c, 12
    add c, 3
  shl c, 5
  shl i, 10
  bor c, i
  sti [j], c
  bra asm.binop.out

;-- return EX=1 if the operand in I has an immediate.
:asm.check.immediate
  set ex, 0
  ifl i, 0x10
    ret
  set ex, 1
  ifl i, 0x18
    ret
  ifn i, 0x1a
    ifn i, 0x1e
      ifn i, 0x1f
:asm.check.immediate.1
        set ex, 0
  ret

;-- return operand in J, or J=ffff on error.
; if an immediate is required, it's stored in [Z].
:assembler.operand
  ifn a, b
    bra assembler.operand.1
  set j, 0xffff
  ret
:assembler.operand.1
  set push, z
  ife [a], '['
    jmp assembler.operand.indirect
  set x, disasm.specreg
  set y, disasm.specreg.end
  set i, 2
  jsr find.string
  ife ex, 0
    bra assembler.operand.spec
  set i, [a]
  jsr parse.reg
  ifn ex, 0
    bra assembler.operand.2
  add a, 1
  set z, pop
  ret
:assembler.operand.2
  jsr parse.hex
  ifn ex, 0
    bra assembler.operand.bad
  set z, pop
  set [z], j
  set j, 0x1f
  ret
:assembler.operand.bad
  set j, 0xffff
:assembler.operand.out
  set z, pop
  ret
:assembler.operand.spec
  set a, i
  ife j, 0
    add j, 1
  add j, 0x17
  ifn j, 0x1a
    bra assembler.operand.out
  ; PICK needs an immediate
  set z, pop
  set push, j
  jsr assembler.immediate
  set j, pop
  ifn ex, 0
    bra assembler.operand.bad
  ret
:assembler.operand.indirect
  add a, 1
  ife a, b
    bra assembler.operand.bad
  set i, [a]
  jsr parse.reg
  ifn ex, 0
    jmp assembler.operand.4
  ; [R] or [R+X]
  add a, 1
  ife a, b
    jmp assembler.operand.bad
  ife [a], '+'
    bra assembler.operand.3
  ; [R]
  jsr assembler.expect.close
  add j, 8
  set z, pop
  ret
:assembler.operand.3
  ; [R+x]
  set push, j
  add a, 1
  jsr parse.hex
  set i, pop
  ifn ex, 0
    jmp assembler.operand.bad
  jsr assembler.expect.close
  set z, pop
  set [z], j
  set j, i
  add j, 0x10
  ret
:assembler.operand.4
  ; [hex]
  jsr parse.hex
  ifn ex, 0
    jmp assembler.operand.bad
  jsr assembler.expect.close
  set z, pop
  set [z], j
  set j, 0x1e
  ret

;-- stick the immediate in [Z].
:assembler.immediate
  jsr skip.ws
  set ex, 1
  ifn a, b
    jsr parse.hex
  ifn ex, 0
    ret
  set [z], j
  ret

:assembler.expect.close
  ife a, b
    bra assembler.expect.close.bad
  ifn [a], ']'
    bra assembler.expect.close.bad
  add a, 1
  ret
:assembler.expect.close.bad
  set z, pop  ; pc
  set z, pop
  set j, 0xffff
  ret

:repl.help_str
  dat p"Q                 quit          "
  dat p"R                 dump registers"
  dat p"<reg>=<hex>       set register  "
  dat p"!                 mini-assembler"
  dat p"<addr>[-<addr>]L  disassemble   "
  dat p"<addr>X           execute (JSR) "
  dat p"<addr>[-<addr>]   dump core     "
  dat p"<addr>: <hex>*    set memory    "
  dat 0

:asm.help_str
  dat p"<enter>          exit assembler "
  dat p"[<addr>:]<line>  compile line   "
  dat p"lines are: <op> [<arg>[,<arg>]] "
  dat 0

:disasm.binop
  dat p"SET\zADD\zSUB\zMUL\zMLI\zDIV\zDVI\zMOD\zMDI\zAND\zBOR\zXOR\zSHR\zASR\zSHL\z"
  dat p"IFB\zIFC\zIFE\zIFN\zIFG\zIFA\zIFL\zIFU\z???\z???\zADX\zSBX\z???\z???\zSTI\zSTD\z"
:disasm.binop.end
:disasm.specop
  dat p"---\zJSR\zHCF\zINT\zIAG\zIAS\zRFI\zIAQ\z"
  dat p"HWN\zHWQ\zHWI\z"
:disasm.specop.end

org 0xfb80
:lem_int dat 0      ; where is the monitor hardware
:keyboard_int dat 0 ; where is the keyboard hardware
:text_ptr dat 0     ; where is the text framebuffer
:text_end dat 0
:color dat 0        ; 1 byte fg/bg color
:cursor_ptr dat 0   ; where inside the text buffer the cursor is
:old_ia dat 0       ; previous interrupt vector
:addr1 dat 0        ; address range for debugger / assembler
:addr2 dat 0
:saved_stack dat 0  ; saved SP during execution
; disassembler state
:disasm.opcode dat 0
:disasm.a dat 0
:disasm.b dat 0
; assembler state
:asm.flag dat 0
:asm.a.immediate dat 0
:asm.b.immediate dat 0

org 0xfe00
:font_data
  dat 0x5026, 0x2d27, 0x2d26, 0x5000, 0x8040, 0x8000, 0x0000, 0x0000
  dat 0x242e, 0x2400, 0x082a, 0x0800, 0x0008, 0x0000, 0x0808, 0x0808
  dat 0x00ff, 0x0000, 0x00fc, 0x0404, 0x04fc, 0x0000, 0x080f, 0x0000
  dat 0x000f, 0x0808, 0x00ff, 0x0808, 0x08f8, 0x0808, 0x08ff, 0x0000
  dat 0x080f, 0x0808, 0x08ff, 0x0808, 0x6633, 0x99cc, 0x9933, 0x66cc
  dat 0xfef8, 0xe080, 0x7f1f, 0x0701, 0x0107, 0x1f7f, 0x80e0, 0xf8fe
  dat 0x5500, 0xaa00, 0x55aa, 0x55aa, 0xffaa, 0xff55, 0x0f0f, 0x0f0f
  dat 0xf0f0, 0xf0f0, 0x0000, 0xffff, 0xffff, 0x0000, 0xffff, 0xffff
  dat 0x0000, 0x0000, 0x005f, 0x0000, 0x0700, 0x0700, 0x3f12, 0x3f00
  dat 0x246b, 0x1200, 0x1208, 0x2400, 0x3649, 0x3650, 0x0004, 0x0300
  dat 0x1c22, 0x4100, 0x4122, 0x1c00, 0x2a1c, 0x2a00, 0x081c, 0x0800
  dat 0x8060, 0x0000, 0x0808, 0x0800, 0x0040, 0x0000, 0x601c, 0x0300
  dat 0x7e41, 0x3f00, 0x427f, 0x4000, 0x7249, 0x4600, 0x2249, 0x3600
  dat 0x0f08, 0x7f00, 0x2745, 0x3900, 0x3e49, 0x3200, 0x7109, 0x0700
  dat 0x3649, 0x3600, 0x2649, 0x3e00, 0x0014, 0x0000, 0x4034, 0x0000
  dat 0x0814, 0x2200, 0x1414, 0x1400, 0x2214, 0x0800, 0x0159, 0x0600
  dat 0x3e59, 0x4e00, 0x7e09, 0x7e00, 0x7f49, 0x3600, 0x3e41, 0x4100
  dat 0x7f41, 0x3e00, 0x7f49, 0x4900, 0x7f09, 0x0900, 0x3e41, 0x3900
  dat 0x7f08, 0x7f00, 0x417f, 0x4100, 0x6040, 0x3f00, 0x7f1c, 0x6300
  dat 0x7f40, 0x4000, 0x7f0e, 0x7f00, 0x7f01, 0x7e00, 0x3e41, 0x3e00
  dat 0x7f09, 0x0600, 0x3e61, 0xbe00, 0x7f09, 0x7600, 0x4649, 0x3100
  dat 0x017f, 0x0100, 0x3f40, 0x7f00, 0x0f70, 0x0f00, 0x7f38, 0x7f00
  dat 0x7708, 0x7700, 0x0778, 0x0700, 0x7149, 0x4700, 0x7f41, 0x0000
  dat 0x031c, 0x6000, 0x0041, 0x7f00, 0x0201, 0x0200, 0x8080, 0x8080
  dat 0x0003, 0x0400, 0x6454, 0x7800, 0x7f44, 0x3800, 0x3844, 0x4400
  dat 0x3844, 0x7f00, 0x3854, 0x5800, 0x047e, 0x0500, 0x98a4, 0x7c00
  dat 0x7f04, 0x7800, 0x007d, 0x0000, 0x8080, 0x7d00, 0x7f10, 0x6c00
  dat 0x007f, 0x0000, 0x7c18, 0x7c00, 0x7c04, 0x7800, 0x3844, 0x3800
  dat 0xfc44, 0x3800, 0x3844, 0xfc80, 0x7804, 0x0400, 0x4854, 0x2400
  dat 0x043f, 0x4400, 0x3c40, 0x7c00, 0x1c70, 0x1c00, 0x7c30, 0x7c00
  dat 0x6c10, 0x6c00, 0x9ca0, 0x7c00, 0x6454, 0x4c00, 0x0836, 0x4100
  dat 0x0077, 0x0000, 0x4136, 0x0800, 0x0804, 0x0804, 0x0205, 0x0200

stack = 0xfc00
textbuf = 0xfc00
linebuf = 0xfd80
linebuf_end = 0xfdff

lem.map_screen = 0
lem.map_font = 1
lem.set_border = 3
keyboard.get_key = 1

bg_color = 0x1
cursor = 0x5f
blink_rate = 4096

; f500 - fb7f: code
; fb80 - fbff: stack + vars
; fc00 - fd7f: text framebuffer
; fd80 - fdff: input line buffer
; fe00 - feff: font data