Merge branch 'master' into cargs2-dev

AUTHORS

@@ -16,3 +16,4 @@ Adam Feuer
 Sean Lynch
 @extrasharp
 @nymacro
+Skye Soss

CHANGELOG.md

@@ -6,10 +6,13 @@ Features
 
 - Arthur Maciel added `opaque?` and `opaque-null?` predicates to `(cyclone foreign)`.
 - Added `import-shared-object` to `(scheme eval)` to allow loading a third party C shared library.
+- Allow C compiler/linker options from a library to be expanded via `cond-expand`.
 
 Bug Fixes
 
+- Updated the runtime to avoid a race condition when creating new symbols. Thanks to Skye Soss for the bug report and patch.
 - Prevent the compiler from inlining calls to primitives that open ports, avoiding a range of issues such as an open file operation being inlined across multiple places in the intermediate code.
+- Arthur Maciel updated `current-jiffy` to use `clock_gettime`.
 
 ## 0.26 - February 3, 2021
 

cyclone.scm

@@ -741,7 +741,7 @@
             '()))
          ;; Read all linker options from dependent libs
          (c-linker-options
-           (let ((lib-options (lib:get-all-c-linker-options lib-deps append-dirs prepend-dirs)))
+           (let ((lib-options (lib:get-all-c-linker-options lib-deps append-dirs prepend-dirs expander)))
              (if program?
                  (string-append ;; Also read from current program
                    (string-join (program-c-linker-opts! in-prog) " ")
@@ -791,7 +791,8 @@
                        (lib:get-all-c-linker-options 
                          lib-deps 
                          append-dirs 
-                         prepend-dirs))
+                         prepend-dirs
+                         expander))
                      ;; Return new deps
                      lib-deps)
                    in-file 

runtime.c

@@ -459,9 +459,16 @@ static object find_symbol_by_name(const char *name)
 object add_symbol(symbol_type * psym)
 {
   pthread_mutex_lock(&symbol_table_lock);       // Only 1 "writer" allowed
-  set_insert(&symbol_table, psym);
+  bool inserted = set_insert(&symbol_table, psym);
   pthread_mutex_unlock(&symbol_table_lock);
+  if (!inserted) {
+    object sym = find_symbol_by_name(psym->desc);
+    free((char *)(psym->desc));
+    free(psym);
+    return sym;
+  } else {
     return psym;
+  }
 }
 
 static object add_symbol_by_name(const char *name)

scheme/cyclone/cgen.sld

@@ -2251,12 +2251,6 @@
       *globals*)
     (emit "")
 
-    ;; Initialize symbol table
-    (for-each
-        (lambda (sym)
-            (emit* "  add_symbol(quote_" (mangle sym) ");"))
-        *symbols*)
-
     ;; Initialize globals
     (let* ((prefix "  ")
            (emit-global

scheme/cyclone/cps-opt-memoize-pure-fncs.scm

@@ -168,6 +168,20 @@
       (map scan exp))
      (else exp)
   ))
+
+  ;; Does given sexp contain any top-level define-c expressions?
+  (define (has-define-c? sexp)
+    (call/cc 
+      (lambda (k) 
+        (for-each 
+          (lambda (exp) 
+            (if (define-c? exp) 
+                (k #t))) 
+          sexp)
+        (k #f))))
+
+  (if (has-define-c? sexp)
+      sexp ;; Can't optimize with define-c (yet), so bail
       (let ((new-exp (scan sexp)))
         (cond
           ((not (null? memo-tbl))
@@ -201,9 +215,7 @@
                       memo-tbl)
                   )))
               new-exp)))
-      (else new-exp)))
+          (else new-exp)))))
-)
-
 
 (cond-expand
   (program

scheme/cyclone/libraries.sld

@@ -434,37 +434,43 @@
     (close-input-port fp)
     includes))
 
-(define (lib:read-c-linker-options import append-dirs prepend-dirs)
+(define (lib:read-c-linker-options import append-dirs prepend-dirs expander)
   (let* ((lib-name (lib:import->library-name import))
          (dir (lib:import->filename lib-name ".sld" append-dirs prepend-dirs))
          (fp (open-input-file dir))
          (lib (read-all fp))
-         (options (lib:c-linker-options (car lib))))
+         (lib* (if expander
+                   (list (lib:cond-expand (car lib) expander))
+                   lib))
+         (options (lib:c-linker-options (car lib*))))
     (close-input-port fp)
     (string-join options " ")))
 
-(define (lib:get-all-c-linker-options imports append-dirs prepend-dirs)
+(define (lib:get-all-c-linker-options imports append-dirs prepend-dirs expander)
   (string-join
     (map 
       (lambda (import)
-        (lib:read-c-linker-options import append-dirs prepend-dirs))
+        (lib:read-c-linker-options import append-dirs prepend-dirs expander))
       imports)
     " "))
 
-(define (lib:read-c-compiler-options import append-dirs prepend-dirs)
+(define (lib:read-c-compiler-options import append-dirs prepend-dirs expander)
   (let* ((lib-name (lib:import->library-name import))
          (dir (lib:import->filename lib-name ".sld" append-dirs prepend-dirs))
          (fp (open-input-file dir))
          (lib (read-all fp))
-         (options (lib:c-compiler-options (car lib))))
+         (lib* (if expander
+                   (list (lib:cond-expand (car lib) expander))
+                   lib))
+         (options (lib:c-compiler-options (car lib*))))
     (close-input-port fp)
     (string-join options " ")))
 
-(define (lib:get-all-c-compiler-options imports append-dirs prepend-dirs)
+(define (lib:get-all-c-compiler-options imports append-dirs prepend-dirs expander)
   (string-join
     (map 
       (lambda (import)
-        (lib:read-c-compiler-options import append-dirs prepend-dirs))
+        (lib:read-c-compiler-options import append-dirs prepend-dirs expander))
       imports)
     " "))
 

scheme/time.sld

@@ -10,12 +10,9 @@
   (export 
     current-second
     current-jiffy
-    jiffies-per-second
+    jiffies-per-second)
-  )
+  (include-c-header "<time.h>")
-  (include-c-header "<sys/time.h>")
+  (import (scheme base))
-  (import (scheme base) 
-  )
-;; TODO: get an FFI syntax for including C header files, even if it is not needed for this library
   (begin
     (define-c current-second
       "(void *data, int argc, closure _, object k)"
@@ -25,10 +22,10 @@
         return_closcall1(data, k, &box); ")
     (define-c current-jiffy
       "(void *data, int argc, closure _, object k)"
-      " struct timeval tv;
+      " struct timespec now;
         make_double(box, 0.0);
-        gettimeofday(&tv, NULL); /* TODO: longer-term consider using clock_gettime instead */
+        clock_gettime(CLOCK_MONOTONIC, &now);
-        long long jiffy = (tv.tv_sec)*1000000LL + tv.tv_usec;
+        long long jiffy = (now.tv_sec)*1000000LL + now.tv_nsec/1000; // nano->microseconds
         /* Future consideration:
         mp_int bn_tmp, bn_tmp2, bn_tmp3;
         mp_init(&bn_tmp);
@@ -50,5 +47,4 @@
       "(void *data, int argc, closure _, object k)"
       " int n = 1000000;
         object obj = obj_int2obj(n);
-        return_closcall1(data, k, obj); ")
+        return_closcall1(data, k, obj); ")))
-  ))