Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-19 05:39:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Clean up examples

Browse source 
Use code from runtime instead of inline here
Added comments as needed, etc
This commit is contained in:
Justin Ethier 2020-08-14 16:48:59 -04:00
parent dc64d52412
commit 67b5e4ee8e
6 changed files with 22 additions and 205 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
examples/call-scm-from-c/Makefile
View file

@ -1,16 +1,16 @@
all: basic-no-gc full-with-gc
basic.o: basic.c
cc -g -c basic.c
cc -c basic.c
basic-no-gc: basic-no-gc.scm basic.o
cyclone -CLNK basic.o basic-no-gc.scm
cyclone -COBJ "basic.o" basic-no-gc.scm
full.o: full.c
cc -g -c full.c
cc -c full.c
full-with-gc: full-with-gc.scm full.o
cyclone -CLNK full.o full-with-gc.scm
cyclone -COBJ full.o full-with-gc.scm
.PHONY: clean
clean:

102
examples/call-scm-from-c/basic.c
View file

@ -6,6 +6,13 @@
/**
* This variable corresponds to the Scheme function in the generated C file
* that we wish to call into.
*
* These names are from the compiled C files but can also be
* generated using icyc:
*
* cyclone> (mangle-global 'signal-done)
* "__glo_signal_91done"
*
*/
extern object __glo_signal_91done;
@ -22,7 +29,7 @@ void *c_thread(void *parent_thd)
sleep(1);
printf("C calling into SCM\n");
object obj = scm_call_no_gc(parent_thd, __glo_signal_91done, boolean_t);
object obj = Cyc_scm_call_no_gc(parent_thd, __glo_signal_91done, boolean_t);
printf("C received: ");
Cyc_write(NULL, obj, stdout);
@ -30,99 +37,6 @@ void *c_thread(void *parent_thd)
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

1
examples/call-scm-from-c/basic.h
View file

@ -1,4 +1,3 @@
#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);

10
examples/call-scm-from-c/full-with-gc.scm
View file

@ -7,9 +7,11 @@
(define lock (make-mutex))
(define *done* #f)
(define *dummy* signal-done) ;; Hack to prevent optimizing out
(define *dummy1* print-result) ;; Hack to prevent optimizing out
(define *dummy2* sum-numbers) ;; Hack to prevent optimizing out
;; Hack to prevent optimizing out functions that are unused in Scheme code
;; This is not required if functions are exported from a library
(define *dummy* signal-done)
(define *dummy1* print-result)
(define *dummy2* sum-numbers)
(define-c start-c-thread
"(void *data, int argc, closure _, object k)"
@ -31,7 +33,7 @@
(write `(SCM result is ,num))
(newline)))
;; Signal (wait) that it is done, this is called from C
;; Signal (wait) that it is done
(define (signal-done obj)
(write `(Called from C set *done* to ,obj))
(newline)

105
examples/call-scm-from-c/full.c
View file

@ -5,7 +5,7 @@
#include <unistd.h>
/**
* This variable corresponds to the Scheme function in the generated C file
* These variables correspond to Scheme functions in the generated C file
* that we wish to call into.
*
* These names are from the compiled C files but can also be
@ -19,8 +19,6 @@ extern object __glo_signal_91done;
extern object __glo_sum_91numbers;
extern object __glo_print_91result;
void *Cyc_init_thread(object thread_and_thunk, int argc, object *args);
/**
* Code for the C thread.
*
@ -34,21 +32,21 @@ void *c_thread(void *parent_thd)
printf("Hello from C thread\n");
printf("C calling into SCM\n");
fnc = scm_call_with_gc(parent_thd, __glo_sum_91numbers, 0, NULL);
fnc = Cyc_scm_call(parent_thd, __glo_sum_91numbers, 0, NULL);
printf("\nC received: ");
Cyc_write(NULL, fnc, stdout);
printf("\n");
args[0] = fnc;
obj = scm_call_with_gc(parent_thd, __glo_print_91result, 1, args);
obj = Cyc_scm_call(parent_thd, __glo_print_91result, 1, args);
printf("\nC received: ");
Cyc_write(NULL, obj, stdout);
printf("\n");
args[0] = boolean_t;
obj = scm_call_with_gc(parent_thd, __glo_signal_91done, 1, args);
obj = Cyc_scm_call(parent_thd, __glo_signal_91done, 1, args);
printf("\nC received: ");
Cyc_write(NULL, obj, stdout);
@ -56,101 +54,6 @@ void *c_thread(void *parent_thd)
return NULL;
}
///////////////////////////////////////////////////////////////////////////////
//
// Should not need to customize below here:
//
///////////////////////////////////////////////////////////////////////////////
void cleanup_and_return(gc_thread_data *thd, int argc, object k, object result)
{
// Cleaup thread object per Cyc_exit_thread
gc_remove_mutator(thd);
ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_RUNNABLE,
CYC_THREAD_STATE_TERMINATED);
// Return to local C caller
vector vec = thd->scm_thread_obj;
gc_thread_data *local = opaque_ptr(vec->elements[4]);
local->gc_cont = result;
longjmp(*(local->jmp_start), 1);
}
/**
* 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)
{
mclosure0(clo, cleanup_and_return);
object buf[1]; buf[0] = result;
GC(thd, &clo, buf, 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);
//}
//
//void call_thunk(void *data, int argc, object self, object k)
//{
//
//}
/**
* 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_with_gc(gc_thread_data *parent_thd, object fnc, int argc, object *args)
{
jmp_buf l;
gc_thread_data local;
local.gc_cont = NULL;
local.jmp_start = &l;
gc_thread_data *td = malloc(sizeof(gc_thread_data));
gc_add_new_unrunning_mutator(td); /* Register this thread */
make_c_opaque(co, td);
make_utf8_string(NULL, name_str, "");
make_c_opaque(co_parent_thd, parent_thd);
make_c_opaque(co_this_thd, &local);
mclosure0(after, (function_type)after_call_scm);
make_empty_vector(vec);
vec.num_elements = 7;
vec.elements = alloca(sizeof(object) * 5);
vec.elements[0] = find_or_add_symbol("cyc-thread-obj");
vec.elements[1] = fnc;
vec.elements[2] = &co;
vec.elements[3] = &name_str;
vec.elements[4] = &co_this_thd; //boolean_f;
vec.elements[5] = &co_parent_thd;
vec.elements[6] = &after;
make_pair(thread_and_thunk, &vec, fnc); // TODO: OK we are not clearing vec[5]? I think so...
if (!setjmp(*(local.jmp_start))) {
Cyc_init_thread(&thread_and_thunk, argc, args);
}
return local.gc_cont;
}
/**
* Called by Scheme to create the C thread.
* This is required by sample app since we start

1
examples/call-scm-from-c/full.h
View file

@ -1,4 +1,3 @@
#include "cyclone/types.h"
void start_c_thread(gc_thread_data *thd);
object scm_call_with_gc(gc_thread_data *parent_thd, object fnc, int argc, object *args);