[armedbear-cvs] r12706 - branches/less-reflection/abcl/src/org/armedbear/lisp

[Alessio Stalla]

Author: astalla
Date: Tue May 18 18:39:43 2010
New Revision: 12706

Log:
Split potentially huge CASE in the fasl-loader in multiple smaller sub-CASEs to avoid stack overflow in the precompiler for big FASLs.


Modified:
   branches/less-reflection/abcl/src/org/armedbear/lisp/compile-file.lisp

Modified: branches/less-reflection/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- branches/less-reflection/abcl/src/org/armedbear/lisp/compile-file.lisp	(original)
+++ branches/less-reflection/abcl/src/org/armedbear/lisp/compile-file.lisp	Tue May 18 18:39:43 2010
@@ -665,11 +665,23 @@
                   (namestring output-file) elapsed))))
     (values (truename output-file) warnings-p failure-p)))
 
+(defmacro ncase (expr min max &rest clauses)
+  "A CASE where all test clauses are numbers ranging from a minimum to a maximum."
+  ;;Expr is subject to multiple evaluation, but since we only use ncase for
+  ;;fn-index below, let's ignore it.
+  (let* ((half (floor (/ (- max min) 2)))
+	 (middle (+ min half)))
+    (if (> (- max min) 10)
+	`(if (< ,expr ,middle)
+	     (ncase ,expr ,min ,middle ,@(subseq clauses 0 half))
+	     (ncase ,expr ,middle ,max ,@(subseq clauses half)))
+	`(case ,expr , at clauses))))
+
 (defun generate-loader-function ()
   (let* ((basename (base-classname))
 	 (expr `(lambda (fasl-loader fn-index)
 		  (identity fasl-loader) ;;to avoid unused arg
-		  (ecase fn-index
+		  (ncase fn-index 0 ,(1- *class-number*)
 		    ,@(loop
 			 :for i :from 1 :to *class-number*
 			 :collect