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);
-  return psym;
+  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,42 +168,54 @@
       (map scan exp))
      (else exp)
   ))
-  (let ((new-exp (scan sexp)))
-    (cond
-      ((not (null? memo-tbl))
-       (when (procedure? add-globals!)
-         (add-globals! (map cdr memo-tbl)))
-       (append
-        (map 
-          (lambda (var/new-var)
-            `(define ,(car var/new-var) #f))
-          memo-tbl)
-        (map
-          (lambda (exp)
-            (cond
-              ((define? exp) exp) ;; not top-level
-              (else
-                ;; Memoize all of the functions at top-level
-                (foldl 
-                  (lambda (var/new-var acc)
-                    (let* ((rsym (gensym 'r))
-                           (var (car var/new-var))
-                           (new-var (cdr var/new-var))
-                           (body
-                             `((Cyc-seq
-                                 (set-global-unsafe! ,(list 'quote var) ,var ,rsym)
-                                 ,acc)))
-                          )
-                      `(Cyc-memoize
-                         ,(ast:make-lambda (list rsym) body)
-                         ,new-var)))
-                  exp
-                  memo-tbl)
-              )))
-          new-exp)))
-      (else new-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))
+           (when (procedure? add-globals!)
+             (add-globals! (map cdr memo-tbl)))
+           (append
+            (map 
+              (lambda (var/new-var)
+                `(define ,(car var/new-var) #f))
+              memo-tbl)
+            (map
+              (lambda (exp)
+                (cond
+                  ((define? exp) exp) ;; not top-level
+                  (else
+                    ;; Memoize all of the functions at top-level
+                    (foldl 
+                      (lambda (var/new-var acc)
+                        (let* ((rsym (gensym 'r))
+                               (var (car var/new-var))
+                               (new-var (cdr var/new-var))
+                               (body
+                                 `((Cyc-seq
+                                     (set-global-unsafe! ,(list 'quote var) ,var ,rsym)
+                                     ,acc)))
+                              )
+                          `(Cyc-memoize
+                             ,(ast:make-lambda (list rsym) body)
+                             ,new-var)))
+                      exp
+                      memo-tbl)
+                  )))
+              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); ")))
-  ))