guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-313-g0ad89c5


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-313-g0ad89c5
Date: Wed, 06 Jun 2012 21:49:05 +0000

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=0ad89c5a20b83568b9c3207ad3728d0b3fd83684

The branch, wip-rtl has been updated
       via  0ad89c5a20b83568b9c3207ad3728d0b3fd83684 (commit)
      from  bc6e7fd902350e317455ededc505fc6a4bcff252 (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 0ad89c5a20b83568b9c3207ad3728d0b3fd83684
Author: Andy Wingo <address@hidden>
Date:   Wed Jun 6 23:48:53 2012 +0200

    rtl: constant table refactorings
    
    * module/system/vm/rtl.scm (intern-constant, link-data): Refactor so
      that the assembler keeps track of the needed init instructions.  Wrap
      stringbufs in their own data type so that they too can go in the
      asm-constants table.

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

Summary of changes:
 module/system/vm/rtl.scm |  517 ++++++++++++++++++++--------------------------
 1 files changed, 228 insertions(+), 289 deletions(-)

diff --git a/module/system/vm/rtl.scm b/module/system/vm/rtl.scm
index dab4e8e..93be866 100644
--- a/module/system/vm/rtl.scm
+++ b/module/system/vm/rtl.scm
@@ -58,60 +58,6 @@
 (define-syntax-rule (pack-u8-u8-u8-u8 x y z w)
   (logior x (ash y 8) (ash z 16) (ash w 24)))
 
-(define-record-type <archive>
-  (%make-archive stringbufs constants)
-  archive?
-  ;; Vhash of string -> label.  Order unimportant, but it helps with
-  ;; consistency.
-  (stringbufs archive-stringbufs set-archive-stringbufs!)
-  ;; Vhash of object -> label.  Order is important.
-  (constants archive-constants set-archive-constants!))
-
-(define (make-archive)
-  (%make-archive vlist-null vlist-null))
-
-(define-inlinable (immediate? x)
-  (not (zero? (logand (object-address x) 6))))
-
-(define (intern-stringbuf archive string)
-  (let ((table (archive-stringbufs archive)))
-    (cond
-     ((vhash-assoc string table) => cdr)
-     (else
-      (let ((label (gensym string)))
-        (set-archive-stringbufs! archive (vhash-cons string label table))
-        label)))))
-
-(define (intern-constant archive obj)
-  (cond
-   ((immediate? obj) #t)
-   ((vhash-assoc obj (archive-constants archive)) => cdr)
-   (else
-    (let ((label (gensym "constant")))
-      (cond
-       ((pair? obj)
-        (intern-constant archive (car obj))
-        (intern-constant archive (cdr obj)))
-       ((vector? obj)
-        (let lp ((i 0))
-          (when (< i (vector-length obj))
-            (intern-constant archive (vector-ref obj i))
-            (lp (1+ i)))))
-       ((symbol? obj)
-        (intern-constant archive (symbol->string obj)))
-       ((string? obj)
-        (intern-stringbuf archive obj))
-       ((keyword? obj)
-        (intern-constant archive (keyword->symbol obj)))
-       ((number? obj)
-        (intern-constant archive (number->string obj)))
-       (else
-        (error "don't know how to intern" obj)))
-      (set-archive-constants! archive
-                              (vhash-cons obj label
-                                          (archive-constants archive)))
-      label))))
-
 (define-syntax *block-size* (identifier-syntax 32))
 
 ;; We'll use native endianness when writing bytecode.  If we're
@@ -121,10 +67,12 @@
 ;; We write constants using the target endianness, though.
 ;;
 (define-record-type <asm>
-  (make-asm archive cur idx start prev written labels relocs
-            word-size endianness string-table)
+  (make-asm cur idx start prev written
+            labels relocs
+            word-size endianness
+            constants inits
+            string-table)
   asm?
-  (archive asm-archive)
   (cur asm-cur set-asm-cur!)
   (idx asm-idx set-asm-idx!)
   (start asm-start set-asm-start!)
@@ -134,6 +82,9 @@
   (relocs asm-relocs set-asm-relocs!)
   (word-size asm-word-size)
   (endianness asm-endianness)
+  ;; Vhash of object -> label.  Order is important.
+  (constants asm-constants set-asm-constants!)
+  (inits asm-inits set-asm-inits!)
   (string-table asm-string-table set-asm-string-table!))
 
 (define-inlinable (fresh-block)
@@ -141,7 +92,10 @@
 
 (define* (make-assembler #:key (word-size (target-word-size))
                          (endianness (target-endianness)))
-  (make-asm (make-archive) (fresh-block) 0 0 '() 0 '() '() word-size endianness
+  (make-asm (fresh-block) 0 0 '() 0
+            '() '()
+            word-size endianness
+            vlist-null '()
             (make-elf-string-table)))
 
 (define (intern-string! asm string)
@@ -200,12 +154,6 @@
          (reloc (make-reloc 's32 label start (- pos start))))
     (set-asm-relocs! asm (cons reloc (asm-relocs asm)))))
 
-;; Returns a label.
-(define (emit-non-immediate asm obj)
-  (when (immediate? obj)
-    (error "expected a non-immediate" obj))
-  (intern-constant (asm-archive asm) obj))
-
 (eval-when (expand compile load eval)
   (define (id-append ctx a b)
     (datum->syntax ctx (symbol-append (syntax->datum a) (syntax->datum b)))))
@@ -502,6 +450,76 @@
               (lp (+ offset len) (cons elt out))))
           (cons* locals meta (reverse out))))))
 
+(define-inlinable (immediate? x)
+  (not (zero? (logand (object-address x) 6))))
+
+(define-record-type <stringbuf>
+  (make-stringbuf string)
+  stringbuf?
+  (string stringbuf-string))
+
+(define (statically-allocatable? x)
+  (or (pair? x) (vector? x) (string? x) (stringbuf? x)))
+
+(define (intern-constant asm obj)
+  (define (recur obj)
+    (intern-constant asm obj))
+  (define (field dst n obj)
+    (let ((src (recur obj)))
+      (if src
+          (list (if (statically-allocatable? obj)
+                    `(make-non-immediate 0 ,src)
+                    `(static-ref 0 ,src))
+                `(static-set! 0 ,dst ,n))
+          '())))
+  (define (intern obj label)
+    (cond
+     ((pair? obj)
+      (append (field label 0 (car obj))
+              (field label 1 (cdr obj))))
+     ((vector? obj)
+      (let lp ((i 0) (inits '()))
+        (if (< i (vector-length obj))
+            (lp (1+ i)
+                (append-reverse (field label (1+ i) (vector-ref obj i))
+                                inits))
+            (reverse inits))))
+     ((stringbuf? obj) '())
+     ((symbol? obj)
+      `((make-non-immediate 0 ,(recur (symbol->string obj)))
+        (string->symbol 0 0)
+        (static-set! 0 ,label 0)))
+     ((string? obj)
+      `((make-non-immediate 0 ,(recur (make-stringbuf obj)))
+        (static-set! 0 ,label 1)))
+     ((keyword? obj)
+      `((static-ref 0 ,(recur (keyword->symbol obj)))
+        (symbol->keyword 0 0)
+        (static-set! 0 ,label 0)))
+     ((number? obj)
+      `((make-non-immediate 0 ,(recur (number->string obj)))
+        (string->number 0 0)
+        (static-set! 0 ,label 0)))
+     (else
+      (error "don't know how to intern" obj))))
+  (cond
+   ((immediate? obj) #f)
+   ((vhash-assoc obj (asm-constants asm)) => cdr)
+   (else
+    ;; Note that calling intern may mutate asm-constants and
+    ;; asm-constant-inits.
+    (let* ((label (gensym "constant"))
+           (inits (intern obj label)))
+      (set-asm-constants! asm (vhash-cons obj label (asm-constants asm)))
+      (set-asm-inits! asm (append-reverse inits (asm-inits asm)))
+      label))))
+
+;; Returns a label.
+(define (emit-non-immediate asm obj)
+  (when (immediate? obj)
+    (error "expected a non-immediate" obj))
+  (intern-constant asm obj))
+
 (define-syntax define-macro-assembler
   (lambda (x)
     (syntax-case x ()
@@ -512,9 +530,6 @@
                (hashq-set! assemblers 'name emit)
                emit)))))))
 
-(define (static? x)
-  (or (pair? x) (vector? x) (string? x)))
-
 (define-macro-assembler (load-constant asm dst obj)
   (cond
    ((immediate? obj)
@@ -526,7 +541,7 @@
         (emit-make-long-immediate asm dst obj))
        (else
         (emit-make-long-long-immediate asm dst obj)))))
-   ((static? obj)
+   ((statically-allocatable? obj)
     (emit-make-non-immediate asm dst (emit-non-immediate asm obj)))
    (else
     (emit-static-ref asm dst (emit-non-immediate asm obj)))))
@@ -541,41 +556,6 @@
   (reset-asm-start! asm)
   (set-asm-labels! asm (acons sym (asm-start asm) (asm-labels asm))))
 
-(define-macro-assembler (init-non-immediate asm label offset obj)
-  (let ((obj-label (cdr (vhash-assoc obj (archive-constants
-                                          (asm-archive asm))))))
-    (if (static? obj)
-        (emit-make-non-immediate asm 0 obj-label)
-        (emit-static-ref asm 0 obj-label))
-    (emit-static-set! asm 0 label offset)))
-
-(define-macro-assembler (init-string asm label obj)
-  (let ((obj-label (cdr (vhash-assoc obj
-                                     (archive-stringbufs (asm-archive asm))))))
-    (emit-make-non-immediate asm 0 obj-label)
-    (emit-static-set! asm 0 label 1)))
-
-(define-macro-assembler (init-symbol asm label obj)
-  (let ((str-label (cdr (vhash-assoc (symbol->string obj)
-                                     (archive-constants (asm-archive asm))))))
-    (emit-make-non-immediate asm 0 str-label)
-    (emit-string->symbol asm 0 0)
-    (emit-static-set! asm 0 label 0)))
-
-(define-macro-assembler (init-keyword asm label obj)
-  (let ((sym-label (cdr (vhash-assoc (keyword->symbol obj)
-                                     (archive-constants (asm-archive asm))))))
-    (emit-static-ref asm 0 sym-label)
-    (emit-symbol->keyword asm 0 0)
-    (emit-static-set! asm 0 label 0)))
-
-(define-macro-assembler (init-number asm label obj)
-  (let ((str-label (cdr (vhash-assoc (number->string obj)
-                                     (archive-constants (asm-archive asm))))))
-    (emit-make-non-immediate asm 0 str-label)
-    (emit-string->number asm 0 0)
-    (emit-static-set! asm 0 label 0)))
-
 (define (emit-text asm instructions)
   (for-each (lambda (inst)
               (apply (or (hashq-ref assemblers (car inst))
@@ -701,15 +681,6 @@
                '() '()
                #:type SHT_STRTAB #:flags 0))
 
-(define (align address alignment)
-  (+ address
-     (modulo (- alignment (modulo address alignment)) alignment)))
-
-(define tc7-vector 13)
-(define tc7-narrow-stringbuf 39)
-(define tc7-wide-stringbuf (+ 39 #x400))
-(define tc7-ro-string (+ 21 #x200))
-
 (define (write-immediate asm buf pos x)
   (let ((val (object-address x))
         (endianness (asm-endianness asm)))
@@ -718,176 +689,149 @@
       ((8) (bytevector-u64-set! buf pos val endianness))
       (else (error "bad word size" asm)))))
 
-(define (write-constant-reference asm buf pos x label offset inits)
-  (cond
-   ((immediate? x)
-    (write-immediate asm buf pos x)
-    inits)
-   (else
-    (write-immediate asm buf pos #f)
-    ;; offset is in units of scm
-    (cons `(init-non-immediate ,label ,offset ,x) inits))))
-
-(define (write-stringbuf asm buf pos x label inits)
-  (let ((endianness (asm-endianness asm))
-        (len (string-length x))
-        (tag (if (= (string-bytes-per-char x) 1)
-                 tc7-narrow-stringbuf
-                 tc7-wide-stringbuf)))
-    (case (asm-word-size asm)
-      ((4)
-       (bytevector-u32-set! buf pos tag endianness)
-       (bytevector-u32-set! buf (+ pos 4) len endianness))
-      ((8)
-       (bytevector-u64-set! buf pos tag endianness)
-       (bytevector-u64-set! buf (+ pos 8) len endianness))
-      (else
-       (error "bad word size" asm)))
-        
-    (let ((pos (+ pos (* (asm-word-size asm) 2))))
-      (case (string-bytes-per-char x)
-        ((1)
-         (let lp ((i 0))
-           (if (< i len)
-               (let ((u8 (char->integer (string-ref x i))))
-                 (bytevector-u8-set! buf (+ pos i) u8)
-                 (lp (1+ i)))
-               (bytevector-u8-set! buf (+ pos i) 0))))
-        ((4)
-         (let lp ((i 0))
-           (if (< i len)
-               (let ((u32 (char->integer (string-ref x i))))
-                 (bytevector-u32-set! buf (+ pos (* i 4)) u32 endianness)
-                 (lp (1+ i)))
-               (bytevector-u32-set! buf (+ pos (* i 4)) 0 endianness))))
-        (else (error "bad string bytes per char" x))))
-
-    inits))
-
-(define (write-string asm buf pos x label inits)
-  (let* ((word-size (asm-word-size asm))
-         (endianness (asm-endianness asm))
-         (archive (asm-archive asm))
-         (tag (logior tc7-ro-string (ash (string-length x) 8))))
-    (case word-size
-      ((4)
-       (bytevector-u32-set! buf pos tc7-ro-string endianness)
-       (write-immediate asm buf (+ pos 4) #f)
-       (bytevector-u32-set! buf (+ pos 8) 0 endianness)
-       (bytevector-u32-set! buf (+ pos 12) (string-length x) endianness))
-      ((8)
-       (bytevector-u64-set! buf pos tc7-ro-string endianness)
-       (write-immediate asm buf (+ pos 8) #f)
-       (bytevector-u64-set! buf (+ pos 16) 0 endianness)
-       (bytevector-u64-set! buf (+ pos 24) (string-length x) endianness))
-      (else (error "bad word size")))
-    (cons `(init-string ,label ,x) inits)))
-
-(define (write-pair asm buf pos x label inits)
-  (let ((word-size (asm-word-size asm)))
-    (write-constant-reference
-     asm buf (+ pos word-size) (cdr x) label 1
-     (write-constant-reference
-      asm buf pos (car x) label 0 inits))))
-
-(define (write-vector asm buf pos x label inits)
-  (let* ((word-size (asm-word-size asm))
-         (len (vector-length x))
-         (tag (logior tc7-vector (ash len 8))))
-    (case word-size
-      ((4) (bytevector-u32-set! buf pos tag (asm-endianness asm)))
-      ((8) (bytevector-u64-set! buf pos tag (asm-endianness asm)))
-      (else (error "bad word size")))
-    (let lp ((i 0) (inits inits))
-      (if (< i (vector-length x))
-          (let ((pos (+ pos word-size (* i word-size)))
-                (elt (vector-ref x i)))
-            (lp (1+ i)
-                (write-constant-reference asm buf pos elt label (1+ i) inits)))
-          inits))))
-
-(define (write-symbol asm buf pos x label inits)
-  (write-immediate asm buf pos #f)
-  (cons `(init-symbol ,label ,x) inits))
-
-(define (write-keyword asm buf pos x label inits)
-  (write-immediate asm buf pos #f)
-  (cons `(init-keyword ,label ,x) inits))
-
-(define (write-number asm buf pos x label inits)
-  (write-immediate asm buf pos #f)
-  (cons `(init-number ,label ,x) inits))
-
-(define (emit-init-constants asm inits)
-  (let ((label (gensym "init-constants")))
-    (emit-text asm
-               `((begin-program ,label 1)
-                 (assert-nargs-ee/locals 0 1)
-                 ,@inits
-                 (load-constant 0 ,*unspecified*)
-                 (return 0)))
-    label))
-
-(define (link-data asm data strings-are-stringbufs?)
-  (define (statically-allocatable? x)
-    (or (pair? x) (vector? x) (string? x)))
-
-  (define (byte-length x)
-    (cond
-     ((string? x)
-      (if strings-are-stringbufs?
-          ;; Strings are actually stringbufs.
-          (+ (* 2 (asm-word-size asm))
+(define (emit-init-constants asm)
+  (let ((inits (asm-inits asm)))
+    (and (not (null? inits))
+         (let ((label (gensym "init-constants")))
+           (emit-text asm
+                      `((begin-program ,label 1)
+                        (assert-nargs-ee/locals 0 1)
+                        ,@(reverse inits)
+                        (load-constant 0 ,*unspecified*)
+                        (return 0)))
+           label))))
+
+(define (link-data asm data name)
+  (define (align address alignment)
+    (+ address
+       (modulo (- alignment (modulo address alignment)) alignment)))
+
+  (define tc7-vector 13)
+  (define tc7-narrow-stringbuf 39)
+  (define tc7-wide-stringbuf (+ 39 #x400))
+  (define tc7-ro-string (+ 21 #x200))
+
+  (let ((word-size (asm-word-size asm))
+        (endianness (asm-endianness asm)))
+    (define (byte-length x)
+      (cond
+       ((stringbuf? x)
+        (let ((x (stringbuf-string x)))
+          (+ (* 2 word-size)
              (case (string-bytes-per-char x)
                ((1) (1+ (string-length x)))
                ((4) (* (1+ (string-length x)) 4))
-               (else (error "bad string bytes per char" x))))
-          (* 4 (asm-word-size asm))))
-     ((pair? x)
-      (* 2 (asm-word-size asm)))
-     ((vector? x)
-      (* (1+ (vector-length x)) (asm-word-size asm)))
-     (else
-      (asm-word-size asm))))
+               (else (error "bad string bytes per char" x))))))
+       ((string? x)
+        (* 4 word-size))
+       ((pair? x)
+        (* 2 word-size))
+       ((vector? x)
+        (* (1+ (vector-length x)) word-size))
+       (else
+        word-size)))
 
-  (cond
-   ((vlist-null? data)
-    (values #f #f))
-   (else
-    (let* ((byte-len (vhash-fold (lambda (k v len)
-                                   (+ (byte-length k) (align len 8)))
-                                 0 data))
-           (buf (make-bytevector byte-len 0))
-           (name (if strings-are-stringbufs? '.rodata '.data)))
-      (let lp ((i 0) (pos 0) (labels '())
-               (inits '()))
-        (if (< i (vlist-length data))
-            (let* ((pair (vlist-ref data i))
-                   (obj (car pair))
-                   (obj-label (cdr pair)))
-              (lp (1+ i)
-                  (align (+ (byte-length obj) pos) 8)
-                  (cons (make-elf-symbol (cdr pair) pos) labels)
-                  (cond
-                   ((string? obj)
-                    (if strings-are-stringbufs?
-                        (write-stringbuf asm buf pos obj obj-label inits)
-                        (write-string asm buf pos obj obj-label inits)))
-                   ((pair? obj)
-                    (write-pair asm buf pos obj obj-label inits))
-                   ((vector? obj)
-                    (write-vector asm buf pos obj obj-label inits))
-                   ((symbol? obj)
-                    (write-symbol asm buf pos obj obj-label inits))
-                   ((keyword? obj)
-                    (write-keyword asm buf pos obj obj-label inits))
-                   ((number? obj)
-                    (write-number asm buf pos obj obj-label inits))
-                   (else
-                    (error "unrecognized object" obj)))))
-            (values (make-object asm name buf '() labels)
-                    (and (not (null? inits))
-                         (emit-init-constants asm (reverse inits))))))))))
+    (define (write-constant-reference buf pos x)
+      ;; The asm-inits will fix up any reference to a non-immediate.
+      (write-immediate asm buf pos (if (immediate? x) x #f)))
+
+    (define (write buf pos obj)
+      (cond
+       ((stringbuf? obj)
+        (let* ((x (stringbuf-string obj))
+               (len (string-length x))
+               (tag (if (= (string-bytes-per-char x) 1)
+                        tc7-narrow-stringbuf
+                        tc7-wide-stringbuf)))
+          (case word-size
+            ((4)
+             (bytevector-u32-set! buf pos tag endianness)
+             (bytevector-u32-set! buf (+ pos 4) len endianness))
+            ((8)
+             (bytevector-u64-set! buf pos tag endianness)
+             (bytevector-u64-set! buf (+ pos 8) len endianness))
+            (else
+             (error "bad word size" asm)))
+          (let ((pos (+ pos (* word-size 2))))
+            (case (string-bytes-per-char x)
+              ((1)
+               (let lp ((i 0))
+                 (if (< i len)
+                     (let ((u8 (char->integer (string-ref x i))))
+                       (bytevector-u8-set! buf (+ pos i) u8)
+                       (lp (1+ i)))
+                     (bytevector-u8-set! buf (+ pos i) 0))))
+              ((4)
+               (let lp ((i 0))
+                 (if (< i len)
+                     (let ((u32 (char->integer (string-ref x i))))
+                       (bytevector-u32-set! buf (+ pos (* i 4)) u32 endianness)
+                       (lp (1+ i)))
+                     (bytevector-u32-set! buf (+ pos (* i 4)) 0 endianness))))
+              (else (error "bad string bytes per char" x))))))
+
+       ((string? obj)
+        (let ((tag (logior tc7-ro-string (ash (string-length obj) 8))))
+          (case word-size
+            ((4)
+             (bytevector-u32-set! buf pos tc7-ro-string endianness)
+             (write-immediate asm buf (+ pos 4) #f) ; stringbuf
+             (bytevector-u32-set! buf (+ pos 8) 0 endianness)
+             (bytevector-u32-set! buf (+ pos 12) (string-length obj) 
endianness))
+            ((8)
+             (bytevector-u64-set! buf pos tc7-ro-string endianness)
+             (write-immediate asm buf (+ pos 8) #f) ; stringbuf
+             (bytevector-u64-set! buf (+ pos 16) 0 endianness)
+             (bytevector-u64-set! buf (+ pos 24) (string-length obj) 
endianness))
+            (else (error "bad word size")))))
+
+       ((pair? obj)
+        (write-constant-reference buf pos (car obj))
+        (write-constant-reference buf (+ pos word-size) (cdr obj)))
+
+       ((vector? obj)
+        (let* ((len (vector-length obj))
+               (tag (logior tc7-vector (ash len 8))))
+          (case word-size
+            ((4) (bytevector-u32-set! buf pos tag endianness))
+            ((8) (bytevector-u64-set! buf pos tag endianness))
+            (else (error "bad word size")))
+          (let lp ((i 0))
+            (when (< i (vector-length obj))
+              (let ((pos (+ pos word-size (* i word-size)))
+                    (elt (vector-ref obj i)))
+                (write-constant-reference buf pos elt)
+                (lp (1+ i)))))))
+
+       ((symbol? obj)
+        (write-immediate asm buf pos #f))
+
+       ((keyword? obj)
+        (write-immediate asm buf pos #f))
+
+       ((number? obj)
+        (write-immediate asm buf pos #f))
+
+       (else
+        (error "unrecognized object" obj))))
+
+    (cond
+     ((vlist-null? data) #f)
+     (else
+      (let* ((byte-len (vhash-fold (lambda (k v len)
+                                     (+ (byte-length k) (align len 8)))
+                                   0 data))
+             (buf (make-bytevector byte-len 0)))
+        (let lp ((i 0) (pos 0) (labels '()))
+          (if (< i (vlist-length data))
+              (let* ((pair (vlist-ref data i))
+                     (obj (car pair))
+                     (obj-label (cdr pair)))
+                (write buf pos obj)
+                (lp (1+ i)
+                    (align (+ (byte-length obj) pos) 8)
+                    (cons (make-elf-symbol obj-label pos) labels)))
+              (make-object asm name buf '() labels))))))))
 
 ;; Hummm
 ;; 
@@ -898,6 +842,7 @@
   ;;
   (define (shareable? x)
     (cond
+     ((stringbuf? x) #t)
      ((pair? x)
       (and (immediate? (car x)) (immediate? (cdr x))))
      ((vector? x)
@@ -906,21 +851,15 @@
             (and (immediate? (vector-ref x i))
                  (lp (1+ i))))))
      (else #f)))
-  (let* ((archive (asm-archive asm))
-         (constants (archive-constants archive))
+  (let* ((constants (asm-constants asm))
          (len (vlist-length constants)))
     (let lp ((i 0)
-             ;; Stringbufs are rodata.
-             (ro (archive-stringbufs archive))
+             (ro vlist-null)
              (rw vlist-null))
       (if (= i len)
-          (call-with-values (lambda () (link-data asm ro #t))
-            (lambda (ro ro-init)
-              (when ro-init
-                (error "read-only data should have no initializers!"))
-              (call-with-values (lambda () (link-data asm rw #f))
-                (lambda (rw rw-init)
-                  (values ro rw rw-init)))))
+          (values (link-data asm ro '.rodata)
+                  (link-data asm rw '.data)
+                  (emit-init-constants asm))
           (let ((pair (vlist-ref constants i)))
             (if (shareable? (car pair))
                 (lp (1+ i) (vhash-consq (car pair) (cdr pair) ro) rw)


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]