diff --git a/src/c/lwp.d b/src/c/lwp.d index 00fd76def..f372c80c9 100644 --- a/src/c/lwp.d +++ b/src/c/lwp.d @@ -13,6 +13,42 @@ */ #include +#include + +#include + +/* -- implementation notes ----------------------------------------------------- + * + * Fist and foremost, ucontext.h has been deprecated in POSIX.1-2001 and removed + * in POSIX.1-2008. That said glibc implements it, and musl libc has a separate + * library called libucontext that implements the API. On Windows we can write a + * similar library that utilizes Fibers. We should abstract platform details. + * + * - arguments passed to the function from `makecontext' are all ints, so it may + * be useful to us only to pass flags, and most notably not pointers (objects) + * + * - `getcontext' creates a new instance of context notably uc_link is not + * inherited from the current context (uc_link contains uinitialized data). + * + * - we must ensure that GC scans all stacks if we don't want to drop objects, + * or disable GC while we are in a multi-stack context + * + * -------------------------------------------------------------------------- */ + +ucontext_t ret; + +static void +_lwp_entry(void) +{ + ucontext_t *top, *own; + top = &ret; + own = top->uc_link; + printf("YYY this is an entry!\n"); + printf("YYY yield\n"); + swapcontext(own, top); + printf("YYY continue brrt!\n"); + printf("YYY return\n"); +} cl_object si_make_thread(cl_object fun) @@ -32,3 +68,33 @@ si_make_continuation(cl_object thread) o->cont.thread = thread; ecl_return1(the_env, o); } + +cl_object +si_pass(cl_object cont) +{ + const cl_env_ptr the_env = ecl_process_env(); + ucontext_t *uc = &cont->cont.uc; + char *stack = cont->cont.stack; + getcontext(uc); + + printf("XXX setup!\n"); + uc->uc_stack.ss_sp = stack; + uc->uc_stack.ss_size = sizeof(stack); + uc->uc_link = &ret; + ret.uc_link = uc; + ecl_module_gc->module.disable(); + + makecontext(uc, (void(*)(void))_lwp_entry, 0); + printf("XXX dispatch!\n"); + + swapcontext(&ret, uc); + printf("XXX returned!\n"); + + swapcontext(&ret, uc); + printf("XXX finished!\n"); + + ecl_module_gc->module.enable(); + ecl_return1(the_env, ECL_T); +} + +/* (si:pass (si:make-continuation (si:make-thread nil))) */ diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 1a081b8fe..fbe7e9da6 100644 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1853,6 +1853,7 @@ cl_symbols[] = { {SYS_ "MAKE-CONTINUATION" ECL_FUN("si_make_continuation", ECL_NAME(si_make_continuation), 1) ECL_VAR(EXT_ORDINARY, OBJNULL)}, {SYS_ "MAKE-THREAD" ECL_FUN("si_make_thread", ECL_NAME(si_make_thread), 1) ECL_VAR(EXT_ORDINARY, OBJNULL)}, +{SYS_ "PASS" ECL_FUN("si_pass", ECL_NAME(si_pass), 1) ECL_VAR(EXT_ORDINARY, OBJNULL)}, {SYS_ "TOKEN" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "MODULE" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, diff --git a/src/h/ecl.h b/src/h/ecl.h index 1fa4363df..52d3e5662 100644 --- a/src/h/ecl.h +++ b/src/h/ecl.h @@ -23,6 +23,7 @@ #include /* setjmp and buffers */ #include /* FILE */ #include +#include /* Microsoft VC++ does not have va_copy() */ #if ( defined(_MSC_VER) && (_MSC_VER < 1800) ) || !defined(va_copy) #define va_copy(dst, src) \ diff --git a/src/h/external.h b/src/h/external.h index 5aa042a48..13c80f900 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -1814,6 +1814,7 @@ extern ECL_API void ecl_tcp_close_all(void); /* lwp.c */ extern ECL_API cl_object si_make_thread(cl_object fun); extern ECL_API cl_object si_make_continuation(cl_object thread); +extern ECL_API cl_object si_pass(cl_object continuation); /* threads.c */