add enable-unsafe-application
original commit: 4c0750d292999dbc476b2b0a80cad3b8beaab660
This commit is contained in:
parent
5a01e2c589
commit
754bae07e3
|
@ -1132,6 +1132,7 @@ generate-interrupt-trap
|
||||||
enable-cross-library-optimization
|
enable-cross-library-optimization
|
||||||
enable-arithmetic-left-associative
|
enable-arithmetic-left-associative
|
||||||
enable-error-source-expression
|
enable-error-source-expression
|
||||||
|
enable-unsafe-application
|
||||||
enable-type-recovery
|
enable-type-recovery
|
||||||
\endschemedisplay
|
\endschemedisplay
|
||||||
|
|
||||||
|
@ -2611,6 +2612,17 @@ This parameter controls whether the compiler can convert erroneous
|
||||||
expressions into a call to an error function that shows the expression
|
expressions into a call to an error function that shows the expression
|
||||||
as an S-expression. The default is \scheme{#t}.
|
as an S-expression. The default is \scheme{#t}.
|
||||||
|
|
||||||
|
%----------------------------------------------------------------------------
|
||||||
|
\entryheader
|
||||||
|
\formdef{enable-unsafe-application}{\categorythreadparameter}{enable-unsafe-application}
|
||||||
|
\listlibraries
|
||||||
|
\endentryheader
|
||||||
|
|
||||||
|
This parameter controls whether application forms are compiled as
|
||||||
|
unsafe (i.e., no check whether the target is a procedure), even when
|
||||||
|
the value of \scheme{optimize-level} is less than \scheme{3}. The
|
||||||
|
default is \scheme{#f}.
|
||||||
|
|
||||||
%----------------------------------------------------------------------------
|
%----------------------------------------------------------------------------
|
||||||
\entryheader
|
\entryheader
|
||||||
\formdef{generate-wpo-files}{\categorythreadparameter}{generate-wpo-files}
|
\formdef{generate-wpo-files}{\categorythreadparameter}{generate-wpo-files}
|
||||||
|
|
|
@ -62,7 +62,7 @@ InstallLZ4Target=
|
||||||
# no changes should be needed below this point #
|
# no changes should be needed below this point #
|
||||||
###############################################################################
|
###############################################################################
|
||||||
|
|
||||||
Version=csv9.5.3.13
|
Version=csv9.5.3.14
|
||||||
Include=boot/$m
|
Include=boot/$m
|
||||||
PetiteBoot=boot/$m/petite.boot
|
PetiteBoot=boot/$m/petite.boot
|
||||||
SchemeBoot=boot/$m/scheme.boot
|
SchemeBoot=boot/$m/scheme.boot
|
||||||
|
|
18
mats/misc.ms
18
mats/misc.ms
|
@ -5526,6 +5526,24 @@
|
||||||
(find-define-m-as-one (expand '(let () (import (define-m-as-one)) m)))
|
(find-define-m-as-one (expand '(let () (import (define-m-as-one)) m)))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(mat enable-unsafe-application
|
||||||
|
(begin
|
||||||
|
(define (get-uncprep-form e)
|
||||||
|
(let ([r #f])
|
||||||
|
(parameterize ([run-cp0 (lambda (cp0 e)
|
||||||
|
(parameterize ([enable-unsafe-application #f])
|
||||||
|
(set! r (#%$uncprep e)))
|
||||||
|
e)])
|
||||||
|
(expand/optimize e))
|
||||||
|
r))
|
||||||
|
#t)
|
||||||
|
(equivalent-expansion? (get-uncprep-form '(lambda (x) (x)))
|
||||||
|
'(lambda (x) (x)))
|
||||||
|
(equivalent-expansion? (parameterize ([enable-unsafe-application #t])
|
||||||
|
(get-uncprep-form '(lambda (x) (x))))
|
||||||
|
'(lambda (x) (#3%$app x)))
|
||||||
|
)
|
||||||
|
|
||||||
(mat phantom-bytevector
|
(mat phantom-bytevector
|
||||||
(phantom-bytevector? (make-phantom-bytevector 0))
|
(phantom-bytevector? (make-phantom-bytevector 0))
|
||||||
(not (phantom-bytevector? 10))
|
(not (phantom-bytevector? 10))
|
||||||
|
|
|
@ -328,7 +328,7 @@
|
||||||
[(_ foo e1 e2) e1] ...
|
[(_ foo e1 e2) e1] ...
|
||||||
[(_ bar e1 e2) e2]))))])))
|
[(_ bar e1 e2) e2]))))])))
|
||||||
|
|
||||||
(define-constant scheme-version #x0905030D)
|
(define-constant scheme-version #x0905030E)
|
||||||
|
|
||||||
(define-syntax define-machine-types
|
(define-syntax define-machine-types
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
|
|
|
@ -586,6 +586,7 @@
|
||||||
[enable-cross-library-optimization (enable-cross-library-optimization)]
|
[enable-cross-library-optimization (enable-cross-library-optimization)]
|
||||||
[enable-arithmetic-left-associative (enable-arithmetic-left-associative)]
|
[enable-arithmetic-left-associative (enable-arithmetic-left-associative)]
|
||||||
[enable-error-source-expression (enable-error-source-expression)]
|
[enable-error-source-expression (enable-error-source-expression)]
|
||||||
|
[enable-unsafe-application (enable-unsafe-application)]
|
||||||
[enable-type-recovery (enable-type-recovery)])
|
[enable-type-recovery (enable-type-recovery)])
|
||||||
(emit-header op (constant machine-type))
|
(emit-header op (constant machine-type))
|
||||||
(when hostop (emit-header hostop (host-machine-type)))
|
(when hostop (emit-header hostop (host-machine-type)))
|
||||||
|
|
|
@ -164,7 +164,8 @@
|
||||||
(if (or (preinfo-call-check? preinfo)
|
(if (or (preinfo-call-check? preinfo)
|
||||||
;; Reporting `#3%$app` is redundant for unsafe mode.
|
;; Reporting `#3%$app` is redundant for unsafe mode.
|
||||||
;; Note that we're losing explicit `#2%$app`s.
|
;; Note that we're losing explicit `#2%$app`s.
|
||||||
(>= (optimize-level) 3))
|
(>= (optimize-level) 3)
|
||||||
|
(enable-unsafe-application))
|
||||||
(if (preinfo-call-can-inline? preinfo)
|
(if (preinfo-call-can-inline? preinfo)
|
||||||
a
|
a
|
||||||
(cons '$app/no-inline a))
|
(cons '$app/no-inline a))
|
||||||
|
|
|
@ -106,6 +106,8 @@
|
||||||
|
|
||||||
(define enable-arithmetic-left-associative ($make-thread-parameter #f (lambda (x) (and x #t))))
|
(define enable-arithmetic-left-associative ($make-thread-parameter #f (lambda (x) (and x #t))))
|
||||||
|
|
||||||
|
(define enable-unsafe-application ($make-thread-parameter #f (lambda (x) (and x #t))))
|
||||||
|
|
||||||
(define-who current-generate-id
|
(define-who current-generate-id
|
||||||
($make-thread-parameter
|
($make-thread-parameter
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
|
|
|
@ -958,6 +958,7 @@
|
||||||
(enable-object-counts [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(enable-object-counts [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(enable-type-recovery [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(enable-type-recovery [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(enable-error-source-expression [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(enable-error-source-expression [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
|
(enable-unsafe-application [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(eval-syntax-expanders-when [sig [() -> (list)] [(sub-list) -> (void)]] [flags])
|
(eval-syntax-expanders-when [sig [() -> (list)] [(sub-list) -> (void)]] [flags])
|
||||||
(expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
(expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted])
|
||||||
(expand-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags])
|
(expand-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags])
|
||||||
|
|
|
@ -550,9 +550,10 @@
|
||||||
(define build-call
|
(define build-call
|
||||||
(lambda (ae e e*)
|
(lambda (ae e e*)
|
||||||
(build-profile ae
|
(build-profile ae
|
||||||
(let ([flags (if (fx< (optimize-level) 3)
|
(let ([flags (if (or (fx>= (optimize-level) 3)
|
||||||
(preinfo-call-mask)
|
(enable-unsafe-application))
|
||||||
(preinfo-call-mask unchecked))])
|
(preinfo-call-mask unchecked)
|
||||||
|
(preinfo-call-mask))])
|
||||||
`(call ,(make-preinfo-call (ae->src ae) #f flags) ,e ,e* ...)))))
|
`(call ,(make-preinfo-call (ae->src ae) #f flags) ,e ,e* ...)))))
|
||||||
|
|
||||||
(define build-application
|
(define build-application
|
||||||
|
|
Loading…
Reference in New Issue
Block a user