summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/vm.texi8
-rw-r--r--libguile/vm-i-system.c20
-rw-r--r--module/language/glil/compile-assembly.scm18
3 files changed, 38 insertions, 8 deletions
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 0bb6ea459..6a7a0a9dd 100644
--- 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 c1d949139..cedd43fd5 100644
--- 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 bfc0a364d..0add22ec3 100644
--- 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)