lwp: first jump to a different stack

src/c/lwp.d

@@ -13,6 +13,42 @@
  */
 
 #include <ecl/ecl.h>
+#include <ecl/internal.h>
+
+#include <ucontext.h>
+
+/* -- 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))) */

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)},

src/h/ecl.h

@@ -23,6 +23,7 @@
 #include <setjmp.h>             /* setjmp and buffers */
 #include <stdio.h>              /* FILE */
 #include <stdbool.h>
+#include <ucontext.h>
 /* Microsoft VC++ does not have va_copy() */
 #if ( defined(_MSC_VER) && (_MSC_VER < 1800) ) || !defined(va_copy)
 #define va_copy(dst, src) \

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 */