diff --git a/benchmarks.larceny/results.Larceny-r6rs b/benchmarks.larceny/results.Larceny-r6rs index 19d1516..7b5f1b8 100644 --- a/benchmarks.larceny/results.Larceny-r6rs +++ b/benchmarks.larceny/results.Larceny-r6rs @@ -8130,3 +8130,63 @@ Words allocated: 6553342 Words reclaimed: 0 Elapsed time...: 3454 ms (User: 2052 ms; System: 1399 ms) Elapsed GC time: 8 ms (CPU: 9 in 25 collections.) + +**************************** +Benchmarking Larceny-r6rs on Fri Jul 13 13:49:43 AST 2007 under Darwin Vesuvius.local 8.9.1 Darwin Kernel Version 8.9.1: Thu Feb 22 20:55:00 PST 2007; root:xnu-792.18.15~1/RELEASE_I386 i386 i386 + +Testing ctak under Larceny-r6rs +Compiling... +Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified) + + +> +> +Running... +Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified) + + +> +Words allocated: 265286850 +Words reclaimed: 0 +Elapsed time...: 4836 ms (User: 4824 ms; System: 10 ms) +Elapsed GC time: 369 ms (CPU: 363 in 1012 collections.) + +**************************** +Benchmarking Larceny-r6rs on Fri Jul 13 13:50:43 AST 2007 under Darwin Vesuvius.local 8.9.1 Darwin Kernel Version 8.9.1: Thu Feb 22 20:55:00 PST 2007; root:xnu-792.18.15~1/RELEASE_I386 i386 i386 + +Testing fibc under Larceny-r6rs +Compiling... +Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified) + + +> +> +Running... +Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified) + + +> +Words allocated: 192411298 +Words reclaimed: 0 +Elapsed time...: 4098 ms (User: 4087 ms; System: 9 ms) +Elapsed GC time: 280 ms (CPU: 270 in 734 collections.) + +**************************** +Benchmarking Larceny-r6rs on Fri Jul 13 13:53:01 AST 2007 under Darwin Vesuvius.local 8.9.1 Darwin Kernel Version 8.9.1: Thu Feb 22 20:55:00 PST 2007; root:xnu-792.18.15~1/RELEASE_I386 i386 i386 + +Testing mbrot under Larceny-r6rs +Compiling... +Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified) + + +> +> +Running... +Larceny v0.93 "Deviated Prevert" (Nov 10 2006 04:27:45, precise:BSD Unix:unified) + + +> +Words allocated: 551809361 +Words reclaimed: 0 +Elapsed time...: 2246 ms (User: 2230 ms; System: 15 ms) +Elapsed GC time: 753 ms (CPU: 762 in 2105 collections.) diff --git a/benchmarks/BUGS b/benchmarks/BUGS index dd2e259..5394358 100644 --- a/benchmarks/BUGS +++ b/benchmarks/BUGS @@ -4,8 +4,6 @@ * slatex needs char-alphabetic? * compiler needs string-downcase -* ctak crashes with a bus error. -* fibc crashes with a segfault. * ntakl kinda slow * string too slow * nbody does not work diff --git a/src/ikarus.boot b/src/ikarus.boot index e23222f..f9cfd09 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/libaltcogen.ss b/src/libaltcogen.ss index 8ec648e..eba99b5 100644 --- a/src/libaltcogen.ss +++ b/src/libaltcogen.ss @@ -192,6 +192,47 @@ (include "pass-specify-rep.ss") + +(define (insert-stack-overflow-check x) + (define who 'insert-stack-overflow-check) + + (define (Tail x) #t) + + (define (insert-check x) + (make-seq + (make-shortcut + (make-conditional + (make-primcall '< + (list esp (make-primcall 'mref (list pcr (make-constant 16))))) + (make-primcall 'interrupt '()) + (make-primcall 'nop '())) + (make-forcall "ik_stack_overflow" '())) + x)) + + (define (ClambdaCase x) + (record-case x + [(clambda-case info body) + (make-clambda-case info (Main body))])) + ;;; + (define (Clambda x) + (record-case x + [(clambda label case* free*) + (make-clambda label (map ClambdaCase case*) free*)])) + ;;; + (define (Main x) + (if (Tail x) + (insert-check x) + x)) + ;;; + (define (Program x) + (record-case x + [(codes code* body) + (make-codes (map Clambda code*) (Main body))])) + ;;; + (Program x)) + + + (define parameter-registers '(%edi)) (define return-value-register '%eax) (define cp-register '%edi) @@ -2737,6 +2778,7 @@ (let* ([x (introduce-primcalls x)] [x (eliminate-fix x)] [x (specify-representation x)] + [x (insert-stack-overflow-check x)] [x (impose-calling-convention/evaluation-order x)] [x (time-it "frame" (lambda () (assign-frame-sizes x)))] [x (time-it "register" (lambda () (color-by-chaitin x)))]