suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: enable fxvector field representation

Browse Source
This commit is contained in:
Matthew Flatt 2018-08-24 12:59:36 -06:00
parent a1b9fd0965
commit d54c60ae3a
2 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
racket/src/cs/compile-file.ss
View File

@ -2,12 +2,15 @@
;; Check to make we're using a build of Chez Scheme ;; Check to make we're using a build of Chez Scheme
;; that has all the features we need. ;; that has all the features we need.
(define (check-defined expr) (define (check-ok what thunk)
(unless (guard (x [else #f]) (eval expr)) (unless (guard (x [else #f]) (thunk))
(error 'compile-file (error 'compile-file
(format (format
"failed trying `~a`; probably you need a newer Chez Scheme" "failed trying `~a`; probably you need a newer Chez Scheme"
expr)))) what))))
(define (check-defined expr)
(check-ok expr (lambda () (eval expr))))
(check-defined 'box-cas!) (check-defined 'box-cas!)
(check-defined 'make-arity-wrapper-procedure) (check-defined 'make-arity-wrapper-procedure)
@ -19,6 +22,16 @@
(check-defined '(define-ftype T (function __collect_safe () void))) (check-defined '(define-ftype T (function __collect_safe () void)))
(check-defined 'call-setting-continuation-attachment) (check-defined 'call-setting-continuation-attachment)
(check-defined 'hashtable-cells) (check-defined 'hashtable-cells)
(check-ok "fxvector-set!"
(lambda ()
(parameterize ([optimize-level 3]
[run-cp0 (lambda (cp0 x) x)])
(eval '(define (op x)
(if (fx- 0) 0 0)))
(eval '(define (f x)
(fxvector-set! x 0 (op 0))))
(eval '(f (fxvector 0))))))
;; ---------------------------------------- ;; ----------------------------------------

6
racket/src/io/common/fixnum.rkt
View File

@ -7,7 +7,6 @@
;; Representing a mutable, fixnum-valued variable with an fxvector can ;; Representing a mutable, fixnum-valued variable with an fxvector can
;; avoid a write barrier on assignment ;; avoid a write barrier on assignment
#;
(define-syntax-rule (define-fixnum id v) (define-syntax-rule (define-fixnum id v)
(begin (begin
(define cell (fxvector v)) (define cell (fxvector v))
@ -18,8 +17,3 @@
[(set! _ r) #'(fxvector-set! cell 0 r)] [(set! _ r) #'(fxvector-set! cell 0 r)]
[(... (_ ...)) (raise-syntax-error stx "bad use" stx)] [(... (_ ...)) (raise-syntax-error stx "bad use" stx)]
[_ #'(fxvector-ref cell 0)])))))) [_ #'(fxvector-ref cell 0)]))))))
;; ... but, for now, something seems to go wrong with whole-program
;; optimization
(define-syntax-rule (define-fixnum id v)
(define id v))