[Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-156-ge08e377

[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=e08e3776d44305668cb882b25e6ee28e23da04b0

The branch, wip-rtl has been updated
       via  e08e3776d44305668cb882b25e6ee28e23da04b0 (commit)
       via  eef6081243532bec75c87d66cee09c3306183933 (commit)
       via  103ccc996ff56d2464c4f643895a2057edbd7c63 (commit)
       via  bbb9cdd5382df79962ce4d3bb25771331d7890d6 (commit)
      from  bf51d129e7e557b629ea6568b581e43a261d5c7d (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 e08e3776d44305668cb882b25e6ee28e23da04b0
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 24 22:36:22 2013 +0100

    add cached-module-ref, cached-module-set! macro-instructions
    
    * module/system/vm/rtl.scm (cached-module-ref, cached-module-set!): New
      macro-assemblers.
    * test-suite/tests/rtl.test ("cached-module-ref", "cached-module-set!"):
      Add tests.

commit eef6081243532bec75c87d66cee09c3306183933
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 24 22:35:14 2013 +0100

    fix chunking bug in rtl assembler
    
    * module/system/vm/rtl.scm (link-text-object): Fix bug in which previous
      chunks were written in the wrong order.

commit 103ccc996ff56d2464c4f643895a2057edbd7c63
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 24 22:03:50 2013 +0100

    add end-program marks
    
    * module/system/vm/rtl.scm (emit-init-constants):
    * test-suite/tests/rtl.test ("call", "tail-call")
      ("cached-toplevel-ref", "cached-toplevel-set!"): Add missing
      `end-program' meta marks.

commit bbb9cdd5382df79962ce4d3bb25771331d7890d6
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 24 21:19:55 2013 +0100

    rename cache-current-module! macro op
    
    * module/system/vm/rtl.scm (cache-current-module!): Rename from
      save-current-module.
    * test-suite/tests/rtl.test ("cached-toplevel-ref")
      ("cached-toplevel-set!"): Adapt.

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

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

diff --git a/module/system/vm/rtl.scm b/module/system/vm/rtl.scm
index d8b4d5b..0f8b391 100644
--- a/module/system/vm/rtl.scm
+++ b/module/system/vm/rtl.scm
@@ -596,7 +596,7 @@
 (define-macro-assembler (label asm sym)
   (set-asm-labels! asm (acons sym (asm-start asm) (asm-labels asm))))
 
-(define-macro-assembler (save-current-module asm tmp scope)
+(define-macro-assembler (cache-current-module! asm tmp scope)
   (let ((mod-label (emit-module-cache-cell asm scope)))
     (emit-current-module asm tmp)
     (reset-asm-start! asm)
@@ -614,6 +614,20 @@
         (cell-label (emit-cache-cell asm scope sym)))
     (emit-toplevel-set! asm src cell-label mod-label sym-label)))
 
+(define-macro-assembler (cached-module-ref asm dst module-name public? sym)
+  (let* ((sym-label (emit-non-immediate asm sym))
+         (key (cons public? module-name))
+         (mod-name-label (intern-constant asm key))
+         (cell-label (emit-cache-cell asm key sym)))
+    (emit-module-ref asm dst cell-label mod-name-label sym-label)))
+
+(define-macro-assembler (cached-module-set! asm src module-name public? sym)
+  (let* ((sym-label (emit-non-immediate asm sym))
+         (key (cons public? module-name))
+         (mod-name-label (emit-non-immediate asm key))
+         (cell-label (emit-cache-cell asm key sym)))
+    (emit-module-set! asm src cell-label mod-name-label sym-label)))
+
 (define (emit-text asm instructions)
   (for-each (lambda (inst)
               (reset-asm-start! asm)
@@ -675,7 +689,7 @@
 
 (define (link-text-object asm)
   (let ((buf (make-u32vector (asm-pos asm))))
-    (let lp ((pos 0) (prev (asm-prev asm)))
+    (let lp ((pos 0) (prev (reverse (asm-prev asm))))
       (if (null? prev)
           (let ((byte-size (* (asm-idx asm) 4)))
             (bytevector-copy! (asm-cur asm) 0 buf pos byte-size)
@@ -758,7 +772,8 @@
                         (assert-nargs-ee/locals 0 1)
                         ,@(reverse inits)
                         (load-constant 0 ,*unspecified*)
-                        (return 0)))
+                        (return 0)
+                        (end-program)))
            label))))
 
 (define (link-data asm data name)
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index bd9884f..219407c 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -131,7 +131,8 @@
                           (assert-nargs-ee/locals 1 0)
                           (call 1 0 ())
                           (return 1) ;; MVRA from call
-                          (return 1))))) ;; RA from call
+                          (return 1) ;; RA from call
+                          (end-program)))))
                   (call (lambda () 42))))
 
   (assert-equal 6
@@ -142,7 +143,8 @@
                           (load-constant 1 3)
                           (call 2 0 (1))
                           (return 2) ;; MVRA from call
-                          (return 2))))) ;; RA from call
+                          (return 2) ;; RA from call
+                          (end-program)))))
                   (call-with-3 (lambda (x) (* x 2))))))
 
 (with-test-prefix "tail-call"
@@ -151,7 +153,8 @@
                        (assemble-program
                         '((begin-program call)
                           (assert-nargs-ee/locals 1 0)
-                          (tail-call 0 0)))))
+                          (tail-call 0 0)
+                          (end-program)))))
                   (call (lambda () 3))))
 
   (assert-equal 6
@@ -161,7 +164,8 @@
                           (assert-nargs-ee/locals 1 1)
                           (mov 1 0) ;; R1 <- R0
                           (load-constant 0 3) ;; R0 <- 3
-                          (tail-call 1 1)))))
+                          (tail-call 1 1)
+                          (end-program)))))
                   (call-with-3 (lambda (x) (* x 2))))))
 
 (with-test-prefix "cached-toplevel-ref"
@@ -170,14 +174,16 @@
                        (assemble-program
                         '((begin-program get-sqrt-trampoline)
                           (assert-nargs-ee/locals 0 1)
-                          (save-current-module 0 sqrt-scope)
+                          (cache-current-module! 0 sqrt-scope)
                           (load-static-procedure 0 sqrt-trampoline)
                           (return 0)
+                          (end-program)
 
                           (begin-program sqrt-trampoline)
                           (assert-nargs-ee/locals 1 1)
                           (cached-toplevel-ref 1 sqrt-scope sqrt)
-                          (tail-call 1 1)))))
+                          (tail-call 1 1)
+                          (end-program)))))
                   ((get-sqrt-trampoline) 25.0))))
 
 (define *top-val* 0)
@@ -189,15 +195,55 @@
                          (assemble-program
                           '((begin-program make-top-incrementor)
                             (assert-nargs-ee/locals 0 1)
-                            (save-current-module 0 top-incrementor)
+                            (cache-current-module! 0 top-incrementor)
                             (load-static-procedure 0 top-incrementor)
                             (return 0)
+                            (end-program)
 
                             (begin-program top-incrementor)
                             (assert-nargs-ee/locals 0 1)
                             (cached-toplevel-ref 0 top-incrementor *top-val*)
                             (add1 0 0)
                             (cached-toplevel-set! 0 top-incrementor *top-val*)
-                            (return/values 0)))))
+                            (return/values 0)
+                            (end-program)))))
+                    ((make-top-incrementor))
+                    *top-val*))))
+
+(with-test-prefix "cached-module-ref"
+  (assert-equal 5.0
+                (let ((get-sqrt-trampoline
+                       (assemble-program
+                        '((begin-program get-sqrt-trampoline)
+                          (assert-nargs-ee/locals 0 1)
+                          (load-static-procedure 0 sqrt-trampoline)
+                          (return 0)
+                          (end-program)
+
+                          (begin-program sqrt-trampoline)
+                          (assert-nargs-ee/locals 1 1)
+                          (cached-module-ref 1 (guile) #t sqrt)
+                          (tail-call 1 1)
+                          (end-program)))))
+                  ((get-sqrt-trampoline) 25.0))))
+
+(with-test-prefix "cached-module-set!"
+  (let ((prev *top-val*))
+    (assert-equal (1+ prev)
+                  (let ((make-top-incrementor
+                         (assemble-program
+                          '((begin-program make-top-incrementor)
+                            (assert-nargs-ee/locals 0 1)
+                            (load-static-procedure 0 top-incrementor)
+                            (return 0)
+                            (end-program)
+
+                            (begin-program top-incrementor)
+                            (assert-nargs-ee/locals 0 1)
+                            (cached-module-ref 0 (tests rtl) #f *top-val*)
+                            (add1 0 0)
+                            (cached-module-set! 0 (tests rtl) #f *top-val*)
+                            (return 0)
+                            (end-program)))))
                     ((make-top-incrementor))
                     *top-val*))))


hooks/post-receive
-- 
GNU Guile