Executables linking to natives working on linux.

This involves a bunch of machinery in cook.janet
and even a little bit in the janet C API.

auxlib/cook.janet

@@ -253,13 +253,18 @@
     (string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
     (string (if is-win "/O" "-O") (opt opts :optimize 2))])
 
+(defn- entry-name
+  "Name of symbol that enters static compilation of a module."
+  [name]
+  (string "janet_module_entry_" (filepath-replace name)))
+
 (defn- compile-c
   "Compile a C file into an object file."
   [opts src dest &opt static?]
   (def cc (opt opts :compiler default-compiler))
   (def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)])
   (def entry-defines (if-let [n (opts :entry-name)]
-                       [(make-define "JANET_ENTRY_NAME" (string "janet_module_entry_" (filepath-replace n)))]
+                       [(make-define "JANET_ENTRY_NAME" n)]
                        []))
   (def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
   (def headers (or (opts :headers) []))
@@ -292,20 +297,13 @@
   [opts target & objects]
   (def ld (opt opts :linker default-linker))
   (def cflags (getcflags opts))
-  (def standalone (opts :standalone))
   (def lflags [;(opt opts :lflags default-lflags)
-               ;(if (opts :static) [] dynamic-lflags)
-               ;(if standalone (case (os/which)
-                                :macos ["-ldl" "-lm"]
-                                :windows []
-                                :linux ["-lm" "-ldl" "-lrt"]
-                                #default
-                                ["-lm"]) [])])
+               ;(if (opts :static) [] dynamic-lflags)])
   (rule target objects
         (print "linking " target "...")
         (if is-win
-          (shell ld ;lflags (string "/OUT:" target) ;objects (if standalone (libjanet) (win-import-library)))
-          (shell ld ;cflags `-o` target ;objects ;(if standalone [(libjanet)] []) ;lflags))))
+          (shell ld ;lflags (string "/OUT:" target) ;objects (win-import-library))
+          (shell ld ;cflags `-o` target ;objects ;lflags))))
 
 (defn- archive-c
   "Link object files together to make a static library."
@@ -340,6 +338,16 @@
 
 (def- root-env (table/getproto (fiber/getenv (fiber/current))))
 
+(defn- modpath-to-meta
+  "Get the meta file path (.meta.janet) corresponding to a native module path (.so)."
+  [path]
+  (string (string/slice path 0 (- (length modext))) "meta.janet"))
+
+(defn- modpath-to-static
+  "Get the static library (.a) path corresponding to a native module path (.so)."
+  [path]
+  (string (string/slice path 0 (- -1 (length modext))) statext))
+
 (defn- create-executable
   "Links an image with libjanet.a (or .lib) to produce an
   executable. Also will try to link native modules into the
@@ -348,37 +356,84 @@
 
   # Create executable's janet image
   (def cimage_dest (string dest ".c"))
-  (rule cimage_dest [source]
+  (rule dest [source]
         (print "generating executable c source...")
         # Load entry environment and get main function.
         (def entry-env (dofile source))
         (def main ((entry-env 'main) :value))
+
         # Create marshalling dictionary
         (def mdict (invert (env-lookup root-env)))
+        # Load all native modules
+        (def prefixes @{})
+        (def static-libs @[])
+        (loop [[name m] :pairs module/cache
+               :let [n (m :native)]
+               :when n
+               :let [prefix (gensym)]]
+          (print "found native " n "...")
+          (put prefixes prefix n)
+          (array/push static-libs (modpath-to-static n))
+          (def oldproto (table/getproto m))
+          (table/setproto m nil)
+          (loop [[sym value] :pairs (env-lookup m)]
+            (put mdict value (symbol prefix sym)))
+          (table/setproto m oldproto))
+
+        # Find static modules
+        (def declarations @"")
+        (def lookup-into-invocations @"")
+        (loop [[prefix name] :pairs prefixes]
+          (def meta (eval-string (slurp (modpath-to-meta name))))
+          (buffer/push-string lookup-into-invocations
+                              "    "
+                              (meta :static-entry)
+                              "(temptab = janet_table(0));\n"
+                              "    janet_env_lookup_into(lookup, temptab, \""
+                              prefix
+                              "\", 0);\n")
+          (buffer/push-string declarations
+                              "extern void "
+                              (meta :static-entry)
+                              "(JanetTable *);\n"))
+
+
         # Build image
         (def image (marshal main mdict))
         # Make image byte buffer
         (create-buffer-c-impl image cimage_dest "janet_payload_image")
         # Append main function
-        (spit cimage_dest ```
+        (spit cimage_dest (string
+                            "\n"
+                            declarations
+```
 
 int main(int argc, const char **argv) {
     janet_init();
 
-    /* Unmarshal bytecode */
+    /* Get core env */
     JanetTable *env = janet_core_env(NULL);
     JanetTable *lookup = janet_env_lookup(env);
+    JanetTable *temptab;
+
+    /* Load natives into unmarshalling dictionary */
+
+```
+                            lookup-into-invocations
+```
+
+    /* Unmarshal bytecode */
     Janet marsh_out = janet_unmarshal(
-       janet_payload_image_embed,
-       janet_payload_image_embed_size,
-       0,
-       lookup,
-       NULL);
+      janet_payload_image_embed,
+      janet_payload_image_embed_size,
+      0,
+      lookup,
+      NULL);
 
     /* Verify the marshalled object is a function */
     if (!janet_checktype(marsh_out, JANET_FUNCTION)) {
-       fprintf(stderr, "invalid bytecode image - expected function.");
-       return 1;
+      fprintf(stderr, "invalid bytecode image - expected function.");
+      return 1;
     }
 
     /* Collect command line arguments */
@@ -404,16 +459,25 @@ int main(int argc, const char **argv) {
     }
     return 0;
 }
-``` :ab))
 
-  # Compile c source
-  (def entryo (string dest objext))
-  (compile-c opts cimage_dest entryo true)
+```) :ab)
 
-  # Link
-  (link-c (merge @{:static true :standalone true} opts)
-          dest
-          entryo))
+# Compile and link final exectable
+(do
+  (def extra-lflags (case (os/which)
+                      :macos ["-ldl" "-lm"]
+                      :windows []
+                      :linux ["-lm" "-ldl" "-lrt"]
+                      #default
+                      ["-lm"]))
+  (def cc (opt opts :compiler default-compiler))
+  (def lflags [(libjanet) ;(opt opts :lflags default-lflags) ;extra-lflags])
+  (def cflags (getcflags opts))
+  (def defines (make-defines (opt opts :defines {})))
+  (print "compiling and linking " dest "...")
+  (if is-win
+    (shell cc ;cflags ;lflags (string "/OUT:" dest) cimage_dest ;static-libs)
+    (shell cc ;cflags `-o` dest cimage_dest ;lflags ;static-libs)))))
 
 (defn- abspath
   "Create an absolute path. Does not resolve . and .. (useful for
@@ -534,10 +598,23 @@ int main(int argc, const char **argv) {
   (add-dep "build" lname)
   (install-rule lname path)
 
+  # Add meta file
+  (def metaname (modpath-to-meta lname))
+  (def ename (entry-name name))
+  (rule metaname []
+        (print "generating meta file " metaname "...")
+        (spit metaname (string/format
+                         "# Metadata for static library %s\n\n%.20p"
+                         (string name statext)
+                         {:static-entry ename
+                          :lflags (opts :lflags)})))
+  (add-dep "build" metaname)
+  (install-rule metaname path)
+
   # Make static module
   (unless (dyn :nostatic)
-    (def opts (merge @{:entry-name name} opts))
     (def sname (string "build" sep name statext))
+    (def opts (merge @{:entry-name ename} opts))
     (def sobjext (string ".static" objext))
     (def sjobjext (string ".janet" sobjext))
     (loop [src :in sources]

src/core/corelib.c

@@ -48,8 +48,8 @@ typedef HINSTANCE Clib;
 static char error_clib_buf[256];
 static char *error_clib(void) {
     FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
-               NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), 
-               error_clib_buf, sizeof(error_clib_buf), NULL);
+                   NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+                   error_clib_buf, sizeof(error_clib_buf), NULL);
     error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
     return error_clib_buf;
 }

src/core/marsh.c

@@ -84,19 +84,36 @@ static Janet entry_getval(Janet env_entry) {
     }
 }
 
-/* Make a forward lookup table from an environment (for unmarshaling) */
-JanetTable *janet_env_lookup(JanetTable *env) {
-    JanetTable *renv = janet_table(env->count);
+/* Merge values from an environment into an existing lookup table. */
+void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse) {
     while (env) {
         for (int32_t i = 0; i < env->capacity; i++) {
             if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
-                janet_table_put(renv,
-                                env->data[i].key,
-                                entry_getval(env->data[i].value));
+                if (prefix) {
+                    size_t prelen = strlen(prefix);
+                    const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
+                    int32_t oldlen = janet_string_length(oldsym);
+                    uint8_t *symbuf = janet_smalloc(prelen + oldlen);
+                    memcpy(symbuf, prefix, prelen);
+                    memcpy(symbuf + prelen, oldsym, oldlen);
+                    Janet s = janet_symbolv(symbuf, prelen + oldlen);
+                    janet_sfree(symbuf);
+                    janet_table_put(renv, s, entry_getval(env->data[i].value));
+                } else {
+                    janet_table_put(renv,
+                                    env->data[i].key,
+                                    entry_getval(env->data[i].value));
+                }
             }
         }
-        env = env->proto;
+        env = recurse ? env->proto : NULL;
     }
+}
+
+/* Make a forward lookup table from an environment (for unmarshaling) */
+JanetTable *janet_env_lookup(JanetTable *env) {
+    JanetTable *renv = janet_table(env->count);
+    janet_env_lookup_into(renv, env, NULL, 1);
     return renv;
 }
 

src/include/janet.h

@@ -1243,6 +1243,7 @@ JANET_API Janet janet_unmarshal(
     JanetTable *reg,
     const uint8_t **next);
 JANET_API JanetTable *janet_env_lookup(JanetTable *env);
+JANET_API void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse);
 
 /* GC */
 JANET_API void janet_mark(Janet x);

src/mainclient/main.c

@@ -47,12 +47,12 @@ int main(int argc, char **argv) {
     dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
     SetConsoleMode(hOut, dwMode);
     SetConsoleOutputCP(65001);
-    
+
     /* Add directory containing janet.exe as DLL search path for
     dynamic modules on windows. This is needed because dynamic modules reference
     janet.exe for symbols. Otherwise, janet.exe would have to be in the current directory
     to load natives correctly. */
- #ifndef JANET_NO_DYNAMIC_MODULES
+#ifndef JANET_NO_DYNAMIC_MODULES
     {
         SetDefaultDllDirectories(LOAD_LIBRARY_SEARCH_USER_DIRS);
         HMODULE hModule = GetModuleHandleW(NULL);
@@ -87,7 +87,7 @@ int main(int argc, char **argv) {
 
     /* Save current executable path to (dyn :executable) */
     janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
-    
+
     /* Run startup script */
     status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
 

test/install/testexec.janet

@@ -1,2 +1,5 @@
+(use build/testmod)
+
 (defn main [&]
-  (print "Hello from executable!"))
+  (print "Hello from executable!")
+  (print (get5)))