1 files changed, 419 insertions, 0 deletions
diff --git a/ocaml/lib/boot.ml b/ocaml/lib/boot.ml
new file mode 100644
index 0000000..34b7746
--- /dev/null
+++ b/ocaml/lib/boot.ml
@@ -0,0 +1,419 @@
+open Noun
+open Nock
+open Serial
+open State
+
+let debug_enabled () =
+  match Sys.getenv_opt "NEOVERE_BOOT_DEBUG" with
+  | None -> false
+  | Some value ->
+      let v = String.lowercase_ascii value in
+      not (v = "0" || v = "false" || v = "off")
+
+let log fmt =
+  if debug_enabled () then
+    Printf.ksprintf (fun msg -> Printf.printf "[boot] %s\n%!" msg) fmt
+  else
+    Printf.ksprintf (fun _ -> ()) fmt
+
+let count_list noun =
+  let rec loop acc current =
+    match current with
+    | Atom z when Z.equal z Z.zero -> acc
+    | Cell (_, t) -> loop (acc + 1) t
+    | _ -> acc
+  in
+  loop 0 noun
+
+type error =
+  | Invalid_pill of string
+  | Unsupported of string
+
+let cue_file ?(verbose=false) path =
+  let ic = open_in_bin path in
+  let len = in_channel_length ic in
+  let data = really_input_string ic len in
+  close_in ic;
+  cue ~verbose (Bytes.of_string data)
+
+let atom_int n = atom (Z.of_int n)
+
+let lifecycle_formula =
+  (* [2 [0 3] [0 2]] *)
+  let axis03 = cell (atom_int 0) (atom_int 3) in
+  let axis02 = cell (atom_int 0) (atom_int 2) in
+  cell (atom_int 2) (cell axis03 axis02)
+
+let run_lifecycle events =
+  log "running lifecycle formula [2 [0 3] [0 2]] on event list";
+  let gate = nock_on events lifecycle_formula in
+  log "lifecycle formula succeeded, extracting kernel from slot 7";
+  let kernel = slot (Z.of_int 7) gate in
+  log "kernel extracted, is_cell=%b" (Noun.is_cell kernel);
+  kernel
+
+let parse_ivory noun =
+  match noun with
+  | Cell (_tag, events) -> Ok events
+  | _ -> Error (Invalid_pill "ivory pill must be a cell")
+
+let boot_ivory state path =
+  log "loading ivory pill: %s" path;
+  let cue_start = Sys.time () in
+  let noun = cue_file ~verbose:(debug_enabled ()) path in
+  let cue_elapsed = Sys.time () -. cue_start in
+  log "cue complete in %.3fs" cue_elapsed;
+  match parse_ivory noun with
+  | Error e -> Error e
+  | Ok events ->
+      let event_count = count_list events in
+      log "ivory event count=%d" event_count;
+      log "running lifecycle formula";
+      let life_start = Sys.time () in
+      let result =
+        try Ok (run_lifecycle events) with
+        | Exit -> Error (Invalid_pill "ivory lifecycle failed (Exit)")
+        | exn -> Error (Invalid_pill (Printexc.to_string exn))
+      in
+      begin match result with
+      | Error err ->
+          log "lifecycle failed";
+          Error err
+      | Ok kernel ->
+          let life_elapsed = Sys.time () -. life_start in
+          log "lifecycle complete in %.3fs" life_elapsed;
+          log "kernel is_cell=%b" (Noun.is_cell kernel);
+          let events_played = Int64.of_int event_count in
+          boot ~events_played state kernel;
+          Ok ()
+      end
+
+let parse_solid noun =
+  match noun with
+  | Cell (tag, rest) ->
+      let pill_tag = Z.of_int 0x6c6c6970 in
+      begin match tag with
+      | Atom z when Z.equal z pill_tag ->
+          (* Structure is flat 4-tuple: [%pill typ bot mod use] *)
+          begin match rest with
+          | Cell (typ, Cell (bot, Cell (mod_, use_))) ->
+              (* Check typ is %solid (0x64696c6f73) or %olid (0x64696c6f) *)
+              begin match typ with
+              | Atom z when Z.equal z (Z.of_int 0x64696c6f73) || Z.equal z (Z.of_int 0x64696c6f) ->
+                  Ok (bot, mod_, use_)
+              | Atom z ->
+                  let typ_hex = Z.format "%x" z in
+                  log "got pill type tag: 0x%s (expected 'solid' = 0x64696c6f73)" typ_hex;
+                  Error (Unsupported (Printf.sprintf "unsupported pill type: 0x%s" typ_hex))
+              | _ -> Error (Unsupported "pill type must be atom")
+              end
+          | _ -> Error (Invalid_pill "expected flat 4-tuple [%pill typ bot mod use]")
+          end
+      | _ -> Error (Invalid_pill "missing %pill tag")
+      end
+  | _ -> Error (Invalid_pill "pill must be a cell")
+
+let rec list_fold noun acc =
+  match noun with
+  | Atom z when Z.equal z Z.zero -> List.rev acc
+  | Cell (h, t) -> list_fold t (h :: acc)
+  | _ -> raise Exit
+
+let rec take n lst =
+  if n <= 0 then []
+  else match lst with
+    | [] -> []
+    | x :: xs -> x :: take (n - 1) xs
+
+(* Convert ASCII string to atom (bytes in little-endian order) *)
+let atom_of_string s =
+  if String.length s = 0 then atom Z.zero
+  else
+    let bytes = Bytes.of_string s in
+    atom (Z.of_bits (Bytes.to_string bytes))
+
+(* Urbit time functions matching vere/pkg/vere/time.c *)
+
+(* Convert Unix seconds to Urbit seconds *)
+let urbit_sec_of_unix_sec unix_sec =
+  (* Urbit epoch offset: 0x8000000cce9e0d80 *)
+  let urbit_epoch = Z.of_string "0x8000000cce9e0d80" in
+  Z.add urbit_epoch (Z.of_int unix_sec)
+
+(* Convert microseconds to Urbit fracto-seconds *)
+let urbit_fsc_of_usec usec =
+  (* (usec * 65536 / 1000000) << 48 *)
+  let usec_z = Z.of_int usec in
+  let scaled = Z.div (Z.mul usec_z (Z.of_int 65536)) (Z.of_int 1000000) in
+  Z.shift_left scaled 48
+
+(* Get current Urbit time as 128-bit atom [low_64 high_64] *)
+let urbit_time_now () =
+  let time_f = Unix.gettimeofday () in
+  let unix_sec = int_of_float time_f in
+  let usec = int_of_float ((time_f -. float_of_int unix_sec) *. 1_000_000.0) in
+
+  let urbit_sec = urbit_sec_of_unix_sec unix_sec in
+  let urbit_fsc = urbit_fsc_of_usec usec in
+
+  (* Combine into 128-bit atom:
+     - Bits 0-63: fractional seconds (urbit_fsc)
+     - Bits 64-127: seconds (urbit_sec shifted left 64 bits) *)
+  let time_128 = Z.logor urbit_fsc (Z.shift_left urbit_sec 64) in
+  atom time_128
+
+let boot_solid_lifecycle state path =
+  log "loading solid pill: %s" path;
+  let cue_start = Sys.time () in
+  let noun = cue_file ~verbose:(debug_enabled ()) path in
+  let cue_elapsed = Sys.time () -. cue_start in
+  log "cue complete in %.3fs" cue_elapsed;
+
+  match parse_solid noun with
+  | Error e -> Error e
+  | Ok (bot, mod_, use_) ->
+      log "parsing event lists...";
+      let bot_list = list_fold bot [] in
+      let mod_list = list_fold mod_ [] in
+      let use_list = list_fold use_ [] in
+      log "bot events: %d, mod events: %d, use events: %d"
+        (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+      (* Add system events like mars.c lines 1741-1767 *)
+      let arvo_wire =
+        (* [/~/ %arvo ~] - wire for system events *)
+        cell (cell (atom (Z.of_int 0)) (atom_of_string "arvo")) (atom Z.zero)
+      in
+
+      (* Add 4 system events to mod list (prepended in reverse order) *)
+      let mod_list =
+        (* 1. wack - entropy (16 words of 0xdeadbeef) *)
+        let eny_bytes = Bytes.create (16 * 4) in
+        for i = 0 to 15 do
+          Bytes.set_int32_le eny_bytes (i * 4) (Int32.of_int 0xdeadbeef)
+        done;
+        let eny_atom = atom (Z.of_bits (Bytes.to_string eny_bytes)) in
+        let wack_card = cell (atom_of_string "wack") eny_atom in
+        let wack = cell arvo_wire wack_card in
+
+        (* 2. whom - identity (fake ship ~zod = 0) *)
+        let whom_card = cell (atom_of_string "whom") (atom Z.zero) in
+        let whom = cell arvo_wire whom_card in
+
+        (* 3. verb - verbosity (verbose = no) *)
+        let verb_card = cell (atom_of_string "verb") (cell (atom Z.zero) (atom Z.zero)) in
+        let verb = cell arvo_wire verb_card in
+
+        (* 4. wyrd - version negotiation *)
+        let sen = atom_of_string "0v1s.vu178" in
+        let ver = cell (atom_of_string "vere")
+                  (cell (atom_of_string "live")
+                   (cell (atom_of_string "3.5") (atom Z.zero))) in
+        let kel =
+          cell (cell (atom_of_string "zuse") (atom (Z.of_int 409)))
+          (cell (cell (atom_of_string "lull") (atom (Z.of_int 321)))
+          (cell (cell (atom_of_string "arvo") (atom (Z.of_int 235)))
+          (cell (cell (atom_of_string "hoon") (atom (Z.of_int 136)))
+          (cell (cell (atom_of_string "nock") (atom (Z.of_int 4)))
+           (atom Z.zero)))))
+        in
+        let wyrd_card = cell (atom_of_string "wyrd") (cell (cell sen ver) kel) in
+        let wyrd = cell arvo_wire wyrd_card in
+
+        wack :: whom :: verb :: wyrd :: mod_list
+      in
+
+      (* Add boot event to use list *)
+      let use_list =
+        (* [/d/term/1 [%boot lit venue]] where venue = [%fake ~zod] *)
+        let boot_wire =
+          cell (atom_of_string "d")
+          (cell (atom_of_string "term")
+          (cell (atom (Z.of_int 1)) (atom Z.zero)))
+        in
+        let venue = cell (atom_of_string "fake") (atom Z.zero) in
+        let boot_card = cell (atom_of_string "boot") (cell (atom Z.zero) venue) in
+        let boot_event = cell boot_wire boot_card in
+        boot_event :: use_list
+      in
+
+      log "after adding system events:";
+      log "  bot events: %d, mod events: %d, use events: %d"
+        (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+      (* Build event list like mars.c:1815-1835 *)
+      (* Bot events are NOT timestamped, mod/use events ARE timestamped *)
+      log "building event list (bot bare, mod/use timestamped)...";
+      let now = urbit_time_now () in
+      let bit = atom (Z.shift_left Z.one 48) in  (* 2^48 = 1/2^16 seconds increment *)
+
+      (* Start with bot events (bare, not timestamped) *)
+      let event_list = List.rev bot_list in
+
+      (* Add mod+use events (timestamped) *)
+      let mod_use = mod_list @ use_list in
+      let rec timestamp_and_add events current_time acc =
+        match events with
+        | [] -> List.rev acc
+        | event :: rest ->
+            let timestamped = cell current_time event in
+            let next_time = match (current_time, bit) with
+              | (Atom t, Atom b) -> atom (Z.add t b)
+              | _ -> failwith "time must be atoms"
+            in
+            timestamp_and_add rest next_time (timestamped :: acc)
+      in
+      let timestamped_mod_use = timestamp_and_add mod_use now [] in
+      let full_event_list = event_list @ timestamped_mod_use in
+
+      log "built event list with %d events" (List.length full_event_list);
+      log "  %d bot (bare) + %d mod/use (timestamped)"
+        (List.length bot_list) (List.length timestamped_mod_use);
+
+      (* Convert to noun list structure *)
+      let rec build_noun_list = function
+        | [] -> atom Z.zero
+        | h :: t -> cell h (build_noun_list t)
+      in
+      let event_noun = build_noun_list full_event_list in
+
+      (* Run lifecycle formula on full event list *)
+      log "running lifecycle formula on full event list...";
+      let life_start = Sys.time () in
+      let result =
+        try Ok (run_lifecycle event_noun) with
+        | Exit -> Error (Invalid_pill "lifecycle formula failed (Exit)")
+        | exn -> Error (Invalid_pill (Printexc.to_string exn))
+      in
+      begin match result with
+      | Error err ->
+          log "lifecycle failed: %s" (match err with Invalid_pill s | Unsupported s -> s);
+          Error err
+      | Ok kernel ->
+          let life_elapsed = Sys.time () -. life_start in
+          log "lifecycle complete in %.3fs" life_elapsed;
+          let events_played = Int64.of_int (List.length full_event_list) in
+          boot ~events_played state kernel;
+          Ok ()
+      end
+
+let boot_solid ?limit ?(apply = poke) state path =
+  log "loading solid pill: %s" path;
+  let cue_start = Sys.time () in
+  let noun = cue_file ~verbose:(debug_enabled ()) path in
+  let cue_elapsed = Sys.time () -. cue_start in
+  log "cue complete in %.3fs" cue_elapsed;
+
+  match parse_solid noun with
+  | Error e -> Error e
+  | Ok (bot, mod_, use_) ->
+      log "parsing event lists...";
+      let bot_list = list_fold bot [] in
+      let mod_list = list_fold mod_ [] in
+      let use_list = list_fold use_ [] in
+      log "bot events: %d, mod events: %d, use events: %d"
+        (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+      (* Add system events like mars.c lines 1741-1767 *)
+      let arvo_wire =
+        (* [/~/ %arvo ~] - wire for system events *)
+        cell (cell (atom (Z.of_int 0)) (atom_of_string "arvo")) (atom Z.zero)
+      in
+
+      (* Add 4 system events to mod list (prepended in reverse order) *)
+      (* Each event is [wire card] *)
+      let mod_list =
+        (* 1. wack - entropy (16 words of 0xdeadbeef) *)
+        let eny_bytes = Bytes.create (16 * 4) in
+        for i = 0 to 15 do
+          Bytes.set_int32_le eny_bytes (i * 4) (Int32.of_int 0xdeadbeef)
+        done;
+        let eny_atom = atom (Z.of_bits (Bytes.to_string eny_bytes)) in
+        let wack_card = cell (atom_of_string "wack") eny_atom in
+        let wack = cell arvo_wire wack_card in
+
+        (* 2. whom - identity (fake ship ~zod = 0) *)
+        let whom_card = cell (atom_of_string "whom") (atom Z.zero) in
+        let whom = cell arvo_wire whom_card in
+
+        (* 3. verb - verbosity (verbose = no) *)
+        let verb_card = cell (atom_of_string "verb") (cell (atom Z.zero) (atom Z.zero)) in
+        let verb = cell arvo_wire verb_card in
+
+        (* 4. wyrd - version negotiation *)
+        let sen = atom_of_string "0v1s.vu178" in
+        let ver = cell (atom_of_string "vere")
+                  (cell (atom_of_string "live")
+                   (cell (atom_of_string "3.5") (atom Z.zero))) in
+        let kel =
+          cell (cell (atom_of_string "zuse") (atom (Z.of_int 409)))
+          (cell (cell (atom_of_string "lull") (atom (Z.of_int 321)))
+          (cell (cell (atom_of_string "arvo") (atom (Z.of_int 235)))
+          (cell (cell (atom_of_string "hoon") (atom (Z.of_int 136)))
+          (cell (cell (atom_of_string "nock") (atom (Z.of_int 4)))
+           (atom Z.zero)))))
+        in
+        let wyrd_card = cell (atom_of_string "wyrd") (cell (cell sen ver) kel) in
+        let wyrd = cell arvo_wire wyrd_card in
+
+        wack :: whom :: verb :: wyrd :: mod_list
+      in
+
+      (* Add boot event to use list *)
+      let use_list =
+        (* [/d/term/1 [%boot lit venue]] where venue = [%fake ~zod] *)
+        let boot_wire =
+          cell (atom_of_string "d")
+          (cell (atom_of_string "term")
+          (cell (atom (Z.of_int 1)) (atom Z.zero)))
+        in
+        let venue = cell (atom_of_string "fake") (atom Z.zero) in
+        let boot_card = cell (atom_of_string "boot") (cell (atom Z.zero) venue) in
+        let boot_event = cell boot_wire boot_card in
+        boot_event :: use_list
+      in
+
+      log "after adding system events:";
+      log "  bot events: %d, mod events: %d, use events: %d"
+        (List.length bot_list) (List.length mod_list) (List.length use_list);
+
+      let all_events = List.concat [ bot_list; mod_list; use_list ] in
+      let all_events = match limit with
+        | None -> all_events
+        | Some n ->
+            log "limiting to first %d events" n;
+            take n all_events
+      in
+
+      (* Timestamp events like mars.c lines 1815-1836 *)
+      log "timestamping %d events..." (List.length all_events);
+      let now = urbit_time_now () in
+      let bit = atom (Z.shift_left Z.one 48) in  (* 2^48 = 1/2^16 seconds increment *)
+
+      let timestamped_events =
+        let rec timestamp_loop remaining current_time acc =
+          match remaining with
+          | [] -> List.rev acc
+          | event :: rest ->
+              (* Each event becomes [timestamp event] *)
+              let timestamped = cell current_time event in
+              (* Increment time by bit (2^48) *)
+              let next_time = match (current_time, bit) with
+                | (Atom t, Atom b) -> atom (Z.add t b)
+                | _ -> failwith "time must be atoms"
+              in
+              timestamp_loop rest next_time (timestamped :: acc)
+        in
+        timestamp_loop all_events now []
+      in
+
+      log "processing %d timestamped events..." (List.length timestamped_events);
+      let counter = ref 0 in
+      List.iter (fun event ->
+        incr counter;
+        if !counter mod 10 = 0 then
+          log "processed %d/%d events" !counter (List.length timestamped_events);
+        ignore (apply state event)
+      ) timestamped_events;
+      log "all events processed";
+      Ok ()