Welcome to the CHICKEN Scheme pasting service
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")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")