summaryrefslogtreecommitdiff
path: root/module/language/assembly/decompile-bytecode.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-01-14 11:38:09 +0100
committerAndy Wingo <wingo@pobox.com>2013-01-14 11:38:09 +0100
commit581f410fbd803721eb750ed8e7d6ec4cc4bcda79 (patch)
tree7406b3fe4d94dcc8cf651f6f0957ead88dd1bb6a /module/language/assembly/decompile-bytecode.scm
parent18c5bffe96947ee82a29b115e758d7357cefbbe9 (diff)
downloadguile-581f410fbd803721eb750ed8e7d6ec4cc4bcda79.tar.gz
case-lambda* clauses fail to match if too many positionals
* doc/ref/api-procedures.texi (Case-lambda): Expand case-lambda* documentation. * module/ice-9/eval.scm (primitive-eval): * libguile/eval.c (prepare_boot_closure_env_for_apply): Dispatch to the next case-lambda clause if there are too many positionals. * doc/ref/vm.texi (Function Prologue Instructions): * libguile/vm-i-system.c (bind-optionals/shuffle-or-br): New instruction, like bind-optionals/shuffle but can dispatch to the next clause if there are too many positionals. * module/language/assembly/disassemble.scm (code-annotation): * module/language/assembly/decompile-bytecode.scm (decode-load-program): * module/language/assembly/compile-bytecode.scm (compile-bytecode): Add case for bind-optionals/shuffle-or-br. * module/language/glil/compile-assembly.scm (glil->assembly): If there is an alternate, use bind-optionals/shuffle-or-br instead of bind-optionals/shuffle. * test-suite/tests/optargs.test ("case-lambda*"): Add tests.
Diffstat (limited to 'module/language/assembly/decompile-bytecode.scm')
-rw-r--r--module/language/assembly/decompile-bytecode.scm14
1 files changed, 12 insertions, 2 deletions
diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm
index 605e3dfdf..c3469bde8 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -1,6 +1,6 @@
;;; Guile VM code converters
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2013 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
@@ -43,7 +43,7 @@
(define (br-instruction? x)
(memq x '(br br-if br-if-not br-if-eq br-if-not-eq br-if-null br-if-not-null)))
(define (br-nargs-instruction? x)
- (memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt)))
+ (memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt br-if-nargs-lt/non-kw)))
(define (bytes->s24 a b c)
(let ((x (+ (ash a 16) (ash b 8) c)))
@@ -88,6 +88,16 @@
(lp (cons `(,br ,(ensure-label rel1 rel2 rel3)) out)))
((,br ,hi ,lo ,rel1 ,rel2 ,rel3) (guard (br-nargs-instruction? br))
(lp (cons `(,br ,hi ,lo ,(ensure-label rel1 rel2 rel3)) out)))
+ ((bind-optionals/shuffle-or-br ,nreq-hi ,nreq-lo
+ ,nreq-and-nopt-hi ,nreq-and-nopt-lo
+ ,ntotal-hi ,ntotal-lo
+ ,rel1 ,rel2 ,rel3)
+ (lp (cons `(bind-optionals/shuffle-or-br
+ ,nreq-hi ,nreq-lo
+ ,nreq-and-nopt-hi ,nreq-and-nopt-lo
+ ,ntotal-hi ,ntotal-lo
+ ,(ensure-label rel1 rel2 rel3))
+ out)))
((mv-call ,n ,rel1 ,rel2 ,rel3)
(lp (cons `(mv-call ,n ,(ensure-label rel1 rel2 rel3)) out)))
((prompt ,n0 ,rel1 ,rel2 ,rel3)