~ chicken-core (chicken-5) 0ab78549940e8bc52933ae5c0bcfd9ccd685ddd3
commit 0ab78549940e8bc52933ae5c0bcfd9ccd685ddd3
Author: felix <bunny351@gmail.com>
AuthorDate: Fri May 7 12:07:15 2010 +0200
Commit: felix <bunny351@gmail.com>
CommitDate: Fri May 7 12:07:15 2010 +0200
add -no-procedure-checks-for-toplevel-bindings
diff --git a/batch-driver.scm b/batch-driver.scm
index b989c28b..edc83333 100644
--- a/batch-driver.scm
+++ b/batch-driver.scm
@@ -265,6 +265,8 @@
(set! no-bound-checks #t) )
(when (memq 'no-procedure-checks options)
(set! no-procedure-checks #t) )
+ (when (memq 'no-procedure-checks-for-toplevel-bindings options)
+ (set! no-global-procedure-checks #t) )
(when (memq 'no-procedure-checks-for-usual-bindings options)
(for-each
(lambda (v)
diff --git a/c-backend.scm b/c-backend.scm
index 2cee404e..65bf43b6 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -278,7 +278,11 @@
(block (third gparams))
(carg #f))
(gen #t "((C_proc" nf ")")
- (cond (block
+ (cond (no-global-procedure-checks
+ (set! carg
+ (string-append "*((C_word*)lf[" (number->string index) "]+1)"))
+ (gen "(void*)(*((C_word*)(" carg ")+1))"))
+ (block
(set! carg (string-append "lf[" (number->string index) "]"))
(if safe
(gen "C_retrieve_proc(" carg ")")
diff --git a/c-platform.scm b/c-platform.scm
index 00020d3a..96c6c3d0 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -88,6 +88,7 @@
disable-stack-overflow-checks raw
emit-external-prototypes-first release local inline-global
analyze-only dynamic scrutinize no-argc-checks no-procedure-checks
+ no-procedure-checks-for-toplevel-bindings
no-bound-checks no-procedure-checks-for-usual-bindings no-compiler-syntax
no-parentheses-synonyms no-symbol-escape r5rs-syntax emit-all-import-libraries
setup-mode unboxing) )
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 7dad067b..6a419c99 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -204,6 +204,7 @@
membership-unfold-limit
no-argc-checks
no-bound-checks
+ no-global-procedure-checks
no-procedure-checks
node->sexpr
non-foldable-bindings
diff --git a/compiler.scm b/compiler.scm
index 2c890733..feeec278 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -64,6 +64,7 @@
; (no-bound-checks)
; (no-procedure-checks)
; (no-procedure-checks-for-usual-bindings)
+; (no-procedure-checks-for-toplevel-bindings)
; (post-process <string> ...)
; (profile <symbol> ...)
; (safe-globals)
@@ -315,6 +316,7 @@
(define no-bound-checks #f)
(define no-argc-checks #f)
(define no-procedure-checks #f)
+(define no-global-procedure-checks #f)
(define source-filename #f)
(define safe-globals-flag #f)
(define explicit-use-flag #f)
@@ -1311,6 +1313,8 @@
(for-each
(cut mark-variable <> '##compiler#always-bound)
(append default-standard-bindings default-extended-bindings)))
+ ((no-procedure-checks-for-toplevel-bindings)
+ (set! no-global-procedure-checks #t))
((bound-to-procedure)
(let ((vars (stripa (cdr spec))))
(for-each (cut mark-variable <> '##compiler#always-bound-to-procedure) vars)
diff --git a/csc.scm b/csc.scm
index 631fd475..f3274e4c 100644
--- a/csc.scm
+++ b/csc.scm
@@ -136,7 +136,8 @@
-no-symbol-escape -no-parentheses-synonyms -r5rs-syntax
-no-argc-checks -no-bound-checks -no-procedure-checks -no-compiler-syntax
-emit-all-import-libraries -setup-mode -unboxing -no-elevation
- -no-procedure-checks-for-usual-bindings))
+ -no-procedure-checks-for-usual-bindings
+ -no-procedure-checks-for-toplevel-bindings))
(define-constant complex-options
'(-debug -output-file -heap-size -nursery -stack-size -compiler -unit -uses -keyword-style
@@ -375,6 +376,9 @@ Usage: #{csc} FILENAME | OPTION ...
-no-procedure-checks-for-usual-bindings
disable procedure call checks only for usual
bindings
+ -no-procedure-checks-for-toplevel-bindings
+ disable procedure call checks for toplevel
+ bindings
Configuration options:
diff --git a/eval.scm b/eval.scm
index 53a6df99..36a9b31a 100644
--- a/eval.scm
+++ b/eval.scm
@@ -364,7 +364,7 @@
(lambda v c)))
[(##core#global-ref)
- (let ([var (cadr x)])
+ (let ([var (cadr x)]) ;XXX broken - should alias (see above)
(if ##sys#eval-environment
(let ([loc (##sys#hash-table-location ##sys#eval-environment var #t)])
(lambda v (##sys#slot loc 1)) )
diff --git a/manual/Declarations b/manual/Declarations
index e3f6cee5..b59b0db6 100644
--- a/manual/Declarations
+++ b/manual/Declarations
@@ -207,6 +207,21 @@ Disables the bound-checking of toplevel bindings.
Disables checking of values in operator position for being of procedure type.
+=== no-procedure-checks-for-usual-bindings
+
+ [declaration specifier] (no-procedure-checks-for-usual-bindings)
+
+Disables checking of procedures for the default standard- and extended toplevel bindings.
+
+
+=== no-procedure-checks-for-toplevel-bindings
+
+ [declaration specifier] (no-procedure-checks-for-toplevel-bindings)
+
+Disables checking of procedures for calls to procedures referenced via a toplevel variable
+(calls to explicitly named procedures).
+
+
=== post-process
[declaration specifier] (post-process STRING ...)
diff --git a/manual/Using the compiler b/manual/Using the compiler
index f7a4655a..03fc0b9c 100644
--- a/manual/Using the compiler
+++ b/manual/Using the compiler
@@ -150,6 +150,8 @@ Possible options are:
; -no-procedure-checks-for-usual-bindings : disable procedure call checks only for usual bindings
+; -no-procedure-checks-for-toplevel-bindings : disable bound and procedure call checks for calls to procedures referenced through a toplevel variable.
+
; -no-symbol-escape : Disables support for escaped symbols, the |...| form.
; -no-trace : Disable generation of tracing information. If a compiled executable should halt due to a runtime error, then a list of the name and the line-number (if available) of the last procedure calls is printed, unless {{-no-trace}} is specified. With this option the generated code is slightly faster.
@@ -188,7 +190,7 @@ Possible options are:
; -raw : Disables the generation of any implicit code that uses the Scheme libraries (that is all runtime system files besides {{runtime.c}} and {{chicken.h}}).
; -require-extension NAME : Loads the extension {{NAME}} before the compilation process commences. This is identical to adding {{(require-extension NAME)}} at the start of the compiled program. If {{-uses NAME}} is also given on the command line, then any occurrences of {{-require-extension NAME}} are replaced with {{(declare (uses NAME))}}. Multiple names may be given and should be separated by {{,}}.
-
+
; -setup-mode : When locating extension, search the current directory first. By default, extensions are located first in the ''extension repository'', where {{chicken-install}} stores compiled extensions and their associated metadata.
; -scrutinize : Enable simple flow-analysis to catch common type errors and argument/result mismatches. You can also use the {{scrutinize}} declaration to enable scrutiny.
diff --git a/support.scm b/support.scm
index 54a8dc2e..3a2b60b9 100644
--- a/support.scm
+++ b/support.scm
@@ -1275,6 +1275,9 @@ Usage: chicken FILENAME OPTION ...
-no-procedure-checks-for-usual-bindings
disable procedure call checks only for usual
bindings
+ -no-procedure-checks-for-toplevel-bindings
+ disable procedure call checks for toplevel
+ bindings
Configuration options:
Trap