[PATCH 7/9] Write docstrings into RTL ELF images

[Andy Wingo <wingo@pobox.com>]

* module/system/vm/assembler.scm (link-docstrs): Write docstrings.
  (link-objects): Link docstrings into the ELF.
---
 module/system/vm/assembler.scm |   58 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 57 insertions(+), 1 deletion(-)

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 7718574..3fe4692 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1167,6 +1167,61 @@
                                      (linker-object-section strtab)))
                 strtab)))))
 
+;;;
+;;; The .guile.docstrs section is a packed, sorted array of (pc, str)
+;;; values.  Pc and str are both 32 bits wide.  (Either could change to
+;;; 64 bits if appropriate in the future.)  Pc is the address of the
+;;; entry to a program, relative to the start of the text section, and
+;;; str is an index into the associated .guile.docstrs.strtab string
+;;; table section.
+;;;
+
+;; The size of a docstrs entry, in bytes.
+(define docstr-size 8)
+
+(define (link-docstrs asm)
+  (define (find-docstrings)
+    (filter-map (lambda (meta)
+                  (define (is-documentation? pair)
+                    (eq? (car pair) 'documentation))
+                  (let* ((props (meta-properties meta))
+                         (tail (find-tail is-documentation? props)))
+                    (and tail
+                         (not (find-tail is-documentation? (cdr tail)))
+                         (string? (cdar tail))
+                         (cons (meta-low-pc meta) (cdar tail)))))
+                (reverse (asm-meta asm))))
+  (let* ((endianness (asm-endianness asm))
+         (docstrings (find-docstrings))
+         (strtab (make-string-table))
+         (bv (make-bytevector (* (length docstrings) docstr-size) 0)))
+    (define (intern-string! name)
+      (call-with-values
+          (lambda () (string-table-intern strtab name))
+        (lambda (table idx)
+          (set! strtab table)
+          idx)))
+    (fold (lambda (pair pos)
+            (match pair
+              ((pc . string)
+               (bytevector-u32-set! bv pos pc endianness)
+               (bytevector-u32-set! bv (+ pos 4) (intern-string! string)
+                                    endianness)
+               (+ pos docstr-size))))
+          0
+          docstrings)
+    (let ((strtab (make-object asm '.guile.docstrs.strtab
+                               (link-string-table strtab)
+                               '() '()
+                               #:type SHT_STRTAB #:flags 0)))
+      (values (make-object asm '.guile.docstrs
+                           bv
+                           '() '()
+                           #:type SHT_PROGBITS #:flags 0
+                           #:link (elf-section-index
+                                   (linker-object-section strtab)))
+              strtab))))
+
 (define (link-objects asm)
   (let*-values (((ro rw rw-init) (link-constants asm))
                 ;; Link text object after constants, so that the
@@ -1175,12 +1230,13 @@
                 ((dt) (link-dynamic-section asm text ro rw rw-init))
                 ((symtab strtab) (link-symtab (linker-object-section text) asm))
                 ((arities arities-strtab) (link-arities asm))
+                ((docstrs docstrs-strtab) (link-docstrs asm))
                 ;; This needs to be linked last, because linking other
                 ;; sections adds entries to the string table.
                 ((shstrtab) (link-shstrtab asm)))
     (filter identity
             (list text ro rw dt symtab strtab arities arities-strtab
-                  shstrtab))))
+                  docstrs docstrs-strtab shstrtab))))
 
 (define (link-assembly asm)
   (link-elf (link-objects asm)))
-- 
1.7.10.4