summaryrefslogtreecommitdiff
path: root/ocaml/lib
diff options
context:
space:
mode:
Diffstat (limited to 'ocaml/lib')
-rw-r--r--ocaml/lib/boot.ml367
1 files changed, 284 insertions, 83 deletions
diff --git a/ocaml/lib/boot.ml b/ocaml/lib/boot.ml
index ce30f2f..9e3f17c 100644
--- a/ocaml/lib/boot.ml
+++ b/ocaml/lib/boot.ml
@@ -249,60 +249,156 @@ let boot state eve_list =
with e ->
Error ("Boot failed: " ^ Printexc.to_string e)
-(* Parse solid pill structure: [%boot [%pill %solid [bot mod use]]]
+(* Parse solid pill structure: [%pill %solid [bot mod use]]
*
- * Following C Vere mars.c:1730 _mars_sift_pill
+ * Following actual solid pill format (not wrapped in %boot)
*)
let parse_solid_pill pil =
- (* Extract [%boot com] *)
if not (Noun.is_cell pil) then
Error "Pill must be a cell"
else
let tag = Noun.head pil in
- let com = Noun.tail pil in
-
- (* Check for %boot tag *)
- let boot_tag = Z.of_string "1953654151028" in (* "boot" *)
-
- match tag with
- | Noun.Atom z when Z.equal z boot_tag ->
- (* Now parse com structure *)
- if not (Noun.is_cell com) then
- Error "Pill com must be a cell"
+ let rest = Noun.tail pil in
+
+ (* Debug: print actual tag value *)
+ (match tag with
+ | Noun.Atom z ->
+ Printf.printf "[Debug] Tag is atom: %s (hex: %s)\n%!"
+ (Z.to_string z) (Z.format "x" z)
+ | Noun.Cell _ ->
+ Printf.printf "[Debug] Tag is cell (unexpected!)\n%!");
+
+ (* Check for %pill tag *)
+ let pill_tag = Z.of_string "1819044208" in (* "pill" = 0x6c6c6970 *)
+
+ begin match tag with
+ | Noun.Atom z when Z.equal z pill_tag ->
+ (* rest should be [%solid bot mod use], extract all 4 *)
+ if not (Noun.is_cell rest) then
+ Error "Pill rest must be a cell"
else
- (* com is [[pill typ] [bot mod use]] *)
- let fst = Noun.head com in
- let snd = Noun.tail com in
+ (* Extract using u3r_qual pattern: [a b c d] *)
+ let typ = Noun.head rest in
+ let rest1 = Noun.tail rest in
- if not (Noun.is_cell fst) then
- Error "Pill fst must be a cell"
+ Printf.printf "[Debug] typ (should be %%solid): %s\n%!"
+ (if Noun.is_atom typ then "atom" else "cell");
+ Printf.printf "[Debug] rest1 structure: %s\n%!"
+ (if Noun.is_cell rest1 then "cell" else "atom");
+
+ if not (Noun.is_cell rest1) then
+ Error "After typ, expected [bot mod use]"
else
- let pill_tag = Noun.head fst in
- let _typ = Noun.tail fst in
-
- (* Check for %pill tag *)
- let pill_atom = Z.of_string "1819633778" in (* "pill" *)
-
- match pill_tag with
- | Noun.Atom z when Z.equal z pill_atom ->
- (* Extract [bot mod use] from snd *)
- if not (Noun.is_cell snd) then
- Error "Events structure must be a cell"
- else
- let bot = Noun.head snd in
- let rest = Noun.tail snd in
-
- if not (Noun.is_cell rest) then
- Error "Mod/use structure must be a cell"
- else
- let mod_ = Noun.head rest in
- let use = Noun.tail (Noun.head (Noun.tail rest)) in
-
- Ok (bot, mod_, use)
- | _ ->
- Error "Expected %pill tag"
- | _ ->
- Error "Expected %boot tag"
+ let bot = Noun.head rest1 in
+ let rest2 = Noun.tail rest1 in
+
+ Printf.printf "[Debug] bot: %s\n%!"
+ (if Noun.is_cell bot then "cell (list)" else "atom");
+ Printf.printf "[Debug] rest2 (should be [mod use]): %s\n%!"
+ (if Noun.is_cell rest2 then "cell" else "atom");
+
+ if not (Noun.is_cell rest2) then
+ Error "After bot, expected [mod use]"
+ else
+ (* u3r_qual extracts [typ bot mod use] as:
+ * typ = head(dat)
+ * bot = head(tail(dat))
+ * mod = head(tail(tail(dat)))
+ * use = tail(tail(tail(dat))) <- NOTE: TAIL, not head!
+ *
+ * So rest2 = [mod use], where:
+ * mod = head(rest2)
+ * use = tail(rest2) <- This is just 'use', not [use cax]
+ *)
+ let mod_ = Noun.head rest2 in
+ let use_ = Noun.tail rest2 in
+
+ Printf.printf "[Debug] mod: %s\n%!"
+ (if Noun.is_cell mod_ then "cell (list)" else "atom");
+ Printf.printf "[Debug] use: %s\n%!"
+ (if Noun.is_cell use_ then "cell (list)" else "atom");
+
+ Ok (bot, mod_, use_)
+ | Noun.Atom _ ->
+ Error "Expected %pill tag"
+ | Noun.Cell _ ->
+ Error "Expected %pill tag (got cell)"
+ end
+
+(* Helper: Convert string to atom (big-endian bytes) *)
+let string_to_atom s =
+ let len = String.length s in
+ let rec loop i acc =
+ if i < 0 then acc
+ else
+ let byte = Char.code s.[i] in
+ loop (i - 1) (Z.add (Z.mul acc (Z.of_int 256)) (Z.of_int byte))
+ in
+ Noun.Atom (loop (len - 1) Z.zero)
+
+(* Synthesize the 4 MOD events - following C Vere mars.c:1763-1779 *)
+let synthesize_mod_events () =
+ (* Wire for all mod events: [%$ %arvo ~] which is [0 'arvo' 0] *)
+ let arvo_str = string_to_atom "arvo" in
+ let wir = Noun.cell (Noun.Atom Z.zero)
+ (Noun.cell arvo_str (Noun.Atom Z.zero)) in
+
+ (* 1. wack: entropy card [%wack [16 random words]] *)
+ let eny_words = Array.init 16 (fun _ ->
+ Random.int64 Int64.max_int) in
+ (* Build list of entropy words *)
+ let rec build_word_list i acc =
+ if i < 0 then acc
+ else build_word_list (i - 1)
+ (Noun.cell (Noun.Atom (Z.of_int64 eny_words.(i))) acc)
+ in
+ let eny_noun = build_word_list 15 (Noun.Atom Z.zero) in
+ let wack_tag = string_to_atom "wack" in
+ let wack_card = Noun.cell wack_tag eny_noun in
+ let wack = Noun.cell (wir) wack_card in
+
+ (* 2. whom: identity card [%whom ship] *)
+ let who = Noun.Atom Z.zero in (* ~zod = 0 *)
+ let whom_tag = string_to_atom "whom" in
+ let whom_card = Noun.cell whom_tag who in
+ let whom = Noun.cell (wir) whom_card in
+
+ (* 3. verb: verbose flag [%verb ~ 0] (0 = verbose off) *)
+ let verb_tag = string_to_atom "verb" in
+ let verb_card = Noun.cell verb_tag
+ (Noun.cell (Noun.Atom Z.zero) (Noun.Atom Z.zero)) in
+ let verb = Noun.cell (wir) verb_card in
+
+ (* 4. wyrd: version card - simplified for now *)
+ (* TODO: Implement proper version card like _mars_wyrd_card *)
+ let wyrd_tag = string_to_atom "wyrd" in
+ let wyrd_card = Noun.cell wyrd_tag (Noun.Atom Z.zero) in
+ let wyrd = Noun.cell wir wyrd_card in
+
+ (* Build list: [wack whom verb wyrd ~] *)
+ Noun.cell wack
+ (Noun.cell whom
+ (Noun.cell verb
+ (Noun.cell wyrd (Noun.Atom Z.zero))))
+
+(* Synthesize legacy boot USE event - following C Vere mars.c:1785-1789 *)
+let synthesize_boot_event () =
+ (* Wire: [%d %term '1' ~] which is ['d' 'term' 0x31 0] *)
+ let d = string_to_atom "d" in
+ let term = string_to_atom "term" in
+ let one = Noun.Atom (Z.of_int 0x31) in (* ASCII '1' *)
+ let wir = Noun.cell d
+ (Noun.cell term
+ (Noun.cell one (Noun.Atom Z.zero))) in
+
+ (* Card: [%boot lit ven] - simplified *)
+ (* lit = 0 (c3n = false), ven will be filled in properly later *)
+ let boot_tag = string_to_atom "boot" in
+ let lit = Noun.Atom Z.zero in
+ let ven = Noun.Atom Z.zero in (* Placeholder for now *)
+ let cad = Noun.cell boot_tag (Noun.cell lit ven) in
+
+ Noun.cell wir cad
(* Build event list following C Vere mars.c:1814-1836
*
@@ -391,63 +487,168 @@ let build_event_list bot mod_ use_ =
Printf.printf "[Boot] ✓ Event list built: %d events\n%!" (count_list ova);
ova
+(* Boot lite - bootstrap ivory pill
+ *
+ * Following C Vere king.c:283 u3v_boot_lite
+ * The ivory pill is [%ivory core], we extract the core
+ *)
+let boot_lite ~fs state ivory_path =
+ Printf.printf "[Lite Boot] Loading ivory pill from %s...\n%!" ivory_path;
+
+ let file_path = Eio.Path.(fs / ivory_path) in
+ let pill_bytes = Eio.Path.load file_path |> Bytes.of_string in
+
+ Printf.printf "[Lite Boot] Cuing ivory pill...\n%!";
+ let pil = Serial.cue pill_bytes in
+
+ (* Ivory pill is [%ivory core], extract the core *)
+ if not (Noun.is_cell pil) then begin
+ Printf.printf "[Lite Boot] ✗ Pill is not a cell\n%!";
+ Error "Ivory pill must be a cell"
+ end else begin
+ let _tag = Noun.head pil in
+ let core = Noun.tail pil in
+
+ Printf.printf "[Lite Boot] Extracted ivory core, setting as kernel\n%!";
+
+ (* Set the core directly as the kernel - no lifecycle formula needed *)
+ State.boot state core;
+
+ Printf.printf "[Lite Boot] ✓ Ivory kernel booted!\n\n%!";
+ Ok ()
+ end
+
(* Boot from solid pill - following C Vere -B flag logic
*
+ * CRITICAL: Must boot ivory FIRST, then solid events!
+ *
* This follows the exact flow from BOOT_FLOW.md:
- * 1. Load pill bytes from file
- * 2. Cue to get [%boot com] structure
- * 3. Parse into bot/mod/use events
- * 4. Timestamp mod/use events (bot stays bare)
- * 5. Boot with event list
+ * Phase 1: Boot ivory pill (creates minimal kernel)
+ * Phase 2: Boot solid events (metamorphosis to full kernel)
*
* Skipping disk persistence for now (steps 4-5 in C flow)
*)
-let boot_solid ~fs state pill_path =
+let boot_solid ~fs state ivory_path solid_path =
Printf.printf "\n%!";
Printf.printf "═══════════════════════════════════════════════════\n%!";
Printf.printf " Solid Pill Boot (Following C Vere -B Logic)\n%!";
Printf.printf "═══════════════════════════════════════════════════\n\n%!";
- (* Step 1: Load pill file *)
- Printf.printf "[1] Loading %s...\n%!" pill_path;
-
- let file_path = Eio.Path.(fs / pill_path) in
- let pill_bytes = Eio.Path.load file_path |> Bytes.of_string in
+ (* PHASE 1: Boot ivory pill first *)
+ Printf.printf "PHASE 1: IVORY BOOTSTRAP\n%!";
+ Printf.printf "─────────────────────────────────────────────────\n%!";
- Printf.printf " ✓ Loaded %d bytes\n\n%!" (Bytes.length pill_bytes);
+ (match boot_lite ~fs state ivory_path with
+ | Error msg -> Error ("Ivory boot failed: " ^ msg)
+ | Ok () ->
+ Printf.printf "─────────────────────────────────────────────────\n\n%!";
- (* Step 2: Cue the pill *)
- Printf.printf "[2] Cuing pill...\n%!";
- let pil = Serial.cue pill_bytes in
- Printf.printf " ✓ Cued successfully\n\n%!";
+ (* PHASE 2: Boot solid events *)
+ Printf.printf "PHASE 2: SOLID PILL BOOT\n%!";
+ Printf.printf "─────────────────────────────────────────────────\n\n%!";
- (* Step 3: Parse pill structure *)
- Printf.printf "[3] Parsing pill structure...\n%!";
- match parse_solid_pill pil with
- | Error msg ->
- Printf.printf " ✗ Parse failed: %s\n%!" msg;
- Error msg
+ (* Step 1: Load pill file *)
+ Printf.printf "[1] Loading %s...\n%!" solid_path;
- | Ok (bot, mod_, use_) ->
- Printf.printf " ✓ Extracted bot/mod/use events\n\n%!";
+ let file_path = Eio.Path.(fs / solid_path) in
+ let pill_bytes = Eio.Path.load file_path |> Bytes.of_string in
- (* Step 4: Build event list (C Vere style) *)
- Printf.printf "[4] Building event list (C Vere style)...\n%!";
- let ova = build_event_list bot mod_ use_ in
- Printf.printf "\n%!";
+ Printf.printf " ✓ Loaded %d bytes\n\n%!" (Bytes.length pill_bytes);
- (* Step 5: Boot with event list *)
- Printf.printf "[5] Calling u3v_boot with event list...\n%!";
- Printf.printf " (Booting Arvo kernel from events)\n\n%!";
+ (* Step 2: Cue the pill *)
+ Printf.printf "[2] Cuing pill...\n%!";
+ let pil = Serial.cue pill_bytes in
+ Printf.printf " ✓ Cued successfully\n\n%!";
- match boot state ova with
+ (* Step 3: Parse pill structure *)
+ Printf.printf "[3] Parsing pill structure...\n%!";
+ match parse_solid_pill pil with
| Error msg ->
- Printf.printf " ✗ BOOT FAILED: %s\n%!" msg;
+ Printf.printf " ✗ Parse failed: %s\n%!" msg;
Error msg
- | Ok () ->
- Printf.printf " ✓ BOOT SUCCEEDED!\n%!";
+
+ | Ok (bot, mod_, use_) ->
+ Printf.printf " ✓ Extracted bot/mod/use events\n%!";
+
+ (* Count helper *)
+ let rec count_list noun =
+ match noun with
+ | Noun.Atom z when Z.equal z Z.zero -> 0
+ | Noun.Cell (_, rest) -> 1 + count_list rest
+ | _ -> 0
+ in
+
+ (* Debug: check structure of each *)
+ Printf.printf " Bot structure: %s (count=%d)\n%!"
+ (if Noun.is_cell bot then "cell (list)" else "atom")
+ (count_list bot);
+ Printf.printf " Mod structure: %s (count=%d)\n%!"
+ (if Noun.is_cell mod_ then "cell (list)" else "atom")
+ (count_list mod_);
+ Printf.printf " Use structure: %s (count=%d)\n%!"
+ (if Noun.is_cell use_ then "cell (list)" else "atom")
+ (count_list use_);
+
+ (* Debug: walk through USE list and show structure *)
+ Printf.printf " USE list details:\n%!";
+ let rec walk_list noun i =
+ match noun with
+ | Noun.Atom z when Z.equal z Z.zero ->
+ Printf.printf " [%d] = ~ (list terminator)\n%!" i
+ | Noun.Cell (head, tail) ->
+ Printf.printf " [%d] = %s\n%!" i
+ (if Noun.is_cell head then "CELL" else "ATOM");
+ if i < 5 then walk_list tail (i + 1)
+ | Noun.Atom _ ->
+ Printf.printf " [%d] = ATOM (improper list!)\n%!" i
+ in
+ walk_list use_ 0;
+ Printf.printf "\n%!";
+
+ (* Step 3.5: Synthesize events (C Vere mars.c:1763-1789) *)
+ Printf.printf "[3.5] Synthesizing events (like C Vere)...\n%!";
+
+ (* Generate 4 synthetic MOD events *)
+ let synth_mod = synthesize_mod_events () in
+ Printf.printf " ✓ Generated 4 synthetic MOD events\n%!";
+
+ (* Generate 1 synthetic USE event *)
+ let synth_use = synthesize_boot_event () in
+ Printf.printf " ✓ Generated 1 synthetic USE event\n%!";
+
+ (* Prepend synthetic events *)
+ (* Helper to prepend to a list *)
+ let rec weld l1 l2 =
+ match l1 with
+ | Noun.Atom z when Z.equal z Z.zero -> l2
+ | Noun.Cell (h, t) -> Noun.Cell (h, weld t l2)
+ | _ -> l2
+ in
+
+ let mod_ = weld synth_mod mod_ in (* 4 synthetic + 0 from pill *)
+ let use_ = Noun.cell synth_use use_ in (* 1 synthetic + 2 from pill *)
+
+ Printf.printf " ✓ Prepended synthetic events\n%!";
+ Printf.printf " After synthesis: mod=%d, use=%d\n\n%!"
+ (count_list mod_) (count_list use_);
+
+ (* Step 4: Build event list (C Vere style) *)
+ Printf.printf "[4] Building event list (C Vere style)...\n%!";
+ let ova = build_event_list bot mod_ use_ in
Printf.printf "\n%!";
- Printf.printf "═══════════════════════════════════════════════════\n%!";
- Printf.printf " ✓ SOLID PILL BOOT COMPLETE!\n%!";
- Printf.printf "═══════════════════════════════════════════════════\n\n%!";
- Ok ()
+
+ (* Step 5: Boot with event list *)
+ Printf.printf "[5] Calling u3v_boot with event list...\n%!";
+ Printf.printf " (Metamorphosis: replacing ivory kernel)\n\n%!";
+
+ match boot state ova with
+ | Error msg ->
+ Printf.printf " ✗ BOOT FAILED: %s\n%!" msg;
+ Error msg
+ | Ok () ->
+ Printf.printf " ✓ BOOT SUCCEEDED!\n%!";
+ Printf.printf "\n%!";
+ Printf.printf "═══════════════════════════════════════════════════\n%!";
+ Printf.printf " ✓ SOLID PILL BOOT COMPLETE!\n%!";
+ Printf.printf "═══════════════════════════════════════════════════\n\n%!";
+ Ok ())
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-16 23:41:03 +0000