add assert-nargs-ee/locals instruction

* libguile/vm-i-system.c (assert-nargs-ee/locals): New instruction, a
  combination of assert-nargs-ee and reserve-locals in the case in which
  nreq and nlocs can both be represented in 8 bits.

* module/language/glil/compile-assembly.scm (glil->assembly): Add
  compiler case.

* doc/ref/vm.texi (Function Prologue Instructions): Update docs.

diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 0bb6ea4..6a7a0a9 100644 (file)
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -827,6 +827,14 @@ operation decrements the stack pointer, any excess values are dropped.
 reserve space for local variables.
 @end deffn
 
+@deffn Instruction assert-nargs-ee/locals n
+@deffnx Instruction assert-nargs-ge/locals n
+A combination of @code{assert-nargs-ee} and @code{reserve-locals}. The
+number of arguments is encoded in the lower three bits of @var{n}, a
+one-byte value. The number of additional local variables is take from
+the upper 5 bits of @var{n}.
+@end deffn
+
 
 @node Trampoline Instructions
 @subsubsection Trampoline Instructions

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index c1d9491..cedd43f 100644 (file)
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1622,6 +1622,26 @@ VM_DEFINE_INSTRUCTION (93, fluid_set, "fluid-set", 0, 2, 0)
   NEXT;
 }
 
+VM_DEFINE_INSTRUCTION (95, assert_nargs_ee_locals, "assert-nargs-ee/locals", 1, 0, 0)
+{
+  scm_t_ptrdiff n;
+  SCM *old_sp;
+
+  /* nargs = n & 0x7, nlocs = nargs + (n >> 3) */
+  n = FETCH ();
+
+  if (SCM_UNLIKELY (sp - (fp - 1) != (n & 0x7)))
+    goto vm_error_wrong_num_args;
+
+  old_sp = sp;
+  sp += (n >> 3);
+  CHECK_OVERFLOW ();
+  while (old_sp < sp)
+    *++old_sp = SCM_UNDEFINED;
+  
+  NEXT;
+}
+
 
 /*
 (defun renumber-ops ()

diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index bfc0a36..0add22e 100644 (file)
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -231,14 +231,16 @@
     
     ((<glil-std-prelude> nreq nlocs else-label)
      (emit-code/arity
-      `(,(if else-label
-             `(br-if-nargs-ne ,(quotient nreq 256)
-                              ,(modulo nreq 256)
-                              ,else-label)
-             `(assert-nargs-ee ,(quotient nreq 256)
-                               ,(modulo nreq 256)))
-        (reserve-locals ,(quotient nlocs 256)
-                        ,(modulo nlocs 256)))
+      (if (and (< nreq 8) (< nlocs (+ nreq 32)) (not else-label))
+          `((assert-nargs-ee/locals ,(logior nreq (ash (- nlocs nreq) 3))))
+          `(,(if else-label
+                 `(br-if-nargs-ne ,(quotient nreq 256)
+                                  ,(modulo nreq 256)
+                                  ,else-label)
+                 `(assert-nargs-ee ,(quotient nreq 256)
+                                   ,(modulo nreq 256)))
+            (reserve-locals ,(quotient nlocs 256)
+                            ,(modulo nlocs 256))))
       nreq #f #f #f))
 
     ((<glil-opt-prelude> nreq nopt rest nlocs else-label)