[Guile-commits] GNU Guile branch, master, updated. v2.1.0-934-g4cbe4d7

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=4cbe4d72aab9723d57b9cd779fc99e76b545802e

The branch, master has been updated
       via  4cbe4d72aab9723d57b9cd779fc99e76b545802e (commit)
      from  c271065e542fc527313d5fb08ef0aaddabb42e72 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 4cbe4d72aab9723d57b9cd779fc99e76b545802e
Author: Andy Wingo <address@hidden>
Date:   Tue Apr 15 22:00:30 2014 +0200

    Fix rtl tests
    
    * module/system/vm/assembler.scm (write-arities): Add a diagnostic.
    
    * test-suite/tests/rtl.test: Fix tests to emit "definition"
      instructions.

-----------------------------------------------------------------------

Summary of changes:
 module/system/vm/assembler.scm |    2 ++
 test-suite/tests/rtl.test      |   17 +++++++++++++++--
 2 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index bed2bf7..8bbe1d9 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1481,6 +1481,8 @@ procedure with label @var{rw-init}.  @var{rw-init} may be 
false.  If
 
 (define (write-arities asm metas headers names-port strtab)
   (define (write-header pos low-pc high-pc offset flags nreq nopt nlocals)
+    (unless (<= (+ nreq nopt) nlocals)
+      (error "forgot to emit definition instructions?"))
     (bytevector-u32-set! headers pos (* low-pc 4) (asm-endianness asm))
     (bytevector-u32-set! headers (+ pos 4) (* high-pc 4) (asm-endianness asm))
     (bytevector-u32-set! headers (+ pos 8) offset (asm-endianness asm))
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index 2ee418a..082e44f 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -1,6 +1,6 @@
 ;;;; Low-level tests of the bytecode assembler -*- mode: scheme; coding: 
utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2010, 2011, 2012, 2013, 2014 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
@@ -104,6 +104,7 @@ a procedure."
                         '((begin-program countdown
                                          ((name . countdown)))
                           (begin-standard-arity (x) 4 #f)
+                          (definition x 1)
                           (br fix-body)
                           (label loop-head)
                           (br-if-= 2 1 #f out)
@@ -140,6 +141,7 @@ a procedure."
                           (begin-program accum
                                          ((name . accum)))
                           (begin-standard-arity (x) 4 #f)
+                          (definition x 1)
                           (free-ref 2 0 0)
                           (box-ref 3 2)
                           (add 3 3 1)
@@ -159,6 +161,7 @@ a procedure."
                         '((begin-program call
                                          ((name . call)))
                           (begin-standard-arity (f) 7 #f)
+                          (definition f 1)
                           (mov 5 1)
                           (call 5 1)
                           (receive 2 5 7)
@@ -173,6 +176,7 @@ a procedure."
                         '((begin-program call-with-3
                                          ((name . call-with-3)))
                           (begin-standard-arity (f) 7 #f)
+                          (definition f 1)
                           (mov 5 1)
                           (load-constant 6 3)
                           (call 5 2)
@@ -189,6 +193,7 @@ a procedure."
                         '((begin-program call
                                          ((name . call)))
                           (begin-standard-arity (f) 2 #f)
+                          (definition f 1)
                           (mov 0 1)
                           (tail-call 1)
                           (end-arity)
@@ -201,6 +206,7 @@ a procedure."
                         '((begin-program call-with-3
                                          ((name . call-with-3)))
                           (begin-standard-arity (f) 2 #f)
+                          (definition f 1)
                           (mov 0 1) ;; R0 <- R1
                           (load-constant 1 3) ;; R1 <- 3
                           (tail-call 2)
@@ -225,6 +231,7 @@ a procedure."
                           (begin-program sqrt-trampoline
                                          ((name . sqrt-trampoline)))
                           (begin-standard-arity (x) 3 #f)
+                          (definition x 1)
                           (cached-toplevel-box 2 sqrt-scope sqrt #t)
                           (box-ref 0 2)
                           (tail-call 2)
@@ -278,6 +285,7 @@ a procedure."
                           (begin-program sqrt-trampoline
                                          ((name . sqrt-trampoline)))
                           (begin-standard-arity (x) 3 #f)
+                          (definition x 1)
                           (cached-module-box 2 (guile) sqrt #t #t)
                           (box-ref 0 2)
                           (tail-call 2)
@@ -342,7 +350,7 @@ a procedure."
           (end-arity)
           (end-program))))))
 
-(with-test-prefix "simply procedure arity"
+(with-test-prefix "simple procedure arity"
   (pass-if-equal "#<procedure foo ()>"
       (object->string
        (assemble-program
@@ -357,6 +365,8 @@ a procedure."
        (assemble-program
         '((begin-program foo ((name . foo)))
           (begin-standard-arity (x y) 3 #f)
+          (definition x 1)
+          (definition y 2)
           (load-constant 1 42)
           (return 1)
           (end-arity)
@@ -367,6 +377,9 @@ a procedure."
        (assemble-program
         '((begin-program foo ((name . foo)))
           (begin-opt-arity (x) (y) z 4 #f)
+          (definition x 1)
+          (definition y 2)
+          (definition z 3)
           (load-constant 1 42)
           (return 1)
           (end-arity)


hooks/post-receive
-- 
GNU Guile