~ chicken-core (chicken-5) 54c1af5d147ff7cbfbd08be69b97d56a484a71cc
commit 54c1af5d147ff7cbfbd08be69b97d56a484a71cc
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sat Jan 23 21:06:33 2016 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sat Jan 23 23:26:49 2016 +0100
Fix unsafe code generation for procedure calls.
When the debugger was integrated, ##core#call in the *target* language
was slightly changed: it got an additional leading argument that
indicates the debug info index, so the "safe-flag" option was moved to
position number 2.
However, the code generation would still interpret the first position
as "safe-flag", which meant C_fast_retrieve_proc() was omitted even in
cases where the called object was not guaranteed to be a closure.
C_fast_retrieve_proc will check the object and raise an exception if
it's not a closure.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/c-backend.scm b/c-backend.scm
index 96e030cb..7318b937 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -241,6 +241,7 @@
(nc i)
(nf (add1 n))
(dbi (first params))
+ (safe-to-call (second params))
(p2 (pair? (cddr params)))
(name (and p2 (third params)))
(name-str (source-info->string name))
@@ -297,7 +298,7 @@
((and (eq? '##core#global (node-class fn))
(not unsafe)
(not no-procedure-checks)
- (not (first params)))
+ (not safe-to-call))
(let* ((gparams (node-parameters fn))
(index (first gparams))
(safe (second gparams))
@@ -333,7 +334,7 @@
(gen ";{")
(push-args args i (string-append "t" (number->string nc)))
(gen #t "((C_proc)")
- (if (or unsafe no-procedure-checks (first params))
+ (if (or unsafe no-procedure-checks safe-to-call)
(gen "(void*)(*((C_word*)t" nc "+1))")
(gen "C_fast_retrieve_proc(t" nc ")") )
(gen ")(" nf ",av2);}") ) ) ) )
Trap