From 209050b2d407aecfc9f0adf79cc0fb2ad812b1ee Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 25 Feb 2021 22:43:19 -0500 Subject: [PATCH 1/8] Allow C compiler/linker options from a library to be expanded via `cond-expand` --- CHANGELOG.md | 1 + cyclone.scm | 5 +++-- scheme/cyclone/libraries.sld | 22 ++++++++++++++-------- 3 files changed, 18 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3102e5f6..ba61f8f3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ 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 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/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) " ")) From 5fb3d69560d4271ab029fa562f966bd076a4de02 Mon Sep 17 00:00:00 2001 From: Arthur Maciel Date: Mon, 1 Mar 2021 23:13:59 -0300 Subject: [PATCH 2/8] Moved from gettimeofday() to the more precise clock_gettime() --- scheme/time.sld | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/scheme/time.sld b/scheme/time.sld index a8803b2e..443b98ae 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)" @@ -23,12 +20,13 @@ time_t t = time(NULL); double_value(&box) = t; 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 + tv.tv_nsec/1000; // nano->microseconds /* Future consideration: mp_int bn_tmp, bn_tmp2, bn_tmp3; mp_init(&bn_tmp); @@ -50,5 +48,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); "))) From 0ff0561ac907befdfe63dd8f77d31b230e43da29 Mon Sep 17 00:00:00 2001 From: Arthur Maciel Date: Mon, 1 Mar 2021 23:15:08 -0300 Subject: [PATCH 3/8] Moved from gettimeofday() to the more precise clock_gettime() --- scheme/time.sld | 1 - 1 file changed, 1 deletion(-) diff --git a/scheme/time.sld b/scheme/time.sld index 443b98ae..98907cb9 100644 --- a/scheme/time.sld +++ b/scheme/time.sld @@ -20,7 +20,6 @@ time_t t = time(NULL); double_value(&box) = t; return_closcall1(data, k, &box); ") - (define-c current-jiffy "(void *data, int argc, closure _, object k)" " struct timespec now; From e4eae1cdf981371decb1e7fff6e9d96dfef6dea2 Mon Sep 17 00:00:00 2001 From: Arthur Maciel Date: Mon, 1 Mar 2021 23:20:00 -0300 Subject: [PATCH 4/8] Moved from gettimeofday() to the more precise clock_gettime() --- scheme/time.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme/time.sld b/scheme/time.sld index 98907cb9..4ad54128 100644 --- a/scheme/time.sld +++ b/scheme/time.sld @@ -25,7 +25,7 @@ " struct timespec now; make_double(box, 0.0); clock_gettime(CLOCK_MONOTONIC, &now); - long long jiffy = (now.tv_sec)*1000000LL + tv.tv_nsec/1000; // nano->microseconds + 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); From d874c05266736e13cac0548f9ef45be05abf1a93 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Mar 2021 22:30:49 -0500 Subject: [PATCH 5/8] Issue #449 - Selectively disable optimizations Memoize optimizations are not compatible with top-level define-c forms, so for now we disable these optimizations in this situation. --- scheme/cyclone/cps-opt-memoize-pure-fncs.scm | 82 +++++++++++--------- 1 file changed, 47 insertions(+), 35 deletions(-) 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 From 6ef8773b316ec52f6880c5669dde994c51b2f4ca Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 3 Mar 2021 21:32:39 -0500 Subject: [PATCH 6/8] Document latest change --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ba61f8f3..8334977b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ Features Bug Fixes - 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 From 2880301d69c9ffadba8615d4d2bddcf2246d3e76 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 Mar 2021 18:02:48 -0500 Subject: [PATCH 7/8] Issue #450 - Updated the runtime to avoid a race condition when creating new symbols --- CHANGELOG.md | 1 + runtime.c | 11 +++++++++-- scheme/cyclone/cgen.sld | 6 ------ 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8334977b..f4b499a2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ Features 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`. diff --git a/runtime.c b/runtime.c index 705bfc08..6a6c7d46 100644 --- a/runtime.c +++ b/runtime.c @@ -454,9 +454,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 3fffa9a0..bb0d0466 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2162,12 +2162,6 @@ *globals*) (emit "") - ;; Initialize symbol table - (for-each - (lambda (sym) - (emit* " add_symbol(quote_" (mangle sym) ");")) - *symbols*) - ;; Initialize globals (let* ((prefix " ") (emit-global From d5e65a09c4a3e4f227011251a5caecd07d67ca7a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 4 Mar 2021 22:15:54 -0500 Subject: [PATCH 8/8] Add credit for latest symbol fix --- AUTHORS | 1 + 1 file changed, 1 insertion(+) 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