From 07500ce6d6d3639b738d7a4890b338cf5a490231 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Sun, 22 Jan 2017 18:58:37 -0500
Subject: [PATCH] Properly store thread ID in thread objects

Also sketched out thread-join support but there are larger issues to consider to get that working.
---
 examples/threading/thread-join.scm | 16 +++++++++++++++
 include/cyclone/types.h            |  1 +
 runtime.c                          |  5 ++---
 scheme/cyclone/cgen.sld            |  1 +
 srfi/18.sld                        | 31 ++++++++++++++++++++++++------
 5 files changed, 45 insertions(+), 9 deletions(-)

diff --git a/examples/threading/thread-join.scm b/examples/threading/thread-join.scm
index 2aaebbcc..b4b478c8 100644
--- a/examples/threading/thread-join.scm
+++ b/examples/threading/thread-join.scm
@@ -24,3 +24,19 @@
 (display "main thread done")
 (newline)
 (thread-sleep! 500)
+
+;(display "thread join")
+;(newline)
+;(let ((t (make-thread
+;            (lambda ()
+;              (display "started second thread")
+;              (newline)
+;              (thread-sleep! 3000)
+;              (display "thread done")
+;              (newline)
+;              1))))
+;  (thread-start! t)
+;  (thread-sleep! 1)
+;  (display (thread-join! t))
+;  (display "main thread done again")
+;  (newline))
diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index 3f947368..e7be94fa 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -140,6 +140,7 @@ struct gc_thread_data_t {
   void **mark_buffer;
   int mark_buffer_len;
   pthread_mutex_t lock;
+  pthread_t thread_id;
   // Data needed for call history
   char **stack_traces;
   int stack_trace_idx;
diff --git a/runtime.c b/runtime.c
index 40d88113..3f6d6421 100644
--- a/runtime.c
+++ b/runtime.c
@@ -4167,6 +4167,7 @@ int gc_minor(void *data, object low_limit, object high_limit, closure cont,
 
   // Transport exception stack
   gc_move2heap(((gc_thread_data *) data)->exception_handler_stack);
+  gc_move2heap(((gc_thread_data *) data)->scm_thread_obj);
 
   // Transport mutations
   {
@@ -4720,9 +4721,7 @@ void *Cyc_init_thread(object thread_and_thunk)
   thd->gc_cont = cdr(thread_and_thunk);
   thd->gc_num_args = 1;
   thd->gc_args[0] = &Cyc_91end_91thread_67_primitive;
-//  thd->thread = pthread_self(); // TODO: ptr vs instance
-//  returns instance so would need to malloc here
-//  would also need to update termination code to free that memory
+  thd->thread_id = pthread_self();
   gc_add_mutator(thd);
   ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_NEW,
                 CYC_THREAD_STATE_RUNNABLE);
diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld
index 145f2ebe..6774d085 100644
--- a/scheme/cyclone/cgen.sld
+++ b/scheme/cyclone/cgen.sld
@@ -99,6 +99,7 @@
  thd->gc_cont = &entry_pt;
  thd->gc_args[0] = &clos_halt;
  thd->gc_num_args = 1;
+ thd->thread_id = pthread_self();
  gc_add_mutator(thd);
  Cyc_heap_init(heap_size);
  thd->thread_state = CYC_THREAD_STATE_RUNNABLE;
diff --git a/srfi/18.sld b/srfi/18.sld
index 845a3a1e..94387ddc 100644
--- a/srfi/18.sld
+++ b/srfi/18.sld
@@ -19,7 +19,7 @@
     thread-yield!
     thread-terminate!
     current-thread
-    ;; TODO: thread-join!
+    thread-join!
 
     mutex?
     make-mutex 
@@ -86,21 +86,40 @@
       " gc_thread_data *td = (gc_thread_data *)data;
         return_closcall1(data, k, td->scm_thread_obj); ")
 
+    (define-c %get-thread-data
+      "(void *data, int argc, closure _, object k)"
+      " gc_thread_data *td = (gc_thread_data *)data;
+        make_c_opaque(co, td);
+        return_closcall1(data, k, &co); ")
+
     (define (thread-start! t)
       ;; Initiate a GC prior to running the thread, in case
       ;; t contains any closures on the "parent" thread's stack
       (let* ((thunk (vector-ref t 1)) 
-             (thread-params (cons t thunk)))
+             (thread-params (cons t (lambda ()
+                                      (vector-set! t 2 (%get-thread-data))
+                                      (thunk)))))
         (Cyc-minor-gc)
-        (let ((mutator-id (Cyc-spawn-thread! thread-params)))
-          (vector-set! t 2 mutator-id))))
+        (Cyc-spawn-thread! thread-params)
+        ))
 
     (define (thread-yield!) (thread-sleep! 1))
     (define-c thread-terminate!
       "(void *data, int argc, closure _, object k)"
       " Cyc_end_thread(data); ")
-    ;; TODO: thread-join!
-    ;; TODO: possible to do this using mutator ID to get the pthread_t ??
+
+;; TODO: not good enough, need to return value from thread
+;; TODO: also not good enough because threads are started detached right now, which makes them unjoinable. need to reconcile that with the SRFI 18 requirement to have a join API
+    (define-c %thread-join!
+      "(void *data, int argc, closure _, object k, object thread_data_opaque)"
+      " gc_thread_data *td = (gc_thread_data *)(opaque_ptr(thread_data_opaque));
+        set_thread_blocked(data, k);
+        pthread_join(td->thread_id, NULL);
+        return_thread_runnable(data, boolean_t);")
+    (define (thread-join! t)
+      (if (and (thread? t) (Cyc-opaque? (vector-ref t 2)))
+        (%thread-join! (vector-ref t 2))
+        #f))
 
     (define-c thread-sleep!
       "(void *data, int argc, closure _, object k, object timeout)"