(herald (assembler mark t 19)
        (env tsys (assembler as_open) (assembler fg) (assembler ib)))

;;; ----------------------------------------------------------------
;;; MARKER
;;;   Compute initial address (minimum spans); make table of SDF's and
;;; of marks.  Set mark addresses, mark sdf pos, ib sdf pos, ib-addresses

(define-structure-type sdf
  span crossers width next-dirty selector  ; initialized, but dynamic
  vars backwards? number          ; dynamic
  static                          ; a structure of static info
  )
                                               
;;; multiplex 2 fields of the structure

(define-integrable sdf-mark sdf-span)
(define-integrable sdf-label sdf-width)

(define (cons-sdf l sel s)
  (let ((sdf (make-sdf)))
    (set (sdf-span          sdf) *empty*) ; initial span will be the mark
    (set (sdf-crossers      sdf) '())
    (set (sdf-width         sdf) l)       ; initial width is actually the label
    (set (sdf-next-dirty    sdf) nil)
    (set (sdf-selector      sdf) sel)
    (set (sdf-static        sdf) s)
    sdf
    ))

;;; ----------------

(define-structure-type sdf-static
  selector first-width width-var displ-var)

(define (cons-sdf-static fw wv dv)
  (let ((s (make-sdf-static)))
    (set (sdf-static-first-width s) fw)
    (set (sdf-static-width-var s) wv)
    (set (sdf-static-displ-var s) dv)
    s))

;;; ----------------

(define-structure-type mark
  number
  sdf-position
  address)

;;; IB-SFD-NUMBER, MARK-SDF-POSITION
;;; Number of sdf's precedeing some spot.  This number is remembered for
;;; each mark or label, as encountered.  This is used in later processing
;;; to fixup labels and marks after the width of each sdf has been determined.

;;; ----------------------------------------------------------------

;;; Returns last address = size in bits (minimum possible),
;;; as well as a vector of sdfs and a vector or marks

(define (marker ibv mark-count span-count)
  (let ((marks (make-vector mark-count))
        (sdfs  (make-vector span-count)))
    (let ((ibv-length (vector-length ibv)))
      (do ((i 0 (fx+ i 1))
           (addr 0 (marker-ib addr (vref ibv i) marks sdfs)))
          ((fx>= i ibv-length)
           (return addr sdfs marks))))))
                                                     
(define (marker-ib start-addr ib marks sdfs)
  (let* ((a (ib-align ib))
         (maximum-alignment-filler (if a (car a) 0))
         (start-addr (fx+ start-addr maximum-alignment-filler)))

    ;; if alignment is specified, make an alignment sdf
    (set (ib-address ib) start-addr)
    (if a
        (let ((sdf-pos (ib-sdf-number ib)))
          (set (vref sdfs (fx- sdf-pos 1)) (cons-sdf '#f '#f '#f))))

    (iterate loop ((i's (ib-instructions ib))
                   (addr start-addr))
      (cond ((null? i's) addr)
            (else
             (let ((new-addr (marker-fg addr (car i's) marks sdfs)))
               (loop (cdr i's) new-addr)))))))

(define (marker-fg start-addr fg marks sdfs)
  (let* ((fgt (fg-type fg))
         (vars (fg-vars fg))
         (vals (fg-type-vals fgt)))
    (iterate loop ((ops (fg-type-ops fgt))
                   (addr start-addr))
      (cond ((null? ops) addr)
            (else
             (xselect (car ops)
               ((wop/fix)
                (destructure (((#f width vop voc1 . ops) ops))
                  (loop ops (fx+ addr width))))
               ((wop/@fix)
                (destructure (((#f width-i vop voc1 . ops) ops))
                  (loop ops (fx+ addr (vref vars width-i)))))

               ((wop/variable)
                (destructure (((#f sdf-i mark-i fge-i . ops) ops))
                  (let* ((sdf (vref vars sdf-i))
                         (sdf# (sdf-number sdf)))
                    (set (sdf-mark sdf) (vref vars mark-i))  
                    (set (sdf-vars sdf) vars)
                    (set (vref sdfs sdf#) sdf)
                    (loop ops (fx+ addr (sdf-static-first-width
                                         (sdf-static sdf)))) )))

               ((wop/subfield)
                (destructure (((#f sf-i . ops) ops))
                  (loop ops (marker-fg addr (vref vars sf-i) marks sdfs))))
               
               ((wop/mark)
                (destructure (((#f marker-i . ops) ops))
                  (let ((mark (vref vars marker-i)))
                    (set (mark-address mark) addr)
                    (set (vref marks (mark-number mark)) mark)
                    (loop ops addr))))

               ((wop/group)
                (destructure (((#f start? . ops) ops))
                  (loop ops addr)))
               ))))))

;;; ---------------- Statistics hack.
                                        
(define (count-align-sdfs sdfs)
  (let ((sdfs-length (vector-length sdfs)))
    (do ((i 0 (fx+ i 1))
         (count 0 (if (empty? (sdf-span (vref sdfs i))) (fx+ count 1) count)) )
        ((fx>= i sdfs-length)
         count))))