~ chicken-core (chicken-5) 5b27c626dcd00e7ee46e6bc7f51aba61c304a800


commit 5b27c626dcd00e7ee46e6bc7f51aba61c304a800
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sat Jan 23 21:04:37 2016 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Jan 23 23:15:30 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 16297d72..c534bedb 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -230,6 +230,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))
@@ -286,7 +287,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)) 
@@ -322,7 +323,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