Enabling stack-checks for continuation procedures (1st attempt) pasted by Bunny351 on Thu Jul 12 14:06:17 2012

diff --git a/c-backend.scm b/c-backend.scm
index a7b6afe..32764af 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -642,7 +642,7 @@
                      (let ([al (make-argument-list argc "t")])
                        (apply gen (intersperse al #\,)) )
                      (gen ");}") ]
-                    [(or rest (> (lambda-literal-allocated ll) 0) (lambda-literal-external ll))
+                    [(or rest (> (lambda-literal-allocated ll) 0))
                      (if (and rest (not (eq? rest-mode 'none)))
                          (set! nsr (lset-adjoin = nsr argc))
                          (set! ns (lset-adjoin = ns argc)) ) ] ) ) ) )
@@ -862,14 +862,14 @@
                    (if (eq? rest-mode 'none)
                        (when (> n 2) (gen #t "if(c<" n ") C_bad_min_argc_2(c," n ",t0);"))
                        (gen #t "if(c!=" n ") C_bad_argc_2(c," n ",t0);") ) )
-                 (when (and (not direct) (or external (> demand 0)))
-                   (when insert-timer-checks (gen #t "C_check_for_interrupt;"))
+                 (when (not direct)
+                   (when (and external insert-timer-checks)
+                     (gen #t "C_check_for_interrupt;"))
                    (if (and looping (> demand 0))
                        (gen #t "if(!C_stack_probe(a)){")
                        (gen #t "if(!C_stack_probe(&a)){") ) ) ] )
           (when (and (not (eq? 'toplevel id))
-                     (not direct)
-                     (or rest external (> demand 0)) )
+                     (not direct))
             (cond [rest
                    (gen #t (if (> nec 0) "C_save_and_reclaim" "C_reclaim") "((void*)tr" n #\r)
                    (gen ",(void*)" id "r")
[ permalink | raw ]

A version that actually works (well, one that runs the test-suite) added by Bunny351 on Thu Jul 12 14:19:48 2012

diff --git a/c-backend.scm b/c-backend.scm
index a7b6afe..51ba0f5 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -642,7 +642,7 @@
                      (let ([al (make-argument-list argc "t")])
                        (apply gen (intersperse al #\,)) )
                      (gen ");}") ]
-                    [(or rest (> (lambda-literal-allocated ll) 0) (lambda-literal-external ll))
+                    [else
                      (if (and rest (not (eq? rest-mode 'none)))
                          (set! nsr (lset-adjoin = nsr argc))
                          (set! ns (lset-adjoin = ns argc)) ) ] ) ) ) )
@@ -862,14 +862,14 @@
                    (if (eq? rest-mode 'none)
                        (when (> n 2) (gen #t "if(c<" n ") C_bad_min_argc_2(c," n ",t0);"))
                        (gen #t "if(c!=" n ") C_bad_argc_2(c," n ",t0);") ) )
-                 (when (and (not direct) (or external (> demand 0)))
-                   (when insert-timer-checks (gen #t "C_check_for_interrupt;"))
+                 (when (not direct)
+                   (when (and external insert-timer-checks)
+                     (gen #t "C_check_for_interrupt;"))
                    (if (and looping (> demand 0))
                        (gen #t "if(!C_stack_probe(a)){")
                        (gen #t "if(!C_stack_probe(&a)){") ) ) ] )
           (when (and (not (eq? 'toplevel id))
-                     (not direct)
-                     (or rest external (> demand 0)) )
+                     (not direct))
             (cond [rest
                    (gen #t (if (> nec 0) "C_save_and_reclaim" "C_reclaim") "((void*)tr" n #\r)
                    (gen ",(void*)" id "r")
[ permalink | raw ]