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

Experimenting with unsafe prims

Browse source
This commit is contained in:
Justin Ethier 2019-11-26 15:37:52 -05:00
parent 4c578f0394
commit 537e8bc975
3 changed files with 13 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
include/cyclone/runtime.h
View file

@ -486,6 +486,8 @@ object Cyc_is_immutable(object obj);
/**@{*/ /**@{*/
object Cyc_vector_length(void *data, object v); object Cyc_vector_length(void *data, object v);
object Cyc_vector_ref(void *d, object v, object k); object Cyc_vector_ref(void *d, object v, object k);
#define Cyc_vector_ref_unsafe(d, v, k) \
((vector) v)->elements[unbox_number(k)]
object Cyc_vector_set(void *d, object v, object k, object obj); object Cyc_vector_set(void *d, object v, object k, object obj);
object Cyc_make_vector(void *data, object cont, int argc, object len, ...); object Cyc_make_vector(void *data, object cont, int argc, object len, ...);
/**@}*/ /**@}*/

4
scheme/cyclone/cgen.sld
View file

@ -41,6 +41,7 @@
(begin (begin
(define *cgen:track-call-history* #t) (define *cgen:track-call-history* #t)
(define *cgen:use-unsafe-prims* #f)
(define *optimize-well-known-lambdas* #f) (define *optimize-well-known-lambdas* #f)
(define (emit line) (define (emit line)
@ -745,7 +746,7 @@
((closure)" ((closure)"
(cgen:mangle-global p) (cgen:mangle-global p)
")->fn)") ")->fn)")
(prim->c-func p use-alloca?))) (prim->c-func p use-alloca? *cgen:use-unsafe-prims*)))
;; Following closure defs are only used for prim:cont? to ;; Following closure defs are only used for prim:cont? to
;; create a new closure for the continuation, if needed. ;; create a new closure for the continuation, if needed.
;; ;;
@ -1855,6 +1856,7 @@
flag-set?) flag-set?)
(set! *global-syms* (append globals (lib:idb:ids import-db))) (set! *global-syms* (append globals (lib:idb:ids import-db)))
(set! *cgen:track-call-history* (flag-set? 'track-call-history)) (set! *cgen:track-call-history* (flag-set? 'track-call-history))
(set! *cgen:use-unsafe-prims* (flag-set? 'use-unsafe-prims))
(set! num-lambdas (+ (adb:max-lambda-id) 1)) (set! num-lambdas (+ (adb:max-lambda-id) 1))
(set! cgen:mangle-global (set! cgen:mangle-global
(lambda (ident) (lambda (ident)

13
scheme/cyclone/primitives.sld
View file

@ -492,7 +492,7 @@
;; TODO: get rid of this function and replace this with the same type of pre-alloc that ;; TODO: get rid of this function and replace this with the same type of pre-alloc that
;; we do for fast numeric operations. That will allow us to prevent out-of-order ;; we do for fast numeric operations. That will allow us to prevent out-of-order
;; execution for these as part of Cyc-seq ;; execution for these as part of Cyc-seq
(define (prim->c-func p use-alloca?) (define (prim->c-func p use-alloca? emit-unsafe)
(cond (cond
(use-alloca? (use-alloca?
;; Special case, when this flag is set the compiler is requesting a ;; Special case, when this flag is set the compiler is requesting a
@ -507,11 +507,11 @@
;((eq? p 'Cyc-fast-list-4) "alloca_list_4") ;((eq? p 'Cyc-fast-list-4) "alloca_list_4")
;((eq? p 'cell) "alloca_cell") ;((eq? p 'cell) "alloca_cell")
(else (else
(_prim->c-func p)))) (_prim->c-func p emit-unsafe))))
(else (else
(_prim->c-func p)))) (_prim->c-func p emit-unsafe))))
(define (_prim->c-func p) (define (_prim->c-func p emit-unsafe)
(cond (cond
((eq? p 'Cyc-global-vars) "Cyc_get_global_variables") ((eq? p 'Cyc-global-vars) "Cyc_get_global_variables")
((eq? p 'Cyc-get-cvar) "Cyc_get_cvar") ((eq? p 'Cyc-get-cvar) "Cyc_get_cvar")
@ -619,7 +619,10 @@
((eq? p 'make-vector) "Cyc_make_vector") ((eq? p 'make-vector) "Cyc_make_vector")
((eq? p 'list->vector) "Cyc_list2vector") ((eq? p 'list->vector) "Cyc_list2vector")
((eq? p 'vector-length) "Cyc_vector_length") ((eq? p 'vector-length) "Cyc_vector_length")
((eq? p 'vector-ref) "Cyc_vector_ref") ((eq? p 'vector-ref)
(if emit-unsafe
"Cyc_vector_ref_unsafe"
"Cyc_vector_ref"))
((eq? p 'vector-set!) "Cyc_vector_set") ((eq? p 'vector-set!) "Cyc_vector_set")
((eq? p 'string-append) "Cyc_string_append") ((eq? p 'string-append) "Cyc_string_append")
((eq? p 'string-cmp) "Cyc_string_cmp") ((eq? p 'string-cmp) "Cyc_string_cmp")