y
                ;; an optimization.
                (emit-static-patch! asm dst field label))
               ((label . #(emit-init static? patches))
                (let ((slot-from-init (and emit-init (emit-init asm label))))
                  (unless (null? patches)
                    (let ((slot (or slot-from-init
                                    (begin
                                      (if static?
                                          (emit-make-non-immediate asm 1 label)
                                          (emit-static-ref asm 1 label))
                                      1))))
                      (for-each (match-lambda
                                  ((dst . offset)
                                   (emit-static-set! asm slot dst offset)))
                                patches))))))
             (unless (zero? n)
               (lp (1- n))))
           (emit-reset-frame asm 1)
           (emit-load-constant asm 0 *unspecified*)
           (emit-return-values asm)
           (emit-end-program asm)
           label))))

(define (link-data asm data name)
  "Link the static data for a program into the @var{name} section (which
should be .data or .rodata), and return the resulting linker object.
@var{data} should be a vhash mapping objects to labels."
  (define (align address alignment)
    (+ address
       (modulo (- alignment (modulo address alignment)) alignment)))

  (define tc7-vector #x0d)
  (define vector-immutable-flag #x80)

  (define tc7-string #x15)
  (define string-read-only-flag #x200)

  (define tc7-stringbuf #x27)
  (define stringbuf-wide-flag #x400)

  (define tc7-syntax #x3d)
  (define syntax-has-source-flag #x100)

  (define tc7-program #x45)

  (define tc7-bytevector #x4d)
  ;; This flag is intended to be left-shifted by 7 bits.
  (define bytevector-immutable-flag #x200)

  (define tc7-array #x5d)

  (define tc7-bitvector #x5f)
  (define bitvector-immutable-flag #x80)

  (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))))))
       ((static-procedure? x)
        (* 2 word-size))
       ((string? x)
        (* 4 word-size))
       ((pair? x)
        (* 2 word-size))
       ((simple-vector? x)
        (* (1+ (vector-length x)) word-size))
       ((syntax? x)
        (* 5 word-size))
       ((jit-data? x)
        (case word-size
          ((4) (+ word-size (* 4 3)))
          ((8) (+ word-size (* 4 4))) ;; One additional uint32_t for padding.
          (else (error word-size))))
       ((simple-uniform-vector? x)
        (* 4 word-size))
       ((uniform-vector-backing-store? x)
        (bytevector-length (uniform-vector-backing-store-bytes x)))
       ((array? x)
        (* word-size (+ 3 (* 3 (array-rank x)))))
       (else
        word-size)))

    (define (write-constant-reference buf pos x)
      (let ((bits (immediate-bits asm x)))
        (if bits
            (write-immediate asm buf pos bits)
            ;; The asm-inits will fix up any reference to a
            ;; non-immediate.
            (write-placeholder asm buf pos))))

    (define (write buf pos obj)
      (cond
       ((stringbuf? obj)
        (let* ((x (stringbuf-string obj))
               (len (string-length x))
               (tag (logior tc7-stringbuf
                            (if (= (string-bytes-per-char x) 1)
                                0
                                stringbuf-wide-flag))))
          (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))))))

       ((static-procedure? obj)
        (case word-size
          ((4)
           (bytevector-u32-set! buf pos tc7-program endianness)
           (bytevector-u32-set! buf (+ pos 4) 0 endianness))
          ((8)
           (bytevector-u64-set! buf pos tc7-program endianness)
           (bytevector-u64-set! buf (+ pos 8) 0 endianness))
          (else (error "bad word size"))))

       ((cache-cell? obj)
        (write-placeholder asm buf pos))

       ((jit-data? obj)
        ;; Default initialization of 0.
        (values))

       ((string? obj)
        (let ((tag (logior tc7-string string-read-only-flag)))
          (case word-size
            ((4)
             (bytevector-u32-set! buf pos tag endianness)
             (write-placeholder asm buf (+ pos 4)) ; 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 tag endianness)
             (write-placeholder asm buf (+ pos 8)) ; 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)))

       ((simple-vector? obj)
        (let* ((len (vector-length obj))
               (tag (logior tc7-vector vector-immutable-flag (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-placeholder asm buf pos))

       ((keyword? obj)
        (write-placeholder asm buf pos))

       ((syntax? obj)
        (let ((tag (logior tc7-syntax syntax-has-source-flag)))
          (case word-size
            ((4) (bytevector-u32-set! buf pos tag endianness))
            ((8) (bytevector-u64-set! buf pos tag endianness))
            (else (error "bad word size"))))
        (write-constant-reference buf (+ pos (* 1 word-size))
                                  (syntax-expression obj))
        (write-constant-reference buf (+ pos (* 2 word-size))
                                  (syntax-wrap obj))
        (write-constant-reference buf (+ pos (* 3 word-size))
                                  (syntax-module obj))
        (write-constant-reference buf (+ pos (* 4 word-size))
                                  (syntax-sourcev obj)))

       ((number? obj)
        (write-placeholder asm buf pos))

       ((simple-uniform-vector? obj)
        (let ((tag (if (bitvector? obj)
                       (logior tc7-bitvector
                               bitvector-immutable-flag)
                       (logior tc7-bytevector
                               ;; Bytevector immutable flag also shifted
                               ;; left.
                               (ash (logior bytevector-immutable-flag
                                            (array-type-code obj))
                                    7)))))
          (case word-size
            ((4)
             (bytevector-u32-set! buf pos tag endianness)
             (bytevector-u32-set! buf (+ pos 4)
                                  (if (bitvector? obj)
                                      (bitvector-length obj)
                                      (bytevector-length obj))
                                  endianness)                 ; length
             (bytevector-u32-set! buf (+ pos 8) 0 endianness) ; pointer
             (write-placeholder asm buf (+ pos 12)))          ; owner
            ((8)
             (bytevector-u64-set! buf pos tag endianness)
             (bytevector-u64-set! buf (+ pos 8)
                                  (if (bitvector? obj)
                                      (bitvector-length obj)
                                      (bytevector-length obj))
                                  endianness)                  ; length
             (bytevector-u64-set! buf (+ pos 16) 0 endianness) ; pointer
             (write-placeholder asm buf (+ pos 24)))           ; owner
            (else (error "bad word size")))))

       ((uniform-vector-backing-store? obj)
        (let ((bv (uniform-vector-backing-store-bytes obj)))
          (bytevector-copy! bv 0 buf pos (bytevector-length bv))
          (unless (eq? endianness (native-endianness))
            (case (uniform-vector-backing-store-element-size obj)
              ((1) #f) ;; Nothing to do.
              ((2) (byte-swap/2! buf pos (+ pos (bytevector-length bv))))
              ((4) (byte-swap/4! buf pos (+ pos (bytevector-length bv))))
              ((8) (byte-swap/8! buf pos (+ pos (bytevector-length bv))))
              (else (error "FIXME: Implement byte order swap"))))))

       ((array? obj)
        (let-values
            ;; array tag + rank
            ;; see libguile/arrays.h: SCM_I_ARRAY_NDIM, SCM_I_ARRAYP, scm_i_raw_array
            (((tag) (logior tc7-array (ash (array-rank obj) 17)))
             ((bv-set! bvs-set!)
              (case word-size
                ((4) (values bytevector-u32-set! bytevector-s32-set!))
                ((8) (values bytevector-u64-set! bytevector-s64-set!))
                (else (error "bad word size")))))
          (bv-set! buf pos tag endianness)
          (write-placeholder asm buf (+ pos word-size))      ; root vector (fixed later)
          (bv-set! buf (+ pos (* word-size 2)) 0 endianness) ; base
          (let lp ((pos (+ pos (* word-size 3)))
                   (bounds (array-shape obj))
                   (incs (shared-array-increments obj)))
            (when (pair? bounds)
              (bvs-set! buf pos (first (first bounds)) endianness)
              (bvs-set! buf (+ pos word-size) (second (first bounds)) endianness)
              (bvs-set! buf (+ pos (* word-size 2)) (first incs) endianness)
              (lp (+ pos (* 3 word-size)) (cdr bounds) (cdr incs))))))

       (else
        (error "unrecognized object" obj))))

    (define (add-relocs obj pos relocs)
      (match obj
        (($ <jit-data> low-pc high-pc)
         ;; Patch "start" and "end" fields of "struct jit_data".
         (cons* (make-linker-reloc 'rel32/1 (+ pos word-size 4)
                                   (+ low-pc word-size 4)
                                   '.rtl-text)
                (make-linker-reloc 'rel32/1 (+ pos word-size 8)
                                   (+ high-pc word-size 8)
                                   '.rtl-text)
                relocs))
        (_ relocs)))

    (cond
     ((vlist-null? data) #f)
     (else
      (let* ((byte-len (vhash-fold (lambda (k v len)
                                     (+ (byte-length k) (align len 8)))
                                   0 data)))
        (let lp ((i 0) (pos 0) (relocs '()) (symbols '()))
          (if (< i (vlist-length data))
              (match (vlist-ref data i)
                ((obj . obj-label)
                 (lp (1+ i)
                     (align (+ (byte-length obj) pos) 8)
                     (add-relocs obj pos relocs)
                     (cons (make-linker-symbol obj-label pos) symbols))))
              (make-object asm name byte-len
                           (lambda (bv)
                             (let loop ((i 0) (pos 0))
                               (when (< i (vlist-length data))
                                 (match (vlist-ref data i)
                                   ((obj . obj-label)
                                    (write bv pos obj)
                                    (loop (1+ i)
                                          (align
                                           (+ (byte-length obj) pos)
                                           8)))))))
                           relocs symbols
                           #:flags (match name
                                     ('.data (logior SHF_ALLOC SHF_WRITE))
                                     ('.rodata SHF_ALLOC))))))))))

(define (link-constants asm)
  "Link sections to hold constants needed by the program text emitted
using @var{asm}.

Returns three values: an object for the .rodata section, an object for
the .data section, and a label for an initialization procedure.  Any of
these may be @code{#f}."
  (define (shareable? x)
    (cond
     ((stringbuf? x) #t)
     ((pair? x)
      (and (immediate-bits asm (car x)) (immediate-bits asm (cdr x))))
     ((simple-vector? x)
      (let lp ((i 0))
        (or (= i (vector-length x))
            (and (immediate-bits asm (vector-ref x i))
                 (lp (1+ i))))))
     ((uniform-vector-backing-store? x) #t)
     (else #f)))
  (let* ((init-constants (emit-init-constants asm))
         (constants (asm-constants asm))
         (len (vlist-length constants)))
    (let lp ((i 0)
             (ro vlist-null)
             (rw vlist-null))
      (if (= i len)
          (values (link-data asm ro '.rodata)
                  (link-data asm rw '.data)
                  init-constants)
          (match (vlist-ref constants i)
            ((obj . label)
             (if (shareable? obj)
                 (lp (1+ i) (vhash-consq obj label ro) rw)
                 (lp (1+ i) ro (vhash-consq obj label rw)))))))))