From bad64945e7f657f5d85b848072cc2328cff072ca Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 11 Jul 2019 05:09:39 -0600 Subject: [PATCH] racket/fasl: support unsafe-undefined Since a literal unsafe-undefined can be serialized in compiled code, support in fasl. --- pkgs/racket-test-core/tests/racket/fasl.rktl | 3 + racket/collects/racket/fasl.rkt | 10 +- racket/src/racket/src/startup.inc | 116 ++++++++++--------- 3 files changed, 73 insertions(+), 56 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/fasl.rktl b/pkgs/racket-test-core/tests/racket/fasl.rktl index d3a36fa61c..03c0454a2e 100644 --- a/pkgs/racket-test-core/tests/racket/fasl.rktl +++ b/pkgs/racket-test-core/tests/racket/fasl.rktl @@ -209,4 +209,7 @@ [current-load-relative-directory #f]) (fasl->s-exp (s-exp->fasl (build-path root 'same)))))) +(test (list (dynamic-require 'racket/unsafe/undefined 'unsafe-undefined)) + fasl->s-exp (s-exp->fasl (list (dynamic-require 'racket/unsafe/undefined 'unsafe-undefined)))) + (report-errs) diff --git a/racket/collects/racket/fasl.rkt b/racket/collects/racket/fasl.rkt index 0afcef6617..0f3289bb32 100644 --- a/racket/collects/racket/fasl.rkt +++ b/racket/collects/racket/fasl.rkt @@ -1,6 +1,7 @@ #lang racket/base (require '#%extfl racket/linklet + racket/unsafe/undefined (for-syntax racket/base) "private/truncate-path.rkt" "private/relative-path.rkt" @@ -95,10 +96,9 @@ (fasl-immutable-hash-type 37) (fasl-srcloc-type 38) - (fasl-extflonum-type 39) - (fasl-correlated-type 40) + (fasl-undefined-type 41) ;; Unallocated numbers here are for future extensions @@ -350,8 +350,10 @@ (correlated-span v))) (loop (for/list ([k (in-list (correlated-property-symbol-keys v))]) (cons k (correlated-property v k))))] + [(eq? v unsafe-undefined) + (write-byte fasl-undefined-type o)] [else - (raise-arguments-error 'fasl-write + (raise-arguments-error 's-exp->fasl "cannot write value" "value" v)])) (get-output-bytes o #t))) @@ -501,6 +503,8 @@ (srcloc-span s)))) (for/fold ([c c]) ([p (in-list (loop))]) (correlated-property c (car p) (cdr p)))] + [(fasl-undefined-type) + unsafe-undefined] [else (cond [(type . >= . fasl-small-integer-start) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index 0d9e947e26..71223d2848 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -18147,6 +18147,7 @@ static const char *startup_source = "(define-values(fasl-srcloc-type) 38)" "(define-values(fasl-extflonum-type) 39)" "(define-values(fasl-correlated-type) 40)" +"(define-values(fasl-undefined-type) 41)" "(define-values(fasl-small-integer-start) 100)" "(define-values(fasl-lowest-small-integer) -10)" "(define-values(fasl-highest-small-integer)(- 255(- fasl-small-integer-start fasl-lowest-small-integer) 1))" @@ -19049,12 +19050,19 @@ static const char *startup_source = " for-loop_0)" " null" " lst_0)))))))" +"(if(eq?" +" v_1" +" unsafe-undefined)" +"(let-values()" +"(1/write-byte" +" fasl-undefined-type" +" o_1))" "(let-values()" "(raise-arguments-error" -" 'fasl-write" -" \"cannot write value\"" -" \"value\"" -" v_1))))))))))))))))))))))))))))))))))" +" 's-exp->fasl" +" \"cannot write value\"" +" \"value\"" +" v_1)))))))))))))))))))))))))))))))))))" " loop_0)" " v_0)" "(get-output-bytes o_1 #t)))))" @@ -19102,7 +19110,7 @@ static const char *startup_source = "(let-values(((index_0)" "(if(fixnum-for-every-system? tmp_0)" "(if(if(unsafe-fx>= tmp_0 1)" -"(unsafe-fx< tmp_0 41)" +"(unsafe-fx< tmp_0 42)" " #f)" "(let-values(((tbl_0)" " '#(1" @@ -19144,11 +19152,12 @@ static const char *startup_source = " 37" " 38" " 11" -" 39)))" +" 39" +" 40)))" "(unsafe-vector*-ref tbl_0(unsafe-fx- tmp_0 1)))" " 0)" " 0)))" -"(if(unsafe-fx< index_0 19)" +"(if(unsafe-fx< index_0 20)" "(if(unsafe-fx< index_0 9)" "(if(unsafe-fx< index_0 4)" "(if(unsafe-fx< index_0 1)" @@ -19190,18 +19199,18 @@ static const char *startup_source = "(if(unsafe-fx< index_0 8)" "(let-values() eof)" "(let-values()(intern_0(read-fasl-integer i_0)))))))" -"(if(unsafe-fx< index_0 13)" +"(if(unsafe-fx< index_0 14)" +"(if(unsafe-fx< index_0 11)" "(if(unsafe-fx< index_0 10)" "(let-values()" "(floating-point-bytes->real" "(read-bytes/exactly 8 i_0)" " #f))" -"(if(unsafe-fx< index_0 11)" "(let-values()" "(real->single-flonum" "(floating-point-bytes->real" "(read-bytes/exactly 4 i_0)" -" #f)))" +" #f))))" "(if(unsafe-fx< index_0 12)" "(let-values()" "(let-values(((bstr_0)" @@ -19212,41 +19221,41 @@ static const char *startup_source = "(bytes->string/utf-8 bstr_0)" " 10" " 'read)))" -"(let-values()(intern_0(/(loop_0)(loop_0)))))))" -"(if(unsafe-fx< index_0 15)" -"(if(unsafe-fx< index_0 14)" +"(if(unsafe-fx< index_0 13)" +"(let-values()(intern_0(/(loop_0)(loop_0))))" "(let-values()" -"(intern_0(make-rectangular(loop_0)(loop_0))))" -"(let-values()" -"(intern_0(integer->char(read-fasl-integer i_0)))))" +"(intern_0(make-rectangular(loop_0)(loop_0)))))))" "(if(unsafe-fx< index_0 16)" -"(let-values()(string->symbol(read-fasl-string i_0)))" +"(if(unsafe-fx< index_0 15)" +"(let-values()" +"(intern_0(integer->char(read-fasl-integer i_0))))" +"(let-values()(string->symbol(read-fasl-string i_0))))" "(if(unsafe-fx< index_0 17)" "(let-values()" "(string->unreadable-symbol(read-fasl-string i_0)))" "(if(unsafe-fx< index_0 18)" "(let-values()" -"(string->uninterned-symbol" -"(read-fasl-string i_0)))" +"(string->uninterned-symbol(read-fasl-string i_0)))" +"(if(unsafe-fx< index_0 19)" "(let-values()" -"(string->keyword(read-fasl-string i_0)))))))))" -"(if(unsafe-fx< index_0 29)" -"(if(unsafe-fx< index_0 23)" -"(if(unsafe-fx< index_0 20)" -"(let-values()(read-fasl-string i_0))" +"(string->keyword(read-fasl-string i_0)))" +"(let-values()(read-fasl-string i_0))))))))" +"(if(unsafe-fx< index_0 30)" +"(if(unsafe-fx< index_0 24)" "(if(unsafe-fx< index_0 21)" "(let-values()" "(intern_0" "(string->immutable-string(read-fasl-string i_0))))" "(if(unsafe-fx< index_0 22)" "(let-values()(read-fasl-bytes i_0))" +"(if(unsafe-fx< index_0 23)" "(let-values()" "(intern_0" -"(bytes->immutable-bytes(read-fasl-bytes i_0)))))))" -"(if(unsafe-fx< index_0 25)" -"(if(unsafe-fx< index_0 24)" +"(bytes->immutable-bytes(read-fasl-bytes i_0))))" "(let-values()" -"(bytes->path(read-fasl-bytes i_0)(loop_0)))" +"(bytes->path(read-fasl-bytes i_0)(loop_0))))))" +"(if(unsafe-fx< index_0 26)" +"(if(unsafe-fx< index_0 25)" "(let-values()" "(let-values(((wrt-dir_0)" "(current-load-relative-directory)))" @@ -19303,22 +19312,18 @@ static const char *startup_source = "(if(null? rel-elems_0)" "(let-values()(build-path 'same))" "(let-values()" -"(apply build-path rel-elems_0))))))))" -"(if(unsafe-fx< index_0 26)" +"(apply build-path rel-elems_0)))))))" "(let-values()" -"(intern_0(pregexp(read-fasl-string i_0))))" +"(intern_0(pregexp(read-fasl-string i_0)))))" "(if(unsafe-fx< index_0 27)" "(let-values()" "(intern_0(regexp(read-fasl-string i_0))))" "(if(unsafe-fx< index_0 28)" "(let-values()" "(intern_0(byte-pregexp(read-fasl-bytes i_0))))" +"(if(unsafe-fx< index_0 29)" "(let-values()" -"(intern_0" -"(byte-regexp(read-fasl-bytes i_0)))))))))" -"(if(unsafe-fx< index_0 34)" -"(if(unsafe-fx< index_0 31)" -"(if(unsafe-fx< index_0 30)" +"(intern_0(byte-regexp(read-fasl-bytes i_0))))" "(let-values()" "(let-values(((len_1)(read-fasl-integer i_0)))" "(reverse$1" @@ -19332,7 +19337,8 @@ static const char *startup_source = "(let-values()" "(check-range start_0 end_0 inc_0)))" "((letrec-values(((for-loop_0)" -"(lambda(fold-var_0 pos_0)" +"(lambda(fold-var_0" +" pos_0)" "(begin" " 'for-loop" "(if(< pos_0 end_0)" @@ -19351,14 +19357,18 @@ static const char *startup_source = "(if(not #f)" "(for-loop_0" " fold-var_1" -"(+ pos_0 inc_0))" +"(+" +" pos_0" +" inc_0))" " fold-var_1)))" " fold-var_0)))))" " for-loop_0)" " null" -" start_0))))))" -"(let-values()(cons(loop_0)(loop_0))))" +" start_0)))))))))))" +"(if(unsafe-fx< index_0 35)" "(if(unsafe-fx< index_0 32)" +"(if(unsafe-fx< index_0 31)" +"(let-values()(cons(loop_0)(loop_0)))" "(let-values()" "(let-values(((len_1)(read-fasl-integer i_0)))" "((letrec-values(((ploop_0)" @@ -19372,7 +19382,7 @@ static const char *startup_source = "(ploop_0" "(sub1 len_2))))))))" " ploop_0)" -" len_1)))" +" len_1))))" "(if(unsafe-fx< index_0 33)" "(let-values()" "(let-values(((len_1)(read-fasl-integer i_0)))" @@ -19385,7 +19395,7 @@ static const char *startup_source = "(let-values()" "(raise-argument-error" " 'for/vector" -" \"exact-nonnegative-integer?\"" +" \"exact-nonnegative-integer?\"" " len_2)))" "(let-values(((v_0)" "(make-vector" @@ -19395,12 +19405,10 @@ static const char *startup_source = "(if(zero? len_2)" "(void)" "(let-values()" -"(let-values(((start_0)" -" 0)" +"(let-values(((start_0) 0)" "((end_0)" " len_1)" -"((inc_0)" -" 1))" +"((inc_0) 1))" "(begin" "(if(variable-reference-from-unsafe?" "(#%variable-reference))" @@ -19459,10 +19467,11 @@ static const char *startup_source = "(if(eqv? type_0 fasl-immutable-vector-type)" "(vector->immutable-vector vec_0)" " vec_0))))" -"(let-values()(box(loop_0))))))" +"(if(unsafe-fx< index_0 34)" +"(let-values()(box(loop_0)))" +"(let-values()(box-immutable(loop_0))))))" +"(if(unsafe-fx< index_0 37)" "(if(unsafe-fx< index_0 36)" -"(if(unsafe-fx< index_0 35)" -"(let-values()(box-immutable(loop_0)))" "(let-values()" "(let-values(((key_0)(loop_0)))" "(let-values(((len_1)(read-fasl-integer i_0)))" @@ -19506,8 +19515,7 @@ static const char *startup_source = " fold-var_0)))))" " for-loop_0)" " null" -" start_0)))))))))" -"(if(unsafe-fx< index_0 37)" +" start_0))))))))" "(let-values()" "(let-values(((ht_0)" "(let-values(((tmp_1)" @@ -19556,7 +19564,7 @@ static const char *startup_source = " for-loop_0)" " start_0)))" "(void)" -" ht_0))))" +" ht_0)))))" "(if(unsafe-fx< index_0 38)" "(let-values()" "(let-values(((ht_0)" @@ -19613,6 +19621,7 @@ static const char *startup_source = "(loop_0)" "(loop_0)" "(loop_0)))" +"(if(unsafe-fx< index_0 40)" "(let-values()" "(let-values(((e_0)(loop_0)))" "(let-values(((s_0)(loop_0)))" @@ -19663,7 +19672,8 @@ static const char *startup_source = " c_1)))))" " for-loop_0)" " c_0" -" lst_0)))))))))))))))))))))" +" lst_0)))))))" +"(let-values() unsafe-undefined)))))))))))))))" " loop_0)))))))))))))))" "(define-values" "(write-fasl-integer)"