~ 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