diff options
author | polwex <polwex@sortug.com> | 2025-10-07 03:47:46 +0700 |
---|---|---|
committer | polwex <polwex@sortug.com> | 2025-10-07 03:47:46 +0700 |
commit | a93db7a168a30d1bace8f7a95ac1c6206125a212 (patch) | |
tree | 79aa9c23eb375fc63490beef3ca3b072a5f6e8af | |
parent | a3170453e08079369da031377c45600ee22ab53a (diff) |
playing with multicore
-rw-r--r-- | ocaml/test/dune | 48 | ||||
-rw-r--r-- | ocaml/test/test_ivory_parallel_d.ml | 114 | ||||
-rw-r--r-- | ocaml/test/test_parallel_workload.ml | 92 | ||||
-rw-r--r-- | ocaml/test/test_solid_massive.ml | 124 | ||||
-rw-r--r-- | ocaml/test/test_solid_parallel.ml | 173 | ||||
-rw-r--r-- | ocaml/test/test_solid_parallel_d.ml | 164 | ||||
-rw-r--r-- | ocaml/test/test_solid_parallel_eio.ml | 152 | ||||
-rw-r--r-- | ocaml/test/test_solid_sequential.ml | 142 | ||||
-rw-r--r-- | ocaml/test/testmulticore.ml | 27 |
9 files changed, 1036 insertions, 0 deletions
diff --git a/ocaml/test/dune b/ocaml/test/dune index 19d53f8..bbc607f 100644 --- a/ocaml/test/dune +++ b/ocaml/test/dune @@ -271,6 +271,7 @@ (name test_two_stage_boot) (modules test_two_stage_boot) (libraries nock_lib eio_main unix)) + ; NOTE: Run with increased stack size for solid pill: ; OCAMLRUNPARAM='l=100M' dune exec test/test_two_stage_boot.exe @@ -278,12 +279,14 @@ (name test_nock_iter) (modules test_nock_iter) (libraries nock_lib eio_main unix)) + ; NOTE: This uses the iterative Nock interpreter - no stack limit needed! (executable (name bench_nock_versions) (modules bench_nock_versions) (libraries nock_lib eio_main unix)) + ; Compare all three Nock implementations (executable @@ -336,6 +339,51 @@ (modules test_ivory_parallel) (libraries nock_lib unix)) +(executable + (name test_ivory_parallel_d) + (modules test_ivory_parallel_d) + (libraries nock_lib unix domainslib)) + +(executable + (name test_solid_parallel) + (modules test_solid_parallel) + (libraries nock_lib unix)) + +(executable + (name test_solid_parallel_eio) + (modules test_solid_parallel_eio) + (libraries nock_lib eio_main unix)) + +(executable + (name test_solid_sequential) + (modules test_solid_sequential) + (libraries nock_lib unix)) + +(executable + (name test_solid_parallel_d) + (modules test_solid_parallel_d) + (libraries nock_lib unix domainslib)) + +(executable + (name testmulticore) + (modules testmulticore) + (libraries nock_lib unix domainslib)) + +(executable + (name test_parallel_workload) + (modules test_parallel_workload) + (libraries nock_lib unix domainslib)) + +(executable + (name test_solid_massive) + (modules test_solid_massive) + (libraries nock_lib unix domainslib)) + +; (executable +; (name domainslib) +; (modules domainslib) +; (libraries nock_lib domainslib)) + ; (executable ; (name test_life_formula) ; (modules test_life_formula) diff --git a/ocaml/test/test_ivory_parallel_d.ml b/ocaml/test/test_ivory_parallel_d.ml new file mode 100644 index 0000000..6388b38 --- /dev/null +++ b/ocaml/test/test_ivory_parallel_d.ml @@ -0,0 +1,114 @@ +(** Test ivory pill lifecycle with all three Nock implementations using Domainslib **) + +open Nock_lib + +module T = Domainslib.Task + +let time_it name f = + Printf.printf " [%s] Starting...\n%!" name; + let start = Unix.gettimeofday () in + let result = f () in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✓ Complete in %.4fs\n%!" name elapsed; + (name, elapsed, result) + +let main () = + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Parallel Ivory Pill Test (Domainslib) ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"; + + Printf.printf "[1] Loading ivory.pill...\n"; + let ic = open_in_bin "ivory.pill" in + let len = in_channel_length ic in + let bytes = Bytes.create len in + really_input ic bytes 0 len; + close_in ic; + Printf.printf " Size: %d bytes\n" len; + + Printf.printf "[2] Cuing ivory pill...\n"; + let pill = Serial.cue bytes in + Printf.printf " ✓ Cued\n"; + + match pill with + | Noun.Cell { h = _tag; t = core; _ } -> + Printf.printf "[3] Building lifecycle formula...\n"; + let formula = Noun.cell + (Noun.atom 2) + (Noun.cell + (Noun.cell (Noun.atom 0) (Noun.atom 3)) + (Noun.cell (Noun.atom 0) (Noun.atom 2))) in + Printf.printf " Formula: [2 [0 3] [0 2]]\n"; + + Printf.printf "\n[4] Setting up Domainslib pool with 3 domains...\n"; + let num_domains = 3 in + let pool = T.setup_pool ~num_domains:(num_domains - 1) () in + + Printf.printf "\n[5] Running lifecycle with all three implementations:\n\n"; + + (* Run in T.run context for effect handlers *) + let (name1, time1, result1), (name2, time2, result2), (name3, time3, result3) = + T.run pool (fun () -> + (* Launch all three as async tasks *) + let task1 = T.async pool (fun () -> + time_it "nock.ml" (fun () -> Nock.nock_on core formula)) in + + let task2 = T.async pool (fun () -> + time_it "nock_iter.ml" (fun () -> Nock_iter.nock_on core formula)) in + + let task3 = T.async pool (fun () -> + time_it "nock_tail.ml" (fun () -> Nock_tail.nock_on core formula)) in + + (* Await all results *) + Printf.printf "\n[6] Waiting for results...\n"; + let r1 = T.await pool task1 in + let r2 = T.await pool task2 in + let r3 = T.await pool task3 in + (r1, r2, r3) + ) + in + + T.teardown_pool pool; + + Printf.printf "\n[7] Computing mugs...\n%!"; + Printf.printf " Computing mug for %s...%!" name1; + let mug1 = Noun.mug result1 in + Printf.printf " 0x%08lx\n%!" mug1; + + Printf.printf " Computing mug for %s...%!" name2; + let mug2 = Noun.mug result2 in + Printf.printf " 0x%08lx\n%!" mug2; + + Printf.printf " Computing mug for %s...%!" name3; + let mug3 = Noun.mug result3 in + Printf.printf " 0x%08lx\n%!" mug3; + + Printf.printf "\n[8] Results:\n"; + Printf.printf " %s: 0x%08lx (%.4fs)\n" name1 mug1 time1; + Printf.printf " %s: 0x%08lx (%.4fs)\n" name2 mug2 time2; + Printf.printf " %s: 0x%08lx (%.4fs)\n" name3 mug3 time3; + + Printf.printf "\n[9] Verification:\n"; + if mug1 = mug2 && mug2 = mug3 then + Printf.printf " ✓ All three mugs match - kernels are identical!\n" + else begin + Printf.printf " ✗ MISMATCH!\n"; + if mug1 <> mug2 then + Printf.printf " nock.ml ≠ nock_iter.ml\n"; + if mug2 <> mug3 then + Printf.printf " nock_iter.ml ≠ nock_tail.ml\n"; + if mug1 <> mug3 then + Printf.printf " nock.ml ≠ nock_tail.ml\n" + end; + + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Summary: ║\n"; + Printf.printf "║ Fastest: %-44s║\n" + (if time1 < time2 && time1 < time3 then name1 + else if time2 < time3 then name2 + else name3); + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n" + + | _ -> + Printf.printf " ✗ Unexpected pill structure\n" + +let _ = main () diff --git a/ocaml/test/test_parallel_workload.ml b/ocaml/test/test_parallel_workload.ml new file mode 100644 index 0000000..d4261aa --- /dev/null +++ b/ocaml/test/test_parallel_workload.ml @@ -0,0 +1,92 @@ +(** Massively parallel Nock workload to test multicore - 32 cores edition! **) + +open Nock_lib + +module T = Domainslib.Task + +let () = + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Massively Parallel Nock Workload (32 cores!) ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"; + + Printf.printf "[1] Loading ivory.pill...\n"; + let ic = open_in_bin "ivory.pill" in + let len = in_channel_length ic in + let bytes = Bytes.create len in + really_input ic bytes 0 len; + close_in ic; + Printf.printf " Size: %d bytes\n" len; + + Printf.printf "[2] Cuing ivory pill...\n"; + let pill = Serial.cue bytes in + Printf.printf " ✓ Cued\n"; + + match pill with + | Noun.Cell { h = _tag; t = core; _ } -> + Printf.printf "[3] Building lifecycle formula...\n"; + let formula = Noun.cell + (Noun.atom 2) + (Noun.cell + (Noun.cell (Noun.atom 0) (Noun.atom 3)) + (Noun.cell (Noun.atom 0) (Noun.atom 2))) in + Printf.printf " Formula: [2 [0 3] [0 2]]\n"; + + let num_iterations = 1000 in (* Run lifecycle 1000 times *) + let num_workers = 32 in (* Use all 32 cores *) + + Printf.printf "\n[4] Setting up Domainslib pool with %d domains...\n" num_workers; + let pool = T.setup_pool ~num_domains:(num_workers - 1) () in + + Printf.printf "[5] Launching %d parallel tasks (each runs lifecycle %d times)...\n\n" + num_workers num_iterations; + + let start_time = Unix.gettimeofday () in + + let results = T.run pool (fun () -> + (* Create tasks list *) + let tasks = List.init num_workers (fun worker_id -> + T.async pool (fun () -> + Printf.printf " [Worker %2d] Starting on domain %d...\n%!" + worker_id (Domain.self () :> int); + + let worker_start = Unix.gettimeofday () in + + (* Each worker runs lifecycle many times *) + for _i = 1 to num_iterations do + ignore (Nock.nock_on core formula) + done; + + let worker_elapsed = Unix.gettimeofday () -. worker_start in + Printf.printf " [Worker %2d] ✓ Completed %d iterations in %.2fs (domain %d)\n%!" + worker_id num_iterations worker_elapsed (Domain.self () :> int); + + (worker_id, worker_elapsed) + ) + ) in + + (* Await all results *) + Printf.printf "\n[6] Waiting for all workers to complete...\n%!"; + List.map (T.await pool) tasks + ) in + + let total_elapsed = Unix.gettimeofday () -. start_time in + + T.teardown_pool pool; + + Printf.printf "\n[7] Results:\n"; + Printf.printf " Total work: %d lifecycles\n" (num_workers * num_iterations); + Printf.printf " Wall time: %.2fs\n" total_elapsed; + Printf.printf " Workers: %d\n" num_workers; + + let total_worker_time = List.fold_left (fun acc (_, t) -> acc +. t) 0.0 results in + Printf.printf " Total CPU time: %.2fs\n" total_worker_time; + Printf.printf " Speedup: %.2fx\n" (total_worker_time /. total_elapsed); + Printf.printf " Parallel efficiency: %.1f%%\n" + (100.0 *. total_worker_time /. (total_elapsed *. float_of_int num_workers)); + + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ All 32 cores SMASHED! 💪 ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n" + + | _ -> + Printf.printf " ✗ Unexpected pill structure\n" diff --git a/ocaml/test/test_solid_massive.ml b/ocaml/test/test_solid_massive.ml new file mode 100644 index 0000000..0d16978 --- /dev/null +++ b/ocaml/test/test_solid_massive.ml @@ -0,0 +1,124 @@ +(** Massive parallel solid pill workload - run lifecycle many times across 32 cores **) + +open Nock_lib + +module T = Domainslib.Task + +let () = + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Massive Parallel Solid Pill Workload (32 cores!) ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"; + + Printf.printf "[1] Loading solid.pill...\n"; + let ic = open_in_bin "solid.pill" in + let len = in_channel_length ic in + let bytes = Bytes.create len in + really_input ic bytes 0 len; + close_in ic; + Printf.printf " Size: %d bytes (%.1f MB)\n" len (float_of_int len /. 1024.0 /. 1024.0); + + Printf.printf "[2] Cuing solid pill...\n"; + let start_time = Unix.gettimeofday () in + let pill = Serial.cue bytes in + let elapsed = Unix.gettimeofday () -. start_time in + Printf.printf " ✓ Cued in %.2fs\n" elapsed; + + Printf.printf "[3] Parsing pill structure...\n"; + + match pill with + | Noun.Cell { h = _tag; t = rest; _ } -> + (match rest with + | Noun.Cell { h = _ptype; t = events_triple; _ } -> + (match events_triple with + | Noun.Cell { h = bot; t = rest2; _ } -> + (match rest2 with + | Noun.Cell { h = _mod; t = rest3; _ } -> + (match rest3 with + | Noun.Cell { h = use; t = _; _ } -> + let rec to_list acc n = + match n with + | Noun.Atom _ -> List.rev acc + | Noun.Cell { h; t; _ } -> to_list (h :: acc) t + in + let bot_list = to_list [] bot in + let use_list = to_list [] use in + let all_events = bot_list @ use_list in + + Printf.printf " Bot events: %d\n" (List.length bot_list); + Printf.printf " Use events: %d\n" (List.length use_list); + Printf.printf " Total: %d events\n" (List.length all_events); + + let rec from_list = function + | [] -> Noun.atom 0 + | h :: t -> Noun.cell h (from_list t) + in + let event_list = from_list all_events in + + Printf.printf "\n[4] Building lifecycle formula...\n"; + let formula = Noun.cell + (Noun.atom 2) + (Noun.cell + (Noun.cell (Noun.atom 0) (Noun.atom 3)) + (Noun.cell (Noun.atom 0) (Noun.atom 2))) in + Printf.printf " Formula: [2 [0 3] [0 2]]\n"; + + let num_iterations = 10 in (* Run lifecycle 10 times per worker *) + let num_workers = 32 in (* Use all 32 cores *) + + Printf.printf "\n[5] Setting up Domainslib pool with %d domains...\n" num_workers; + let pool = T.setup_pool ~num_domains:(num_workers - 1) () in + + Printf.printf "[6] Launching %d parallel tasks (each runs lifecycle %d times)...\n\n" + num_workers num_iterations; + + let start_time = Unix.gettimeofday () in + + let results = T.run pool (fun () -> + let tasks = List.init num_workers (fun worker_id -> + T.async pool (fun () -> + Printf.printf " [Worker %2d] Starting on domain %d with nock_iter...\n%!" + worker_id (Domain.self () :> int); + + let worker_start = Unix.gettimeofday () in + + (* Use nock_iter since it won't stack overflow *) + for _i = 1 to num_iterations do + ignore (Nock_iter.nock_on event_list formula) + done; + + let worker_elapsed = Unix.gettimeofday () -. worker_start in + Printf.printf " [Worker %2d] ✓ Completed %d lifecycles in %.2fs (domain %d)\n%!" + worker_id num_iterations worker_elapsed (Domain.self () :> int); + + (worker_id, worker_elapsed) + ) + ) in + + Printf.printf "\n[7] Waiting for all workers to complete...\n%!"; + List.map (T.await pool) tasks + ) in + + let total_elapsed = Unix.gettimeofday () -. start_time in + + T.teardown_pool pool; + + Printf.printf "\n[8] Results:\n"; + Printf.printf " Total lifecycles: %d\n" (num_workers * num_iterations); + Printf.printf " Wall time: %.2fs\n" total_elapsed; + Printf.printf " Workers: %d\n" num_workers; + + let total_worker_time = List.fold_left (fun acc (_, t) -> acc +. t) 0.0 results in + Printf.printf " Total CPU time: %.2fs\n" total_worker_time; + Printf.printf " Speedup: %.2fx\n" (total_worker_time /. total_elapsed); + Printf.printf " Parallel efficiency: %.1f%%\n" + (100.0 *. total_worker_time /. (total_elapsed *. float_of_int num_workers)); + + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ 32 cores crushing solid pill! 🔥 ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n" + + | _ -> Printf.printf " ✗ Unexpected structure\n") + | _ -> Printf.printf " ✗ Unexpected structure\n") + | _ -> Printf.printf " ✗ Unexpected structure\n") + | _ -> Printf.printf " ✗ Unexpected structure\n") + | _ -> Printf.printf " ✗ Unexpected pill structure\n" diff --git a/ocaml/test/test_solid_parallel.ml b/ocaml/test/test_solid_parallel.ml new file mode 100644 index 0000000..845921e --- /dev/null +++ b/ocaml/test/test_solid_parallel.ml @@ -0,0 +1,173 @@ +(** Test solid pill lifecycle with all three Nock implementations in parallel **) + +open Nock_lib + +let time_it name f = + Printf.printf " [%s] Starting on domain %d...\n%!" name (Domain.self () :> int); + let start = Unix.gettimeofday () in + try + let result = f () in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✓ Complete in %.4fs\n%!" name elapsed; + Ok (name, elapsed, result) + with + | Stack_overflow -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✗ Stack overflow after %.4fs\n%!" name elapsed; + Error (name, "Stack overflow") + | e -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✗ Error: %s (after %.4fs)\n%!" name (Printexc.to_string e) elapsed; + Error (name, Printexc.to_string e) + +let () = + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Parallel Solid Pill Lifecycle Test ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"; + + Printf.printf "[0] System info:\n"; + Printf.printf " CPU cores available: %d\n" (Domain.recommended_domain_count ()); + Printf.printf " Main domain ID: %d\n\n" (Domain.self () :> int); + + Printf.printf "[1] Loading solid.pill...\n"; + let ic = open_in_bin "solid.pill" in + let len = in_channel_length ic in + let bytes = Bytes.create len in + really_input ic bytes 0 len; + close_in ic; + Printf.printf " Size: %d bytes (%.1f MB)\n" len (float_of_int len /. 1024.0 /. 1024.0); + + Printf.printf "[2] Cuing solid pill...\n"; + let start = Unix.gettimeofday () in + let pill = Serial.cue bytes in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " ✓ Cued in %.2fs\n" elapsed; + + Printf.printf "[3] Parsing pill structure...\n"; + + (* Parse: [tag type [bot mod use]] *) + match pill with + | Noun.Cell { h = _tag; t = rest; _ } -> + (match rest with + | Noun.Cell { h = _ptype; t = events_triple; _ } -> + (match events_triple with + | Noun.Cell { h = bot; t = rest2; _ } -> + (match rest2 with + | Noun.Cell { h = _mod; t = rest3; _ } -> + (match rest3 with + | Noun.Cell { h = use; t = _; _ } -> + (* Concatenate bot and use *) + let rec to_list acc n = + match n with + | Noun.Atom _ -> List.rev acc + | Noun.Cell { h; t; _ } -> to_list (h :: acc) t + in + let bot_list = to_list [] bot in + let use_list = to_list [] use in + let all_events = bot_list @ use_list in + + Printf.printf " Bot events: %d\n" (List.length bot_list); + Printf.printf " Use events: %d\n" (List.length use_list); + Printf.printf " Total: %d events\n" (List.length all_events); + + (* Convert to proper Nock list format *) + let rec from_list = function + | [] -> Noun.atom 0 + | h :: t -> Noun.cell h (from_list t) + in + let event_list = from_list all_events in + + Printf.printf "\n[4] Building lifecycle formula...\n"; + let formula = Noun.cell + (Noun.atom 2) + (Noun.cell + (Noun.cell (Noun.atom 0) (Noun.atom 3)) + (Noun.cell (Noun.atom 0) (Noun.atom 2))) in + Printf.printf " Formula: [2 [0 3] [0 2]]\n"; + + Printf.printf "\n[5] Running lifecycle with all three implementations:\n\n"; + + (* Spawn domains for parallel execution *) + let domain1 = Domain.spawn (fun () -> + time_it "nock.ml" (fun () -> + Nock.nock_on event_list formula) + ) in + + let domain2 = Domain.spawn (fun () -> + time_it "nock_iter.ml" (fun () -> + Nock_iter.nock_on event_list formula) + ) in + + let domain3 = Domain.spawn (fun () -> + time_it "nock_tail.ml" (fun () -> + Nock_tail.nock_on event_list formula) + ) in + + (* Wait for all to complete *) + Printf.printf "\n[6] Joining domains...\n%!"; + let res1 = Domain.join domain1 in + let res2 = Domain.join domain2 in + let res3 = Domain.join domain3 in + + Printf.printf "\n[7] Results:\n"; + + let successes = ref [] in + let failures = ref [] in + + (match res1 with + | Ok (name, time, result) -> + let mug = Noun.mug result in + Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time; + successes := (name, mug, time) :: !successes + | Error (name, err) -> + Printf.printf " %s: %s ✗\n" name err; + failures := (name, err) :: !failures); + + (match res2 with + | Ok (name, time, result) -> + let mug = Noun.mug result in + Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time; + successes := (name, mug, time) :: !successes + | Error (name, err) -> + Printf.printf " %s: %s ✗\n" name err; + failures := (name, err) :: !failures); + + (match res3 with + | Ok (name, time, result) -> + let mug = Noun.mug result in + Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time; + successes := (name, mug, time) :: !successes + | Error (name, err) -> + Printf.printf " %s: %s ✗\n" name err; + failures := (name, err) :: !failures); + + Printf.printf "\n[8] Verification:\n"; + Printf.printf " Successes: %d\n" (List.length !successes); + Printf.printf " Failures: %d\n" (List.length !failures); + + if List.length !successes >= 2 then begin + let mugs = List.map (fun (_, mug, _) -> mug) !successes in + let all_same = List.for_all (fun m -> m = List.hd mugs) mugs in + if all_same then + Printf.printf " ✓ All successful implementations produce identical kernels!\n" + else + Printf.printf " ✗ Mug mismatch between successful implementations!\n" + end; + + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Summary: ║\n"; + if List.length !successes > 0 then begin + let fastest = List.fold_left + (fun (acc_name, acc_time) (name, _, time) -> + if time < acc_time then (name, time) else (acc_name, acc_time)) + ("", max_float) + !successes in + Printf.printf "║ Fastest (of successful): %-28s║\n" (fst fastest); + end; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n" + + | _ -> Printf.printf " ✗ Unexpected structure at use level\n") + | _ -> Printf.printf " ✗ Unexpected structure at mod level\n") + | _ -> Printf.printf " ✗ Unexpected structure at bot level\n") + | _ -> Printf.printf " ✗ Unexpected structure at events level\n") + | _ -> Printf.printf " ✗ Unexpected pill structure\n" diff --git a/ocaml/test/test_solid_parallel_d.ml b/ocaml/test/test_solid_parallel_d.ml new file mode 100644 index 0000000..e43dcd7 --- /dev/null +++ b/ocaml/test/test_solid_parallel_d.ml @@ -0,0 +1,164 @@ +(** Test solid pill lifecycle with all three Nock implementations using Domainslib **) + +open Nock_lib + +module T = Domainslib.Task + +let time_it name f = + Printf.printf " [%s] Starting on domain %d...\n%!" name (Domain.self () :> int); + let start = Unix.gettimeofday () in + try + let result = f () in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✓ Complete in %.4fs (domain %d)\n%!" name elapsed (Domain.self () :> int); + Ok (name, elapsed, result) + with + | Stack_overflow -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✗ Stack overflow after %.4fs (domain %d)\n%!" name elapsed (Domain.self () :> int); + Error (name, "Stack overflow") + | e -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✗ Error: %s (after %.4fs, domain %d)\n%!" name (Printexc.to_string e) elapsed (Domain.self () :> int); + Error (name, Printexc.to_string e) + +let main () = + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Parallel Solid Pill Test (Domainslib) ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"; + + Printf.printf "[1] Loading solid.pill...\n"; + let ic = open_in_bin "solid.pill" in + let len = in_channel_length ic in + let bytes = Bytes.create len in + really_input ic bytes 0 len; + close_in ic; + Printf.printf " Size: %d bytes (%.1f MB)\n" len (float_of_int len /. 1024.0 /. 1024.0); + + Printf.printf "[2] Cuing solid pill...\n"; + let start_time = Unix.gettimeofday () in + let pill = Serial.cue bytes in + let elapsed = Unix.gettimeofday () -. start_time in + Printf.printf " ✓ Cued in %.2fs\n" elapsed; + + Printf.printf "[3] Parsing pill structure...\n"; + + (* Parse: [tag type [bot mod use]] *) + match pill with + | Noun.Cell { h = _tag; t = rest; _ } -> + (match rest with + | Noun.Cell { h = _ptype; t = events_triple; _ } -> + (match events_triple with + | Noun.Cell { h = bot; t = rest2; _ } -> + (match rest2 with + | Noun.Cell { h = _mod; t = rest3; _ } -> + (match rest3 with + | Noun.Cell { h = use; t = _; _ } -> + (* Concatenate bot and use *) + let rec to_list acc n = + match n with + | Noun.Atom _ -> List.rev acc + | Noun.Cell { h; t; _ } -> to_list (h :: acc) t + in + let bot_list = to_list [] bot in + let use_list = to_list [] use in + let all_events = bot_list @ use_list in + + Printf.printf " Bot events: %d\n" (List.length bot_list); + Printf.printf " Use events: %d\n" (List.length use_list); + Printf.printf " Total: %d events\n" (List.length all_events); + + (* Convert to proper Nock list format *) + let rec from_list = function + | [] -> Noun.atom 0 + | h :: t -> Noun.cell h (from_list t) + in + let event_list = from_list all_events in + + Printf.printf "\n[4] Building lifecycle formula...\n"; + let formula = Noun.cell + (Noun.atom 2) + (Noun.cell + (Noun.cell (Noun.atom 0) (Noun.atom 3)) + (Noun.cell (Noun.atom 0) (Noun.atom 2))) in + Printf.printf " Formula: [2 [0 3] [0 2]]\n"; + + Printf.printf "\n[5] Setting up Domainslib pool with 3 domains...\n"; + let num_domains = 18 in + let pool = T.setup_pool ~num_domains:(num_domains - 1) () in + + Printf.printf "\n[6] Running lifecycle with all three implementations:\n\n"; + + (* Run in T.run context for effect handlers *) + let res1, res2, res3 = + T.run pool (fun () -> + (* Launch all three as async tasks *) + let task1 = T.async pool (fun () -> + time_it "nock.ml" (fun () -> Nock.nock_on event_list formula)) in + + let task2 = T.async pool (fun () -> + time_it "nock_iter.ml" (fun () -> Nock_iter.nock_on event_list formula)) in + + let task3 = T.async pool (fun () -> + time_it "nock_tail.ml" (fun () -> Nock_tail.nock_on event_list formula)) in + + (* Await all results *) + Printf.printf "\n[7] Waiting for results...\n%!"; + let r1 = T.await pool task1 in + let r2 = T.await pool task2 in + let r3 = T.await pool task3 in + (r1, r2, r3) + ) + in + + T.teardown_pool pool; + + Printf.printf "\n[8] Results:\n"; + + let successes = ref [] in + let failures = ref [] in + + List.iter (fun res -> + match res with + | Ok (name, time, result) -> + let mug = Noun.mug result in + Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time; + successes := (name, mug, time) :: !successes + | Error (name, err) -> + Printf.printf " %s: %s ✗\n" name err; + failures := (name, err) :: !failures + ) [res1; res2; res3]; + + Printf.printf "\n[9] Verification:\n"; + Printf.printf " Successes: %d\n" (List.length !successes); + Printf.printf " Failures: %d\n" (List.length !failures); + + if List.length !successes >= 2 then begin + let mugs = List.map (fun (_, mug, _) -> mug) !successes in + let all_same = List.for_all (fun m -> m = List.hd mugs) mugs in + if all_same then + Printf.printf " ✓ All successful implementations produce identical kernels!\n" + else + Printf.printf " ✗ Mug mismatch between successful implementations!\n" + end; + + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Summary: ║\n"; + if List.length !successes > 0 then begin + let fastest = List.fold_left + (fun (acc_name, acc_time) (name, _, time) -> + if time < acc_time then (name, time) else (acc_name, acc_time)) + ("", max_float) + !successes in + Printf.printf "║ Fastest (of successful): %-28s║\n" (fst fastest); + Printf.printf "║ Time: %.2fs ║\n" (snd fastest); + end; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n" + + | _ -> Printf.printf " ✗ Unexpected structure at use level\n") + | _ -> Printf.printf " ✗ Unexpected structure at mod level\n") + | _ -> Printf.printf " ✗ Unexpected structure at bot level\n") + | _ -> Printf.printf " ✗ Unexpected structure at events level\n") + | _ -> Printf.printf " ✗ Unexpected pill structure\n" + +let _ = main () diff --git a/ocaml/test/test_solid_parallel_eio.ml b/ocaml/test/test_solid_parallel_eio.ml new file mode 100644 index 0000000..cee139b --- /dev/null +++ b/ocaml/test/test_solid_parallel_eio.ml @@ -0,0 +1,152 @@ +(** Test solid pill lifecycle with all three Nock implementations in parallel using Eio Domain_manager **) + +open Nock_lib + +let time_it name f = + Printf.printf " [%s] Starting...\n%!" name; + let start = Unix.gettimeofday () in + try + let result = f () in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✓ Complete in %.4fs\n%!" name elapsed; + Ok (name, elapsed, result) + with + | Stack_overflow -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✗ Stack overflow after %.4fs\n%!" name elapsed; + Error (name, "Stack overflow") + | e -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " [%s] ✗ Error: %s (after %.4fs)\n%!" name (Printexc.to_string e) elapsed; + Error (name, Printexc.to_string e) + +let () = + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Parallel Solid Pill (Eio Domain_manager) ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"; + + Eio_main.run (fun env -> + let domain_mgr = Eio.Stdenv.domain_mgr env in + + Printf.printf "[1] Loading solid.pill...\n"; + let ic = open_in_bin "solid.pill" in + let len = in_channel_length ic in + let bytes = Bytes.create len in + really_input ic bytes 0 len; + close_in ic; + Printf.printf " Size: %d bytes (%.1f MB)\n" len (float_of_int len /. 1024.0 /. 1024.0); + + Printf.printf "[2] Cuing solid pill...\n"; + let start = Unix.gettimeofday () in + let pill = Serial.cue bytes in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " ✓ Cued in %.2fs\n" elapsed; + + Printf.printf "[3] Parsing pill structure...\n"; + + (* Parse: [tag type [bot mod use]] *) + match pill with + | Noun.Cell { h = _tag; t = rest; _ } -> + (match rest with + | Noun.Cell { h = _ptype; t = events_triple; _ } -> + (match events_triple with + | Noun.Cell { h = bot; t = rest2; _ } -> + (match rest2 with + | Noun.Cell { h = _mod; t = rest3; _ } -> + (match rest3 with + | Noun.Cell { h = use; t = _; _ } -> + (* Concatenate bot and use *) + let rec to_list acc n = + match n with + | Noun.Atom _ -> List.rev acc + | Noun.Cell { h; t; _ } -> to_list (h :: acc) t + in + let bot_list = to_list [] bot in + let use_list = to_list [] use in + let all_events = bot_list @ use_list in + + Printf.printf " Bot events: %d\n" (List.length bot_list); + Printf.printf " Use events: %d\n" (List.length use_list); + Printf.printf " Total: %d events\n" (List.length all_events); + + (* Convert to proper Nock list format *) + let rec from_list = function + | [] -> Noun.atom 0 + | h :: t -> Noun.cell h (from_list t) + in + let event_list = from_list all_events in + + Printf.printf "\n[4] Building lifecycle formula...\n"; + let formula = Noun.cell + (Noun.atom 2) + (Noun.cell + (Noun.cell (Noun.atom 0) (Noun.atom 3)) + (Noun.cell (Noun.atom 0) (Noun.atom 2))) in + Printf.printf " Formula: [2 [0 3] [0 2]]\n"; + + Printf.printf "\n[5] Running lifecycle with Domain_manager (true multicore):\n\n"; + + (* Create closures that capture event_list and formula *) + let task1 () = time_it "nock.ml" (fun () -> + Nock.nock_on event_list formula) in + let task2 () = time_it "nock_iter.ml" (fun () -> + Nock_iter.nock_on event_list formula) in + let task3 () = time_it "nock_tail.ml" (fun () -> + Nock_tail.nock_on event_list formula) in + + (* Run all three on separate domains in parallel using Fiber.both/pair *) + let res1, (res2, res3) = Eio.Fiber.pair + (fun () -> Eio.Domain_manager.run domain_mgr task1) + (fun () -> Eio.Fiber.pair + (fun () -> Eio.Domain_manager.run domain_mgr task2) + (fun () -> Eio.Domain_manager.run domain_mgr task3)) + in + let results = [res1; res2; res3] in + + Printf.printf "\n[6] Results:\n"; + + let successes = ref [] in + let failures = ref [] in + + List.iter (fun res -> + match res with + | Ok (name, time, result) -> + let mug = Noun.mug result in + Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time; + successes := (name, mug, time) :: !successes + | Error (name, err) -> + Printf.printf " %s: %s ✗\n" name err; + failures := (name, err) :: !failures + ) results; + + Printf.printf "\n[7] Verification:\n"; + Printf.printf " Successes: %d\n" (List.length !successes); + Printf.printf " Failures: %d\n" (List.length !failures); + + if List.length !successes >= 2 then begin + let mugs = List.map (fun (_, mug, _) -> mug) !successes in + let all_same = List.for_all (fun m -> m = List.hd mugs) mugs in + if all_same then + Printf.printf " ✓ All successful implementations produce identical kernels!\n" + else + Printf.printf " ✗ Mug mismatch between successful implementations!\n" + end; + + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Summary: ║\n"; + if List.length !successes > 0 then begin + let fastest = List.fold_left + (fun (acc_name, acc_time) (name, _, time) -> + if time < acc_time then (name, time) else (acc_name, acc_time)) + ("", max_float) + !successes in + Printf.printf "║ Fastest (of successful): %-28s║\n" (fst fastest); + end; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n" + + | _ -> Printf.printf " ✗ Unexpected structure at use level\n") + | _ -> Printf.printf " ✗ Unexpected structure at mod level\n") + | _ -> Printf.printf " ✗ Unexpected structure at bot level\n") + | _ -> Printf.printf " ✗ Unexpected structure at events level\n") + | _ -> Printf.printf " ✗ Unexpected pill structure\n" + ) diff --git a/ocaml/test/test_solid_sequential.ml b/ocaml/test/test_solid_sequential.ml new file mode 100644 index 0000000..3e78e49 --- /dev/null +++ b/ocaml/test/test_solid_sequential.ml @@ -0,0 +1,142 @@ +(** Test solid pill lifecycle with all three Nock implementations sequentially **) + +open Nock_lib + +let time_it name f = + Printf.printf "\n[%s] Starting...\n%!" name; + let start = Unix.gettimeofday () in + try + let result = f () in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf "[%s] ✓ Complete in %.4fs\n%!" name elapsed; + Ok (name, elapsed, result) + with + | Stack_overflow -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf "[%s] ✗ Stack overflow after %.4fs\n%!" name elapsed; + Error (name, "Stack overflow") + | e -> + let elapsed = Unix.gettimeofday () -. start in + Printf.printf "[%s] ✗ Error: %s (after %.4fs)\n%!" name (Printexc.to_string e) elapsed; + Error (name, Printexc.to_string e) + +let () = + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Sequential Solid Pill Lifecycle Test ║\n"; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"; + + Printf.printf "[1] Loading solid.pill...\n"; + let ic = open_in_bin "solid.pill" in + let len = in_channel_length ic in + let bytes = Bytes.create len in + really_input ic bytes 0 len; + close_in ic; + Printf.printf " Size: %d bytes (%.1f MB)\n" len (float_of_int len /. 1024.0 /. 1024.0); + + Printf.printf "[2] Cuing solid pill...\n"; + let start = Unix.gettimeofday () in + let pill = Serial.cue bytes in + let elapsed = Unix.gettimeofday () -. start in + Printf.printf " ✓ Cued in %.2fs\n" elapsed; + + Printf.printf "[3] Parsing pill structure...\n"; + + (* Parse: [tag type [bot mod use]] *) + match pill with + | Noun.Cell { h = _tag; t = rest; _ } -> + (match rest with + | Noun.Cell { h = _ptype; t = events_triple; _ } -> + (match events_triple with + | Noun.Cell { h = bot; t = rest2; _ } -> + (match rest2 with + | Noun.Cell { h = _mod; t = rest3; _ } -> + (match rest3 with + | Noun.Cell { h = use; t = _; _ } -> + (* Concatenate bot and use *) + let rec to_list acc n = + match n with + | Noun.Atom _ -> List.rev acc + | Noun.Cell { h; t; _ } -> to_list (h :: acc) t + in + let bot_list = to_list [] bot in + let use_list = to_list [] use in + let all_events = bot_list @ use_list in + + Printf.printf " Bot events: %d\n" (List.length bot_list); + Printf.printf " Use events: %d\n" (List.length use_list); + Printf.printf " Total: %d events\n" (List.length all_events); + + (* Convert to proper Nock list format *) + let rec from_list = function + | [] -> Noun.atom 0 + | h :: t -> Noun.cell h (from_list t) + in + let event_list = from_list all_events in + + Printf.printf "\n[4] Building lifecycle formula...\n"; + let formula = Noun.cell + (Noun.atom 2) + (Noun.cell + (Noun.cell (Noun.atom 0) (Noun.atom 3)) + (Noun.cell (Noun.atom 0) (Noun.atom 2))) in + Printf.printf " Formula: [2 [0 3] [0 2]]\n"; + + Printf.printf "\n[5] Running lifecycle sequentially:\n"; + + (* Run each implementation sequentially *) + let res1 = time_it "nock_iter.ml" (fun () -> + Nock_iter.nock_on event_list formula) in + + let res2 = time_it "nock_tail.ml" (fun () -> + Nock_tail.nock_on event_list formula) in + + let res3 = time_it "nock.ml" (fun () -> + Nock.nock_on event_list formula) in + + Printf.printf "\n[6] Results:\n"; + + let successes = ref [] in + let failures = ref [] in + + List.iter (fun res -> + match res with + | Ok (name, time, result) -> + let mug = Noun.mug result in + Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time; + successes := (name, mug, time) :: !successes + | Error (name, err) -> + Printf.printf " %s: %s ✗\n" name err; + failures := (name, err) :: !failures + ) [res1; res2; res3]; + + Printf.printf "\n[7] Verification:\n"; + Printf.printf " Successes: %d\n" (List.length !successes); + Printf.printf " Failures: %d\n" (List.length !failures); + + if List.length !successes >= 2 then begin + let mugs = List.map (fun (_, mug, _) -> mug) !successes in + let all_same = List.for_all (fun m -> m = List.hd mugs) mugs in + if all_same then + Printf.printf " ✓ All successful implementations produce identical kernels!\n" + else + Printf.printf " ✗ Mug mismatch between successful implementations!\n" + end; + + Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n"; + Printf.printf "║ Summary: ║\n"; + if List.length !successes > 0 then begin + let fastest = List.fold_left + (fun (acc_name, acc_time) (name, _, time) -> + if time < acc_time then (name, time) else (acc_name, acc_time)) + ("", max_float) + !successes in + Printf.printf "║ Fastest: %-44s║\n" (fst fastest); + Printf.printf "║ Time: %.2fs ║\n" (snd fastest); + end; + Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n" + + | _ -> Printf.printf " ✗ Unexpected structure at use level\n") + | _ -> Printf.printf " ✗ Unexpected structure at mod level\n") + | _ -> Printf.printf " ✗ Unexpected structure at bot level\n") + | _ -> Printf.printf " ✗ Unexpected structure at events level\n") + | _ -> Printf.printf " ✗ Unexpected pill structure\n" diff --git a/ocaml/test/testmulticore.ml b/ocaml/test/testmulticore.ml new file mode 100644 index 0000000..fd794cd --- /dev/null +++ b/ocaml/test/testmulticore.ml @@ -0,0 +1,27 @@ + +(* fib_par.ml *) +let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 +let n = try int_of_string Sys.argv.(2) with _ -> 1 + +(* Sequential Fibonacci *) +let rec fib n = + if n < 2 then 1 else fib (n - 1) + fib (n - 2) + +module T = Domainslib.Task + +let rec fib_par pool n = + if n > 20 then begin + let a = T.async pool (fun _ -> fib_par pool (n-1)) in + let b = T.async pool (fun _ -> fib_par pool (n-2)) in + T.await pool a + T.await pool b + end else + (* Call sequential Fibonacci if the available work is small *) + fib n + +let main () = + let pool = T.setup_pool ~num_domains:(num_domains - 1) () in + let res = T.run pool (fun _ -> fib_par pool n) in + T.teardown_pool pool; + Printf.printf "fib(%d) = %d\n" n res + +let _ = main () |