open Uxn
open Effect.Deep

let debug = Option.is_some (Sys.getenv_opt "DBG")
let banks = Array.init 15 (fun _ -> Bytes.create 65536)

let get_bank_memory mach bank =
  if bank = 0 then Machine.ram mach
  else if bank > 0 && bank < 16 then banks.(bank - 1)
  else Bytes.create 0

let system_expansion mach cmd_addr =
  let ram = Machine.ram mach in
  let cmd = Bytes.get_uint8 ram cmd_addr in
  match cmd with
  | 0x00 ->
      let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
      let bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
      let addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
      let value = Bytes.get_uint8 ram (cmd_addr + 7) in
      if bank < 16 then begin
        let mem = get_bank_memory mach bank in
        for i = 0 to length - 1 do
          let pos = (addr + i) land 0xffff in
          Bytes.set_uint8 mem pos value
        done
      end
  | 0x01 ->
      let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
      let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
      let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
      let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
      let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
      if src_bank < 16 && dst_bank < 16 then begin
        let src_mem = get_bank_memory mach src_bank in
        let dst_mem = get_bank_memory mach dst_bank in
        for i = 0 to length - 1 do
          let src_pos = (src_addr + i) land 0xffff in
          let dst_pos = (dst_addr + i) land 0xffff in
          let v = Bytes.get_uint8 src_mem src_pos in
          Bytes.set_uint8 dst_mem dst_pos v
        done
      end
  | 0x02 ->
      let length = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 1) in
      let src_bank = Bytes.get_uint16_be ram (cmd_addr + 3) in
      let src_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 5) in
      let dst_bank = Bytes.get_uint16_be ram (cmd_addr + 7) in
      let dst_addr = Util.get_uint16_wrap ~wrap:0xffff ram (cmd_addr + 9) in
      if src_bank < 16 && dst_bank < 16 then begin
        let src_mem = get_bank_memory mach src_bank in
        let dst_mem = get_bank_memory mach dst_bank in
        for i = length - 1 downto 0 do
          let src_pos = (src_addr + i) land 0xffff in
          let dst_pos = (dst_addr + i) land 0xffff in
          let v = Bytes.get_uint8 src_mem src_pos in
          Bytes.set_uint8 dst_mem dst_pos v
        done
      end
  | _ -> Fmt.epr "System/expansion: unknown command #%02x" cmd

let print_stack ~name (Machine.Stack { data; sp }) =
  Fmt.epr "%s: @[%a@]@." name
    (Fmt.on_bytes (Fmt.octets ()))
    (Bytes.sub data 0 sp)

let console_vector = ref 0

let run m pc =
  let dev = Machine.dev m in
  let ram = Machine.ram m in
  try Machine.dispatch ~trace:debug m pc with
  | effect Machine.Trace (pc, instr, args), k when debug ->
      Fmt.epr "PC = %04x | %6s %a@." pc (Instr.to_string instr)
        (Fmt.list ~sep:(Fmt.any " ") (Fmt.fmt "%02x"))
        args;
      Out_channel.flush stderr;
      continue k ()
  | effect Machine.Trace _, k -> continue k ()
  | effect Machine.BRK, _ -> ()
  | effect Machine.DEI (`Byte, port), k ->
      let value =
        match port with
        | 0x04 ->
            let (Machine.Stack { sp; _ }) = Machine.wst m in
            sp
        | 0x05 ->
            let (Machine.Stack { sp; _ }) = Machine.rst m in
            sp
        | _ -> Bytes.get_uint8 dev port
      in
      continue k value
  | effect Machine.DEI (`Short, port), k ->
      continue k (Util.get_uint16_wrap ~wrap:0xffff dev port)
  | effect Machine.DEO (port, value), k ->
      (match port with
      | 0x02 -> system_expansion m value
      | 0x04 ->
          let (Machine.Stack s) = Machine.wst m in
          s.sp <- value land 0xff
      | 0x05 ->
          let (Machine.Stack s) = Machine.rst m in
          s.sp <- value land 0xff
      | 0x0e ->
          if value <> 0 then begin
            print_stack ~name:"WST" (Machine.wst m);
            print_stack ~name:"RST" (Machine.rst m);
            Out_channel.flush stderr
          end
      | 0x0f -> Bytes.set_uint8 dev 0x0f value
      | 0x10 -> console_vector := Bytes.get_uint16_be dev 0x10
      | 0x18 ->
          print_char (Char.chr value);
          Out_channel.flush stdout
      | 0x19 ->
          prerr_char (Char.chr value);
          Out_channel.flush stderr
      | 0xaa -> Varvara.File.file_lengths.(0) <- Bytes.get_uint16_be dev 0xaa
      | 0xa4 ->
          let addr = Bytes.get_uint16_be dev 0xa4 in
          let len = Varvara.File.file_lengths.(0) in
          let result = Varvara.File.file_stat ram 0 addr len in
          Varvara.File.file_success dev 0xa2 result
      | 0xa6 ->
          let result = Varvara.File.file_delete 0 in
          Varvara.File.file_success dev 0xa2 (if result = 0 then 1 else 0)
      | 0xa8 ->
          let addr = Bytes.get_uint16_be dev 0xa8 in
          let result = Varvara.File.file_init ram 0 addr in
          Varvara.File.file_success dev 0xa2 result
      | 0xac ->
          let addr = Bytes.get_uint16_be dev 0xac in
          let len = Varvara.File.file_lengths.(0) in
          let result = Varvara.File.file_read ram 0 addr len in
          Varvara.File.file_success dev 0xa2 result
      | 0xae ->
          let addr = Bytes.get_uint16_be dev 0xae in
          let len = Varvara.File.file_lengths.(0) in
          let append = Bytes.get_uint8 dev 0xa7 in
          let result = Varvara.File.file_write ram 0 addr len append in
          Varvara.File.file_success dev 0xa2 result
      | 0xba -> Varvara.File.file_lengths.(1) <- Bytes.get_uint16_be dev 0xba
      | 0xb4 ->
          let addr = Bytes.get_uint16_be dev 0xb4 in
          let len = Varvara.File.file_lengths.(1) in
          let result = Varvara.File.file_stat ram 1 addr len in
          Varvara.File.file_success dev 0xb2 result
      | 0xb6 ->
          let result = Varvara.File.file_delete 1 in
          Varvara.File.file_success dev 0xb2 (if result = 0 then 1 else 0)
      | 0xb8 ->
          let addr = Bytes.get_uint16_be dev 0xb8 in
          let result = Varvara.File.file_init ram 1 addr in
          Varvara.File.file_success dev 0xb2 result
      | 0xbc ->
          let addr = Bytes.get_uint16_be dev 0xbc in
          let len = Varvara.File.file_lengths.(1) in
          let result = Varvara.File.file_read ram 1 addr len in
          Varvara.File.file_success dev 0xb2 result
      | 0xbe ->
          let addr = Bytes.get_uint16_be dev 0xbe in
          let len = Varvara.File.file_lengths.(1) in
          let append = Bytes.get_uint8 dev 0xb7 in
          let result = Varvara.File.file_write ram 1 addr len append in
          Varvara.File.file_success dev 0xb2 result
      | _ -> ());
      continue k ()

let main () =
  if Array.length Sys.argv < 2 then (
    Fmt.epr "usage: uxnemu file.rom\n";
    exit 1);

  let code =
    In_channel.with_open_bin Sys.argv.(1) (fun i -> In_channel.input_all i)
  in

  In_channel.set_binary_mode stdin true;
  Out_channel.set_binary_mode stdout true;

  let mach = Machine.create code in
  let dev = Machine.dev mach in

  let has_args = Array.length Sys.argv > 2 in
  Bytes.set_uint8 dev 0x17 (if has_args then 1 else 0);

  run mach 0x100;

  if !console_vector <> 0 then begin
    let console_input ch ty =
      Bytes.set_uint8 dev 0x12 ch;
      Bytes.set_uint8 dev 0x17 ty;
      if Bytes.get_uint8 dev 0x0f = 0 then run mach !console_vector
    in
    if has_args then begin
      for i = 2 to Array.length Sys.argv - 1 do
        let arg = Sys.argv.(i) in
        String.iter
          (fun c ->
            if Bytes.get_uint8 dev 0x0f = 0 then console_input (Char.code c) 2)
          arg;
        if Bytes.get_uint8 dev 0x0f = 0 then
          console_input 0 (if i = Array.length Sys.argv - 1 then 4 else 3)
      done
    end;
    try
      while Bytes.get_uint8 dev 0x0f = 0 do
        match In_channel.input_byte stdin with
        | None -> raise Exit
        | Some c -> console_input c 1
      done
    with Exit -> console_input 0 4
  end;
  if debug then begin
    print_stack ~name:"wst" (Machine.wst mach);
    print_stack ~name:"rst" (Machine.rst mach)
  end;
  exit (Bytes.get_uint8 dev 0x0f land 0x7f)

let _ = main ()