otation.
;;
;; FIXME: Define all tc7 values in Scheme in one place, derived from
;; tags.h.
(define-tc7-macro-assembler br-if-symbol #x05)
(define-tc7-macro-assembler br-if-variable #x07)
(define-tc7-macro-assembler br-if-vector #x0d)
;(define-tc7-macro-assembler br-if-weak-vector 13)
(define-tc7-macro-assembler br-if-string #x15)
;(define-tc7-macro-assembler br-if-heap-number 23)
;(define-tc7-macro-assembler br-if-stringbuf 39)
(define-tc7-macro-assembler br-if-bytevector #x4d)
;(define-tc7-macro-assembler br-if-pointer 31)
;(define-tc7-macro-assembler br-if-hashtable 29)
;(define-tc7-macro-assembler br-if-fluid 37)
;(define-tc7-macro-assembler br-if-dynamic-state 45)
;(define-tc7-macro-assembler br-if-frame 47)
(define-tc7-macro-assembler br-if-keyword #x35)
;(define-tc7-macro-assembler br-if-syntax #x3d)
;(define-tc7-macro-assembler br-if-vm 55)
;(define-tc7-macro-assembler br-if-vm-cont 71)
;(define-tc7-macro-assembler br-if-rtl-program 69)
;(define-tc7-macro-assembler br-if-weak-set 85)
;(define-tc7-macro-assembler br-if-weak-table 87)
;(define-tc7-macro-assembler br-if-array 93)
(define-tc7-macro-assembler br-if-bitvector #x5f)
;(define-tc7-macro-assembler br-if-port 125)
;(define-tc7-macro-assembler br-if-smob 127)

(define-macro-assembler (begin-program asm label properties)
  (emit-label asm label)
  (let ((meta (make-meta label properties (asm-start asm))))
    (set-asm-meta! asm (cons meta (asm-meta asm)))))

(define-macro-assembler (end-program asm)
  (let ((meta (car (asm-meta asm))))
    (set-meta-high-pc! meta (asm-start asm))
    (set-meta-arities! meta (reverse (meta-arities meta)))))

(define-macro-assembler (begin-standard-arity asm req nlocals alternate)
  (emit-begin-opt-arity asm req '() #f nlocals alternate))

(define-macro-assembler (begin-opt-arity asm req opt rest nlocals alternate)
  (emit-begin-kw-arity asm req opt rest '() #f nlocals alternate))

(define-macro-assembler (begin-kw-arity asm req opt rest kw-indices
                                        allow-other-keys? nlocals alternate)
  (assert-match req ((? symbol?) ...) "list of symbols")
  (assert-match opt ((? symbol?) ...) "list of symbols")
  (assert-match rest (or #f (? symbol?)) "#f or symbol")
  (assert-match kw-indices (((? keyword?) . (? integer?)) ...)
                "alist of keyword -> integer")
  (assert-match allow-other-keys? (? boolean?) "boolean")
  (assert-match nlocals (? integer?) "integer")
  (assert-match alternate (or #f (? exact-integer?) (? symbol?)) "#f or symbol")
  (let* ((meta (car (asm-meta asm)))
         (arity (make-arity req opt rest kw-indices allow-other-keys?
                            (asm-start asm) #f '()))
         ;; The procedure itself is in slot 0, in the standard calling
         ;; convention.  For procedure prologues, nreq includes the
         ;; procedure, so here we add 1.
         (nreq (1+ (length req)))
         (nopt (length opt))
         (rest? (->bool rest)))
    (set-meta-arities! meta (cons arity (meta-arities meta)))
    (cond
     ((or allow-other-keys? (pair? kw-indices))
      (emit-kw-prelude asm nreq nopt rest? kw-indices allow-other-keys?
                       nlocals alternate))
     ((or rest? (pair? opt))
      (emit-opt-prelude asm nreq nopt rest? nlocals alternate))
     (else
      (emit-standard-prelude asm nreq nlocals alternate)))))

(define-macro-assembler (end-arity asm)
  (let ((arity (car (meta-arities (car (asm-meta asm))))))
    (set-arity-definitions! arity (reverse (arity-definitions arity)))
    (set-arity-high-pc! arity (asm-start asm))))

(define-macro-assembler (standard-prelude asm nreq nlocals alternate)
  (cond
   (alternate
    (emit-br-if-nargs-ne asm nreq alternate)
    (emit-alloc-frame asm nlocals))
   ((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12)))
    (emit-assert-nargs-ee/locals asm nreq (- nlocals nreq)))
   (else
    (emit-assert-nargs-ee asm nreq)
    (emit-alloc-frame asm nlocals))))

(define-macro-assembler (opt-prelude asm nreq nopt rest? nlocals alternate)
  (if alternate
      (emit-br-if-nargs-lt asm nreq alternate)
      (emit-assert-nargs-ge asm nreq))
  (cond
   (rest?
    (emit-bind-rest asm (+ nreq nopt)))
   (alternate
    (emit-br-if-nargs-gt asm (+ nreq nopt) alternate))
   (else
    (emit-assert-nargs-le asm (+ nreq nopt))))
  (emit-alloc-frame asm nlocals))

(define-macro-assembler (kw-prelude asm nreq nopt rest? kw-indices
                                    allow-other-keys? nlocals alternate)
  (if alternate
      (begin
        (emit-br-if-nargs-lt asm nreq alternate)
        (unless rest?
          (emit-br-if-npos-gt asm nreq (+ nreq nopt) alternate)))
      (emit-assert-nargs-ge asm nreq))
  (let ((ntotal (fold (lambda (kw ntotal)
                        (match kw
                          (((? keyword?) . idx)
                           (max (1+ idx) ntotal))))
                      (+ nreq nopt) kw-indices)))
    ;; FIXME: port 581f410f
    (emit-bind-kwargs asm nreq
                      (pack-flags allow-other-keys? rest?)
                      (+ nreq nopt)
                      ntotal
                      (intern-constant asm kw-indices))
    (emit-alloc-frame asm nlocals)))

(define-macro-assembler (label asm sym)
  (hashq-set! (asm-labels asm) sym (asm-start asm)))

(define-macro-assembler (source asm source)
  (set-asm-sources! asm (acons (asm-start asm) source (asm-sources asm))))

(define-macro-assembler (definition asm name slot representation)
  (let* ((arity (car (meta-arities (car (asm-meta asm)))))
         (def (vector name slot representation
                      (- (asm-start asm) (arity-low-pc arity)))))
    (set-arity-definitions! arity (cons def (arity-definitions arity)))))

(define-macro-assembler (cache-current-module! asm module scope)
  (let ((mod-label (intern-module-cache-cell asm scope)))
    (emit-static-set! asm module mod-label 0)))

(define-macro-assembler (cached-toplevel-box asm dst scope sym bound?)
  (let ((sym-label (intern-non-immediate asm sym))
        (mod-label (intern-module-cache-cell asm scope))
        (cell-label (intern-cache-cell asm scope sym)))
    (emit-toplevel-box asm dst cell-label mod-label sym-label bound?)))

(define-macro-assembler (cached-module-box asm dst module-name sym public? bound?)
  (let* ((sym-label (intern-non-immediate asm sym))
         (key (cons public? module-name))
         (mod-name-label (intern-constant asm key))
         (cell-label (intern-cache-cell asm key sym)))
    (emit-module-box asm dst cell-label mod-name-label sym-label bound?)))

(define-macro-assembler (slot-map asm proc-slot slot-map)
  (unless (zero? slot-map)
    (set-asm-slot-maps! asm (cons
                             (cons* (asm-start asm) proc-slot slot-map)
                             (asm-slot-maps asm)))))