Revert "Semaphore without probes: dummy notes"

backend/amd64/emit.mlp

@@ -528,29 +528,18 @@ let function_name = ref ""
 let tailrec_entry_point = ref None
 
 (* Emit tracing probes *)
-type probe_handler =
-  {
-    probe_stack_offset: int;
-    probe_num_stack_slots: int array;
-    (* Record frame info held in the corresponding mutable variables. *)
-    probe_handler_code_sym: string;
-    (* Probe handler function symbol. *)
-    probe_arg: Reg.t array;
-    probe_live: Reg.Set.t;
-    (* Information about Iprobe instruction,
-       recorded at probe site and used for emitting the notes and
-       the wrapper code at the end of the compilation unit. *)
-  }
 
 type probe =
   {
+    stack_offset: int;
+    num_stack_slots: int array;
+    (* Record frame info held in the corresponding mutable variables. *)
     probe_label: label;
     (* Probe site, recorded in .note.stapsdt section
        for enabling and disabling the probes  *)
-    probe_name: string;
-    (* User-defined name of the probe. *)
-    probe_handler: probe_handler option;
-    (* User-defined handler or None for dummy probes. *)
+    probe_insn: Linear.instruction;
+    (* Iprobe instruction, recorded at probe site and used for emitting
+       the notes and the wrapper code at the end of the compilation unit. *)
   }
 
 let probe_handler_wrapper_name probe_label =
@@ -946,20 +935,13 @@ let emit_instr fallthrough i =
     in
     I.prefetch is_write locality (addressing addr QWORD i 0)
   | Lop (Iname_for_debugger _) -> ()
-  | Lop (Iprobe { name; handler_code_sym }) ->
+  | Lop (Iprobe _) ->
     let probe_label = new_label () in
-    let h =
-      { probe_handler_code_sym = handler_code_sym;
-        probe_arg = Array.copy i.arg;
-        probe_live = i.live;
-        probe_stack_offset = !stack_offset;
-        probe_num_stack_slots = Array.copy num_stack_slots;
-      }
-    in
     let probe =
       { probe_label;
-        probe_name = name;
-        probe_handler = Some h;
+        probe_insn = i;
+        stack_offset = !stack_offset;
+        num_stack_slots = Array.copy num_stack_slots;
       }
     in
     probes := probe :: !probes;
@@ -1301,20 +1283,23 @@ let make_stack_loc ~offset i (r : Reg.t) =
 
 let emit_probe_handler_wrapper p =
   let wrap_label = probe_handler_wrapper_name p.probe_label in
-  let h = Option.get p.probe_handler in
+  let probe_name, handler_code_sym =
+    match p.probe_insn.desc with
+    | Lop (Iprobe { name; handler_code_sym; }) -> name, handler_code_sym
+    | _ -> assert false
+  in
   (* Restore stack frame info as it was at the probe site, so we can easily
      refer to slots in the corresponding frame.  (As per the comment above,
      recall that the wrapper does however have its own frame.) *)
   frame_required := true;
-  stack_offset := h.probe_stack_offset;
+  stack_offset := p.stack_offset;
   for i = 0 to Proc.num_register_classes - 1 do
-    num_stack_slots.(i) <- h.probe_num_stack_slots.(i);
+    num_stack_slots.(i) <- p.num_stack_slots.(i);
   done;
   (* Account for the return address that is now pushed on the stack. *)
   stack_offset := !stack_offset + 8;
   (* Emit function entry code *)
-  D.comment (Printf.sprintf "probe %s %s" p.probe_name
-               h.probe_handler_code_sym);
+  D.comment (Printf.sprintf "probe %s %s" probe_name handler_code_sym);
   emit_named_text_section wrap_label;
   D.align 16;
   _label wrap_label;
@@ -1328,15 +1313,15 @@ let emit_probe_handler_wrapper p =
   assert (size_addr = 8 && size_int = 8 && size_float = 8);
   (* Compute the size of stack slots for all live hard registers. *)
   let live =
-    Reg.Set.elements h.probe_live
+    Reg.Set.elements p.probe_insn.live
     |> List.filter Reg.is_reg
     |> Array.of_list
   in
   let live_offset = 8 * (Array.length live) in
   (* Compute the size of stack slots for spilling all arguments of the probe. *)
   let aux_offset = 8 (* for saving r15 *) in
-  let tmp_offset = 8 * (Array.length h.probe_arg) in
-  let loc_args, loc_offset = Proc.loc_arguments (Reg.typv h.probe_arg) in
+  let tmp_offset = 8 * (Array.length p.probe_insn.arg) in
+  let loc_args, loc_offset = Proc.loc_arguments (Reg.typv p.probe_insn.arg) in
   (* Ensure the stack is aligned.
      Assuming that the stack at the probe site is 16-byte aligned,
      [loc_arguments] ensures that [loc_offset] is 16-byte aligned.
@@ -1360,16 +1345,16 @@ let emit_probe_handler_wrapper p =
   I.mov r15 (reg saved_r15);
   (* Spill all arguments of the probe.  Some of these may already be on the
      stack, in which case a temporary is used for the move. *)
-  let tmp = Array.mapi (make_stack_loc ~offset:loc_offset) h.probe_arg in
+  let tmp = Array.mapi (make_stack_loc ~offset:loc_offset) p.probe_insn.arg in
   Array.iteri (fun i reg -> move_allowing_stack_to_stack reg (tmp.(i)))
-    h.probe_arg;
+    p.probe_insn.arg;
   (* Load probe arguments to correct locations for the handler *)
   Array.iteri (fun i reg -> move_allowing_stack_to_stack tmp.(i) reg) loc_args;
   (* Reload spilled registers used as temporaries *)
   I.mov (reg saved_r15) r15;
   (* Emit call to handler *)
-  add_used_symbol h.probe_handler_code_sym;
-  emit_call h.probe_handler_code_sym;
+  add_used_symbol handler_code_sym;
+  emit_call handler_code_sym;
   (* Record a frame description for the wrapper *)
   let label = new_label () in
   let live_offset =
@@ -1398,7 +1383,7 @@ let emit_probe_handler_wrapper p =
   cfi_endproc ();
   emit_function_type_and_size wrap_label
 
-let emit_probe_notes0 probes =
+let emit_probe_notes0 () =
   begin match system with
   | S_gnu | S_cygwin | S_solaris | S_win32 | S_linux_elf | S_bsd_elf
   | S_beos | S_mingw | S_win64 | S_linux | S_mingw64 | S_unknown ->
@@ -1418,16 +1403,18 @@ let emit_probe_notes0 probes =
     Printf.sprintf "%d@%s" (Reg.size_of_contents_in_bytes arg) arg_name
   in
   let describe_one_probe p =
+    let probe_name =
+      match p.probe_insn.desc with
+      | Lop (Iprobe { name; _; }) -> name
+      | _ -> assert false
+    in
     let args =
-      match p.probe_handler with
-      | None -> ""
-      | Some h ->
-        Array.fold_right (fun arg acc -> (stap_arg arg)::acc)
-          h.probe_arg
-          []
-        |> String.concat " "
+      Array.fold_right (fun arg acc -> (stap_arg arg)::acc)
+        p.probe_insn.arg
+        []
+      |> String.concat " "
     in
-    let semaphore_label = emit_symbol (find_or_add_semaphore p.probe_name) in
+    let semaphore_label = emit_symbol (find_or_add_semaphore probe_name) in
     D.align 4;
     let a = new_label() in
     let b = new_label() in
@@ -1453,13 +1440,13 @@ let emit_probe_notes0 probes =
       D.qword (const 0)
     end;
     D.qword (ConstLabel semaphore_label);
-    D.bytes "ocaml.2\000";
-    D.bytes (p.probe_name ^ "\000");
+    D.bytes "ocaml.1\000";
+    D.bytes (probe_name ^ "\000");
     D.bytes (args ^ "\000");
     def_label d;
     D.align 4;
   in
-  List.iter describe_one_probe probes;
+  List.iter describe_one_probe !probes;
   begin match system with
   | S_gnu | S_cygwin | S_solaris | S_win32 | S_linux_elf | S_bsd_elf
   | S_beos | S_mingw | S_win64 | S_linux | S_mingw64 | S_unknown ->
@@ -1488,49 +1475,10 @@ let emit_probe_notes0 probes =
       add_def_symbol label)
     !probe_semaphores
 
-let emit_probe_notes probes =
-  match probes, String.Map.is_empty !probe_semaphores with
-  | [], true -> ()
-  | _ -> emit_probe_notes0 probes
-
-let emit_dummy_probe_sites () =
-  let semaphores_without_probes =
-    List.fold_left (fun acc probe ->
-      String.Map.remove probe.probe_name acc)
-      !probe_semaphores !probes in
-  if (String.Map.is_empty semaphores_without_probes) then []
-  else begin
-    let fun_name = Compilenv.make_symbol (Some "___dummy_probes") in
-
-    (* start the function (as in fundecl) *)
-    emit_named_text_section fun_name;
-    D.align 16;
-    add_def_symbol fun_name;
-    D.global (emit_symbol fun_name);
-    D.label (emit_symbol fun_name);
-    cfi_startproc ();
-
-    (* emit dummy probe sites: labeled NOP only for stapsdt probes to work,
-       but no calls to probe wrapper because there is no ocaml probe handler. *)
-    let dummy_probes =
-      String.Map.fold (fun probe_name _label acc ->
-        let probe_label = new_label () in
-        def_label probe_label;
-        I.nop (); (* for uprobes and usdt probes as well *)
-        let probe = { probe_name;
-                      probe_label;
-                      probe_handler = None;
-                    }
-        in
-        probe :: acc)
-        semaphores_without_probes []
-    in
-    I.ret ();
-    (* end the function (as in fundecl) *)
-    cfi_endproc ();
-    emit_function_type_and_size fun_name;
-    dummy_probes
-  end
+let emit_probe_notes () =
+  match !probes with
+  | [] -> ()
+  | _ -> emit_probe_notes0 ()
 
 let end_assembly() =
   if !float_constants <> [] then begin
@@ -1547,9 +1495,6 @@ let end_assembly() =
   (* Emit probe handler wrappers *)
   List.iter emit_probe_handler_wrapper !probes;
 
-  (* Emit dummy probes for semaphores without probes in this compilation unit. *)
-  let dummy_probes = emit_dummy_probe_sites () in
-
   emit_named_text_section (Compilenv.make_symbol (Some "code_end"));
   if system = S_macosx then I.nop ();
   (* suppress "ld warning: atom sorting error" *)
@@ -1599,7 +1544,7 @@ let end_assembly() =
     D.size frametable (ConstSub (ConstThis, ConstLabel frametable))
   end;
 
-  emit_probe_notes (dummy_probes @ !probes);
+  emit_probe_notes ();
 
   if system = S_linux then
     (* Mark stack as non-executable, PR#4564 *)

ocaml/typing/typecore.ml

@@ -124,6 +124,7 @@ type error =
   | Probe_format
   | Probe_name_too_long of string
   | Probe_name_format of string
+  | Probe_name_undefined of string
   | Probe_is_enabled_format
   | Literal_overflow of string
   | Unknown_literal of string * char
@@ -3752,6 +3753,10 @@ and type_expect_
                        _ } ,
                       _)}]) ->
         check_probe_name name name_loc env;
+        add_delayed_check
+          (fun () ->
+             if not (Env.has_probe name) then
+               raise(Error(name_loc, env, (Probe_name_undefined name))));
         rue {
           exp_desc = Texp_probe_is_enabled {name};
           exp_loc = loc; exp_extra = [];
@@ -5601,6 +5606,11 @@ let report_error ~loc env = function
          Probe names may only contain alphanumeric characters or \
          underscores."
         name
+  | Probe_name_undefined name ->
+      Location.errorf ~loc
+        "Undefined probe name `%s' used in %%probe_is_enabled. \
+         Not found [%%probe \"%s\" ...] in the same compilation unit."
+        name name
   | Probe_format ->
       Location.errorf ~loc
         "Probe points must consist of a name, as a string \

ocaml/typing/typecore.mli

@@ -181,6 +181,7 @@ type error =
   | Probe_format
   | Probe_name_too_long of string
   | Probe_name_format of string
+  | Probe_name_undefined of string
   (* CR-soon mshinwell: Use an inlined record *)
   | Probe_is_enabled_format
   | Literal_overflow of string