diff --git a/examples/callbacks/Makefile b/examples/callbacks/Makefile index 81b4cb72..37e0b1eb 100644 --- a/examples/callbacks/Makefile +++ b/examples/callbacks/Makefile @@ -6,8 +6,11 @@ basic.o: basic.c basic-no-gc: basic-no-gc.scm basic.o cyclone -CLNK basic.o basic-no-gc.scm -full-with-gc: full-with-gc.scm basic.o - cyclone -CLNK basic.o full-with-gc.scm +full.o: full.c + cc -g -c full.c + +full-with-gc: full-with-gc.scm full.o + cyclone -CLNK full.o full-with-gc.scm .PHONY: clean clean: diff --git a/examples/callbacks/full-with-gc.scm b/examples/callbacks/full-with-gc.scm index e0f0bb38..016de0c8 100644 --- a/examples/callbacks/full-with-gc.scm +++ b/examples/callbacks/full-with-gc.scm @@ -3,7 +3,7 @@ (srfi 1) (srfi 18)) -(include-c-header "basic.h") +(include-c-header "full.h") (define lock (make-mutex)) (define *done* #f) diff --git a/examples/callbacks/full.c b/examples/callbacks/full.c new file mode 100644 index 00000000..95ebc90b --- /dev/null +++ b/examples/callbacks/full.c @@ -0,0 +1,142 @@ +#include "cyclone/types.h" +#include "cyclone/runtime.h" +#include "basic.h" +#include + +/** + * This variable corresponds to the Scheme function in the generated C file + * that we wish to call into. + */ +extern object __glo_signal_91done; + +/** + * Code for the C thread. + * + * In our application we just call the trampoline function to setup a call + * into Scheme code. In a real application this thread would probably do + * quite a bit more work in C, only calling into Scheme code as necessary. + */ +void *c_thread(void *parent_thd) +{ + printf("Hello from C thread\n"); + sleep(1); + printf("C calling into SCM\n"); + + object obj = scm_call_no_gc(parent_thd, __glo_signal_91done, boolean_t); + + printf("C received: "); + Cyc_write(NULL, obj, stdout); + printf("\n"); + return NULL; +} + + +/////////////////////////////////////////////////////////////////////////////// +// +// Should not need to customize below here: +// +/////////////////////////////////////////////////////////////////////////////// + + +/** + * Scheme function calls into this function when it is done. + * We store results and longjmp back to where we started, at the + * bottom of the trampoline (we only jump once). + */ +void after_call_scm(gc_thread_data *thd, int argc, object k, object result) +{ + thd->gc_cont = result; + longjmp(*(thd->jmp_start), 1); +} + +/** + * Call into Scheme function + */ +void call_scm(gc_thread_data *thd, object fnc, object obj) +{ + mclosure0(after, (function_type)after_call_scm); + ((closure)fnc)->fn(thd, 2, fnc, &after, obj); +} + +/** + * Setup a quick-and-dirty thread object and use it to + * make a call into Scheme code. + * + * Note this call is made in a limited way, and is only + * designed for a quick call. There is no support for + * performing any memory allocation by the Scheme code + * other than temporary objects in the nursery. The + * returned object will need to either be an immediate + * or re-allocated (EG: malloc) before returning it + * to the C layer. + */ +object scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg) +{ + long stack_size = 100000; + char *stack_base = (char *)&stack_size; + char *stack_traces[MAX_STACK_TRACES]; + gc_thread_data thd = {0}; + jmp_buf jmp; + thd.jmp_start = &jmp; + thd.stack_start = stack_base; +#if STACK_GROWTH_IS_DOWNWARD + thd.stack_limit = stack_base - stack_size; +#else + thd.stack_limit = stack_base + stack_size; +#endif + thd.stack_traces = stack_traces; + + thd.thread_id = pthread_self(); + thd.thread_state = CYC_THREAD_STATE_RUNNABLE; + + // Copy parameter objects from the calling thread + object parent = parent_thd->param_objs; // Unbox parent thread's data + object child = NULL; + while (parent) { + if (thd.param_objs == NULL) { + alloca_pair(p, NULL, NULL); + thd.param_objs = p; + child = thd.param_objs; + } else { + alloca_pair(p, NULL, NULL); + cdr(child) = p; + child = p; + } + alloca_pair(cc, car(car(parent)), cdr(car(parent))); + car(child) = cc; + parent = cdr(parent); + } + + // Setup trampoline and call into Scheme + // + // When the Scheme call is done we return result back to C + // + // It is very important to know that the result, IF ON THE STACK, + // is further up the stack than the caller and will be overwritten + // by subsequent C calls on this thread. Thus the caller will want + // to immediately create a copy of the object... + // + if (!setjmp(*(thd.jmp_start))) { + call_scm(&thd, fnc, arg); + } else { + return(thd.gc_cont); + } +} + +/** + * Called by Scheme to create the C thread. + * This is required by sample app since we start + * from a Scheme thread. + */ +void start_c_thread(gc_thread_data *thd) +{ + pthread_t thread; + pthread_attr_t attr; + pthread_attr_init(&attr); + pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); + if (pthread_create(&thread, &attr, c_thread, thd)) { + fprintf(stderr, "Error creating a new thread\n"); + exit(1); + } + pthread_attr_destroy(&attr); +} diff --git a/examples/callbacks/full.h b/examples/callbacks/full.h new file mode 100644 index 00000000..0f47f722 --- /dev/null +++ b/examples/callbacks/full.h @@ -0,0 +1,4 @@ +#include "cyclone/types.h" + +void start_c_thread(gc_thread_data *thd); +object scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg);