Re: Catching Break?

[Ian T Zimmerman <itz@transbay.net>]

Xavier Leroy <Xavier.Leroy@inria.fr> writes:

>
> > Why doesn't this work:
> >  let main() =
> >   Sys.catch_break true; try Unix.kill (Unix.getpid()) Sys.sigint
> >   with Sys.Break -> prerr_endline "CAUGHT!"; exit 0
> >  let _ = main()
> >  This program just prints "Fatal error: Uncaught exception
> > Sys.Break" as if the try block weren't there.  Am I overlooking
> > something really obvious?

>  No, it's fairly subtle, actually.  For various reasons related to
> the Caml runtime system, signals in OCaml are not necessarily
> handled at the program point where they are received: the signal
> handler is called only at the next "safe" program point.
>  In the case of the ocamlc bytecode interpreter, "safe" program
> points are at function application and at the beginning of each loop
             ^^^^^^^^^^^^^^^^^^^^^^^^
> iteration.  So, in your example above, we leave the "try..with"
> before the handler for the signal is called, and that handler thus
> raises the Sys.Break exception outside of the "try..with".
>  If you add a function call after the Unix.kill, everything should
> work as expected:
>
> > let main() =
> >   Sys.catch_break true; try Unix.kill (Unix.getpid()) Sys.sigint;
> >   prerr_endline "Sent signal" with Sys.Break -> prerr_endline
> >   "CAUGHT!"; exit 0
>  This is actually a minor OCaml bug; it would be better to check for
> pending signals just before leaving a "try..with" block.  I'll see
> what can be done about it.

As I didn't get any further followups on this topic, I looked at the
bytecode compiler and interpreter.  (As of Ocaml 2.01) I cannot see
the "function application" case being done:

kronstadt:/usr/src/ocaml-2.01/bytecomp$ grep -B 8 -e Kcheck_signals *.ml
bytegen.ml-            comp_expr (add_var id (sz+1) env) handler (sz+1) (add_pop 1 cont1))
bytegen.ml-  | Lifthenelse(cond, ifso, ifnot) ->
bytegen.ml-      comp_binary_test env cond ifso ifnot sz cont
bytegen.ml-  | Lsequence(exp1, exp2) ->
bytegen.ml-      comp_expr env exp1 sz (comp_expr env exp2 sz cont)
bytegen.ml-  | Lwhile(cond, body) ->
bytegen.ml-      let lbl_loop = new_label() in
bytegen.ml-      let lbl_test = new_label() in
bytegen.ml:      Kbranch lbl_test :: Klabel lbl_loop :: Kcheck_signals ::
--
bytegen.ml-  | Lfor(param, start, stop, dir, body) ->
bytegen.ml-      let lbl_loop = new_label() in
bytegen.ml-      let lbl_test = new_label() in
bytegen.ml-      let offset = match dir with Upto -> 1 | Downto -> -1 in
bytegen.ml-      let comp = match dir with Upto -> Cle | Downto -> Cge in
bytegen.ml-      comp_expr env start sz
bytegen.ml-        (Kpush :: comp_expr env stop (sz+1)
bytegen.ml-          (Kpush :: Kbranch lbl_test ::
bytegen.ml:           Klabel lbl_loop :: Kcheck_signals ::
--
emitcode.ml-      out_int (Array.length tbl_const + (Array.length tbl_block lsl 16));
emitcode.ml-      let org = !out_position in
emitcode.ml-      Array.iter (out_label_with_orig org) tbl_const;
emitcode.ml-      Array.iter (out_label_with_orig org) tbl_block
emitcode.ml-  | Kboolnot -> out opBOOLNOT
emitcode.ml-  | Kpushtrap lbl -> out opPUSHTRAP; out_label lbl
emitcode.ml-  | Kpoptrap -> out opPOPTRAP
emitcode.ml-  | Kraise -> out opRAISE
emitcode.ml:  | Kcheck_signals -> out opCHECK_SIGNALS
--
instruct.ml-  | Kbranchifnot of label
instruct.ml-  | Kstrictbranchif of label
instruct.ml-  | Kstrictbranchifnot of label
instruct.ml-  | Kswitch of label array * label array
instruct.ml-  | Kboolnot
instruct.ml-  | Kpushtrap of label
instruct.ml-  | Kpoptrap
instruct.ml-  | Kraise
instruct.ml:  | Kcheck_signals
--
printinstr.ml-      Array.iter (fun lbl -> print_space(); print_int lbl) consts;
printinstr.ml-      print_string "/";
printinstr.ml-      Array.iter (fun lbl -> print_space(); print_int lbl) blocks;
printinstr.ml-      close_box()
printinstr.ml-  | Kboolnot -> print_string "\tboolnot"
printinstr.ml-  | Kpushtrap lbl -> print_string "\tpushtrap L"; print_int lbl
printinstr.ml-  | Kpoptrap -> print_string "\tpoptrap"
printinstr.ml-  | Kraise -> print_string "\traise"
printinstr.ml:  | Kcheck_signals -> print_string "\tcheck_signals"


So I'll see if inserting a dummy loop after the slow system call
helps.  But yes something should be done about this.

I haven't even start to think what to do in the native code case...

-- 
Ian T Zimmerman                        <itz@transbay.net>
I came to the conclusion that what was wrong about the guillotine
was that the condemned man had no chance at all, absolutely none.
Albert Camus, _The Outsider_