mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Break out C files for GC example
This commit is contained in:
parent
fa5f630fa5
commit
734f137832
4 changed files with 152 additions and 3 deletions
|
@ -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:
|
||||
|
|
|
@ -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)
|
||||
|
|
142
examples/callbacks/full.c
Normal file
142
examples/callbacks/full.c
Normal file
|
@ -0,0 +1,142 @@
|
|||
#include "cyclone/types.h"
|
||||
#include "cyclone/runtime.h"
|
||||
#include "basic.h"
|
||||
#include <unistd.h>
|
||||
|
||||
/**
|
||||
* 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);
|
||||
}
|
4
examples/callbacks/full.h
Normal file
4
examples/callbacks/full.h
Normal file
|
@ -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);
|
Loading…
Add table
Reference in a new issue