mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

Add bind-optionals instruction

Browse source 
* doc/ref/vm.texi (Function Prologue Instructions): Document new
  instruction.
* libguile/jit.c (compile_bind_optionals): New compiler.
* libguile/vm-engine.c (VM_NAME): New interpreter.
* module/system/vm/assembler.scm (opt-prelude): Emit bind-optionals as
  appropriate.
* module/system/vm/disassembler.scm (define-stack-effect-parser)
  (code-annotation): Handle bind-optionals.
This commit is contained in:
Andy Wingo 2019-06-06 16:20:20 +02:00
parent 12d6e43176
commit 9fd978ed7e
5 changed files with 73 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

13
module/system/vm/assembler.scm
View file

@ -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

6
module/system/vm/disassembler.scm
View file

@ -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)))