diff options
-rw-r--r-- | doc/ref/vm.texi | 8 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 20 | ||||
-rw-r--r-- | module/language/glil/compile-assembly.scm | 18 |
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) |