Commit 7b870505c761f67e57cdefa22f6716c006b880c7

Thomas de Grivel 2024-12-02T20:39:37

wip threads

diff --git a/.ikc3_history b/.ikc3_history
index 458c8c6..47af30a 100644
--- a/.ikc3_history
+++ b/.ikc3_history
@@ -1,4 +1,3 @@
-type(1234)
 type(12345)
 type(123456)
 type(123456789)
@@ -97,3 +96,4 @@ quote if true do %{plop: 123, hop: 456} end
 pid
 pid()
 man getpid
+t = Thread.new(fn () { puts("ok") })
diff --git a/lib/kc3/0.1/httpd.kc3 b/lib/kc3/0.1/httpd.kc3
index 6a610b0..79fd872 100644
--- a/lib/kc3/0.1/httpd.kc3
+++ b/lib/kc3/0.1/httpd.kc3
@@ -96,8 +96,8 @@ defmodule HTTPd do
   def daemonize = fn () {
     if (KC3.daemonize) do
       puts("forking to background")
-      if fork() > 0 do
-        exit(0)
+      if (pid = fork()) > 0 do
+        _exit(0)
       end
     end
   }
@@ -105,9 +105,9 @@ defmodule HTTPd do
   def time_zero = %Time{}
 
   def server = fn (host, port) {
-    daemonize()
-    if event_base = Event.base_new() do
-      if socket = Socket.listen(host, port) do
+    if socket = Socket.listen(host, port) do
+      daemonize()
+      if event_base = Event.base_new() do
         puts("KC3 HTTPd: listening on #{host}:#{port}")
         load_app()
         acceptor_ev = Event.new(event_base, socket.fd, [:read, :persist],
diff --git a/lib/kc3/0.1/kc3.facts b/lib/kc3/0.1/kc3.facts
index 0fb1ecc..60ec745 100644
--- a/lib/kc3/0.1/kc3.facts
+++ b/lib/kc3/0.1/kc3.facts
@@ -304,6 +304,8 @@ add {KC3, :symbol, KC3.inspect}
 replace {KC3.inspect, :symbol_value, cfn Str "inspect_tag" (Tag, Result)}
 add {KC3, :symbol, KC3.exit}
 replace {KC3.exit, :symbol_value, cfn Void "kc3_exit" (Tag)}
+add {KC3, :symbol, KC3._exit}
+replace {KC3._exit, :symbol_value, cfn Void "kc3__exit" (Tag)}
 add {KC3, :symbol, KC3.fork}
 replace {KC3.fork, :symbol_value, cfn S32 "fork" ()}
 add {KC3, :symbol, KC3.system}
diff --git a/lib/kc3/0.1/thread.kc3 b/lib/kc3/0.1/thread.kc3
new file mode 100644
index 0000000..0ca1b84
--- /dev/null
+++ b/lib/kc3/0.1/thread.kc3
@@ -0,0 +1,7 @@
+defmodule Thread do
+
+  def delete = cfn Tag "kc3_thread_delete" (Ptr, Result)
+
+  def new = cfn Ptr "kc3_thread_new" (Result, Callable)
+
+end
diff --git a/libkc3/env.c b/libkc3/env.c
index a48dd1d..f77ef9c 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -63,7 +63,7 @@
 #include "tuple.h"
 #include "var.h"
 
-s_env g_kc3_env;
+thread_local s_env g_kc3_env;
 
 static void env_clean_globals (s_env *env);
 static void env_clean_toplevel (s_env *env);
diff --git a/libkc3/env.h b/libkc3/env.h
index 6e234f6..197fc07 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -15,7 +15,7 @@
 
 #include "types.h"
 
-extern s_env g_kc3_env;
+extern thread_local s_env g_kc3_env;
 
 /* Stack allocation compatible functions, call env_clean after use. */
 void    env_clean (s_env *env);
diff --git a/libkc3/eval.c b/libkc3/eval.c
index b146fb6..fff636f 100644
--- a/libkc3/eval.c
+++ b/libkc3/eval.c
@@ -24,7 +24,6 @@ bool eval_callable_call (s_callable *callable, s_list *arguments,
                          s_tag *dest)
 {
   assert(callable);
-  assert(arguments);
   assert(dest);
   if (! callable) {
     err_puts("eval_callable_call: NULL callable");
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index 7b1b27a..a4210e7 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -12,6 +12,7 @@
  */
 #include <dlfcn.h>
 #include <errno.h>
+#include <pthread.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -31,6 +32,7 @@
 #include "buf_parse.h"
 #include "call.h"
 #include "env.h"
+#include "eval.h"
 #include "fact.h"
 #include "facts.h"
 #include "facts_cursor.h"
@@ -38,6 +40,7 @@
 #include "kc3_main.h"
 #include "list.h"
 #include "map.h"
+#include "s32.h"
 #include "str.h"
 #include "struct.h"
 #include "struct_type.h"
@@ -223,6 +226,19 @@ void kc3_exit (s_tag *code)
   exit((int) code_u8);
 }
 
+void kc3__exit (s_tag *code)
+{
+  u8 code_u8;
+  const s_sym *type;
+  type = &g_sym_U8;
+  if (! u8_init_cast(&code_u8, &type, code)) {
+    err_puts("kc3__exit: u8_init_cast");
+    assert(! "kc3__exit: u8_init_cast");
+    return;
+  }
+  _exit((int) code_u8);
+}
+
 s_tag * kc3_fact_object (s_fact *fact, s_tag *dest)
 {
   if (! fact->object)
@@ -695,6 +711,44 @@ void kc3_system_pipe_exec (s32 pipe_w, char **argv,
   _exit(1);
 }
 
+s_tag * kc3_thread_delete (u_ptr_w *thread, s_tag *dest)
+{
+  pthread_t t;
+  s_tag *tmp;
+  t = thread->p;
+  if (pthread_join(t, (void **) &tmp)) {
+    err_puts("kc3_thread_delete: pthread_join");
+    assert(! "kc3_thread_delete: pthread_join");
+    return NULL;
+  }
+  *dest = *tmp;
+  free(tmp);
+  return dest;
+}
+
+u_ptr_w * kc3_thread_new (u_ptr_w *dest, p_callable *start)
+{
+  if (pthread_create((pthread_t *) &dest->p, NULL, kc3_thread_start,
+                     *start)) {
+    err_puts("kc3_thread_new: pthread_create");
+    assert(! "kc3_thread_new: pthread_create");
+    return NULL;
+  }
+  return dest;
+}
+
+void * kc3_thread_start (void *arg)
+{
+  s_callable *start;
+  s_tag *tag;
+  start = arg;
+  if (! (tag = tag_new()))
+    return NULL;
+  if (! eval_callable_call(start, NULL, tag))
+    return NULL;
+  return tag;
+}
+
 s_tag * kc3_while (s_tag *cond, s_tag *body, s_tag *dest)
 {
   return env_while(&g_kc3_env, cond, body, dest);
diff --git a/libkc3/kc3_main.h b/libkc3/kc3_main.h
index ec76097..905afb8 100644
--- a/libkc3/kc3_main.h
+++ b/libkc3/kc3_main.h
@@ -124,6 +124,9 @@ s_str *      kc3_strerror (sw err_no, s_str *dest);
 s_tag *      kc3_struct_put (s_tag *s, const s_sym * const *key,
                              s_tag *value, s_tag *dest);
 s_str *      kc3_system (const s_list * const *list, s_str *dest);
+s_tag *      kc3_thread_delete (u_ptr_w *thread, s_tag *dest);
+u_ptr_w *    kc3_thread_new (u_ptr_w *dest, p_callable *start);
+void *       kc3_thread_start (void *arg);
 
 /* Special operators. */
 s_tag * kc3_if_then_else (s_tag *cond, s_tag *then,
diff --git a/libkc3/types.h b/libkc3/types.h
index 8fa56e2..a6e4d69 100644
--- a/libkc3/types.h
+++ b/libkc3/types.h
@@ -34,6 +34,25 @@
 # undef true
 #endif
 
+#ifndef thread_local
+# if __STDC_VERSION__ >= 201112 && !defined __STDC_NO_THREADS__
+#  define thread_local _Thread_local
+# elif defined _WIN32 && (defined _MSC_VER || \
+                          defined __ICL ||    \
+                          defined __DMC__ ||  \
+                          defined __BORLANDC__ )
+#  define thread_local __declspec(thread)
+/* note that ICC (linux) and Clang are covered by __GNUC__ */
+# elif defined __GNUC__ ||   \
+       defined __SUNPRO_C || \
+       defined __hpux ||     \
+       defined __xlC__
+#  define thread_local __thread
+# else
+#  error "Cannot define thread_local"
+# endif
+#endif
+
 /* Basic integer types. */
 typedef int8_t             s8;
 typedef int16_t            s16;
diff --git a/test/Makefile b/test/Makefile
index f38ae78..b7b3660 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -166,21 +166,6 @@ test_http_cov:
 test_http_debug:
 	KC3S=${SRC_TOP}/kc3s/kc3s_debug time ./http_test
 
-test_httpd: test_httpd_assets
-	${SRC_TOP}/httpd/.libs/kc3_httpd -C ${SRC_TOP}/test/httpd -d 127.0.0.1 58000
-
-test_httpd_asan: test_httpd_assets
-	${SRC_TOP}/httpd/.libs/kc3_httpd_asan -C ${SRC_TOP}/test/httpd -d 127.0.0.1 58000
-
-test_httpd_assets:
-	${MAKE} -C httpd/assets
-
-test_httpd_cov: test_httpd_assets
-	${SRC_TOP}/httpd/.libs/kc3_httpd_cov -C ${SRC_TOP}/httpd -d 0.0.0.0 58000
-
-test_httpd_debug: test_httpd_assets
-	${SRC_TOP}/httpd/.libs/kc3_httpd_debug -C ${SRC_TOP}/httpd -d 0.0.0.0 58000
-
 test_ikc3:
 	IKC3=${SRC_TOP}/ikc3/ikc3 time ./ikc3_test
 
diff --git a/test/httpd/Makefile b/test/httpd/Makefile
new file mode 100644
index 0000000..89a0655
--- /dev/null
+++ b/test/httpd/Makefile
@@ -0,0 +1,22 @@
+
+include ../config.mk
+
+main: assets
+	${SRC_TOP}/httpd/.libs/kc3_httpd -C ${SRC_TOP}/test/httpd -d 127.0.0.1 15004
+
+assets:
+	${MAKE} -C assets
+
+asan: assets
+	${SRC_TOP}/httpd/.libs/kc3_httpd_asan -C ${SRC_TOP}/test/httpd -d 127.0.0.1 15004
+
+cov: assets
+	${SRC_TOP}/httpd/.libs/kc3_httpd_cov -C ${SRC_TOP}/test/httpd -d 127.0.0.1 15004
+
+debug: assets
+	${SRC_TOP}/httpd/.libs/kc3_httpd_debug -C ${SRC_TOP}/test/httpd -d 127.0.0.1 15004
+
+run: assets
+	${SRC_TOP}/httpd/.libs/kc3_httpd -C ${SRC_TOP}/test/httpd 127.0.0.1 15004
+
+.PHONY: assets asan cov debug main run