[gambit-list] endless loop when doing longjmp over C boundaries

[Christian]

Hello Marc

I'm writing an interface to perl, and am trying to get exception
handling right.

At the moment, I'm only caring about exceptions thrown in perl code
(which has been called by scheme), I may be dealing with exceptions
thrown in scheme code called by perl later.

One way to handle perl exceptions would be to catch exceptions on
every perl-from-scheme function call (using the G_EVAL flag to
call_sv, like: call_sv(perlfunction,G_EVAL);), and reraise them as
scheme exceptions. But I expect this to be relatively costly (several
hundred cpu cycles per call), and I think placing perl exception
catchers manually might also make more sense. So I'm imaging a
solution like:

 (with-perl-exception-catcher (lambda (sv)
                                ;; sv is the perl scalar value representing $@
                                (display "Got a perl exception: ")
                                (display (sv->string sv))
                                #f)
    (lambda ()
      (perl-call "thrower")
      #t))

where the perl interpreter has this perl code loaded:

 sub thrower {
     print "(thrower called)\n";
     die "Hi from thrower";
 }
 sub nothrower {
     print "(nothrower called)\n";
 }

Running the scheme program would then print "Got a perl exception: Hi
from thrower at file.pl line 2" and return #f.

I've got perl-call, sv->string and such already running, now I'm
trying to implement with-perl-exception-catcher.

Perl is using setjmp/longjmp for implementing exceptions (or, at the
user's request, can throw C++ exceptions). It maintains a linked list
of extended jmp_buf buffers. The exception value is stored in the perl
global "$@". An exception classifyer is stored in the extended jmp
buffer upon calling longjmp and copied to a user variable by the
JMPENV_PUSH() macro.

scheme code:

(define with-perl-exception-catcher
  (c-lambda (scheme-object scheme-object) scheme-object
            "gperl__with_perl_exception_catcher"))

(c-define (trampoline-0 cont)
          (scheme-object) scheme-object "gperl_trampoline_0" ""
  (cont))

(c-define (trampoline-1 cont v1)
          (scheme-object scheme-object) scheme-object "gperl_trampoline_1" ""
  (cont v1))

C code:

___SCMOBJ
gperl__with_perl_exception_catcher(___SCMOBJ handler,
	 			   ___SCMOBJ thunk)
{
    if (gperl_current_interpreter) {
	dJMPENV; // macro from perl: declares jmp environment.
	int rEtV = 0;
	___SCMOBJ res;

	JMPENV_PUSH(rEtV); // macro from perl: make the new environment
                           // the current (and link it to the previous),
                           // call setjmp, set rEtV to 0 at first or
                           // to the error classifyer upon longjmp.
	if (rEtV == 0) {
	    // now either throw a perl exception directly:
	    //  croak("Hello this is a perl exception");
	    // or call thunk through gperl-trampoline-0:
	    //  res= gperl_trampoline_0(thunk);
	    // or call thunk through this scary code:
	    #define ___NARGS 1
	    ___BEGIN_SFUN_SCMOBJ(___MLBL(___C_LBL_gperl_trampoline_0)) /* label reused :o) */
	    ___BEGIN_SFUN_ARG_SCMOBJ(1)
	    #define ___ARG1 thunk
	    ___BEGIN_SFUN_BODY
	    ___SFUN_ARG(1,___ARG1)
	    ___SFUN_CALL_SCMOBJ
	    ___SFUN_SET_RESULT_SCMOBJ
	    ___END_SFUN_BODY
	    #undef ___ARG1
	    ___END_SFUN_ARG_SCMOBJ(1)
	    ___SFUN_ERROR_SCMOBJ
	    ___SFUN_SET_RESULT_SCMOBJ
	    ___END_SFUN_SCMOBJ
	    #undef ___NARGS
	    res= ___result;
	    fprintf(stderr,"gperl_with_perl_exception_catcher: no exception occured in perl.\n");
	}
	JMPENV_POP; // make the previous environment the current.
	if (rEtV != 0) {
	    fprintf(stderr,"gperl_with_perl_exception_catcher: an exception occured in perl!\n");
	    // now call handler and return it's value
	    return gperl_trampoline_1(handler, ___FIX(1234)); //todo: replace with gperl_get_sv("$@")
	} else {
	    // return thunk's value.
	    return res;
	}
    } else {
	return ___FIX(-1235); //(todo: produce a scheme exception)
    }
}


Note that I've first tried to call back to the scheme lambdas using
c-define'd trampoline functions. It worked just fine so far when
calling the perl function "nothrower", i.e.

 (with-perl-exception-catcher (lambda (sv)
                                (display "Got a perl exception\n"))
    (lambda () (perl-call "nothrower")))

but when calling "thrower", it is outputting "(nothrower called)",
"gperl_with_perl_exception_catcher: an exception occured in perl!" and
"Got a perl exception", but then is hanging in an infinite loop, which
ctl-c doesn't interrupt. Call graph:

 scheme -> C -> scheme: thunk -> C -> perl: nothrower
        <-   <-               <-   <-
 ok.

 scheme -> C -> scheme: thunk -> C -> perl: thrower
             <-------------------longjmp-
             -> scheme: handler
 [ somewhere here it loops: ]
             <-
        <-


Then I've replaced the gperl_trampoline_0(thunk); call with the above
code which is an excerpt from what the compiler produced for the
former; this still works for "nothrower", but terminates the program
with signal 4 (illegal instruction) for "thrower".

When commenting out both the gperl_trampoline_0 and compiler-produced
code and directly call the C function croak("Hello this is a perl
exception"); which to the best of my knowledge acts exactly as the
perl die function, there is no crash or endless loop, everything seems
to work. Call graph:

 scheme -> C croak();
             <-longjmp-
             -> scheme: handler
             <-
        <-

So I would guess it must be the call to the thunk which makes
it loop.


My questions:

- is it at all possible to longjmp over scheme<->C boundaries?
- what is the most natural way to call back into a scheme lambda from
  C?
 (I've noticed the C closure code in os_dyn.c, is this code used in
 one of the above situations?)

I'll be happy to give you more information or real code for testing.

I've tested on Debian/x86.

Thanks
Christian.