diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi index 5a0b5a739..e603204ca 100644 --- a/doc/ref/vm.texi +++ b/doc/ref/vm.texi @@ -807,6 +807,12 @@ will signal an error if an unknown key is found. A macro-mega-instruction. @end deftypefn +@deftypefn Instruction {} bind-optionals f24:@var{nlocals} +Expand the current frame to have at least @var{nlocals} locals, filling +in any fresh values with @code{SCM_UNDEFINED}. If the frame has more +than @var{nlocals} locals, it is left as it is. +@end deftypefn + @deftypefn Instruction {} bind-rest f24:@var{dst} Collect any arguments at or above @var{dst} into a list, and store that list at @var{dst}. @@ -814,8 +820,7 @@ list at @var{dst}. @deftypefn Instruction {} alloc-frame c24:@var{nlocals} Ensure that there is space on the stack for @var{nlocals} local -variables, setting them all to @code{SCM_UNDEFINED}, except those values -that are already on the stack. +variables. The value of any new local is undefined. @end deftypefn @deftypefn Instruction {} reset-frame c24:@var{nlocals} diff --git a/libguile/jit.c b/libguile/jit.c index d09c3ad5d..4e4a35506 100644 --- a/libguile/jit.c +++ b/libguile/jit.c @@ -2005,6 +2005,37 @@ compile_bind_rest (scm_jit_state *j, uint32_t dst) jit_patch_here (j->jit, k); } +static void +compile_bind_optionals (scm_jit_state *j, uint32_t dst) +{ + ASSERT_HAS_REGISTER_STATE (FP_IN_REGISTER | SP_IN_REGISTER); + ASSERT(j->frame_size == -1); + + jit_gpr_t saved_frame_size = T1_PRESERVED; + jit_subr (j->jit, saved_frame_size, FP, SP); + + jit_reloc_t no_optionals = jit_bgei + (j->jit, saved_frame_size, dst * sizeof (union scm_vm_stack_element)); + + emit_alloc_frame (j, T0, dst); + + jit_gpr_t walk = saved_frame_size; + jit_subr (j->jit, walk, FP, saved_frame_size); + + jit_reloc_t done = jit_bler (j->jit, walk, SP); + jit_movi (j->jit, T0, SCM_UNPACK (SCM_UNDEFINED)); + + void *head = jit_address (j->jit); + jit_subi (j->jit, walk, walk, sizeof (union scm_vm_stack_element)); + jit_str (j->jit, walk, T0); + jit_patch_there (j->jit, jit_bner (j->jit, walk, SP), head); + + jit_patch_here (j->jit, done); + jit_patch_here (j->jit, no_optionals); + + ASSERT(j->frame_size == -1); +} + static void compile_allocate_words (scm_jit_state *j, uint16_t dst, uint16_t nwords) { diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 062dc00bd..a2e4be57a 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -3231,7 +3231,28 @@ VM_NAME (scm_thread *thread) VM_DEFINE_OP (153, f64_set, "f64-set!", OP1 (X8_S8_S8_S8)) PTR_SET (double, F64); - VM_DEFINE_OP (154, unused_154, NULL, NOP) + /* bind-optionals nargs:24 + * + * Expand the current frame to have NARGS locals, filling in any fresh + * values with SCM_UNDEFINED. + */ + VM_DEFINE_OP (154, bind_optionals, "bind-optionals", DOP1 (X8_F24)) + { + uint32_t nlocals, nargs; + + UNPACK_24 (op, nlocals); + nargs = FRAME_LOCALS_COUNT (); + + if (nargs < nlocals) + { + ALLOC_FRAME (nlocals); + while (nargs < nlocals) + FP_SET (nargs++, SCM_UNDEFINED); + } + + NEXT (1); + } + VM_DEFINE_OP (155, unused_155, NULL, NOP) VM_DEFINE_OP (156, unused_156, NULL, NOP) VM_DEFINE_OP (157, unused_157, NULL, NOP) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index f3682f7e8..9477cb932 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -1,6 +1,6 @@ ;;; Guile bytecode assembler -;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009-2019 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 @@ -246,7 +246,6 @@ emit-assert-nargs-ee emit-assert-nargs-ge emit-assert-nargs-le - emit-alloc-frame emit-reset-frame emit-assert-nargs-ee/locals emit-bind-kwargs @@ -1478,6 +1477,8 @@ returned instead." (emit-assert-nargs-ge asm nreq)) (cond (rest? + (unless (zero? nopt) + (emit-bind-optionals asm (+ nreq nopt))) (emit-bind-rest asm (+ nreq nopt))) (alternate (emit-arguments<=? asm (+ nreq nopt)) @@ -1485,9 +1486,13 @@ returned instead." ;; whereas for <, NONE usually indicates greater-than-or-equal, ;; hence the name jge. Perhaps we just need to rename jge to ;; br-if-none. - (emit-jge asm alternate)) + (emit-jge asm alternate) + (unless (zero? nopt) + (emit-bind-optionals asm (+ nreq nopt)))) (else - (emit-assert-nargs-le asm (+ nreq nopt)))) + (emit-assert-nargs-le asm (+ nreq nopt)) + (unless (zero? nopt) + (emit-bind-optionals asm (+ nreq nopt))))) (emit-alloc-frame asm nlocals)) (define-macro-assembler (kw-prelude asm nreq nopt rest? kw-indices diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index 83499333c..73910fda0 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -1,6 +1,6 @@ ;;; Guile bytecode disassembler -;;; Copyright (C) 2001, 2009-2010, 2012-2015, 2017-2018 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009-2010, 2012-2015, 2017-2019 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 @@ -231,6 +231,8 @@ address of that offset." (('assert-nargs-ee/locals nargs locals) ;; The nargs includes the procedure. (list "~a slot~:p (~a arg~:p)" (+ locals nargs) (1- nargs))) + (('bind-optionals nargs) + (list "~a args~:p" (1- nargs))) (('alloc-frame nlocals) (list "~a slot~:p" nlocals)) (('reset-frame nlocals) @@ -546,7 +548,7 @@ address of that offset." #'(lambda (code pos size) (let ((count (ash (bytevector-u32-native-ref code pos) -8))) (and size (- size count))))) - ((alloc-frame reset-frame) + ((alloc-frame reset-frame bind-optionals) #'(lambda (code pos size) (let ((nlocals (ash (bytevector-u32-native-ref code pos) -8))) nlocals)))