Merge branch 'stable-2.0'

Conflicts:
	module/system/vm/traps.scm
	test-suite/tests/peval.test

diff --cc doc/ref/api-data.texi
Simple merge

diff --cc libguile/load.c
Simple merge

diff --cc libguile/numbers.c
Simple merge

diff --cc libguile/numbers.h
Simple merge

diff --cc libguile/read.c
index 382a1d3,b36ecd4..61addf3
--- 1/libguile/read.c
--- 2/libguile/read.c
+++ b/libguile/read.c
@@@ -1116,9 -1121,12 +1116,12 @@@ read_decimal_integer (SCM port, int c, 
  
    while ('0' <= c && c <= '9')
      {
+       if (((SSIZE_MAX - (c-'0')) / 10) <= res)
+         scm_i_input_error ("read_decimal_integer", port,
+                            "number too large", SCM_EOL);
        res = 10*res + c-'0';
        got_it = 1;
 -      c = scm_getc (port);
 +      c = scm_getc_unlocked (port);
      }
  
    if (got_it)

diff --cc libguile/socket.c
Simple merge

diff --cc module/ice-9/boot-9.scm
Simple merge

diff --cc module/ice-9/psyntax-pp.scm
index eeffecf,f5f764b..0684890
--- 1/module/ice-9/psyntax-pp.scm
--- 2/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@@ -2196,13 -2165,13 +2199,13 @@@
             (call-with-values
               (lambda () (convert-pattern pat keys))
               (lambda (p pvars)
-                (cond ((not (distinct-bound-ids? (map car pvars)))
-                       (syntax-violation 'syntax-case "duplicate pattern variable" pat))
-                      ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
+                (cond ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
                        (syntax-violation 'syntax-case "misplaced ellipsis" pat))
+                      ((not (distinct-bound-ids? (map car pvars)))
+                       (syntax-violation 'syntax-case "duplicate pattern variable" pat))
                       (else
                        (let ((y (gen-var 'tmp)))
 -                        (build-application
 +                        (build-call
                            #f
                            (build-simple-lambda
                              #f

diff --cc module/ice-9/psyntax.scm
Simple merge

diff --cc module/language/tree-il/peval.scm
Simple merge

diff --cc module/system/vm/traps.scm
index aa13b6a,b65e034..114647e
--- 1/module/system/vm/traps.scm
--- 2/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@@ -104,25 -105,22 +104,28 @@@
  
      enable-trap))
  
 -(define (new-enabled-trap vm frame enable disable)
 -  ((new-disabled-trap vm enable disable) frame))
 +(define (new-enabled-trap frame enable disable)
 +  ((new-disabled-trap enable disable) frame))
  
 -(define (frame-matcher proc match-objcode?)
 +;; Returns an absolute IP.
 +(define (program-last-ip prog)
 +  (let ((pdi (find-program-debug-info (program-code prog))))
 +    (and pdi (program-debug-info-size pdi))))
 +
 +(define (frame-matcher proc match-code?)
-   (if match-code?
-       (if (program? proc)
-           (let ((start (program-code proc))
-                 (end (program-last-ip proc)))
-             (lambda (frame)
-               (let ((ip (frame-instruction-pointer frame)))
-                 (and (<= start ip) (< ip end)))))
-           (lambda (frame) #f))
-       (lambda (frame)
-         (eq? (frame-procedure frame) proc))))
+   (let ((proc (if (struct? proc)
+                   (procedure proc)
+                   proc)))
 -    (if match-objcode?
 -        (lambda (frame)
 -          (let ((frame-proc (frame-procedure frame)))
 -            (or (eq? frame-proc proc)
 -                (and (program? frame-proc)
 -                     (eq? (program-objcode frame-proc)
 -                          (program-objcode proc))))))
++    (if match-code?
++        (if (program? proc)
++            (let ((start (program-code proc))
++                  (end (program-last-ip proc)))
++              (lambda (frame)
++                (let ((ip (frame-instruction-pointer frame)))
++                  (and (<= start ip) (< ip end)))))
++            (lambda (frame) #f))
+         (lambda (frame)
+           (eq? (frame-procedure frame) proc)))))
  
  ;; A basic trap, fires when a procedure is called.
  ;;

diff --cc test-suite/tests/peval.test
index cb17652,5b003d2..4d8a280
--- 1/test-suite/tests/peval.test
--- 2/test-suite/tests/peval.test
+++ b/test-suite/tests/peval.test
@@@ -1273,17 -1223,18 +1273,31 @@@
        (call-with-prompt t
                          (lambda () (abort-to-prompt t 1 2 3))
                          (lambda (k x y z) (list x y z))))
 -    (apply (primitive 'list) (const 1) (const 2) (const 3)))
 -
 -  (pass-if-peval resolve-primitives
 -   ;; Should not inline tail list to apply if it is mutable.
 -   ;; <http://debbugs.gnu.org/15533>
 -   (let ((l '()))
 -     (if (pair? arg)
 -         (set! l arg))
 -     (apply f l))
 -   (let (l) (_) ((const ()))
 -        (begin
 -          (if (apply (primitive pair?) (toplevel arg))
 -              (set! (lexical l _) (toplevel arg))
 -              (void))
 -          (apply (primitive @apply) (toplevel f) (lexical l _))))))
 +    (primcall list (const 1) (const 2) (const 3)))
 +
 +  (pass-if-peval
 +      (call-with-values foo (lambda (x) (bar x)))
 +    (let (x) (_) ((call (toplevel foo)))
 +         (call (toplevel bar) (lexical x _))))
 +
 +  (pass-if-peval
 +      ((lambda (foo)
 +         (define* (bar a #:optional (b (1+ a)))
 +           (list a b))
 +         (bar 1))
 +       1)
-     (primcall list (const 1) (const 2))))
++    (primcall list (const 1) (const 2)))
++
++  (pass-if-peval
++      ;; Should not inline tail list to apply if it is mutable.
++      ;; <http://debbugs.gnu.org/15533>
++      (let ((l '()))
++        (if (pair? arg)
++            (set! l arg))
++        (apply f l))
++    (let (l) (_) ((const ()))
++         (seq
++           (if (primcall pair? (toplevel arg))
++               (set! (lexical l _) (toplevel arg))
++               (void))
++           (primcall apply (toplevel f) (lexical l _))))))

diff --cc test-suite/tests/syntax.test
Simple merge