Demonstrate passing args to SCM func from C

This commit is contained in:
Justin Ethier 2020-08-13 18:46:48 -04:00
parent af1be469e8
commit c07a6ff6bf
3 changed files with 29 additions and 22 deletions

View file

@ -7,8 +7,9 @@
(define lock (make-mutex)) (define lock (make-mutex))
(define *done* #f) (define *done* #f)
(define *dummy* signal-done) ;; Hack to prevent optimizing out signal-done (define *dummy* signal-done) ;; Hack to prevent optimizing out
(define *dummy2* sum-numbers) ;; Hack to prevent optimizing out signal-done (define *dummy1* print-result) ;; Hack to prevent optimizing out
(define *dummy2* sum-numbers) ;; Hack to prevent optimizing out
(define-c start-c-thread (define-c start-c-thread
"(void *data, int argc, closure _, object k)" "(void *data, int argc, closure _, object k)"
@ -16,7 +17,7 @@
return_closcall1(data, k, boolean_t); ") return_closcall1(data, k, boolean_t); ")
(define (sum-numbers) (define (sum-numbers)
(let ((result 0)) (let ((result 500))
(for-each (for-each
(lambda (n) (lambda (n)
(set! result (+ result n))) (set! result (+ result n)))
@ -24,16 +25,19 @@
(lambda X (lambda X
(list result 'result #(result))))) (list result 'result #(result)))))
;(define (print-result (define (print-result fnc)
(let* ((result (fnc))
(num (car result)))
(write `(SCM result is ,num))
(newline)))
;; Signal (wait) that it is done, this is called from C ;; Signal (wait) that it is done, this is called from C
(define (signal-done) ; obj) (define (signal-done obj)
(let ((obj #t))
(write `(Called from C set *done* to ,obj)) (write `(Called from C set *done* to ,obj))
(newline) (newline)
(mutex-lock! lock) (mutex-lock! lock)
(set! *done* obj) (set! *done* obj)
(mutex-unlock! lock))) (mutex-unlock! lock))
;; More efficient to use a condition var here to signal ready, ;; More efficient to use a condition var here to signal ready,
;; but this is just an example ;; but this is just an example

View file

@ -10,10 +10,11 @@
*/ */
extern object __glo_signal_91done; extern object __glo_signal_91done;
extern object __glo_sum_91numbers; extern object __glo_sum_91numbers;
extern object __glo_print_91result;
gc_thread_data local; gc_thread_data local;
void *Cyc_init_thread(object thread_and_thunk); void *Cyc_init_thread(object thread_and_thunk, int argc, object *args);
/** /**
* Code for the C thread. * Code for the C thread.
@ -24,19 +25,27 @@ void *Cyc_init_thread(object thread_and_thunk);
*/ */
void *c_thread(void *parent_thd) void *c_thread(void *parent_thd)
{ {
object obj; object obj, fnc, args[1];
printf("Hello from C thread\n"); printf("Hello from C thread\n");
printf("C calling into SCM\n"); printf("C calling into SCM\n");
obj = scm_call_with_gc(parent_thd, __glo_sum_91numbers, boolean_t); fnc = scm_call_with_gc(parent_thd, __glo_sum_91numbers, 0, NULL);
printf("C received: "); 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);
printf("\nC received: ");
Cyc_write(NULL, obj, stdout); Cyc_write(NULL, obj, stdout);
printf("\n"); printf("\n");
obj = scm_call_with_gc(parent_thd, __glo_signal_91done, boolean_t); args[0] = boolean_t;
obj = scm_call_with_gc(parent_thd, __glo_signal_91done, 1, args);
printf("C received: "); printf("\nC received: ");
Cyc_write(NULL, obj, stdout); Cyc_write(NULL, obj, stdout);
printf("\n"); printf("\n");
return NULL; return NULL;
@ -51,9 +60,6 @@ void *c_thread(void *parent_thd)
void cleanup_and_return(gc_thread_data *thd, int argc, object k, object result) void cleanup_and_return(gc_thread_data *thd, int argc, object k, object result)
{ {
int i;
printf("cleanup and return %p result %p\n", &i, result);
// Cleaup thread object per Cyc_exit_thread // Cleaup thread object per Cyc_exit_thread
gc_remove_mutator(thd); gc_remove_mutator(thd);
ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_RUNNABLE, ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_RUNNABLE,
@ -71,9 +77,6 @@ void cleanup_and_return(gc_thread_data *thd, int argc, object k, object result)
*/ */
void after_call_scm(gc_thread_data *thd, int argc, object k, object result) void after_call_scm(gc_thread_data *thd, int argc, object k, object result)
{ {
int i;
printf("after call scm %p result %p\n", &i, result);
mclosure0(clo, cleanup_and_return); mclosure0(clo, cleanup_and_return);
object buf[1]; buf[0] = result; object buf[1]; buf[0] = result;
GC(thd, &clo, buf, 1); GC(thd, &clo, buf, 1);
@ -105,7 +108,7 @@ void after_call_scm(gc_thread_data *thd, int argc, object k, object result)
* or re-allocated (EG: malloc) before returning it * or re-allocated (EG: malloc) before returning it
* to the C layer. * to the C layer.
*/ */
object scm_call_with_gc(gc_thread_data *parent_thd, object fnc, object arg) object scm_call_with_gc(gc_thread_data *parent_thd, object fnc, int argc, object *args)
{ {
jmp_buf l; jmp_buf l;
local.gc_cont = NULL; local.gc_cont = NULL;
@ -133,7 +136,7 @@ object scm_call_with_gc(gc_thread_data *parent_thd, object fnc, object arg)
make_pair(thread_and_thunk, &vec, fnc); // TODO: OK we are not clearing vec[5]? I think so... make_pair(thread_and_thunk, &vec, fnc); // TODO: OK we are not clearing vec[5]? I think so...
if (!setjmp(*(local.jmp_start))) { if (!setjmp(*(local.jmp_start))) {
Cyc_init_thread(&thread_and_thunk); Cyc_init_thread(&thread_and_thunk, argc, args);
} }
return local.gc_cont; return local.gc_cont;

View file

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