diff --git a/AUTHORS b/AUTHORS index ec54277a..a9c58825 100644 --- a/AUTHORS +++ b/AUTHORS @@ -16,3 +16,4 @@ Adam Feuer Sean Lynch @extrasharp @nymacro +Skye Soss diff --git a/CHANGELOG.md b/CHANGELOG.md index 3102e5f6..f4b499a2 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/cyclone.scm b/cyclone.scm index be581d7d..5ebfddb3 100644 --- a/cyclone.scm +++ b/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 diff --git a/runtime.c b/runtime.c index 901740bf..e7f31ff5 100644 --- a/runtime.c +++ b/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) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 1fbc3084..2dcaaf8a 100644 --- a/scheme/cyclone/cgen.sld +++ b/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 diff --git a/scheme/cyclone/cps-opt-memoize-pure-fncs.scm b/scheme/cyclone/cps-opt-memoize-pure-fncs.scm index 62db884b..1b096394 100644 --- a/scheme/cyclone/cps-opt-memoize-pure-fncs.scm +++ b/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 diff --git a/scheme/cyclone/libraries.sld b/scheme/cyclone/libraries.sld index b07eee7b..0345438b 100644 --- a/scheme/cyclone/libraries.sld +++ b/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) " ")) diff --git a/scheme/time.sld b/scheme/time.sld index a8803b2e..4ad54128 100644 --- a/scheme/time.sld +++ b/scheme/time.sld @@ -10,12 +10,9 @@ (export current-second current-jiffy - jiffies-per-second - ) - (include-c-header "") - (import (scheme base) - ) -;; TODO: get an FFI syntax for including C header files, even if it is not needed for this library + jiffies-per-second) + (include-c-header "") + (import (scheme base)) (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 */ - long long jiffy = (tv.tv_sec)*1000000LL + tv.tv_usec; + clock_gettime(CLOCK_MONOTONIC, &now); + 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); ")))