Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-15 00:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into cargs2-dev

Browse source
This commit is contained in:
Justin Ethier 2021-03-04 22:58:11 -05:00
commit ee11bc0ab0
8 changed files with 84 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
AUTHORS
View file

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

3
CHANGELOG.md
View file

@ -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

5
cyclone.scm
View file

@ -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

11
runtime.c
View file

@ -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)

6
scheme/cyclone/cgen.sld
View file

@ -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

82
scheme/cyclone/cps-opt-memoize-pure-fncs.scm
View file

@ -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

22
scheme/cyclone/libraries.sld
View file

@ -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)
" "))

18
scheme/time.sld
View file

@ -10,12 +10,9 @@
(export
current-second
current-jiffy
jiffies-per-second
)
(include-c-header "<sys/time.h>")
(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 "<time.h>")
(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); ")))