reorganization and project rename

lib/kestrel_varvara/Console.ml

@@ -0,0 +1,22 @@
+type state = { mutable console_vector : int }
+
+module Make () : Kestrel.Device.DEVICE with type state = state = struct
+  type nonrec state = state
+
+  let state = { console_vector = 0 }
+  let dei_ports = Kestrel.Device.Int_set.empty
+  let deo_ports = Kestrel.Device.Int_set.of_list [ 0x10; 0x18; 0x19 ]
+  let dei _ _ = assert false
+  let dei2 _ _ = assert false
+
+  let deo _ port value =
+    match port with
+    | 0x10 -> state.console_vector <- value
+    | 0x18 ->
+        print_char (Char.chr value);
+        Out_channel.flush stdout
+    | 0x19 ->
+        prerr_char (Char.chr value);
+        Out_channel.flush stderr
+    | _ -> assert false
+end

lib/kestrel_varvara/Datetime.ml

@@ -0,0 +1,34 @@
+module Make () : Kestrel.Device.DEVICE with type state = unit = struct
+  type state = unit
+
+  let state = ()
+
+  let dei_ports =
+    Kestrel.Device.Int_set.of_list
+      [ 0xc0; 0xc2; 0xc3; 0xc4; 0xc5; 0xc6; 0xc7; 0xc8; 0xca ]
+
+  let deo_ports = Kestrel.Device.Int_set.empty
+
+  let dei _ port =
+    let now = Unix.time () in
+    let tm = Unix.localtime now in
+    match port with
+    | 0xc2 -> tm.Unix.tm_mon
+    | 0xc3 -> tm.Unix.tm_mday
+    | 0xc4 -> tm.Unix.tm_hour
+    | 0xc5 -> tm.Unix.tm_min
+    | 0xc6 -> tm.Unix.tm_sec
+    | 0xc7 -> tm.Unix.tm_wday
+    | 0xca -> Bool.to_int tm.Unix.tm_isdst
+    | _ -> assert false
+
+  let dei2 _ port =
+    let now = Unix.time () in
+    let tm = Unix.localtime now in
+    match port with
+    | 0xc0 -> tm.Unix.tm_year + 1900
+    | 0xc8 -> tm.Unix.tm_yday
+    | _ -> assert false
+
+  let deo _ _ _ = assert false
+end

lib/kestrel_varvara/File.ml

@@ -0,0 +1,231 @@
+type file_state =
+  | Idle
+  | File_read of in_channel
+  | File_write of out_channel
+  | Dir_read of Unix.dir_handle * string
+  | Dir_write
+
+type state = {
+  mutable filepath : string option;
+  mutable state : file_state;
+  mutable length : int;
+}
+
+module type ADDR = sig
+  val start : int
+end
+
+module Make (Addr : ADDR) : Kestrel.Device.DEVICE with type state = state =
+struct
+  type nonrec state = state
+
+  let state = { filepath = None; state = Idle; length = 0 }
+  let dei_ports = Kestrel.Device.Int_set.empty
+
+  let deo_ports =
+    Kestrel.Device.Int_set.of_list
+      [
+        Addr.start + 0x0a;
+        Addr.start + 0x04;
+        Addr.start + 0x06;
+        Addr.start + 0x08;
+        Addr.start + 0x0c;
+        Addr.start + 0x0e;
+      ]
+
+  let read_cstring ram addr =
+    let buf = Buffer.create 256 in
+    let rec loop pos =
+      if pos >= Bytes.length ram then Buffer.contents buf
+      else
+        let c = Bytes.get ram pos in
+        if c = '\x00' then Buffer.contents buf
+        else (
+          Buffer.add_char buf c;
+          loop (pos + 1))
+    in
+    loop addr
+
+  let file_reset dev =
+    (match dev.state with
+    | File_read ic -> close_in_noerr ic
+    | File_write oc -> close_out_noerr oc
+    | Dir_read (dh, _) -> Unix.closedir dh
+    | Idle | Dir_write -> ());
+    dev.state <- Idle
+
+  let file_init ram addr =
+    file_reset state;
+    state.filepath <- Some (read_cstring ram addr);
+    0
+
+  let file_not_ready () = state.filepath |> Option.is_none
+
+  let format_size size len =
+    let hex_digits = "0123456789abcdef" in
+    let buf = Bytes.create len in
+    for i = 0 to len - 1 do
+      let shift = 4 * (len - 1 - i) in
+      let nibble = (size lsr shift) land 0xf in
+      Bytes.set buf i hex_digits.[nibble]
+    done;
+    Bytes.to_string buf
+
+  let format_stat ?(capsize = false) filepath len =
+    try
+      let st = Unix.stat filepath in
+      let is_dir = st.Unix.st_kind = Unix.S_DIR in
+      if is_dir then String.make len '-'
+      else if capsize && st.Unix.st_size >= 0x10000 then String.make len '?'
+      else format_size st.Unix.st_size len
+    with Unix.Unix_error _ -> String.make len '!'
+
+  let format_dir_entry filepath basename =
+    let full_path = Filename.concat filepath basename in
+    let stat_str = format_stat ~capsize:true full_path 4 in
+    try
+      let st = Unix.stat full_path in
+      let is_dir = st.Unix.st_kind = Unix.S_DIR in
+      Printf.sprintf "%s %s%s\n" stat_str basename (if is_dir then "/" else "")
+    with Unix.Unix_error _ -> Printf.sprintf "%s %s\n" stat_str basename
+
+  let read_directory filepath maxlen =
+    let dh = Unix.opendir filepath in
+    let buf = Buffer.create 1024 in
+    let rec read_entries () =
+      try
+        let entry = Unix.readdir dh in
+        if entry <> "." && entry <> ".." then
+          Buffer.add_string buf (format_dir_entry filepath entry);
+        if Buffer.length buf < maxlen then read_entries ()
+      with End_of_file -> ()
+    in
+    read_entries ();
+    Unix.closedir dh;
+    let result = Buffer.contents buf in
+    if String.length result > maxlen then String.sub result 0 maxlen else result
+
+  let create_directories path =
+    let rec mkdir_parents p =
+      if p <> "" && p <> "." && p <> "/" then
+        if not (Sys.file_exists p) then (
+          mkdir_parents (Filename.dirname p);
+          try Unix.mkdir p 0o755 with Unix.Unix_error _ -> ())
+    in
+    mkdir_parents (Filename.dirname path)
+
+  let is_dir_path path =
+    String.length path > 0 && path.[String.length path - 1] = '/'
+
+  let file_read ram addr len =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath -> (
+          (match state.state with
+          | Idle ->
+              if Sys.is_directory filepath then
+                state.state <- Dir_read (Unix.opendir filepath, filepath)
+              else state.state <- File_read (open_in_bin filepath)
+          | _ -> ());
+          match state.state with
+          | File_read ic -> (
+              try
+                let max_len = 0x10000 - addr in
+                let bytes_read = input ic ram addr (min max_len len) in
+                bytes_read
+              with
+              | End_of_file -> 0
+              | Sys_error _ -> 0)
+          | Dir_read (dh, fp) -> (
+              try
+                let contents = read_directory fp len in
+                let bytes_to_copy = min len (String.length contents) in
+                let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
+                Bytes.blit_string contents 0 ram addr bytes_to_copy;
+                Unix.closedir dh;
+                state.state <- Idle;
+                bytes_to_copy
+              with Unix.Unix_error _ -> 0)
+          | _ -> 0)
+
+  let file_write ram addr len append_flag =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath -> (
+          (match state.state with
+          | Idle ->
+              if is_dir_path filepath then (
+                create_directories filepath;
+                state.state <- Dir_write)
+              else (
+                create_directories filepath;
+                let mode =
+                  if append_flag land 0x01 <> 0 then
+                    [ Open_wronly; Open_binary; Open_append; Open_creat ]
+                  else [ Open_wronly; Open_binary; Open_creat; Open_trunc ]
+                in
+                try
+                  let oc = open_out_gen mode 0o644 filepath in
+                  state.state <- File_write oc
+                with Sys_error _ -> ())
+          | _ -> ());
+          match state.state with
+          | File_write oc -> (
+              try
+                let max_len = 0x10000 - addr in
+                output oc ram addr (min max_len len);
+                flush oc;
+                min max_len len
+              with Sys_error _ -> 0)
+          | Dir_write ->
+              if Sys.file_exists filepath && Sys.is_directory filepath then 1
+              else 0
+          | _ -> 0)
+
+  let file_stat ram addr len =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath ->
+          let stat_str = format_stat filepath len in
+          let bytes_to_copy = min len (String.length stat_str) in
+          let bytes_to_copy = min (0x10000 - addr) bytes_to_copy in
+          Bytes.blit_string stat_str 0 ram addr bytes_to_copy;
+          bytes_to_copy
+
+  let file_delete () =
+    if file_not_ready () then 0
+    else
+      match state.filepath with
+      | None -> 0
+      | Some filepath -> (
+          try
+            Unix.unlink filepath;
+            1
+          with Unix.Unix_error _ -> 0)
+
+  let file_success dev port value = Bytes.set_uint16_be dev port value
+  let dei _ _ = assert false
+  let dei2 _ _ = assert false
+
+  let deo mach port value =
+    let open Kestrel in
+    let ram = Machine.ram mach in
+    let dev = Machine.dev mach in
+    let with_success result = file_success dev (Addr.start + 0x02) result in
+    match port - Addr.start with
+    | 0x0a -> state.length <- value
+    | 0x04 -> file_stat (Machine.ram mach) value state.length |> with_success
+    | 0x06 -> file_delete () |> with_success
+    | 0x08 -> file_init (Machine.ram mach) value |> with_success
+    | 0x0c -> file_read (Machine.ram mach) value state.length |> with_success
+    | 0x0e ->
+        let append = Bytes.get_uint8 dev (Addr.start + 0x07) in
+        file_write ram value state.length append |> with_success
+    | _ -> failwith (Printf.sprintf "%02x" port)
+end

lib/kestrel_varvara/System.ml

@@ -0,0 +1,107 @@
+open Kestrel
+
+type state = { banks : bytes array }
+
+module Make () : Kestrel.Device.DEVICE with type state = state = struct
+  type nonrec state = state
+
+  let state = { banks = Array.init 15 (fun _ -> Bytes.create 65536) }
+  let dei_ports = Kestrel.Device.Int_set.of_list [ 0x04; 0x05 ]
+
+  let deo_ports =
+    Kestrel.Device.Int_set.of_list [ 0x02; 0x04; 0x05; 0x0e; 0x0f ]
+
+  let print_stack ~name (Kestrel.Machine.Stack { data; sp }) =
+    Printf.eprintf "%s " name;
+    for i = sp - 8 to sp - 1 do
+      Printf.eprintf "%02x%s"
+        (Bytes.get_uint8 data (i land 0xff))
+        (if i land 0xff == 0xff then "|" else " ")
+    done;
+    Printf.eprintf "<%02x\n" sp
+
+  let get_bank mach bank =
+    if bank = 0 then Machine.ram mach
+    else if bank > 0 && bank < 16 then state.banks.(bank - 1)
+    else Bytes.create 0
+
+  let 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 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 mach src_bank in
+          let dst_mem = get_bank 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 mach src_bank in
+          let dst_mem = get_bank 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
+    | _ -> Format.eprintf "System/expansion: unknown command #%02x" cmd
+
+  let dei m port =
+    match port with
+    | 0x04 ->
+        let (Machine.Stack { sp; _ }) = Machine.wst m in
+        sp
+    | 0x05 ->
+        let (Machine.Stack { sp; _ }) = Machine.rst m in
+        sp
+    | _ -> assert false
+
+  let dei2 _ _ = assert false
+
+  let deo mach port value =
+    match port with
+    | 0x02 -> expansion mach value
+    | 0x04 ->
+        let (Machine.Stack s) = Machine.wst mach in
+        s.sp <- value land 0xff
+    | 0x05 ->
+        let (Machine.Stack s) = Machine.rst mach in
+        s.sp <- value land 0xff
+    | 0x0e ->
+        if value <> 0 then begin
+          print_stack ~name:"wst" (Machine.wst mach);
+          print_stack ~name:"rst" (Machine.rst mach);
+          Out_channel.flush stderr
+        end
+    | 0x0f -> Bytes.set_uint8 (Machine.dev mach) 0x0f value
+    | _ -> assert false
+end

lib/kestrel_varvara/dune

@@ -0,0 +1,3 @@
+(library
+ (name kestrel_varvara)
+ (libraries kestrel unix))