(define-macro-assembler (name asm dst a b)
    (emit-call-scm<-scm-scm asm dst a b (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-scm-uimm-intrinsic name)
  (define-macro-assembler (name asm dst a b)
    (emit-call-scm<-scm-uimm asm dst a b (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm-sz-u32-intrinsic name)
  (define-macro-assembler (name asm a b c)
    (emit-call-scm-sz-u32 asm a b c (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-scm-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-scm<-scm asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-f64<-scm-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-f64<-scm asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-f64<-f64-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-f64<-f64 asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-f64<-f64-f64-intrinsic name)
  (define-macro-assembler (name asm dst a b)
    (emit-call-f64<-f64-f64 asm dst a b (intrinsic-name->index 'name))))
(define-syntax-rule (define-u64<-scm-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-u64<-scm asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-s64<-scm-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-s64<-scm asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-u64-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-scm<-u64 asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-s64-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-scm<-s64 asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-thread-intrinsic name)
  (define-macro-assembler (name asm)
    (emit-call-thread asm (intrinsic-name->index 'name))))
(define-syntax-rule (define-thread-scm-intrinsic name)
  (define-macro-assembler (name asm a)
    (emit-call-thread-scm asm a (intrinsic-name->index 'name))))
(define-syntax-rule (define-thread-scm-scm-intrinsic name)
  (define-macro-assembler (name asm a b)
    (emit-call-thread-scm-scm asm a b (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-thread-scm-intrinsic name)
  (define-macro-assembler (name asm dst src)
    (emit-call-scm<-thread-scm asm dst src (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-scm-u64-intrinsic name)
  (define-macro-assembler (name asm dst a b)
    (emit-call-scm<-scm-u64 asm dst a b (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-scm-bool-intrinsic name)
  (define-macro-assembler (name asm dst a b)
    (emit-call-scm<-scm-uimm asm dst a (if b 1 0) (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-thread-intrinsic name)
  (define-macro-assembler (name asm dst)
    (emit-call-scm<-thread asm dst (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm-scm-intrinsic name)
  (define-macro-assembler (name asm a b)
    (emit-call-scm-scm asm a b (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm-uimm-scm-intrinsic name)
  (define-macro-assembler (name asm a b c)
    (emit-call-scm-uimm-scm asm a b c (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm-scm-scm-intrinsic name)
  (define-macro-assembler (name asm a b c)
    (emit-call-scm-scm-scm asm a b c (intrinsic-name->index 'name))))
(define-syntax-rule (define-scm<-scmn-scmn-intrinsic name)
  (define-macro-assembler (name asm dst a b)
    (unless (statically-allocatable? a) (error "not statically allocatable" a))
    (unless (statically-allocatable? b) (error "not statically allocatable" b))
    (let ((a (intern-constant asm a))
          (b (intern-constant asm b)))
      (emit-call-scm<-scmn-scmn asm dst a b (intrinsic-name->index 'name)))))

(define-scm<-scm-scm-intrinsic add)
(define-scm<-scm-uimm-intrinsic add/immediate)
(define-scm<-scm-scm-intrinsic sub)
(define-scm<-scm-uimm-intrinsic sub/immediate)
(define-scm<-scm-scm-intrinsic mul)
(define-scm<-scm-scm-intrinsic div)
(define-scm<-scm-scm-intrinsic quo)
(define-scm<-scm-scm-intrinsic rem)
(define-scm<-scm-scm-intrinsic mod)
(define-scm<-scm-intrinsic inexact)
(define-scm<-scm-intrinsic abs)
(define-scm<-scm-intrinsic sqrt)
(define-scm<-scm-intrinsic floor)
(define-scm<-scm-intrinsic ceiling)
(define-scm<-scm-intrinsic sin)
(define-scm<-scm-intrinsic cos)
(define-scm<-scm-intrinsic tan)
(define-scm<-scm-intrinsic asin)
(define-scm<-scm-intrinsic acos)
(define-scm<-scm-intrinsic atan)
(define-scm<-scm-scm-intrinsic atan2)
(define-f64<-f64-intrinsic fabs)
(define-f64<-f64-intrinsic fsqrt)
(define-f64<-f64-intrinsic ffloor)
(define-f64<-f64-intrinsic fceiling)
(define-f64<-f64-intrinsic fsin)
(define-f64<-f64-intrinsic fcos)
(define-f64<-f64-intrinsic ftan)
(define-f64<-f64-intrinsic fasin)
(define-f64<-f64-intrinsic facos)
(define-f64<-f64-intrinsic fatan)
(define-f64<-f64-f64-intrinsic fatan2)
(define-scm<-scm-scm-intrinsic logand)
(define-scm<-scm-scm-intrinsic logior)
(define-scm<-scm-scm-intrinsic logxor)
(define-scm<-scm-scm-intrinsic logsub)
(define-scm-sz-u32-intrinsic string-set!)
(define-scm<-scm-intrinsic string->number)
(define-scm<-scm-intrinsic string->symbol)
(define-scm<-scm-intrinsic symbol->keyword)
(define-scm<-scm-intrinsic class-of)
(define-f64<-scm-intrinsic scm->f64)
(define-u64<-scm-intrinsic scm->u64)
(define-u64<-scm-intrinsic scm->u64/truncate)
(define-s64<-scm-intrinsic scm->s64)
(define-scm<-u64-intrinsic u64->scm)
(define-scm<-s64-intrinsic s64->scm)
(define-thread-scm-scm-intrinsic wind)
(define-thread-intrinsic unwind)
(define-thread-scm-scm-intrinsic push-fluid)
(define-thread-intrinsic pop-fluid)
(define-scm<-thread-scm-intrinsic fluid-ref)
(define-thread-scm-scm-intrinsic fluid-set!)
(define-thread-scm-intrinsic push-dynamic-state)
(define-thread-intrinsic pop-dynamic-state)
(define-scm<-scm-u64-intrinsic lsh)
(define-scm<-scm-u64-intrinsic rsh)
(define-scm<-scm-uimm-intrinsic lsh/immediate)
(define-scm<-scm-uimm-intrinsic rsh/immediate)
(define-scm<-scm-bool-intrinsic resolve-module)
(define-scm<-scm-scm-intrinsic module-variable)
(define-scm<-scm-scm-intrinsic lookup)
(define-scm<-scm-scm-intrinsic lookup-bound)
(define-scm<-scmn-scmn-intrinsic lookup-bound-public)
(define-scm<-scmn-scmn-intrinsic lookup-bound-private)
(define-scm<-scm-scm-intrinsic define!)
(define-scm<-thread-intrinsic current-module)
(define-scm<-scm-intrinsic symbol->string)
(define-scm<-scm-intrinsic string->utf8)
(define-scm<-scm-intrinsic utf8->string)
(define-u64<-scm-intrinsic string-utf8-length)

(define-scm<-scm-intrinsic $car)
(define-scm<-scm-intrinsic $cdr)
(define-scm-scm-intrinsic $set-car!)
(define-scm-scm-intrinsic $set-cdr!)
(define-scm<-scm-intrinsic $variable-ref)
(define-scm-scm-intrinsic $variable-set!)
(define-scm<-scm-intrinsic $vector-length)
(define-scm<-scm-scm-intrinsic $vector-ref)
(define-scm-scm-scm-intrinsic $vector-set!)
(define-scm<-scm-uimm-intrinsic $vector-ref/immediate)
(define-scm-uimm-scm-intrinsic $vector-set!/immediate)
(define-scm<-scm-scm-intrinsic $allocate-struct)
(define-scm<-scm-intrinsic $struct-vtable)
(define-scm<-scm-scm-intrinsic $struct-ref)
(define-scm-scm-scm-intrinsic $struct-set!)
(define-scm<-scm-uimm-intrinsic $struct-ref/immediate)
(define-scm-uimm-scm-intrinsic $struct-set!/immediate)

(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))))
  (emit-instrument-entry* 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)))
    (set-asm-constants!
     asm
     (vhash-cons (make-jit-data (meta-low-pc meta) (meta-high-pc meta))
                 (meta-jit-data-label meta)
                 (asm-constants asm)))))

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

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

(define-macro-assembler (begin-kw-arity asm has-closure? 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?
                            has-closure?
                            ;; Include the initial instrument-entry in
                            ;; the first arity.
                            (if (null? (meta-arities meta))
                                (meta-low-pc meta)
                                (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.
         (nclosure (if has-closure? 1 0))
         (nreq (+ nclosure (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 (begin-unchecked-arity asm has-closure? req nlocals)
  (assert-match req ((? symbol?) ...) "list of symbols")
  (assert-match nlocals (? integer?) "integer")
  (let* ((meta (car (asm-meta asm)))
         (arity (make-arity req '() #f '() #f has-closure?
                            (meta-low-pc meta) #f '()))
         (nclosure (if has-closure? 1 0))
         (nreq (+ nclosure (length req))))
    (set-meta-arities! meta (cons arity (meta-arities meta)))
    (emit-unchecked-prelude asm nreq nlocals)))

(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 (unchecked-prelude asm nreq nlocals)
  (unless (= nlocals nreq)
    (emit-alloc-frame asm nlocals)))

(define-macro-assembler (standard-prelude asm nreq nlocals alternate)
  (cond
   (alternate
    (emit-arguments<=? asm nreq)
    (emit-jne asm 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
      (begin
        (emit-arguments<=? asm nreq)
        (emit-jl asm alternate))
      (emit-assert-nargs-ge asm nreq))
  (cond
   (rest?
    (unless (zero? nopt)
      (emit-bind-optionals asm (+ nreq nopt)))
    (emit-bind-rest asm (+ nreq nopt)))
   (alternate
    (emit-arguments<=? asm (+ nreq nopt))
    ;; The arguments<=? instruction sets NONE to indicate greater-than,
    ;; whereas for <, NONE usually indicates greater-than-or-equal,
    ;; hence the name jge.  Perhaps we just need to rename jge to
    ;; br-if-none.
    (emit-jge asm alternate)
    (unless (zero? nopt)
      (emit-bind-optionals asm (+ nreq nopt))))
   (else
    (emit-assert-nargs-le asm (+ nreq nopt))
    (unless (zero? nopt)
      (emit-bind-optionals 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-arguments<=? asm nreq)
        (emit-jl asm alternate)
        (unless rest?
          (emit-positional-arguments<=? asm nreq (+ nreq nopt))
          (emit-jge asm 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-ref asm dst key)
  (emit-static-ref asm dst (intern-cache-cell asm key)))

(define-macro-assembler (cache-set! asm key val)
  (emit-static-set! asm val (intern-cache-cell asm key) 0))

(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)))))