Merge branch 'threads-3' of github.com:janet-lang/janet into threads-3

Makefile

@@ -28,7 +28,7 @@ INCLUDEDIR?=$(PREFIX)/include
 BINDIR?=$(PREFIX)/bin
 LIBDIR?=$(PREFIX)/lib
 JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
-CLIBS=-lm
+CLIBS=-lm -lpthread
 JANET_TARGET=build/janet
 JANET_LIBRARY=build/libjanet.so
 JANET_STATIC_LIBRARY=build/libjanet.a
@@ -106,6 +106,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
 				   src/core/struct.c \
 				   src/core/symcache.c \
 				   src/core/table.c \
+				   src/core/thread.c \
 				   src/core/tuple.c \
 				   src/core/typedarray.c \
 				   src/core/util.c \

auxbin/jpm

@@ -112,6 +112,12 @@
 (def default-linker (if is-win "link" "cc"))
 (def default-archiver (if is-win "lib" "ar"))
 
+# Detect threads
+(def env (fiber/getenv (fiber/current)))
+(def threads? (not (not (env 'thread/from-image))))
+
+(print "threads " threads?)
+
 # Default flags for natives, but not required
 (def default-lflags (if is-win ["/nologo"] []))
 (def default-cflags
@@ -119,6 +125,10 @@
     ["/nologo" "/MD"]
     ["-std=c99" "-Wall" "-Wextra"]))
 
+
+# Link to pthreads
+(def- thread-flags (if is-win [] (if threads? ["-lpthread"] [])))
+
 # Required flags for dynamic libraries. These
 # are used no matter what for dynamic libraries.
 (def- dynamic-cflags
@@ -127,10 +137,10 @@
     ["-fPIC"]))
 (def- dynamic-lflags
     (if is-win
-      ["/DLL"]
+      ["/DLL" ;thread-flags]
       (if is-mac
-        ["-shared" "-undefined" "dynamic_lookup"]
+        ["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
-        ["-shared"])))
+        ["-shared" ;thread-flags])))
 
 (defn- opt
   "Get an option, allowing overrides via dynamic bindings AND some
@@ -497,11 +507,11 @@ int main(int argc, const char **argv) {
 # Compile and link final exectable
 (do
   (def extra-lflags (case (os/which)
-                      :macos ["-ldl" "-lm"]
+                      :macos ["-ldl" "-lm" ;thread-flags]
-                      :windows []
+                      :windows [;thread-flags]
-                      :linux ["-lm" "-ldl" "-lrt"]
+                      :linux ["-lm" "-ldl" "-lrt" ;thread-flags]
                       #default
-                      ["-lm"]))
+                      ["-lm" ;thread-flags]))
   (def cc (opt opts :compiler default-compiler))
   (def lflags [;dep-lflags ;(opt opts :lflags default-lflags) ;extra-lflags])
   (def cflags (getcflags opts))

meson.build

@@ -30,6 +30,7 @@ header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet'
 cc = meson.get_compiler('c')
 m_dep = cc.find_library('m', required : false)
 dl_dep = cc.find_library('dl', required : false)
+thread_dep = dependency('threads')
 
 # Link options
 if build_machine.system() != 'windows'
@@ -128,6 +129,7 @@ core_src = [
   'src/core/struct.c',
   'src/core/symcache.c',
   'src/core/table.c',
+  'src/core/thread.c',
   'src/core/tuple.c',
   'src/core/typedarray.c',
   'src/core/util.c',
@@ -155,7 +157,7 @@ mainclient_src = [
 janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
   include_directories : incdir,
   c_args : '-DJANET_BOOTSTRAP',
-  dependencies : [m_dep, dl_dep],
+  dependencies : [m_dep, dl_dep, thread_dep],
   native : true)
 
 # Build core image
@@ -166,7 +168,7 @@ core_image = custom_target('core_image',
 
 libjanet = library('janet', core_src, core_image,
   include_directories : incdir,
-  dependencies : [m_dep, dl_dep],
+  dependencies : [m_dep, dl_dep, thread_dep],
   install : true)
 
 # Extra c flags - adding -fvisibility=hidden matches the Makefile and
@@ -186,14 +188,14 @@ endif
 
 janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
   include_directories : incdir,
-  dependencies : [m_dep, dl_dep],
+  dependencies : [m_dep, dl_dep, thread_dep],
   c_args : extra_native_cflags,
   install : true)
 
 if meson.is_cross_build()
   janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
     include_directories : incdir,
-    dependencies : [m_dep, dl_dep],
+    dependencies : [m_dep, dl_dep, thread_dep],
     c_args : extra_cross_cflags,
     native : true)
 else
@@ -223,7 +225,7 @@ amalg_shell = custom_target('amalg-shell',
 # Amalgamated client
 janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
   include_directories : incdir,
-  dependencies : [m_dep, dl_dep],
+  dependencies : [m_dep, dl_dep, thread_dep],
   build_by_default : false)
 
 # Tests

src/boot/boot.janet

@@ -1843,16 +1843,27 @@
     (res)
     (error (res :error))))
 
+
+(def make-image-dict
+  "A table used in combination with marshal to marshal code (images), such that
+  (make-image x) is the same as (marshal x make-image-dict)."
+  @{})
+
+(def load-image-dict
+  "A table used in combination with unmarshal to unmarshal byte sequences created
+  by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-images-dict)."
+  @{})
+
 (defn make-image
   "Create an image from an environment returned by require.
   Returns the image source as a string."
   [env]
-  (marshal env (invert (env-lookup _env))))
+  (marshal env make-image-dict))
 
 (defn load-image
   "The inverse operation to make-image. Returns an environment."
   [image]
-  (unmarshal image (env-lookup _env)))
+  (unmarshal image load-image-dict))
 
 (def- nati (if (= :windows (os/which)) ".dll" ".so"))
 (defn- check-. [x] (if (string/has-prefix? "." x) x))
@@ -2108,9 +2119,16 @@
                 :on-status (or onsignal (make-onsignal env 1))
                 :source "repl"}))
 
-# Clean up some extra defs
+###
-(put _env 'boot/opts nil)
+###
-(put _env '_env nil)
+### Thread Extras
+###
+###
+
+(defn thread/new
+  "Create a new thread from a closure."
+  [f]
+  (thread/from-image (make-image f)))
 
 ###
 ###
@@ -2232,6 +2250,19 @@
     (setdyn :err-color (if *colorize* true))
     (repl getchunk onsig)))
 
+
+###
+###
+### Clean up
+###
+###
+
+(do
+  (put _env 'boot/opts nil)
+  (put _env '_env nil)
+  (merge-into load-image-dict (env-lookup _env))
+  (merge-into make-image-dict (invert load-image-dict)))
+
 ###
 ###
 ### Bootstrap

src/core/corelib.c

@@ -987,13 +987,54 @@ static const uint32_t propagate_asm[] = {
     JOP_PROPAGATE | (1 << 24),
     JOP_RETURN
 };
-#endif /* ifndef JANET_NO_BOOTSTRAP */
+#endif /* ifdef JANET_BOOTSTRAP */
+
+/*
+ * Setup Environment
+ */
+
+static void janet_load_libs(JanetTable *env) {
+    janet_core_cfuns(env, NULL, corelib_cfuns);
+    janet_lib_io(env);
+    janet_lib_math(env);
+    janet_lib_array(env);
+    janet_lib_tuple(env);
+    janet_lib_buffer(env);
+    janet_lib_table(env);
+    janet_lib_fiber(env);
+    janet_lib_os(env);
+    janet_lib_parse(env);
+    janet_lib_compile(env);
+    janet_lib_debug(env);
+    janet_lib_string(env);
+    janet_lib_marsh(env);
+#ifdef JANET_PEG
+    janet_lib_peg(env);
+#endif
+#ifdef JANET_ASSEMBLER
+    janet_lib_asm(env);
+#endif
+#ifdef JANET_TYPED_ARRAY
+    janet_lib_typed_array(env);
+#endif
+#ifdef JANET_INT_TYPES
+    janet_lib_inttypes(env);
+#endif
+#ifdef JANET_THREADS
+    janet_lib_thread(env);
+#endif
+}
+
+#ifdef JANET_BOOTSTRAP
+
+JanetTable *janet_core_dictionary(JanetTable *replacements) {
+    (void) replacements;
+    janet_panic("not defined in bootstrap");
+    return NULL;
+}
 
 JanetTable *janet_core_env(JanetTable *replacements) {
     JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
-    janet_core_cfuns(env, NULL, corelib_cfuns);
-
-#ifdef JANET_BOOTSTRAP
     janet_quick_asm(env, JANET_FUN_PROP,
                     "propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
                     JDOC("(propagate x fiber)\n\n"
@@ -1145,48 +1186,29 @@ JanetTable *janet_core_env(JanetTable *replacements) {
     /* Allow references to the environment */
     janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
 
-    /* Set as gc root */
+    janet_load_libs(env);
     janet_gcroot(janet_wrap_table(env));
-#endif
+    return env;
+}
 
-    /* Load auxiliary envs */
+#else
-    janet_lib_io(env);
-    janet_lib_math(env);
-    janet_lib_array(env);
-    janet_lib_tuple(env);
-    janet_lib_buffer(env);
-    janet_lib_table(env);
-    janet_lib_fiber(env);
-    janet_lib_os(env);
-    janet_lib_parse(env);
-    janet_lib_compile(env);
-    janet_lib_debug(env);
-    janet_lib_string(env);
-    janet_lib_marsh(env);
-#ifdef JANET_PEG
-    janet_lib_peg(env);
-#endif
-#ifdef JANET_ASSEMBLER
-    janet_lib_asm(env);
-#endif
-#ifdef JANET_TYPED_ARRAY
-    janet_lib_typed_array(env);
-#endif
-#ifdef JANET_INT_TYPES
-    janet_lib_inttypes(env);
-#endif
 
-#ifndef JANET_BOOTSTRAP
+JanetTable *janet_core_dictionary(JanetTable *replacements) {
-    /* Unmarshal from core image */
+    JanetTable *dict = (NULL != replacements) ? replacements : janet_table(0);
+    janet_load_libs(dict);
+    return dict;
+}
+
+JanetTable *janet_core_env(JanetTable *replacements) {
+    JanetTable *dict = janet_core_dictionary(replacements);
     Janet marsh_out = janet_unmarshal(
                           janet_core_image,
                           janet_core_image_size,
                           0,
-                          env,
+                          dict,
                           NULL);
     janet_gcroot(marsh_out);
-    env = janet_unwrap_table(marsh_out);
+    return janet_unwrap_table(marsh_out);
-#endif
-
-    return env;
 }
+
+#endif

src/core/thread.c

@@ -0,0 +1,163 @@
+/*
+* Copyright (c) 2019 Calvin Rose
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+#ifndef JANET_AMALG
+#include <janet.h>
+#include "gc.h"
+#include "util.h"
+#endif
+
+#ifdef JANET_THREADS
+
+#include <pthread.h>
+
+static void shared_cleanup(JanetThreadShared *shared) {
+    pthread_mutex_destroy(&shared->refCountLock);
+    pthread_mutex_destroy(&shared->memoryLock);
+    free(shared->memory);
+    free(shared);
+}
+
+static int thread_gc(void *p, size_t size) {
+    JanetThread *thread = (JanetThread *)p;
+    JanetThreadShared *shared = thread->shared;
+    if (NULL == shared) return 0;
+    (void) size;
+    pthread_mutex_lock(&shared->refCountLock);
+    int refcount = --shared->refCount;
+    if (refcount == 0) {
+        shared_cleanup(shared);
+    } else {
+        pthread_mutex_unlock(&shared->refCountLock);
+    }
+    return 0;
+}
+
+static JanetAbstractType Thread_AT = {
+    "core/thread",
+    thread_gc,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
+JanetThread *janet_getthread(Janet *argv, int32_t n) {
+    return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
+}
+
+/* Runs in new thread */
+static int thread_worker(JanetThreadShared *shared) {
+    /* Init VM */
+    janet_init();
+
+    JanetTable *dict = janet_core_dictionary(NULL);
+    const uint8_t *next = NULL;
+
+    /* Unmarshal the function */
+    Janet funcv = janet_unmarshal(shared->memory, shared->memorySize, 0, dict, &next);
+    if (next == shared->memory) goto error;
+    if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
+    JanetFunction *func = janet_unwrap_function(funcv);
+
+    /* Create self thread */
+    JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
+    thread->shared = shared;
+    thread->handle = pthread_self();
+
+    /* Clean up thread when done, do not wait for a join. For
+     * communicating with other threads, we will rely on the
+     * JanetThreadShared structure. */
+    pthread_detach(thread->handle);
+
+    /* Call function */
+    JanetFiber *fiber = janet_fiber(func, 64, 0, NULL);
+    fiber->env = janet_table(0);
+    janet_table_put(fiber->env, janet_ckeywordv("worker"), janet_wrap_abstract(thread));
+    Janet out;
+    janet_continue(fiber, janet_wrap_nil(), &out);
+
+    /* TODO - marshal 'out' into sharedMemory */
+
+    /* Success */
+    janet_deinit();
+    return 0;
+
+    /* Fail */
+error:
+    janet_deinit();
+    return 1;
+}
+
+void *janet_pthread_wrapper(void *param) {
+    thread_worker((JanetThreadShared *)param);
+    return NULL;
+}
+
+static Janet cfun_from_image(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 1);
+    JanetByteView bytes = janet_getbytes(argv, 0);
+
+    /* Create Shared memory chunk of thread object */
+    JanetThreadShared *shared = malloc(sizeof(JanetThreadShared));
+    uint8_t *mem = malloc(bytes.len);
+    if (NULL == shared || NULL == mem) {
+        janet_panicf("could not allocate memory for thread");
+    }
+    shared->memory = mem;
+    shared->memorySize = bytes.len;
+    memcpy(mem, bytes.bytes, bytes.len);
+    shared->refCount = 2;
+    pthread_mutex_init(&shared->refCountLock, NULL);
+    pthread_mutex_init(&shared->memoryLock, NULL);
+
+    /* Create thread abstract */
+    JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
+    thread->shared = shared;
+
+    /* Run thread */
+    int error = pthread_create(&thread->handle, NULL, janet_pthread_wrapper, shared);
+    if (error) {
+        thread->shared = NULL; /* Prevent GC from trying to mess with shared memory here */
+        shared_cleanup(shared);
+    }
+
+    return janet_wrap_abstract(thread);
+}
+
+static const JanetReg threadlib_cfuns[] = {
+    {
+        "thread/from-image", cfun_from_image,
+        JDOC("(thread/from-image image)\n\n"
+             "Start a new thread. image is a byte sequence, containing a marshalled function.")
+    },
+    {NULL, NULL, NULL}
+};
+
+/* Module entry point */
+void janet_lib_thread(JanetTable *env) {
+    janet_core_cfuns(env, NULL, threadlib_cfuns);
+}
+
+#endif

src/core/util.h

@@ -120,5 +120,8 @@ void janet_lib_typed_array(JanetTable *env);
 #ifdef JANET_INT_TYPES
 void janet_lib_inttypes(JanetTable *env);
 #endif
+#ifdef JANET_THREADS
+void janet_lib_thread(JanetTable *env);
+#endif
 
 #endif

src/include/janet.h

@@ -143,6 +143,11 @@ extern "C" {
 #define JANET_INT_TYPES
 #endif
 
+/* Enable or disable threads */
+#ifndef JANET_NO_THREADS
+#define JANET_THREADS
+#endif
+
 /* How to export symbols */
 #ifndef JANET_API
 #ifdef JANET_WINDOWS
@@ -319,6 +324,24 @@ typedef struct JanetRange JanetRange;
 typedef struct JanetRNG JanetRNG;
 typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
 
+/* Thread types */
+#ifdef JANET_THREADS
+#include <pthread.h>
+typedef struct JanetThread JanetThread;
+typedef struct JanetThreadShared JanetThreadShared;
+struct JanetThreadShared {
+    pthread_mutex_t memoryLock;
+    pthread_mutex_t refCountLock;
+    uint8_t *memory;
+    size_t memorySize;
+    int refCount;
+};
+struct JanetThread {
+    pthread_t handle;
+    JanetThreadShared *shared;
+};
+#endif
+
 /* Basic types for all Janet Values */
 typedef enum JanetType {
     JANET_NUMBER,
@@ -1092,6 +1115,7 @@ struct JanetCompileResult {
 JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where);
 
 /* Get the default environment for janet */
+JANET_API JanetTable *janet_core_dictionary(JanetTable *replacements); /* Used for unmarshaling images */
 JANET_API JanetTable *janet_core_env(JanetTable *replacements);
 
 JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);

src/mainclient/line.c

@@ -89,18 +89,18 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
 /* static state */
 #define JANET_LINE_MAX 1024
 #define JANET_HISTORY_MAX 100
-static int gbl_israwmode = 0;
+static JANET_THREAD_LOCAL int gbl_israwmode = 0;
-static const char *gbl_prompt = "> ";
+static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
-static int gbl_plen = 2;
+static JANET_THREAD_LOCAL int gbl_plen = 2;
-static char gbl_buf[JANET_LINE_MAX];
+static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
-static int gbl_len = 0;
+static JANET_THREAD_LOCAL int gbl_len = 0;
-static int gbl_pos = 0;
+static JANET_THREAD_LOCAL int gbl_pos = 0;
-static int gbl_cols = 80;
+static JANET_THREAD_LOCAL int gbl_cols = 80;
-static char *gbl_history[JANET_HISTORY_MAX];
+static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
-static int gbl_history_count = 0;
+static JANET_THREAD_LOCAL int gbl_history_count = 0;
-static int gbl_historyi = 0;
+static JANET_THREAD_LOCAL int gbl_historyi = 0;
-static int gbl_sigint_flag = 0;
+static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
-static struct termios gbl_termios_start;
+static JANET_THREAD_LOCAL struct termios gbl_termios_start;
 
 /* Unsupported terminal list from linenoise */
 static const char *badterms[] = {
@@ -126,7 +126,6 @@ static int rawmode() {
     if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
     t = gbl_termios_start;
     t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
-    t.c_oflag &= ~(OPOST);
     t.c_cflag |= (CS8);
     t.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
     t.c_cc[VMIN] = 1;
@@ -490,6 +489,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
         }
         return;
     }
+    fflush(stdin);
     norawmode();
     fputc('\n', out);
     janet_buffer_ensure(buffer, gbl_len + 1, 2);