@@ -7,6 +7,17 @@ let _get_local_debug_runtime = Utils._get_local_debug_runtime
77[%% global_debug_log_level 9 ]
88[%% global_debug_log_level_from_env_var " OCANNL_LOG_LEVEL" ]
99
10+ let check_merge_buffer ~scheduled_node ~code_node =
11+ let name = function Some tn -> Tnode. debug_name tn | None -> " none" in
12+ match (scheduled_node, code_node) with
13+ | _ , None -> ()
14+ | Some actual , Some expected when Tnode. equal actual expected -> ()
15+ | _ ->
16+ raise
17+ @@ Utils. User_error
18+ (" Merge buffer mismatch, on stream: " ^ name scheduled_node ^ " , expected by code: "
19+ ^ name code_node)
20+
1021module Multicore_backend (Backend : Backend_types.No_device_backend ) : Backend_types. Backend =
1122struct
1223 module Domain = Domain [@ warning " -3" ]
@@ -690,6 +701,11 @@ module Lowered_no_device_backend (Backend : Backend_types.Lowered_no_device_back
690701 verify from_prior_context;
691702 link_compiled ~merge_buffer prior_context proc
692703 in
704+ let schedule =
705+ Task. prepend schedule ~work: (fun () ->
706+ check_merge_buffer ~scheduled_node: (Option. map ! merge_buffer ~f: snd)
707+ ~code_node: (expected_merge_node code))
708+ in
693709 { context; schedule; bindings; name }
694710
695711 let link_batch ~merge_buffer (prior_context : context ) (code_batch : code_batch ) =
@@ -711,9 +727,15 @@ module Lowered_no_device_backend (Backend : Backend_types.Lowered_no_device_back
711727 verify from_prior_context;
712728 procs
713729 in
714- Array. fold_map procs ~init: prior_context ~f: (fun context -> function
730+ let code_nodes = expected_merge_nodes code_batch in
731+ Array. fold_mapi procs ~init: prior_context ~f: (fun i context -> function
715732 | Some proc ->
716733 let context, bindings, schedule, name = link_compiled ~merge_buffer context proc in
734+ let schedule =
735+ Task. prepend schedule ~work: (fun () ->
736+ check_merge_buffer ~scheduled_node: (Option. map ! merge_buffer ~f: snd)
737+ ~code_node: code_nodes.(i))
738+ in
717739 (context, Some { context; schedule; bindings; name })
718740 | None -> (context, None ))
719741
@@ -800,6 +822,12 @@ module Lowered_backend (Device : Backend_types.Lowered_backend) : Backend_types.
800822 verify_prior_context ~ctx_arrays ~is_in_context ~prior_context: context.ctx
801823 ~from_prior_context: code.from_prior_context [| code.traced_store |];
802824 let ctx, bindings, schedule = link context.ctx code.code in
825+ let schedule =
826+ Task. prepend schedule ~work: (fun () ->
827+ check_merge_buffer
828+ ~scheduled_node: (scheduled_merge_node @@ get_ctx_stream context.ctx)
829+ ~code_node: (expected_merge_node code))
830+ in
803831 { context = { ctx; expected_merge_node = code.expected_merge_node }; schedule; bindings; name }
804832
805833 let link_batch context code_batch =
@@ -809,12 +837,14 @@ module Lowered_backend (Device : Backend_types.Lowered_backend) : Backend_types.
809837 ( { ctx; expected_merge_node = context.expected_merge_node },
810838 Array. mapi schedules ~f: (fun i ->
811839 Option. map ~f: (fun schedule ->
812- {
813- context = { ctx; expected_merge_node = code_batch.expected_merge_nodes.(i) };
814- schedule;
815- bindings;
816- name;
817- })) )
840+ let expected_merge_node = code_batch.expected_merge_nodes.(i) in
841+ let schedule =
842+ Task. prepend schedule ~work: (fun () ->
843+ check_merge_buffer
844+ ~scheduled_node: (scheduled_merge_node @@ get_ctx_stream context.ctx)
845+ ~code_node: expected_merge_node)
846+ in
847+ { context = { ctx; expected_merge_node }; schedule; bindings; name })) )
818848
819849 let init stream = { ctx = init stream; expected_merge_node = None }
820850 let get_ctx_stream context = get_ctx_stream context.ctx
0 commit comments