support calls and tail-calls with more than 255 formals

* module/language/tree-il/compile-glil.scm (flatten-lambda-case):
  Support calls and tail-calls with more than 255 formals.

* test-suite/tests/tree-il.test ("many args"): Add a test.

diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index a9f6df9..e4df6e1 100644 (file)
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -1,6 +1,6 @@
 ;;; TREE-IL -> GLIL compiler
 
-;; Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2008,2009,2010,2011,2012,2013 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -527,9 +527,20 @@
          (for-each comp-push args)
          (let ((len (length args)))
            (case context
-             ((tail) (emit-code src (make-glil-call 'tail-call len)))
-             ((push) (emit-code src (make-glil-call 'call len))
+             ((tail) (if (<= len #xff)
+                         (emit-code src (make-glil-call 'tail-call len))
+                         (begin
+                           (comp-push (make-const #f len))
+                           (emit-code src (make-glil-call 'tail-call/nargs 0)))))
+             ((push) (if (<= len #xff)
+                         (emit-code src (make-glil-call 'call len))
+                         (begin
+                           (comp-push (make-const #f len))
+                           (emit-code src (make-glil-call 'call/nargs 0))))
                      (maybe-emit-return))
+             ;; FIXME: mv-call doesn't have a /nargs variant, so it is
+             ;; limited to 255 args.  Can work around it with a
+             ;; trampoline and tail-call/nargs, but it's not so nice.
              ((vals) (emit-code src (make-glil-mv-call len MVRA))
                      (maybe-emit-return))
              ((drop) (let ((MV (make-label)) (POST (make-label)))

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 2217ffc..ddc3e76 100644 (file)
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1,7 +1,7 @@
 ;;;; tree-il.test --- test suite for compiling tree-il   -*- scheme -*-
 ;;;; Andy Wingo <wingo@pobox.com> --- May 2009
 ;;;;
-;;;;   Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -702,6 +702,22 @@
               #:opts '(#:partial-eval? #f)))))
 
 \f
+(define (sum . args)
+  (apply + args))
+
+(with-test-prefix "many args"
+  (pass-if "call with > 256 args"
+    (equal? (compile `(1+ (sum ,@(iota 1000)))
+                     #:env (current-module))
+            (1+ (apply sum (iota 1000)))))
+
+  (pass-if "tail call with > 256 args"
+    (equal? (compile `(sum ,@(iota 1000))
+                     #:env (current-module))
+            (apply sum (iota 1000)))))
+
+
+\f
 (with-test-prefix "tree-il-fold"
 
   (pass-if "empty tree"