
; hash table operations

(define HASH-SIZE 509)

(define (make-hash)
  (make-vector HASH-SIZE '()))

(define (hash-set! vec key value)
  (let
    ((hash-idx (remainder (symbol-hash key) HASH-SIZE)))
    (vector-set!
      vec
      hash-idx
      (cons (list key value) (vector-ref vec hash-idx)))))
 
(define (hash-ref vec key)
  (let
    ((hash-idx (remainder (symbol-hash key) HASH-SIZE)))
    (assq key (vector-ref vec hash-idx))))

(define (empty-hash-table? vec n)
  (if (= n HASH-SIZE)
    #t
    (let
      ((element (vector-ref vec n)))
      (if (not (null? element))
        #f
        (empty-hash-table? vec (+ n 1))))))


(define target (read))

(define version '())
(define instruction-run-count-threshold  0)
(define MAXIMUM-FREE-REGISTERS 0)

(if (eq? target 'arm)
  (begin
    (set! version (read))
    (set! instruction-run-count-threshold (read))
    (if (eq? version 'aarch64)
      (set! MAXIMUM-FREE-REGISTERS 9)
      (set! MAXIMUM-FREE-REGISTERS 7)))
  (if (eq? target 'x86)
    (begin
      (set! version (read)) ; 32 or 64
      (if (= version 32) ; TODO can now specify eax vs rax etc based on version
        ; 7 almost works results in illegal instruction esi, [esi]
        (set! MAXIMUM-FREE-REGISTERS 6)
        (set! MAXIMUM-FREE-REGISTERS 7))) ; 64 bit
    (if (eq? target 'riscv)
      (set! MAXIMUM-FREE-REGISTERS 8)
      (if (eq? target 'm68k)
        (set! MAXIMUM-FREE-REGISTERS 6))))) ; TODO try more

(define target-save target)

(define quiet #f)

(define (my-display x)
  (if (not quiet)
    (display x)))

(define (my-newline)
  (if (not quiet)
    (newline)))

(define gen-n 0)

(define (gen)
  (let
    ((n gen-n))
    (set! gen-n (+ gen-n 1))
    n))

(define code-instructions '())

(define (log-code-instruction instruction)
  (if (not quiet)
    (set! code-instructions (cons instruction code-instructions))))

(define (imm? instruction)
  (if (pair? instruction)
    (eq? (car instruction) 'imm)
  #f))

(define (display-label-dot target)
  (if (or (eq? target 'arm)
          (eq? target 'x86)
          (eq? target 'm68k)
          (eq? target 'riscv))
    (display ".")))

(define (display-label-character target)
  (if (or (eq? target 'arm)
          (eq? target 'x86)
          (eq? target 'riscv)
          (eq? target 'm68k))
    (display ":")))

(define (display-code code-instructions)
  (if (not (null? code-instructions))
    (let
      ((instruction (car code-instructions)))
      (cond
        ((number? instruction) ; label
          (set! target target-save) ; TODO remove
          (display-label-dot target)
	  (display "l") (display instruction)
          (display-label-character target)
          (set! target 'vm) ; TODO remove
          (newline))
        ((symbol? instruction) ; function name
	  (display-name instruction)
          (set! target target-save) ; TODO remove
          (display-label-character target)
          (set! target 'vm) ; TODO remove
          (newline))
        ((eq? (car instruction) 'expr) ; pseudo instruction
          (let
            ((expr (cadr (cddr (cdr instruction)))))
            (set! fast-expression (cadr instruction))
            (set! max-register-idx (cadr (cdr instruction)))
            (set! fast-relop (cadr (cddr instruction)))
            (set! register-idx 0)
            (set! immediate-list '())
            (set! target target-save) ; TODO remove
            (display-comment)
            (set! target 'vm) ; TODO remove
            (display instruction)
            (newline)))
        ((memq (car instruction) '(br btr bfl))
          (set! target target-save) ; TODO remove
          (if (or (eq? target 'arm)
                  (eq? target 'x86)
                  (eq? target 'riscv)
                  (eq? target 'm68k))
            (display-comment))
	  (display "(") (display (car instruction)) (display " l")
	  (display (cadr instruction)) (display ")")
          (newline)
	  (case (car instruction) ; arm, x86, riscv or m68k
	    ((btr) (btr target (cadr instruction)))
	    ((bfl) (bfl target (cadr instruction)))
	    ((br) (br target (cadr instruction))))
          (set! target 'vm) ; TODO remove
         )
        ((eq? (car instruction) 'brtable)
          (set! target target-save) ; TODO remove
          (if (or (eq? target 'arm) (eq? target 'x86)
                  (eq? target 'riscv) (eq? target 'm68k))
            (display-comment))
	  (let
	    ((operands (cadr instruction)))
	    (display "(") (display (car instruction))
	    (do ((i 0 (+ i 1))) ((= i (length operands)))
	      (display " (") (display i)
	      (display " l") (display (cadr (list-ref operands i)))
	    (display ")"))
	    (display ")")
	    (newline))
          (brtable target (cadr instruction)))
	(else
          (set! target target-save)
          (if (eq? target 'vm)
            (begin
              (if (not (imm? instruction))
                (begin
                  (display instruction)
                  (newline))))
            (display-instruction instruction))
          (set! target 'vm)))
      (display-code (cdr code-instructions)))))

(define (return-followed-by-branch instruction code)
  (if (equal? instruction '(return))
    (if (not (null? (cdr code)))
      (if (pair? (cadr code))
        (eq? (car (cadr code)) 'br)
        #f)
      #f)
     #f))

(define (find-label-followed-by-branch label code labels)
  (if (null? code)
    #f
    (if (pair? code)
      (if (number? (car code))
        ; skip possible labels before instruction
        (find-label-followed-by-branch label (cdr code) labels)
        (if (pair? (car code))
          (if (eq? (caar code) 'br)
	    (let
	      ((new-label (cadr (car code))))
	      ; follow the new label for chained branches
	      (let
	        ((next-label
                  (find-label-followed-by-branch
	            new-label (vector-ref labels new-label) labels)))
	        (if (not next-label)
	          new-label
	          next-label)))
	    #f)
	  #f))
      #f)))

(define (test-branch-followed-by-branch instruction code full-code labels)
  (if (pair? instruction)
    (let
      ((op (car instruction)))
      (if (memq op '(br bfl))
	(let
	  ((label (cadr instruction)))
          (find-label-followed-by-branch
	    label (vector-ref labels label) labels))
        #f))
    #f))

(define (optimize-code code full-code labels)
  (if (null? code)
    '()
    (let
      ((instruction (car code)))
      (if (return-followed-by-branch instruction code)
        (cons instruction (optimize-code (cddr code) full-code labels))
        (let
          ((found (test-branch-followed-by-branch
		    instruction code
		    full-code
		    labels)))
          (if found
            (cons
	      (list (car instruction) found)
	      (optimize-code
		(cdr code)
		full-code
		labels))
            (cons instruction (optimize-code (cdr code) full-code labels))))))))

(define (match-sequence? code sequence)
  (if (null? sequence)
    #t
    (if (pair? code)
      (let
        ((instruction (car code)))
        (if (pair? instruction)
          (if (eq? (car sequence) (car instruction))
            (match-sequence? (cdr code) (cdr sequence))
            #f)
          #f))
      #f)))

(define (simple-x86-assignment? code sequence) ; simple inc dec statements
  (if (match-sequence? code sequence)
    (let
      ((one? (cadr (cadr code)))
       (offset1 (cadr (cadr (cdr code)))) ; replace cd...r with function calls
       (offset2 (cadr (cadr (cddr (cdr code))))))
      (if (= one? 1)
        (if (equal? offset1 offset2)
          offset1
          #f)
        #f))
    #f))

(define (optimize-code-x86-dec target code)
  (if (not (eq? target 'x86))
    code
    (if (null? code)
      '()
      (let
        ((match (simple-x86-assignment? code
          '(imm push stack-ref-n sub stack-set-n))))
        (if match
          (cons (list 'dec match)
            (optimize-code-x86-dec target (cddr (cddr (cdr code)))))
          (cons (car code) (optimize-code-x86-dec target (cdr code))))))))

(define (optimize-code-x86-inc target code)
  (if (not (eq? target 'x86))
    code
    (if (null? code)
      '()
      (let
        ((match (simple-x86-assignment? code
          '(imm push stack-ref-n add stack-set-n))))
        (if match
          (cons (list 'inc match)
            (optimize-code-x86-inc target (cddr (cddr (cdr code)))))
          (cons (car code) (optimize-code-x86-inc target (cdr code))))))))

(define level 0)

(define global-vars '())
(define local-vars '())
(define formal-parameters '())
(define functions '())
(define function-type '())
(define dynamic-link '())

(define loop-label-stack '())

(define fast-expression #f)
(define operand1-is-num #f)

(define fast-relop #f)

(define immediate-push #f)
(define immediate-list '())

(define hash-functions (make-hash))

(define (make-hash-functions functions)
  (if (not (null? functions))
    (let
      ((function (car functions)))
      (let
        ((name (car function))
         (value (cadr function)))
        (hash-set! hash-functions name value) 
        (make-hash-functions (cdr functions))))))

(define (display-comment)
  (if (not quiet)
    (case target
      ((vm) (my-display "; ")) ; scheme comment
      ((arm) (if (not (eq? version 'aarch64))
               (my-display "@ ")
               (my-display "// ")))
      ((riscv) (my-display "# "))
      ((x86) (my-display "# "))
      ((m68k) (my-display "; ")))))

;;; armv6 x86 riscv m68k code generation

(define register-idx 0)
(define max-register-idx 0)

(define (increment-register)
  (set! register-idx (+ register-idx 1))
  (if (> register-idx max-register-idx)
    (set! max-register-idx register-idx)))

(define (decrement-register)
  (set! register-idx (- register-idx 1)))

(define (write-register-type-x86)
  (case register-idx
    ((0)
      (my-display "a"))
    ((1)
      (my-display "b"))
    ((2)
      (my-display "c"))
    ((3)
      (my-display "d"))
    ((4)
      (my-display "d"))
    ((5)
      (if (= version 32)
        (my-display "s")
        (my-display "8")))
    ((6) ; will only happen with 64 bit
      (my-display "9"))
    ; tried to add r10d. adds no value. r10 is a free register
    (else
      (my-display "?"))))

(define (write-register)
  (case target
    ((arm)
      (if (not (eq? version 'aarch64))
        (my-display "r")
        (my-display "w"))
      (let
	((table '#("0" "2" "4" "5" "6" "7" "9" "11" "12")))
        ; note register w13 in aarch64 is reserved for the constant 0
	(if (>= register-idx (vector-length table))
          (my-display "?")
	  (my-display (vector-ref table register-idx)))))
    ((x86)
      (if (and (= version 64) (>= register-idx 4))
        (begin ; this will only happen for 64 bit
          (case register-idx
            ((4) (my-display "%r11d")) ; used in 64bit instead of rdi
            ((5) (my-display "%r8d"))
            ((6) (my-display "%r9d"))
            ; tried to add r10d. adds no value. r10 is a free register
            (else
              (my-display "?"))))
        (begin ; 32 bit
          (my-display "%e")
          (write-register-type-x86)
          (if (= register-idx 4)
            (my-display "i")
            (if (= register-idx 5)
              (my-display "p")
              (my-display "x"))))))
    ((riscv)
      (my-display "s")
      (let
	((table '#("0" "2" "4" "5" "6" "7" "9" "11")))
	(if (>= register-idx (vector-length table))
          (my-display "?")
	  (my-display (vector-ref table register-idx)))))
    ((m68k)
      (my-display "d")
      (let
	((table '#("0" "1" "2" "3" "4" "5" "6" "7")))
	(if (>= register-idx (vector-length table))
          (my-display "?")
	  (my-display (vector-ref table register-idx)))))))

(define (write-register-64)
  (case target
    ((arm)
      (if (not (eq? version 'aarch64))
        (my-display "r")
        (my-display "x"))
      (let
	((table '#("0" "2" "4" "5" "6" "7" "9" "11" "12")))
        ; note register w13 in aarch64 is reserved for the constant 0
	(if (>= register-idx (vector-length table))
          (my-display "?")
	  (my-display (vector-ref table register-idx)))))
    ((x86)
      (if (and (= version 64) (= register-idx 4))
	; dont push/pop the rdi as with 32 bit. for 64 bit use r11 here
        (my-display "%r11")
        (begin ; 32 bit
          (my-display "%r")
          (write-register-type-x86)
          (if (= register-idx 4)
            (my-display "i")
           ;(if (= register-idx 5) ; TODO remove
           ;  (my-display "p")
            (if (< register-idx 5)
              (my-display "x"))))))
    ((riscv)
      (my-display "s")
      (let
	((table '#("0" "2" "4" "5" "6" "7" "9" "11")))
	(if (>= register-idx (vector-length table))
          (my-display "?")
	  (my-display (vector-ref table register-idx)))))
    ((m68k)
      (my-display "d")
      (let
	((table '#("0" "1" "2" "3" "4" "5" "6" "7")))
	(if (>= register-idx (vector-length table))
          (my-display "?")
	  (my-display (vector-ref table register-idx)))))))

(define (write-push-register n)
  (if fast-expression
    (write-register)
    (begin
      (case target
	((arm)
          (if (not (eq? version 'aarch64))
            (my-display "r")
            (my-display "w"))
          (my-display n))
	((x86)
          (my-display "?") ; TODO document
          (my-display n))
	((riscv)
          (my-display "s")
          (my-display n))
	((m68k)
          (my-display "d")
          (my-display n))))))

(define (write-register-minus-one)
  (decrement-register)
  (write-register)
  (increment-register))

(define (write-register-64-minus-one)
  (decrement-register)
  (write-register-64)
  (increment-register))

(define (write-register-minus-two)
  (decrement-register)
  (decrement-register)
  (write-register)
  (increment-register)
  (increment-register))

(define (write-register-64-minus-two)
  (decrement-register)
  (decrement-register)
  (write-register-64)
  (increment-register)
  (increment-register))

(define (write-register-minus-two-or-constant immediate-constant)
  (if immediate-constant
    (begin
      (if (or (and (eq? target 'arm) (not (eq? version 'aarch64)))
              (eq? target 'x86))
        (my-display "$")
        (if (eq? target 'm68k)
          (my-display "#")))
      (my-display immediate-constant))
    (write-register-minus-two)))

(define (write-register-lo-x86-32)
  ; will only be invoked for registers x86 32 or less
  (if (>= register-idx 4) ; edi or more. TODO 3 should be 4
    (my-display "?")
    (begin
      (my-display "%")
      (write-register-type-x86)))
  (my-display "l"))

(define (write-register-lo-minus-one-x86-32)
  ; will only be invoked for registers x86 32 or less
  (decrement-register)
  (write-register-lo-x86-32)
  (increment-register))

(define (write-register-lo-minus-two-x86-32)
  ; will only be invoked for registers x86 32 or less
  (decrement-register)
  (decrement-register)
  (write-register-lo-x86-32)
  (increment-register)
  (increment-register))

(define (write-arm-opcode opcode)
  (my-display "        ")
  (let
    ((table '(
      (ARM_MOV "mov    ")
      (ARM_MVN "mvn    ")
      (ARM_LDR "ldr    ")
      (ARM_STR "str    ")
      (ARM_ADD "add    ")
      (ARM_SUB "sub    ")
      (ARM_MUL "mul    ")
      (ARM_CMP "cmp    ")
      (ARM_BGE "bge    ")
      (ARM_BEQ "beq    ")
      (ARM_BNE "bne    ")
      (ARM_BL "bl     ")
      (ARM_B "b      ")
      (ARM_MOVEQ "moveq  ")
      (ARM_MOVNE "movne  ")
      (ARM_LDMFD "ldmfd  ")
      (ARM_STMFD "stmfd  ")
      (ARM_LSL "lsl    ")
      (ARM_STP "stp    ")
      (ARM_LDP "ldp    ")
      (ARM_RET "ret    ")
      (ARM_CSET "cset   ")
      (ARM_MOVK "movk   "))))
    (my-display (cadr (assq opcode table)))))

(define (write-x86-opcode opcode)
  (my-display "        ")
  (let
    ((table '(
      (X86_MOV "mov    ")
      (X86_MOVL "movl   ")
      (X86_ADD "add    ")
      (X86_SUB "sub    ")
      (X86_MUL "mul    ")
      (X86_CMP "cmp    ")
      (X86_BGE "jge    ")
      (X86_BEQ "je     ")
      (X86_BNE "jne    ")
      (X86_B "jmp    ")
      (X86_CALL "call   ")
      (X86_RET "ret    ")
      (X86_NEG "neg    ")
      (X86_NOT "not    ")
      (X86_AND "and    ")
      (X86_SHL "shl    ")
      (X86_XOR "xor    ")
      (X86_TEST "test   ")
      (X86_LEA "lea    ")
      (X86_ALIGN ".align "))))
    (my-display (cadr (assq opcode table)))))

(define (write-riscv-opcode opcode)
  (my-display "        ")
  (let
    ((table '(
      (RISCV_MV "mv    ")
      (RISCV_LI "li    ")
      (RISCV_LA "la    ")
      (RISCV_LW "lw    ")
      (RISCV_LD "ld    ")
      (RISCV_LUI "lui   ")
      (RISCV_SW "sw    ")
      (RISCV_SD "sd    ")
      (RISCV_ADD "add   ")
      (RISCV_ADDI "addi  ")
      (RISCV_SUB "sub   ")
      (RISCV_BEQ "beq   ")
      (RISCV_BNE "bne   ")
      (RISCV_BGE "bge   ")
      (RISCV_SLT "slt   ")
      (RISCV_SLTU "sltu  ")
      (RISCV_SLTIU "sltiu ")
      (RISCV_J "j     ")
      (RISCV_JR "jr    ")
      (RISCV_CALL "call  ")
      (RISCV_OR "or    ")
      (RISCV_AND "and   ")
      (RISCV_XOR "xor   ")
      (RISCV_SLLI "slli  ")
      (RISCV_XORI "xori  ")
      (RISCV_JAL "jal   ")
      (RISCV_JALR "jalr  "))))
    (my-display (cadr (assq opcode table)))))

(define (write-m68k-opcode opcode)
  (my-display "        ")
  (let
    ((table '(
      (M68K_MOV "move.l  ")
      (M68K_MOVA "movea.l ")
      (M68K_ADD "add.l   ")
      (M68K_ADDA "adda.l  ")
      (M68K_ADDQ "addq.l  ")
      (M68K_SUB "sub.l   ")
      (M68K_SUBA "suba.l  ")
      (M68K_SUBQ "subq.l  ")
      (M68K_CMP "cmp.l   ")
      (M68K_TST "tst.l   ")
      (M68K_BEQ "beq.l   ")
      (M68K_BNE "bne.l   ")
      (M68K_B "jmp     ")
      (M68K_BRA "bra.l   ")
      (M68K_CALL "bsr.w   ")
      (M68K_JSR "jsr     ")
      (M68K_RET "rts     ")
      (M68K_NEG "neg.l   ")
      (M68K_NOT "not.l   ")
      (M68K_AND "and.l   ")
      (M68K_OR "or.l    ")
      (M68K_XOR "eor.l   ")
      (M68K_LSL "lsl.l   ")
      (M68K_ASR "asr.l   ")
      (M68K_LEA "lea     ")
      (M68K_CLRW "clr.w   ")
      (M68K_NOP "nop     "))))
    (my-display (cadr (assq opcode table)))))

(define (write-predicate-op target opcode)
  (case target
    ((arm riscv)
      (case opcode
        ((=)
          (my-display "eq  "))
        ((<)
          (my-display "lt  "))
        ((>)
          (my-display "gt  "))
        ((<=)
          (my-display "le  "))
        ((>=)
          (my-display "ge  "))
        ((!= ne)
          (my-display "ne  "))))
    ((m68k)
      (case opcode
        ((=)
          (my-display "eq.l "))
        ((<)
          (my-display "lt.l "))
        ((>)
          (my-display "gt.l "))
        ((<=)
          (my-display "le.l "))
        ((>=)
          (my-display "ge.l "))
        ((!= ne)
          (my-display "ne.l "))))
    ((x86)
      (my-display "j")
      (case opcode
        ((=)
          (my-display "e     "))
        ((<)
          (my-display "l     "))
        ((>)
          (my-display "g     "))
        ((<=)
          (my-display "le    "))
        ((>=)
          (my-display "ge    "))
        ((!=)
          (my-display "ne    "))))))

(define (write-predicate-set-op-x86 opcode)
  (my-display "        ")
  (case opcode
    ((=)
      (my-display "sete  "))
    ((<)
      (my-display "setl  "))
    ((>)
      (my-display "setg  "))
    ((<=)
      (my-display "setle "))
    ((>=)
      (my-display "setge "))
    ((!= ne)
      (my-display "setne "))))

(define (write-predicate-set-op-m68k opcode)
  (my-display "        ")
  (case opcode
    ((=)
      (my-display "seq.b   "))
    ((<)
      (my-display "slt.b   "))
    ((>)
      (my-display "sgt.b   "))
    ((<=)
      (my-display "sle.b   "))
    ((>=)
      (my-display "sge.b   "))
    ((!= ne)
      (my-display "sne.b   "))))

(define (write-not-predicate-op target opcode)
  (case target
    ; isn't called by riscv
    ((arm)
      (case opcode
        ((=)
          (my-display "ne  "))
        ((<)
          (my-display "ge  "))
        ((>)
          (my-display "le  "))
        ((<=)
          (my-display "gt  "))
        ((>=)
          (my-display "lt  "))
        ((!=)
          (my-display "eq  "))))
    ((m68k)
      (case opcode
        ((=)
          (my-display "ne.l "))
        ((<)
          (my-display "ge.l "))
        ((>)
          (my-display "le.l "))
        ((<=)
          (my-display "gt.l "))
        ((>=)
          (my-display "lt.l "))
        ((!=)
          (my-display "eq.l "))))
    ((x86)
      (my-display "j")
      (case opcode
        ((=)
          (my-display "ne    "))
        ((<)
          (my-display "ge    "))
        ((>)
          (my-display "le    "))
        ((<=)
          (my-display "g     "))
        ((>=)
          (my-display "l     "))
        ((!=)
          (my-display "e     "))))))

(define (write-binary-opcode target opcode)
  (my-display "        ")
  (let
    ((table '(
      (arm
        (+ "add   ") (- "sub   ") (* "mul   ") (^ "eor   ")
        (shl "lsl   ") (shr "asr   ")
        (|| "orr   ") (| "orr   ")
        (&& "and   ") (& "and   "))
      (x86
        (+ "add    ") (add "add    ") (- "sub    ") (sub "sub    ")
        (* "mul    ")
        (^ "xor    ") (eor "xor    ") (bitxor "xor    ")
        (shl "shl    ") (shr "sar    ")
        (|| "or     ") (| "or     ")
        (or "or     ") (orr "or     ") (bitor "or     ")
        (&& "and    ") (& "and    ")
        (and "and    ") (bitand "and    "))
      (riscv
        (+ "add   ") (add "add   ") (- "sub   ") (sub "sub   ")
        (* "mul   ") (mul "mul   ")
        (/ "div   ") (div "div   ")
        (% "rem   ") (mod "rem   ")
        (shl "sll    ") (shr "sra    ")
        (^ "xor   ") (bitxor "xor   ")
        (|| "or    ") (| "or    ")
        (or "or    ") (bitor "or    ")
        (&& "and   ") (& "and   ")
        (and "and   ") (bitand "and   "))
      (m68k
        (+ "add.l   ") (add "add.l   ") (- "sub.l   ") (sub "sub.l   ")
        (* "muls    ") (mul "muls    ")
        (/ "divs    ") (div "divs    ")
        (% "divu    ") (mod "divu    ")
        (shl "lsl.l   ") (shr "asr.l   ")
        (^ "eor.l   ") (eor "eor.l   ") (bitxor "eor.l   ")
        (|| "or.l    ") (| "or.l    ")
        (or "or.l    ") (bitor "or.l    ")
        (&& "and.l   ") (& "and.l   ")
        (and "and.l   ") (bitand "and.l   ")))))
     (let
       ((sub-table (cdr (assq target table))))
       (my-display (cadr (assq opcode sub-table))))))

(define instruction-run-count 0)

(define (ltorg)
  (begin
    (my-display ".ltorg") (my-newline) 
    (set! instruction-run-count 0)))

(define (poolgap)
  (if (eq? target 'arm)
    (begin
      (if (> instruction-run-count instruction-run-count-threshold)
        (let
          ((label (gen)))
          (my-display "        b    ")
            (my-display-label label) (my-newline)
          (my-display ".ltorg") (my-newline)
          (my-display-label label) (my-display ":") (my-newline)
          (set! instruction-run-count 0))))))

(define (my-display-stack-offset offset)
  (if (= version 32)
    (my-display offset)
    (my-display (* 2 offset)))) ; 64 bit

(define (numeric-binary-function-fast target op immediate-constant)
  (case target
    ((arm)
      (if (and (not (eq? version 'aarch64)) (eq? op 'shl))
        (begin
          (write-arm-opcode 'ARM_MOV)
          (write-register-minus-two)
          (my-display ", ")
          (write-register-minus-one)
          (my-display ", lsl ")
          (write-register-minus-two-or-constant immediate-constant)
          (my-newline))
        (if (and (not (eq? version 'aarch64)) (eq? op 'shr))
          (begin
            (write-arm-opcode 'ARM_MOV)
            (write-register-minus-two)
            (my-display ", ")
            (write-register-minus-one)
            (my-display ", asr ")
            (write-register-minus-two-or-constant immediate-constant)
            (my-newline))
          (begin
            (my-display "        ")
              (my-display (filter-shift-arm op)) (my-display "    ")
            (write-register-minus-two)
            (my-display ", ")
            (write-register-minus-one)
            (my-display ", ")
            (write-register-minus-two-or-constant immediate-constant)
            (my-newline))))
      (decrement-register))
    ((x86)
      (if (or (eq? op 'shl) (eq? op 'shr))
	(begin
	  (if immediate-constant
	    (begin
              (write-binary-opcode target op)
              (write-register-minus-two-or-constant immediate-constant)
              (my-display ", ")
              (write-register-minus-one)
              (my-newline)
              (write-x86-opcode 'X86_MOV)
              (write-register-minus-one)
              (my-display ", ")
              (write-register-minus-two)
              (my-newline)
              (pop-x86-register-if-max)
              (decrement-register))
	    (begin ; have to use cl register for the shift
              (my-display "        push   %rbx") (my-newline) ; save ebx
              (my-display "        push   %rcx") (my-newline) ; save ecx
              (my-display "        push   ")
                (write-register-64-minus-two) (my-newline)
              (my-display "        push   ")
                (write-register-64-minus-one) (my-newline)
	      ; reserve stack slot for return shift value
              (write-x86-opcode 'X86_SUB)
                (my-display "$")
		(my-display-stack-offset 4)
		(my-display ", %rsp") (my-newline)
              (write-x86-opcode 'X86_MOV)
                (my-display-stack-offset 8)
		(my-display "(%rsp), %ecx") (my-newline)
              (write-x86-opcode 'X86_MOV)
                (my-display-stack-offset 4)
		(my-display "(%rsp), %ebx") (my-newline)
              (write-binary-opcode target op)
	        (my-display "%cl, %ebx") (my-newline)
              (write-x86-opcode 'X86_MOV) ; return shifted value
                (my-display "%ebx, (%rsp)") (my-newline)
              (write-x86-opcode 'X86_MOV) ; restore ecx
                (my-display-stack-offset 12)
		(my-display "(%rsp), %ecx") (my-newline)
              (write-x86-opcode 'X86_MOV) ; restore ebx
                (my-display-stack-offset 16)
		(my-display "(%rsp), %ebx") (my-newline)
              (write-x86-opcode 'X86_MOV) ; move return value to free register
                (my-display "(%rsp), ")
                (write-register-minus-two) (my-newline)
              (write-x86-opcode 'X86_ADD)
	        (my-display "$")
		(my-display-stack-offset 20)
		(my-display ", %rsp") (my-newline)
              (pop-x86-register-if-max)
              (decrement-register))))
	(begin
          (write-binary-opcode target op)
          (write-register-minus-two-or-constant immediate-constant)
          (my-display ", ")
          (write-register-minus-one)
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (write-register-minus-one)
          (my-display ", ")
          (write-register-minus-two)
          (my-newline)
          (pop-x86-register-if-max)
          (decrement-register))))
    ((riscv)
      (write-binary-opcode target op)
      (write-register-minus-two)
      (my-display ", ")
      (write-register-minus-one)
      (my-display ", ")
      (write-register-minus-two-or-constant immediate-constant)
      (my-newline)
      (decrement-register))
    ((m68k)
      (if (and (or (eq? op 'shr) (eq? op 'shl))
               (and (number? immediate-constant) (> immediate-constant 8)))
        (let
          ((a (quotient immediate-constant 8)))
          (set! immediate-constant (remainder immediate-constant 8))
	  (do ((i 0 (+ i 1))) ((= i a))
            (write-binary-opcode target op)
            (write-register-minus-two-or-constant 8)
            (my-display ", ")
            (write-register-minus-one)
            (my-newline))))
      (if (not (and (or (eq? op 'shr) (eq? op 'shl))
               (and (number? immediate-constant) (= immediate-constant 0))))
        (begin
          (write-binary-opcode target op)
          (write-register-minus-two-or-constant immediate-constant)
          (my-display ", ")
          (write-register-minus-one)
          (my-newline)))
      (if (not (eq? op 'bitxor)) ; xor stores back result in reg minus 2
        (begin
          (write-m68k-opcode 'M68K_MOV)
          (write-register-minus-one)
          (my-display ", ")
          (write-register-minus-two)
          (my-newline)))
      (decrement-register))))

(define (filter-shift-arm op)
  ; only comes into play for aarch64
  (if (eq? op 'shl) 'lsl
    (if (eq? op 'shr) 'asr
      op)))

(define (numeric-binary-function target op op2)
  (if fast-expression
    (numeric-binary-function-fast target op (immediate-value? op2))
    ; not fast
    (case target
      ((arm)
        (if (eq? version 'aarch64)
          (begin
            (my-display "        ldr    w7, [x3, -4]!") (my-newline)
            (my-display "        ldr    w5, [x3, -4]") (my-newline)
            (my-display "        ") (my-display (filter-shift-arm op))
              (my-display "    w4, w7, w5") (my-newline)
            (my-display "        str    w4, [x3, -4]") (my-newline))
          (begin
            (my-display "        ldr    r7, [r3, $-4]!") (my-newline)
            (my-display "        ldr    r5, [r3, $-4]") (my-newline)
            (if (eq? op 'shl)
              (begin
                (my-display "        ") (my-display "mov")
                (my-display "    r4, r7, lsl r5") (my-newline))
              (if (eq? op 'shr)
                (begin
                  (my-display "        ") (my-display "mov")
                  (my-display "    r4, r7, asr r5") (my-newline))
                (begin
                  (my-display "        ") (my-display op)
                  (my-display "    r4, r7, r5") (my-newline))))
            (my-display "        str    r4, [r3, $-4]") (my-newline))))
      ((x86)
        (case op
          ((mul)
	    ; always will cause expression to not be fast
            (call 'x86 'my_mul))
          ((shl shr)
	    (write-x86-opcode 'X86_SUB)
            (my-display "$4, %rdi")
            (my-newline)
            (write-x86-opcode 'X86_MOV)
            (my-display "(%rdi), %eax")
            (my-newline)
            (write-x86-opcode 'X86_MOV)
            (my-display "-4(%rdi), %cl")
            (my-newline)
            (write-binary-opcode target op)
            (my-display "%cl, %eax")
            (my-newline)
            (write-x86-opcode 'X86_MOV)
            (my-display "%eax, -4(%rdi)")
            (my-newline))
	  (else
            (write-x86-opcode 'X86_SUB)
              (my-display "$4, %rdi") (my-newline)
            (write-x86-opcode 'X86_MOV)
              (my-display "(%rdi), %eax") (my-newline)
            (write-x86-opcode 'X86_MOV)
              (my-display "-4(%rdi), %ebx") (my-newline)
            (write-binary-opcode target op)
              (my-display "%ebx, %eax") (my-newline)
            (write-x86-opcode 'X86_MOV)
              (my-display "%eax, -4(%rdi)") (my-newline))))
      ((riscv)
        (write-riscv-opcode 'RISCV_ADDI)
          (my-display "s3, s3, -4") (my-newline)
        (write-riscv-opcode 'RISCV_LW)
          (my-display "s7, (s3)") (my-newline)
        (write-riscv-opcode 'RISCV_LW)
          (my-display "s5, -4(s3)") (my-newline)
        (write-binary-opcode target op)
          (my-display "s4, s7, s5") (my-newline)
        (write-riscv-opcode 'RISCV_SW)
          (my-display "s4, -4(s3)") (my-newline))
      ((m68k)
        (if (eq? op 'mul)
          (begin
            (write-m68k-opcode 'M68K_MOVA)
              (my-display "#30, a4") (my-newline)
            (write-m68k-opcode 'M68K_JSR)
              (my-display "(a4)") (my-newline))
          (begin
            (write-m68k-opcode 'M68K_SUBQ)
              (my-display "#4, a2") (my-newline)
            (write-m68k-opcode 'M68K_MOV)
              (my-display "(a2), d0") (my-newline)
            (write-m68k-opcode 'M68K_MOV)
              (my-display "-4(a2), d1") (my-newline)
            (write-binary-opcode target op)
            (my-display "d1, d0") (my-newline)
            (write-m68k-opcode 'M68K_MOV)
              (if (memq op '(^ eor bitxor))
                (my-display "d1, -4(a2)")
                (my-display "d0, -4(a2)"))
              (my-newline)))))))

(define (get-predicate op)
  (cadr (assq op '(
    (= eq)
    (< lt)
    (> gt)
    (<= le)
    (>= ge)
    (ne ne)))))

(define (get-not-predicate op)
  (cadr (assq op '(
    (= ne)
    (< ge)
    (> le)
    (<= gt)
    (>= lt)
    (ne eq)))))

(define (my-display-label label)
  (my-display ".l")
  (my-display label))

(define (predicate-binary-function-fast target opcode immediate-constant)
  (case target
    ((arm)
      (write-arm-opcode 'ARM_CMP)
      (write-register-minus-one)
      (my-display ", ")
      (write-register-minus-two-or-constant immediate-constant)
      (my-newline)
      (if (not fast-relop)
        (if (eq? version 'aarch64)
          (begin
            (write-arm-opcode 'ARM_CSET)
              (write-register-minus-two) (my-display ", ")
              (my-display (get-predicate opcode)) (my-newline))
          (begin
            (my-display "        mov") (my-display (get-predicate opcode))
            (my-display "  ")
            (write-register-minus-two)
            (my-display ", $1")
            (my-newline)
            (my-display "        mov") (my-display (get-not-predicate opcode))
            (my-display "  ")
            (write-register-minus-two)
            (my-display ", $0")
            (my-newline))))
      (decrement-register))
    ((x86)
      (write-x86-opcode 'X86_CMP)
      (write-register-minus-two-or-constant immediate-constant)
      (my-display ", ")
      (write-register-minus-one)
      (my-newline)
      (if (not fast-relop)
        (begin
          (write-predicate-set-op-x86 opcode)
	  (write-register-lo-minus-two-x86-32)
          (my-newline)
	  (write-x86-opcode 'X86_AND)
	  (my-display "$255, ")
	  (write-register-minus-two)
          (my-newline)))
      (pop-x86-register-if-max)
      (decrement-register))
    ((riscv)
      (cond
        ((memq opcode '(< > <= >=))
          (write-riscv-opcode 'RISCV_SLT)
          (write-register-minus-two)
          (my-display ", ")
          (if (or (eq? opcode '<) (eq? opcode '>=))
            (write-register-minus-one)
            (write-register-minus-two)) ; > or <=
          (my-display ", ")
          (if (or (eq? opcode '<) (eq? opcode '>=))
            (write-register-minus-two)
            (write-register-minus-one)) ; > or <=
          (my-newline)
          (if (or (eq? opcode '>=) (eq? opcode '<=))
            (begin
              (write-riscv-opcode 'RISCV_XORI)
              (write-register-minus-two) (my-display ", ")
              (write-register-minus-two) (my-display ", 1")
              (my-newline)))
          (decrement-register))
        ((or (eq? opcode '=) (eq? opcode 'ne))
          (write-riscv-opcode 'RISCV_XOR)
          (write-register-minus-two)
          (my-display ", ")
          (write-register-minus-one)
          (my-display ", ")
          (write-register-minus-two)
          (my-newline)
          (if (eq? opcode '=)
            (begin
              (write-riscv-opcode 'RISCV_SLTIU)
              (write-register-minus-two)
              (my-display ", ")
              (write-register-minus-two)
              (my-display ", 1"))
            (begin ; ne
              (write-riscv-opcode 'RISCV_SLTU)
              (write-register-minus-two)
              (my-display ", zero, ")
              (write-register-minus-two)))
          (my-newline)
          (decrement-register))))
    ((m68k)
      (if (and immediate-constant (= immediate-constant 0))
        (begin
          (write-m68k-opcode 'M68K_TST)
          (write-register-minus-one)
          (my-newline))
        (begin
          (write-m68k-opcode 'M68K_CMP)
          (write-register-minus-two-or-constant immediate-constant)
          (my-display ", ")
          (write-register-minus-one)
          (my-newline)))
      (if (not fast-relop)
        (begin
          (write-predicate-set-op-m68k opcode)
          (write-register-minus-two)
          (my-newline)
	  (write-m68k-opcode 'M68K_AND)
	  (my-display "#1, ")
	  (write-register-minus-two)
          (my-newline)))
      (decrement-register))))

(define (predicate-binary-function target op op2)
  (if fast-expression
    (predicate-binary-function-fast target op (immediate-value? op2))
    (case target
      ((arm)
        (if (eq? version 'aarch64)
          (begin
            (my-display "        ldr    w7, [x3, -4]!") (my-newline)
            (if fast-relop
              (my-display "        ldr    w5, [x3, -4]!")
              (my-display "        ldr    w5, [x3, -4]"))
            (my-newline)
            (my-display "        cmp    w7, w5") (my-newline))
          (begin
            (my-display "        ldr    r7, [r3, $-4]!") (my-newline)
            (if fast-relop
              (my-display "        ldr    r5, [r3, $-4]!")
              (my-display "        ldr    r5, [r3, $-4]"))
            (my-newline)
            (my-display "        cmp    r7, r5") (my-newline)))
        (if (not fast-relop)
          (if (eq? version 'aarch64)
            (begin
              (write-arm-opcode 'ARM_CSET)
                (my-display " w1, ")
                (my-display (get-predicate op)) (my-newline)
              (my-display "        str    w1, [x3, -4]") (my-newline))
            (begin
              (my-display "        mov") (my-display (get-predicate op))
                (my-display "  r1, $1") (my-newline)
              (my-display "        mov") (my-display (get-not-predicate op))
                (my-display "  r1, $0") (my-newline)
              (my-display "        str    r1, [r3, $-4]") (my-newline)))))
      ((x86)
        (write-x86-opcode 'X86_SUB)
          (my-display "$4, %rdi") (my-newline)
        (write-x86-opcode 'X86_MOV)
          (my-display "(%rdi), %eax") (my-newline)
        (write-x86-opcode 'X86_MOV)
          (my-display "-4(%rdi), %ebx") (my-newline)
        (write-x86-opcode 'X86_CMP)
          (my-display "%ebx, %eax") (my-newline)
        (write-predicate-set-op-x86 op)
          (my-display "%al") (my-newline)
        (write-x86-opcode 'X86_AND)
          (my-display "$255, %eax") (my-newline)
        (write-x86-opcode 'X86_MOV)
          (my-display "%eax, -4(%rdi)") (my-newline))
      ((riscv)
        (write-riscv-opcode 'RISCV_ADDI)
          (my-display "s3, s3, -4") (my-newline)
        (write-riscv-opcode 'RISCV_LW)
          (my-display "s7, (s3)") (my-newline)
        (set! fast-relop #f) ; TODO resolve this. I dont think fast relop
                             ; means anything for riscv
        (if fast-relop
          (begin
            (write-riscv-opcode 'RISCV_ADDI)
              (my-display "s3, s3, -4") (my-newline)
            (write-riscv-opcode 'RISCV_LW)
              (my-display "s5, (s3)"))
          (begin
            (write-riscv-opcode 'RISCV_LW)
              (my-display "s5, -4(s3)") (my-newline)))
        (if (not fast-relop)
          (begin
            (cond
              ((eq? op '=)
                (write-riscv-opcode 'RISCV_XOR)
                  (my-display "s1, s7, s5") (my-newline)
                (write-riscv-opcode 'RISCV_SLTIU)
                  (my-display "s1, s1, 1") (my-newline))
              ((or (eq? op '!=) (eq? op 'ne))
                (write-riscv-opcode 'RISCV_XOR)
                  (my-display "s1, s7, s5") (my-newline)
                (write-riscv-opcode 'RISCV_SLTU)
                  (my-display "s1, zero, s1") (my-newline))
              ((or (eq? op '<) (eq? op '>=))
                (write-riscv-opcode 'RISCV_SLT)
                  (my-display "s1, s7, s5") (my-newline)
                (if (eq? op '>=)
                  (begin
                    (write-riscv-opcode 'RISCV_XORI)
                      (my-display "s1, s1, 1") (my-newline))))
              ((or (eq? op '>) (eq? op '<=))
                (write-riscv-opcode 'RISCV_SLT)
                  (my-display "s1, s5, s7") (my-newline)
                (if (eq? op '<=)
                  (begin
                    (write-riscv-opcode 'RISCV_XORI)
                      (my-display "s1, s1, 1") (my-newline)))))
            (write-riscv-opcode 'RISCV_SW)
              (my-display "s1, -4(s3)")
              (my-newline))))
      ((m68k)
        (write-m68k-opcode 'M68K_SUBQ)
          (my-display "#4, a2") (my-newline)
        (write-m68k-opcode 'M68K_MOV)
          (my-display "(a2), d0") (my-newline)
        (write-m68k-opcode 'M68K_MOV)
          (my-display "-4(a2), d1") (my-newline)
        (write-m68k-opcode 'M68K_CMP)
          (my-display "d1, d0") (my-newline)
        (write-predicate-set-op-m68k op)
          (my-display "d0") (my-newline)
        (write-m68k-opcode 'M68K_AND)
          (my-display "#1, d0") (my-newline)
        (write-m68k-opcode 'M68K_MOV)
          (my-display "d0, -4(a2)") (my-newline)))))

(define (write-riscv-special-symbol numeric-value)
  (if (= numeric-value 1)
    (my-display "in_ch")
    (my-display "unknown")))

(define (write-riscv-load-number-or-symbol mode numeric-value register-number)
  (if (= mode 0)
    (begin
      (write-riscv-opcode 'RISCV_LI)
        (write-push-register register-number)
        (my-display ", ")
        (my-display numeric-value) (my-newline))
    (begin ; TODO use pseudo op "la"
      (write-riscv-opcode 'RISCV_LUI)
        (write-push-register register-number)
        (my-display ", %")
        ; upper half word
        (my-display "hi(")
        (if (= mode 1)
          (write-riscv-special-symbol numeric-value)
          (begin
            (my-display-label numeric-value)))
        (my-display ")") (my-newline)
      (write-riscv-opcode 'RISCV_ADDI)
        (write-push-register register-number)
        (my-display ", ")
        (write-push-register register-number)
        (my-display ", %")
        ; lower half word
        (my-display "lo(")
        (if (= mode 1)
          (write-riscv-special-symbol numeric-value)
          (begin
            (my-display-label numeric-value)))
        (my-display ")") (my-newline))))

(define (display-4-times n)
  (my-display (* 4 n)))

(define (display-4-times-dollar n)
  (my-display "$")
  (my-display (* 4 n)))

(define (display-4-times-dollar-plus-4 n)
  (my-display "$")
  (my-display (+ (* 4 n) 4)))

(define (display-4-times-hash n)
  (my-display "#")
  (my-display (* 4 n)))

(define (display-4-times-hash-plus-4 n)
  (my-display "#")
  (my-display (+ (* 4 n) 4)))

(define (top-level-begin target one two)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        mov    x10, x8") (my-newline)
          (my-display "        mov    x4, ")
            ; lower half word
            (my-display (bitwise-and two 65535))
	    (my-newline)
          (my-display "        movk   x4, ")
            (my-display
	      ; mask out upper half word
	      (bitwise-and (arithmetic-shift two -16) 65535))
            (my-display ", lsl 16") (my-newline)
          (my-display "        mov    x4, x4, lsl 2") (my-newline)
          (my-display "        add    x3, x10, x4") (my-newline))
        (begin
          (my-display "        mov    r10, r8") (my-newline)
          (if (eq? version 'v6)
            (begin
              (log-constant two)
              (my-display "        ldr    r4, =N_")
                (my-display two) (my-newline)
              (my-display "        ldr    r4, [r4]") (my-newline))
            (begin ; v7
              (my-display "        movw   r4, #")
                ; mask out lower half word
                (my-display (bitwise-and two 65535))
	        (my-newline)
              (my-display "        movt   r4, #")
                (my-display
	          ; mask out upper half word
	          (bitwise-and (arithmetic-shift two -16) 65535))
	        (my-newline)))
          (my-display "        mov    r4, r4, lsl $2") (my-newline)
          (my-display "        add    r3, r10, r4") (my-newline))))
    ((x86)
      (write-x86-opcode 'X86_MOV)
      (my-display "%rax, %rsi")
      (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "%rax, %rbp")
      (my-newline)
      (write-x86-opcode 'X86_ADD)
      (display-4-times-dollar two)
        (my-display ", %rax")
        (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "%rax, %rdi")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_MV)
        (my-display "s10, s8") (my-newline)
      (write-riscv-load-number-or-symbol 0 two 4)
      (write-riscv-opcode 'RISCV_SLLI)
        (my-display "s4, s4, 2") (my-newline)
      (write-riscv-opcode 'RISCV_ADD)
        (my-display "s3, s10, s4") (my-newline))
    ((m68k)
      (my-display "_start:") (my-newline)
      (write-m68k-opcode 'M68K_LEA)
        (my-display "stack, a0") (my-newline)
      (write-m68k-opcode 'M68K_LEA)
        (my-display "stack, a1") (my-newline)
      (write-m68k-opcode 'M68K_LEA)
        (my-display "stack, a2") (my-newline)
      (write-m68k-opcode 'M68K_ADDA)
      (display-4-times-hash two)
        (my-display ", a2") (my-newline))))

(define (function-proc-begin target one two dynamic-link)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        str    x30, [sp, -16]!") (my-newline)
          (my-display "        mov    x1, x10") (my-newline)
          (my-display "        sub    x10, x3, ")
            (my-display (* one 4)) (my-newline)
          (my-display "        add    x3, x10, ")
            (my-display (+ (* two 4) 4)) ; add 4 bytes for 8 byte pointer
            (my-newline)
          (my-display "        add    x0, x10, ")
            (my-display (* dynamic-link 4)) (my-newline)
          (my-display "        str    x1, [x0]") (my-newline))
        (begin
          (my-display "        stmfd  sp!, {fp, lr}") (my-newline)
          (my-display "        add    fp, sp, $4") (my-newline)
          (my-display "        mov    r1, r10") (my-newline)
          (my-display "        sub    r10, r3, $")
            (my-display (* one 4)) (my-newline)
          (my-display "        add    r3, r10, $")
            (my-display (* two 4)) (my-newline)
          (my-display "        add    r0, r10, $")
            (my-display (* dynamic-link 4)) (my-newline)
          (my-display "        str    r1, [r0]") (my-newline))))
    ((x86)
      (write-x86-opcode 'X86_MOV)
      (my-display "%rbp, %rcx")
      (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "%rdi, %rdx")
      (my-newline)
      (if (not (= one 0))
        (begin
          (write-x86-opcode 'X86_SUB)
          (display-4-times-dollar one)
          (my-display ", %rdx")
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "%rdx, %rbp")
      (my-newline)
      (if (not (= two 0))
        (begin
          (write-x86-opcode 'X86_ADD)
          (display-4-times-dollar-plus-4 two) ; add 4 bytes for 8 byte pointer
          (my-display ", %rdi")
          (my-newline)))
      (if (not (= dynamic-link 0))
        (begin
          (write-x86-opcode 'X86_ADD)
          (display-4-times-dollar dynamic-link)
          (my-display ", %rdx")
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "%rcx, (%rdx)")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_ADD)
        (my-display "sp, sp, -8") (my-newline)
      (write-riscv-opcode 'RISCV_SD)
        (my-display "ra, (sp)") (my-newline)
      (write-riscv-opcode 'RISCV_MV)
        (my-display "s1, s10") (my-newline)

      (write-riscv-opcode 'RISCV_ADDI)
        (my-display "s10, s3, -")
        (my-display (* one 4)) (my-newline)
  
      (write-riscv-opcode 'RISCV_ADDI)
        (my-display "s3, s10, ")
        ; riscv 64 needs an extra 4 bytes to save the 64bits
        ; add 4 bytes for 8 byte pointer
        (my-display (+ (* two 4) 4))
        (my-newline)

      (write-riscv-opcode 'RISCV_ADDI)
      (my-display "s0, s10, ")
      (my-display (* dynamic-link 4)) (my-newline)

      (write-riscv-opcode 'RISCV_SD)
      (my-display "s1, (s0)")
      (my-newline))
    ((m68k)
      (write-m68k-opcode 'M68K_MOV)
        (my-display "a1, d2") (my-newline)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "a2, a3") (my-newline)
      (if (not (= one 0))
        (begin
          (write-m68k-opcode 'M68K_SUBA)
            (display-4-times-hash one)
            (my-display ", a3") (my-newline)))
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "a3, a1") (my-newline)
      (if (not (= two 0))
        (begin
          (write-m68k-opcode 'M68K_ADDA)
            (display-4-times-hash-plus-4 two) ; add 4 bytes for 8 byte pointer
            (my-display ", a2") (my-newline)))
      (if (not (= dynamic-link 0))
        (begin
          (write-m68k-opcode 'M68K_ADDA)
            (display-4-times-hash dynamic-link)
            (my-display ", a3") (my-newline)))
      (write-m68k-opcode 'M68K_MOV)
      (my-display "d2, (a3)")
      (my-newline))))

(define (write-arm-branch relop)
  (my-display "        b")
  (write-predicate-op 'arm relop)
  (my-display "  "))

(define (write-arm-branch-negate relop)
  (my-display "        b")
  (write-not-predicate-op 'arm relop)
  (my-display "  "))

(define (write-m68k-branch relop)
  (my-display "        b")
  (write-predicate-op 'm68k relop)
  (my-display "  "))

(define (write-m68k-branch-negate relop)
  (my-display "        b")
  (write-not-predicate-op 'm68k relop)
  (my-display "  "))

(define (write-x86-branch relop)
  (my-display "        ")
  (write-predicate-op 'x86 relop)
  (my-display "  "))

(define (write-x86-branch-negate relop)
  (my-display "        ")
  (write-not-predicate-op 'x86 relop)
  (my-display "  "))

(define (write-x86-push-rdi)
  (my-display "        push   %rdi") ; save rdi
  (my-newline))

(define (write-x86-pop-rdi)
  (my-display "        pop    %rdi") ; restore rdi
  (my-newline))

(define (push-x86-register-if-max)
  (if (= version 32)
    (if (and (= max-register-idx (- MAXIMUM-FREE-REGISTERS 1))
             (= register-idx (- MAXIMUM-FREE-REGISTERS 2))
             fast-expression)
      (begin
        (display-comment)
        (my-display "# save rdi")
        (my-newline)
        (write-x86-push-rdi)))))

(define (pop-x86-register-if-max)
  (if (= version 32)
    (if (and (= max-register-idx (- MAXIMUM-FREE-REGISTERS 1))
             (= register-idx (- MAXIMUM-FREE-REGISTERS 2))
             fast-expression)
      (begin
        (display-comment)
        (my-display "# restore rdi")
        (my-newline)
        (write-x86-pop-rdi)))))

(define (write-inc-x86 offset)
  (my-display "        addl   $1, ")
  (if (not (= offset 0))
    (display-4-times offset))
  (my-display "(%rbp)")
  (my-newline))

(define (write-dec-x86 offset)
  (my-display "        subl   $1, ")
  (if (not (= offset 0))
    (display-4-times offset))
  (my-display "(%rbp)")
  (my-newline))

(define (function-end target dynamic-link)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        add    x3, x10, 4") (my-newline)
          (my-display "        ldr    x10, [x10, ")
            (my-display (* dynamic-link 4)) (my-display "]") (my-newline))
        (begin
          (my-display "        add    r3, r10, $4") (my-newline)
          (my-display "        ldr    r10, [r10, $")
            (my-display (* dynamic-link 4)) (my-display "]") (my-newline))))
    ((x86)
      (write-x86-opcode 'X86_MOV)
      (my-display "%rbp, %rdi")
      (my-newline)
      (write-x86-opcode 'X86_ADD)
      (my-display "$4, %rdi")
      (my-newline)
      (if (not (= dynamic-link 0))
	(begin
          (write-x86-opcode 'X86_ADD)
          (display-4-times-dollar dynamic-link)
          (my-display ", %rbp")
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "(%rbp), %rbp")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_ADDI)
        (my-display "s3, s10, 4") (my-newline)
      (write-riscv-opcode 'RISCV_LD)
        (my-display "s10, ")
        (my-display (* dynamic-link 4))
        (my-display "(s10)") (my-newline))
    ((m68k)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "a1, a2") (my-newline)
      (write-m68k-opcode 'M68K_ADDQ)
        (my-display "#4, a2") (my-newline)
      (if (not (= dynamic-link 0))
	(begin
          (write-m68k-opcode 'M68K_ADDA)
          (display-4-times-hash dynamic-link)
          (my-display ", a1")
          (my-newline)))
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "(a1), a1") (my-newline))))

(define (proc-end target dynamic-link)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        mov    x3, x10") (my-newline)
          (if (= dynamic-link 0)
            (begin
              (my-display "        ldr    x10, [x10]") (my-newline))
            (begin
              (my-display "        ldr    x10, [x10, ")
                (my-display (* dynamic-link 4))
                (my-display "]") (my-newline))))
        (begin
          (my-display "        mov    r3, r10") (my-newline)
          (if (= dynamic-link 0)
            (begin
              (my-display "        ldr    r10, [r10]") (my-newline))
            (begin
              (my-display "        ldr    r10, [r10, $")
                (my-display (* dynamic-link 4))
                (my-display "]") (my-newline))))))
    ((x86)
      (write-x86-opcode 'X86_MOV)
      (my-display "%rbp, %rdi")
      (my-newline)
      (if (not (= dynamic-link 0))
        (begin
          (write-x86-opcode 'X86_ADD)
          (display-4-times-dollar dynamic-link)
          (my-display ", %rbp")
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "(%rbp), %rbp")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_MV)
        (my-display "s3, s10") (my-newline)
      (if (= dynamic-link 0)
        (begin
          (write-riscv-opcode 'RISCV_LD)
          (my-display "s10, (s10)") (my-newline))
        (begin
          (write-riscv-opcode 'RISCV_LD)
            (my-display "s10, ")
            (my-display (* dynamic-link 4))
            (my-display "(s10)") (my-newline))))
    ((m68k)
      (write-m68k-opcode 'M68K_MOVA)
      (my-display "a1, a2")
      (my-newline)
      (if (not (= dynamic-link 0))
        (begin
          (write-m68k-opcode 'M68K_ADDA)
            (display-4-times-hash dynamic-link) (my-display ", a1")
            (my-newline)))
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "(a1), a1") (my-newline))))

(define (stack-ref target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_LSL)
              (write-register-minus-one)
              (my-display ", ")
              (write-register-minus-one)
              (my-display ", 2")
              (my-newline)
            (write-arm-opcode 'ARM_LDR)
              (write-register-minus-one)
              (my-display ", [x8, ")
              (write-register-64-minus-one) ; use full 64 bit register
              (my-display "]")
              (my-newline))
          (begin
            (my-display "        sub    x0, x3, 4") (my-newline)
            (my-display "        ldr    w5, [x0]") (my-newline)
            (my-display "        lsl    w5, w5, 2") (my-newline)
            (my-display "        ldr    w6, [x8, x5]") (my-newline)
            (my-display "        str    w6, [x0]") (my-newline)))
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_LDR)
            (write-register-minus-one)
            (my-display ", [r8, ")
            (write-register-minus-one)
            (my-display ", lsl $2]")
            (my-newline))
          (begin
            (my-display "        sub    r0, r3, $4") (my-newline)
            (my-display "        ldr    r5, [r0]") (my-newline)
            (my-display "        ldr    r6, [r8, r5, lsl $2]") (my-newline)
            (my-display "        str    r6, [r0]") (my-newline)))))
    ((x86)
      (if fast-expression
	(begin
          (write-x86-opcode 'X86_MOV)
          (my-display "(%rsi, ")
          (write-register-64-minus-one)
          (my-display ", 4), ")
          (write-register-minus-one)
          (my-newline))
        (begin
          (write-x86-opcode 'X86_MOV) (my-display "%rdi, %rbx") (my-newline)
          (write-x86-opcode 'X86_SUB) (my-display "$4, %rbx") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "(%rbx), %ecx") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "(%rsi, %rcx, 4), %edx")
	    (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "%edx, (%rbx)")
	    (my-newline))))
    ((riscv)
      (if fast-expression
        (begin
          (write-riscv-opcode 'RISCV_SLLI)
            (write-register-minus-one)
            (my-display ", ")
            (write-register-minus-one) (my-display ", 2") (my-newline)
          (write-riscv-opcode 'RISCV_ADD)
            (write-register-minus-one)
            (my-display ", s8, ")
            (write-register-minus-one) (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (write-register-minus-one)
            (my-display ", (")
            (write-register-minus-one)
            (my-display ")") (my-newline))
        (begin
          (write-riscv-opcode 'RISCV_ADDI)
            (my-display "s0, s3, -4") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s5, (s0)") (my-newline)
          (write-riscv-opcode 'RISCV_SLLI)
            (my-display "s5, s5, 2") (my-newline)
          (write-riscv-opcode 'RISCV_ADD)
            (my-display "s5, s8, s5") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s6, (s5)") (my-newline)
          (write-riscv-opcode 'RISCV_SW)
            (my-display "s6, (s0)") (my-newline))))
    ((m68k)
      (if fast-expression
	(begin
          (write-m68k-opcode 'M68K_LSL)
            (my-display "#2, ")
            (write-register-minus-one) (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "(a0, ")
            (write-register-minus-one) (my-display "), ")
            (write-register-minus-one) (my-newline))
        (begin
          (write-m68k-opcode 'M68K_MOVA) (my-display "a2, a3") (my-newline)
          (write-m68k-opcode 'M68K_SUBQ) (my-display "#4, a3") (my-newline)
          (write-m68k-opcode 'M68K_MOV) (my-display "(a3), d0") (my-newline)
          (write-m68k-opcode 'M68K_LSL) (my-display "#2, d0") (my-newline)
          (write-m68k-opcode 'M68K_MOV) (my-display "(a0, d0), d0") (my-newline)
          (write-m68k-opcode 'M68K_MOV) (my-display "d0, (a3)") (my-newline))))))

(define (stack-ref-n target n)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (if fast-expression
          (begin
            (if (= n 0)
              (begin
                (write-arm-opcode 'ARM_LDR)
	          (write-register) (my-display ", [x10]") (my-newline))
              (begin
                (write-arm-opcode 'ARM_LDR)
	          (write-register) (my-display ", [x10, ")
                  (my-display (* n 4)) (my-display "]")
                  (my-newline)))
            (increment-register))
          (if (= n 0)
            (begin
              (my-display "        ldr    w0, [x10]") (my-newline)
              (my-display "        str    w0, [x3], 4") (my-newline))
            (begin
              (my-display "        ldr    w0, [x10, ")
                (my-display (* n 4)) (my-display "]") (my-newline)
              (my-display "        str    w0, [x3], 4") (my-newline))))
        (if fast-expression
          (begin
            (if (= n 0)
              (begin
                (write-arm-opcode 'ARM_LDR)
	          (write-register) (my-display ", [r10]") (my-newline))
              (begin
                (write-arm-opcode 'ARM_LDR)
	          (write-register) (my-display ", [r10, $")
                  (my-display (* n 4)) (my-display "]")
                  (my-newline)))
            (increment-register))
          (if (= n 0)
            (begin
              (my-display "        ldr    r0, [r10]") (my-newline)
              (my-display "        str    r0, [r3], $4") (my-newline))
            (begin
              (my-display "        ldr    r0, [r10, $")
                (my-display (* n 4)) (my-display "]") (my-newline)
              (my-display "        str    r0, [r3], $4") (my-newline))))))
    ((x86)
      (if fast-expression
        (begin
          (if (= n 0)
            (begin
              (write-x86-opcode 'X86_MOV)
                (my-display "(%rbp), ")
                (write-register)
		(my-newline))
            (begin
              (write-x86-opcode 'X86_MOV)
		(display-4-times n)
                (my-display "(%rbp), ")
	        (write-register)
                (my-newline)))
          (increment-register)
          (push-x86-register-if-max))
        (begin
          (if (= n 0)
	    (begin
              (write-x86-opcode 'X86_MOV) (my-display "(%rbp), %eax")
	        (my-newline))
	    (begin
              (write-x86-opcode 'X86_MOV)
              (display-4-times n)
              (my-display "(%rbp), %eax")
	      (my-newline)))
          (write-x86-opcode 'X86_MOV) (my-display "%eax, (%rdi)") (my-newline)
          (write-x86-opcode 'X86_ADD) (my-display "$4, %rdi") (my-newline))))
    ((riscv)
      (if fast-expression
        (begin
          (if (= n 0)
            (begin
              (write-riscv-opcode 'RISCV_LW) (write-register)
                (my-display ", (s10)") (my-newline))
            (begin
              (write-riscv-opcode 'RISCV_LW) (write-register)
                (my-display ", ") (my-display (* n 4)) (my-display "(s10)")
                (my-newline)))
          (increment-register))
        (begin
          (if (= n 0)
            (begin
              (write-riscv-opcode 'RISCV_LW)
                (my-display "s0, (s10)") (my-newline)
              (write-riscv-opcode 'RISCV_SW)
                (my-display "s0, (s3)") (my-newline)
              (write-riscv-opcode 'RISCV_ADDI)
                (my-display "s3, s3, 4") (my-newline))
            (begin
              (write-riscv-opcode 'RISCV_LW)
                (my-display "s0, ")
                (my-display (* n 4))
                (my-display "(s10)") (my-newline)
              (write-riscv-opcode 'RISCV_SW)
                (my-display "s0, (s3)") (my-newline)
              (write-riscv-opcode 'RISCV_ADDI)
                (my-display "s3, s3, 4") (my-newline))))))
    ((m68k)
      (if fast-expression
        (begin
          (if (= n 0)
            (begin
              (write-m68k-opcode 'M68K_MOV)
                (my-display "(a1), ") (write-register) (my-newline))
            (begin
              (write-m68k-opcode 'M68K_MOV)
		(display-4-times n) (my-display "(a1), ")
	        (write-register) (my-newline)))
          (increment-register))
        (begin
          (if (= n 0)
	    (begin
              (write-m68k-opcode 'M68K_MOV) (my-display "(a1), d0")
	        (my-newline))
	    (begin
              (write-m68k-opcode 'M68K_MOV) (display-4-times n)
                (my-display "(a1), d0") (my-newline)))
          (write-m68k-opcode 'M68K_MOV) (my-display "d0, (a2)") (my-newline)
          (write-m68k-opcode 'M68K_ADDQ) (my-display "#4, a2") (my-newline))))))

(define (stack-set target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_LSL)
              (my-display "w2, w2, 2") (my-newline)
            (write-arm-opcode 'ARM_STR)
              (my-display "w0, [x8, x2]")
              (my-newline))
          (begin
            (my-display "        ldr    w4, [x3, -8]!") (my-newline)
            (my-display "        ldr    w6, [x3, 4]") (my-newline)
            (my-display "        lsl    w6, w6, 2") (my-newline)
            (my-display "        str    w4, [x8, x6]") (my-newline)))
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_STR)
            (my-display "r0, [r8, r2, lsl $2]")
            (my-newline))
          (begin
            (my-display "        ldr    r4, [r3, $-8]!") (my-newline)
            (my-display "        ldr    r6, [r3, $4]") (my-newline)
            (my-display "        str    r4, [r8, r6, lsl $2]") (my-newline)))))
    ((x86)
      (if fast-expression
	(begin
          (write-x86-opcode 'X86_MOV)
          (my-display "%eax, (%rsi, %rbx, 4)")
          (my-newline))
        (begin
          (write-x86-opcode 'X86_SUB) (my-display "$8, %rdi") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "(%rdi), %ecx") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "4(%rdi), %edx") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "%ecx, (%rsi, %rdx, 4)")
            (my-newline))))
    ((riscv)
      (if fast-expression
	(begin
          (write-riscv-opcode 'RISCV_SLLI)
            (my-display "s2, s2, 2") (my-newline)
          (write-riscv-opcode 'RISCV_ADD)
            (my-display "s2, s8, s2") (my-newline)
          (write-riscv-opcode 'RISCV_SW)
            (my-display "s0, (s2)") (my-newline))
	(begin
          (write-riscv-opcode 'RISCV_ADDI)
            (my-display "s3, s3, -8") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s4, (s3)") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s6, 4(s3)") (my-newline)
          (write-riscv-opcode 'RISCV_SLLI)
            (my-display "s6, s6, 2") (my-newline)
          (write-riscv-opcode 'RISCV_ADD)
            (my-display "s6, s8, s6") (my-newline)
          (write-riscv-opcode 'RISCV_SW)
            (my-display "s4, (s6)") (my-newline))))
    ((m68k)
      (if fast-expression
	(begin
          (write-m68k-opcode 'M68K_LSL)
            (my-display "#2, d1") (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "d0, (a0, d1)") (my-newline))
        (begin
          (write-m68k-opcode 'M68K_SUBQ) (my-display "#8, a2") (my-newline)
          (write-m68k-opcode 'M68K_MOV) (my-display "(a2), d0") (my-newline)
          (write-m68k-opcode 'M68K_MOV) (my-display "4(a2), d1") (my-newline)
          (write-m68k-opcode 'M68K_LSL) (my-display "#2, d1") (my-newline)
          (write-m68k-opcode 'M68K_MOV) (my-display "d0, (a0, d1)") (my-newline))))))

(define (stack-set-n target n)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (if fast-expression
          (begin
            (if (= n 0)
              (begin
                (write-arm-opcode 'ARM_STR)
                (my-display "w0, [x10]")
                (my-newline))
              (begin
                (write-arm-opcode 'ARM_STR)
                (my-display "w0, [x10, ")
                (my-display (* n 4))
                (my-display "]")
                (my-newline))))
          (if (= n 0)
            (begin
              (my-display "        ldr    w0, [x3, -4]!") (my-newline)
              (my-display "        str    w0, [x10]") (my-newline))
            (begin
              (my-display "        ldr    w0, [x3, -4]!") (my-newline)
              (my-display "        str    w0, [x10, ")
                (my-display (* n 4)) (my-display "]") (my-newline))))
        (if fast-expression
          (begin
            (if (= n 0)
              (begin
                (write-arm-opcode 'ARM_STR)
                (my-display "r0, [r10]")
                (my-newline))
              (begin
                (write-arm-opcode 'ARM_STR)
                (my-display "r0, [r10, $")
                (my-display (* n 4))
                (my-display "]")
                (my-newline))))
          (if (= n 0)
            (begin
              (my-display "        ldr    r0, [r3, $-4]!") (my-newline)
              (my-display "        str    r0, [r10]") (my-newline))
            (begin
              (my-display "        ldr    r0, [r3, $-4]!") (my-newline)
              (my-display "        str    r0, [r10, $")
                (my-display (* n 4)) (my-display "]") (my-newline))))))
    ((x86)
      (if fast-expression
        (if (= n 0)
	  (begin
            (write-x86-opcode 'X86_MOV) (my-display "%eax, (%rbp)")
	      (my-newline))
          (begin
            (write-x86-opcode 'X86_MOV)
              (my-display "%eax, ") (display-4-times n)
              (my-display "(%rbp)")
	      (my-newline)))
	(begin
          (write-x86-opcode 'X86_SUB)
          (my-display "$4, %rdi")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "(%rdi), %edx")
          (my-newline)
          (if (not (= n 0))
            (begin
              (write-x86-opcode 'X86_MOV)
	        (my-display "%edx, ")
                (display-4-times n)
		(my-display "(%rbp)")
                (my-newline))
            (begin
              (write-x86-opcode 'X86_MOV)
              (my-display "%edx, (%rbp)")
              (my-newline))))))
    ((riscv)
      (if fast-expression
        (if (= n 0)
	  (begin
            (write-riscv-opcode 'RISCV_SW)
            (my-display "s0, (s10)") (my-newline))
	  (begin
            (write-riscv-opcode 'RISCV_SW)
              (my-display "s0, ")
              (my-display (* n 4))
              (my-display "(s10)") (my-newline)))
        (begin
          (if (= n 0)
	    (begin
              (write-riscv-opcode 'RISCV_ADDI)
                (my-display "s3, s3, -4") (my-newline)
              (write-riscv-opcode 'RISCV_LW)
                (my-display "s0, (s3)") (my-newline)
              (write-riscv-opcode 'RISCV_SW)
                (my-display "s0, (s10)") (my-newline))
	    (begin
              (write-riscv-opcode 'RISCV_ADDI)
                (my-display "s3, s3, -4") (my-newline)
              (write-riscv-opcode 'RISCV_LW)
                (my-display "s0, (s3)") (my-newline)
              (write-riscv-opcode 'RISCV_SW)
                (my-display "s0, ")
                (my-display (* n 4))
                (my-display "(s10)") (my-newline))))))
    ((m68k)
      (if fast-expression
        (if (= n 0)
	  (begin
            (write-m68k-opcode 'M68K_MOV) (my-display "d0, (a1)")
	      (my-newline))
          (begin
            (write-m68k-opcode 'M68K_MOV)
              (my-display "d0, ") (display-4-times n)
              (my-display "(a1)")
	      (my-newline)))
	(begin
          (write-m68k-opcode 'M68K_SUBQ)
          (my-display "#4, a2")
          (my-newline)
          (write-m68k-opcode 'M68K_MOV)
          (my-display "(a2), d0")
          (my-newline)
          (if (not (= n 0))
            (begin
              (write-m68k-opcode 'M68K_MOV)
	        (my-display "d0, ")
                (display-4-times n)
		(my-display "(a1)")
                (my-newline))
            (begin
              (write-m68k-opcode 'M68K_MOV)
              (my-display "d0, (a1)")
              (my-newline))))))))

(define global-constants '())

(define (log-constant x)
  (if (not (member x global-constants))
    (set! global-constants (cons x global-constants))))

(define (display-global-constants constants)
  (if (not (null? constants))
    (let
      ((constant (car constants)))
      (if (>= constant 0)
        (begin
          (my-display "@X@")
          (my-display "N_") (my-display constant) (my-display ":") (my-newline)
            (my-display "@X@")
            (my-display ".word ") (my-display constant) (my-newline))
        (begin
          (my-display "@X@")
          (my-display "NN_") (my-display (abs constant)) (my-display ":") (my-newline)
            (my-display "@X@")
            (my-display ".word ") (my-display constant) (my-newline)))
      (display-global-constants (cdr constants)))))

(define (push-mov n1 n2)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (if (eq? version 'aarch64)
    (my-display ", ")
    (my-display ", $"))
  (my-display n1)
  (my-newline)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (my-display ", ")
  (write-push-register 5)
  (if (eq? version 'aarch64)
    (my-display ", ror ")
    (my-display ", ror $"))
  (my-display n2)
  (my-newline))

(define (push-movn n1 n2)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (if (eq? version 'aarch64)
    (my-display ", ")
    (my-display ", $"))
  (my-display n1)
  (my-newline)
  (write-arm-opcode 'ARM_MVN)
  (write-push-register 5)
  (my-display ", ")
  (write-push-register 5)
  (if (eq? version 'aarch64)
    (my-display ", ror ")
    (my-display ", ror $"))
  (my-display n2)
  (my-newline))

(define (push-mov-lsl n1 n2)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (if (eq? version 'aarch64)
    (my-display ", ")
    (my-display ", $"))
  (my-display n1)
  (my-newline)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (my-display ", ")
  (write-push-register 5)
  (if (eq? version 'aarch64)
    (my-display ", lsl ")
    (my-display ", lsl $"))
  (my-display n2)
  (my-newline))

(define (push-arm n)
  (if immediate-push
    (begin
      (set! immediate-push #f)
      (set! immediate-list (cons (list register-idx n) immediate-list)))
    (case n
      ((268435455)
        (push-movn 15 4))
      ((268435456)
        (push-mov 1 4))
      ((1610612736)
        (push-mov 6 4))
      ((1073741824)
        (push-mov 4 4))
      ((1073741825)
        (push-mov 4 4)
        (write-arm-opcode 'ARM_ADD)
        (write-push-register 5)
        (my-display ", ")
        (write-push-register 5)
	(if (eq? version 'aarch64)
          (my-display ", 1")
          (my-display ", $1"))
	(my-newline))
      ((16777216)
        (push-mov 1 8))
      ((-16777216)
        (push-mov 255 8))
      ((16777215)
        (push-movn 255 8))
      ((16711680)
        (push-mov-lsl 255 16))
      ((-2147483648)
        (push-mov 8 4))
      ((2147483647)
        (push-movn 8 4))
      ((536870912)
        (push-mov 2 4))
      ((1879048192)
        (push-mov 7 4))
      ((67108864)
        (push-mov 4 8))
      ((83886080)
        (push-mov 5 8))
      ((65535)
        (push-mov-lsl 1 16)
        (write-arm-opcode 'ARM_SUB)
        (write-push-register 5)
        (my-display ", ")
        (write-push-register 5)
	(if (eq? version 'aarch64)
          (my-display ", 1")
          (my-display ", $1"))
	(my-newline))
      (else
        (cond
          ((and (< n 256) (>= n 0))
            (write-arm-opcode 'ARM_MOV)
            (write-push-register 5)
	    (if (eq? version 'aarch64)
              (my-display ", ")
              (my-display ", $"))
            (my-display n)
            (my-newline))
          ((and (< n 0) (>= n -255))
            (write-arm-opcode 'ARM_MVN)
            (write-push-register 5)
	    (if (eq? version 'aarch64)
              (my-display ", ")
              (my-display ", $"))
            (my-display (abs (+ n 1))) (my-newline))
          ((>= n 0)
	    (if (eq? version 'v6)
	      (begin
                (log-constant n)
                (write-arm-opcode 'ARM_LDR)
                (write-push-register 5)
                (my-display ", =N_") (my-display n) (my-newline)
                (write-arm-opcode 'ARM_LDR)
                (write-push-register 5)
                (my-display ", [")
                (write-push-register 5)
                (my-display "]")
                (my-newline))
	      (if (eq? version 'aarch64)
	        (begin
                  (my-display "        mov   ")
                  (write-push-register 5)
                  (my-display ", ")
                  ; lower half word
                  (my-display (bitwise-and n 65535))
		  (my-newline)
		  (if (> n 65535)
		    (begin
                      (my-display "        movk  ")
                      (write-push-register 5)
                      (my-display ", ")
                      ; upper half word
                      (my-display (bitwise-and (arithmetic-shift n -16) 65535))
                      (my-display ", lsl 16")
		      (my-newline))))
	        (begin
                  (my-display "        movw  ")
                  (write-push-register 5)
                  (my-display ", #")
                  ; mask out lower half word
                  (my-display (bitwise-and n 65535))
		  (my-newline)
		  (if (> n 65535)
		    (begin
                      (my-display "        movt  ")
                      (write-push-register 5)
                      (my-display ", #")
                      ; mask out upper half word
                      (my-display (bitwise-and (arithmetic-shift n -16) 65535))
		      (my-newline)))))))
          (else ; n < 0
	    (if (eq? version 'v6)
	      (begin
                (log-constant n)
                (write-arm-opcode 'ARM_LDR)
                (write-push-register 5)
                (my-display ", =NN_") (my-display (abs n)) (my-newline)
                (write-arm-opcode 'ARM_LDR)
                (write-push-register 5)
                (my-display ", [")
                (write-push-register 5)
                (my-display "]")
                (my-newline))
	      (if (eq? version 'aarch64)
	        (begin
                  (my-display "        mov   ")
                  (write-push-register 5)
                  (my-display ", ")
                  ; lower half word
                  (my-display (bitwise-and n 65535))
		  (my-newline)
                  (my-display "        movk  ")
                  (write-push-register 5)
                  (my-display ", ")
                  ; upper half word
                  (my-display (bitwise-and (arithmetic-shift n -16) 65535))
                  (my-display ", lsl 16")
		  (my-newline))
	        (begin
                  (my-display "        movw  ")
                  (write-push-register 5)
                  (my-display ", #")
                  ; mask out lower half word
                  (my-display (bitwise-and n 65535))
		  (my-newline)
                  (my-display "        movt  ")
                  (write-push-register 5)
                  (my-display ", #")
                  ; mask out upper half word
                  (my-display (bitwise-and (arithmetic-shift n -16) 65535))
		  (my-newline))))) ; end else
	  ))))
    (if fast-expression
      (increment-register)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        str    w5, [x3], 4") (my-newline))
        (begin
          (my-display "        str    r5, [r3], $4") (my-newline)))))

(define (push-x86 n)
  (if immediate-push
    (begin
      (set! immediate-push #f)
      (set! immediate-list (cons (list register-idx n) immediate-list))
      (increment-register)
      (push-x86-register-if-max))
    (if fast-expression
      (begin
        (if (= n 0)
	  (begin
            (write-x86-opcode 'X86_XOR)
            (write-push-register n)
            (my-display ", ")
            (write-push-register n))
	  (begin
            (write-x86-opcode 'X86_MOV)
            (my-display "$")
            (my-display n)
            (my-display ", ")
            (write-push-register n)))
        (my-newline)
        (increment-register)
        (push-x86-register-if-max))
      (begin
        (write-x86-opcode 'X86_MOVL)
          (my-display "$")
          (my-display n)
          (my-display ", (%rdi)")
	  (my-newline)
        (write-x86-opcode 'X86_ADD)
          (my-display "$4, %rdi") (my-newline)))))

(define (push-m68k n)
  (if immediate-push
    (begin
      (set! immediate-push #f)
      (set! immediate-list (cons (list register-idx n) immediate-list))
      (increment-register))
    (if fast-expression
      (begin
        (write-m68k-opcode 'M68K_MOV)
          (my-display "#") (my-display n)
          (my-display ", ") (write-push-register n) (my-newline)
        (increment-register))
      (begin
        (write-m68k-opcode 'M68K_MOV)
          (my-display "#")
          (my-display n)
          (my-display ", d0")
	  (my-newline)
        (write-m68k-opcode 'M68K_MOV)
          (my-display "d0, (a2)")
	  (my-newline)
        (write-m68k-opcode 'M68K_ADDQ)
          (my-display "#4, a2") (my-newline)))))

(define (push-riscv n)
  ; TODO look at old code support immediate

; (if (number? n)
;   (begin
;     (write-riscv-opcode 'RISCV_ADDI)
;     (write-push-register 5)
;     (my-display ", zero, ")
;     (my-display n) (my-newline))
;   (write-riscv-load-number-or-symbol 0 n 5))

  (write-riscv-load-number-or-symbol 0 n 5)

  (if fast-expression
    (increment-register)
    (begin
      (write-riscv-opcode 'RISCV_SW)
        (my-display "s5, (s3)") (my-newline)
      (write-riscv-opcode 'RISCV_ADDI)
        (my-display "s3, s3, 4") (my-newline))))

(define (push target n)
  (case target
    ((arm)
      (push-arm n))
    ((x86)
      (push-x86 n))
    ((riscv)
      (push-riscv n))
    ((m68k)
      (push-m68k n))))

(define (div target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        ldr    w0, [x3, -4]!") (my-newline)
          (my-display "        ldr    w1, [x3, -4]") (my-newline)
          (my-display "        bl     signed_quotient") (my-newline)
          (my-display "        str    w0, [x3, -4]") (my-newline))
        (begin
          (my-display "        ldr    r0, [r3, $-4]!") (my-newline)
          (my-display "        ldr    r1, [r3, $-4]") (my-newline)
          (my-display "        bl     signed_quotient") (my-newline)
          (my-display "        str    r0, [r3, $-4]") (my-newline))))
    ((x86)
      (call 'x86 'my_div))
    ((m68k)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "#40, a4") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a4)") (my-newline))))

(define (mod target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        ldr    w0, [x3, -4]!") (my-newline)
          (my-display "        ldr    w1, [x3, -4]") (my-newline)
          (my-display "        bl     signed_remainder") (my-newline)
          (my-display "        str    w0, [x3, -4]") (my-newline))
        (begin
          (my-display "        ldr    r0, [r3, $-4]!") (my-newline)
          (my-display "        ldr    r1, [r3, $-4]") (my-newline)
          (my-display "        bl     signed_remainder") (my-newline)
          (my-display "        str    r0, [r3, $-4]") (my-newline))))
    ((x86)
      (call 'x86 'my_mod))
    ((m68k)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "#50, a4") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a4)") (my-newline))))

(define (abs_ target)
  (case target
    ((arm)
      (let
        ((label (gen)))
        (if (eq? version 'aarch64)
          (begin
            (my-display "        sub    x4, x3, 4") (my-newline)
            (my-display "        ldr    w5, [x4]") (my-newline)
            (my-display "        cmp    w5, 0") (my-newline)
            (my-display "        bge    ") (my-display-label label) (my-newline)
            (my-display "        mov    w0, 0") (my-newline)
            (my-display "        sub    w5, w0, w5") (my-newline)
            (my-display "        str    w5, [x4]") (my-newline))
          (begin
            (my-display "        sub    r4, r3, $4") (my-newline)
            (my-display "        ldr    r5, [r4]") (my-newline)
            (my-display "        cmp    r5, $0") (my-newline)
            (my-display "        bge    ") (my-display-label label) (my-newline)
            (my-display "        mov    r0, $0") (my-newline)
            (my-display "        sub    r5, r0, r5") (my-newline)
            (my-display "        str    r5, [r4]") (my-newline)))
        (my-display-label label) (my-display ":") (my-newline)))
    ((x86)
      (call 'x86 'my_abs))
    ((riscv)
      (let
        ((label (gen)))
        (write-riscv-opcode 'RISCV_ADDI)
          (my-display "s4, s3, -4") (my-newline)
        (write-riscv-opcode 'RISCV_LW)
          (my-display "s5, (s4)") (my-newline)
        (write-riscv-opcode 'RISCV_BGE)
          (my-display "s5, zero, ")
          (my-display-label label) (my-newline)
        (write-riscv-opcode 'RISCV_SUB)
          (my-display "s5, zero, s5") (my-newline)
        (write-riscv-opcode 'RISCV_SW)
          (my-display "s5, (s4)") (my-newline)
        (my-display-label label)
          (my-display ":") (my-newline)))
    ((m68k)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "#60, a4") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a4)") (my-newline))))

(define (negate target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_MOV)
            (my-display "w1, 0")
            (my-newline)
            (write-arm-opcode 'ARM_SUB)
            (write-register-minus-one)
            (my-display ", w1, ")
            (write-register-minus-one)
            (my-newline))
          (begin
            (my-display "        sub    x4, x3, 4") (my-newline)
            (my-display "        ldr    w5, [x4]") (my-newline)
            (my-display "        mov    w0, 0") (my-newline)
            (my-display "        sub    w5, w0, w5") (my-newline)
            (my-display "        str    w5, [x4]") (my-newline)))
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_MOV)
            (my-display "r1, $0")
            (my-newline)
            (write-arm-opcode 'ARM_SUB)
            (write-register-minus-one)
            (my-display ", r1, ")
            (write-register-minus-one)
            (my-newline))
          (begin
            (my-display "        sub    r4, r3, $4") (my-newline)
            (my-display "        ldr    r5, [r4]") (my-newline)
            (my-display "        mov    r0, $0") (my-newline)
            (my-display "        sub    r5, r0, r5") (my-newline)
            (my-display "        str    r5, [r4]") (my-newline)))))
    ((x86)
      (if fast-expression
        (begin
          (write-x86-opcode 'X86_NEG)
          (write-register-minus-one)
          (my-newline))
        (begin
          (write-x86-opcode 'X86_MOV)
            (my-display "%rdi, %rcx") (my-newline)
          (write-x86-opcode 'X86_SUB)
            (my-display "$4, %rcx") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "(%rcx), %eax") (my-newline)
          (write-x86-opcode 'X86_NEG)
            (my-display "%eax") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "%eax, (%rcx)") (my-newline))))
    ((riscv)
      (if fast-expression
        (begin
          (write-riscv-opcode 'RISCV_SUB)
            (write-register-minus-one)
            (my-display ", zero, ")
            (write-register-minus-one) (my-newline))
        (begin
          (write-riscv-opcode 'RISCV_ADDI)
            (my-display "s4, s3, -4") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s5, (s4)") (my-newline)
          (write-riscv-opcode 'RISCV_SUB)
            (my-display "s5, zero, s5") (my-newline)
          (write-riscv-opcode 'RISCV_SW)
            (my-display "s5, (s4)") (my-newline))))
    ((m68k)
      (if fast-expression
        (begin
          (write-m68k-opcode 'M68K_NEG)
          (write-register-minus-one)
          (my-newline))
        (begin
          (write-m68k-opcode 'M68K_MOVA)
            (my-display "a2, a3") (my-newline)
          (write-m68k-opcode 'M68K_SUBQ)
            (my-display "#4, a3") (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "(a3), d0") (my-newline)
          (write-m68k-opcode 'M68K_NEG)
            (my-display "d0") (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "d0, (a3)") (my-newline))))))

(define (bitnot target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_MVN)
            (write-register-minus-one)
            (my-display ", ")
            (write-register-minus-one)
            (my-newline))
          (begin
            (my-display "        sub    x4, x3, 4") (my-newline)
            (my-display "        ldr    w5, [x4]") (my-newline)
            (my-display "        mvn    w5, w5") (my-newline)
            (my-display "        str    w5, [x4]") (my-newline)))
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_MVN)
            (write-register-minus-one)
            (my-display ", ")
            (write-register-minus-one)
            (my-newline))
          (begin
            (my-display "        sub    r4, r3, $4") (my-newline)
            (my-display "        ldr    r5, [r4]") (my-newline)
            (my-display "        mvn    r5, r5") (my-newline)
            (my-display "        str    r5, [r4]") (my-newline)))))
    ((x86)
      (if fast-expression
	(begin
          (write-x86-opcode 'X86_NOT)
          (write-register-minus-one)
          (my-newline))
	(begin
          (write-x86-opcode 'X86_MOV)
          (my-display "%rdi, %rcx")
          (my-newline)
          (write-x86-opcode 'X86_SUB)
          (my-display "$4, %rcx")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "(%rcx), %eax")
          (my-newline)
          (write-x86-opcode 'X86_NOT)
          (my-display "%eax")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "%eax, (%rcx)")
          (my-newline))))
    ((riscv)
      (if fast-expression
	(begin
          (write-riscv-opcode 'RISCV_XORI)
            (write-register-minus-one) (my-display ", ")
          (write-register-minus-one)
            (my-display ", -1") (my-newline))
	(begin
          (write-riscv-opcode 'RISCV_ADDI)
            (my-display "s4, s3, -4") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s5, (s4)") (my-newline)
          (write-riscv-opcode 'RISCV_XORI)
            (my-display "s5, s5, -1") (my-newline)
          (write-riscv-opcode 'RISCV_SW)
            (my-display "s5, (s4)") (my-newline))))
    ((m68k)
      (if fast-expression
        (begin
          (write-m68k-opcode 'M68K_NOT)
          (write-register-minus-one)
          (my-newline))
        (begin
          (write-m68k-opcode 'M68K_MOVA)
            (my-display "a2, a3") (my-newline)
          (write-m68k-opcode 'M68K_SUBQ)
            (my-display "#4, a3") (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "(a3), d0") (my-newline)
          (write-m68k-opcode 'M68K_NOT)
            (my-display "d0") (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "d0, (a3)") (my-newline))))))

(define (btr target label)
  (case target
    ((arm)
      (if fast-expression
        (begin
          (if fast-relop
            (begin
              (write-arm-branch fast-relop)
              (my-display-label label)
              (my-newline))
            (begin
              (write-arm-opcode 'ARM_CMP)
              (if (eq? version 'aarch64)
                (my-display "w0, 1")
                (my-display "r0, $1"))
              (my-newline)
              (write-arm-opcode 'ARM_BEQ)
              (my-display-label label)
              (my-newline))))
        (begin
          (if fast-relop
            (begin
              (write-arm-branch fast-relop)
              (my-display-label label)
              (my-newline))
            (begin
              (if (eq? version 'aarch64)
                (begin
                  (my-display "        ldr    w5, [x3, -4]!") (my-newline)
                  (my-display "        cmp    w5, 1") (my-newline))
                (begin
                  (my-display "        ldr    r5, [r3, $-4]!") (my-newline)
                  (my-display "        cmp    r5, $1") (my-newline)))
              (my-display "        beq    ") (my-display-label label)
	      (my-newline)))))
      (set! fast-relop #f)) ; reset
    ((x86)
      (if fast-expression
        (begin
          (if (not fast-relop)
	    (begin
              (write-x86-opcode 'X86_CMP)
              (my-display "$1, %eax")
              (my-newline)
              (write-x86-opcode 'X86_BEQ)
              (my-display-label label)
              (my-newline))
	    (begin
              (write-x86-branch fast-relop)
              (my-display-label label)
              (my-newline)
              (set! fast-relop #f))))
	(begin
          (if (not fast-relop)
	    (begin
              (write-x86-opcode 'X86_SUB)
              (my-display "$4, %rdi")
              (my-newline)
              (write-x86-opcode 'X86_MOV)
              (my-display "(%rdi), %eax")
              (my-newline)
              (write-x86-opcode 'X86_CMP)
              (my-display "$1, %eax")
              (my-newline)
              (write-x86-opcode 'X86_BEQ)
              (my-display-label label)
              (my-newline))
	    (begin
              (write-x86-branch fast-relop)
              (my-display-label label)
              (my-newline)
              (set! fast-relop #f))))))
    ((riscv)
      (if fast-expression
        (begin
          (write-riscv-opcode 'RISCV_BNE)
          (my-display "s0, zero, ")
          (my-display-label label)
          (my-newline))
        (begin
          (write-riscv-opcode 'RISCV_ADDI)
            (my-display "s3, s3, -4") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s5, (s3)") (my-newline)
          (write-riscv-opcode 'RISCV_BNE)
            (my-display "s5, zero, ")
          (my-display-label label)
          (my-newline))))
    ((m68k)
      (if fast-expression
        (begin
          (if (not fast-relop)
	    (begin
              (write-m68k-opcode 'M68K_TST)
              (my-display "d0")
              (my-newline)
              (write-m68k-opcode 'M68K_BNE)
              (my-display-label label)
              (my-newline))
	    (begin
              (write-m68k-branch fast-relop)
              (my-display-label label) (my-newline)
              (set! fast-relop #f))))
	(begin
          (write-m68k-opcode 'M68K_SUBQ)
          (my-display "#4, a2")
          (my-newline)
          (write-m68k-opcode 'M68K_MOV)
          (my-display "(a2), d0")
          (my-newline)
          (write-m68k-opcode 'M68K_TST)
          (my-display "d0")
          (my-newline)
          (write-m68k-opcode 'M68K_BNE)
          (my-display-label label)
          (my-newline)
          (set! fast-relop #f))))))

(define (bfl target label)
  (case target
    ((arm)
      (if fast-expression
        (begin
          (if fast-relop
            (begin
              (write-arm-branch-negate fast-relop)
              (my-display-label label)
              (my-newline))
            (begin
              (write-arm-opcode 'ARM_CMP)
              (if (eq? version 'aarch64)
                (my-display "w0, 0")
                (my-display "r0, $0"))
              (my-newline)
              (write-arm-opcode 'ARM_BEQ)
              (my-display-label label)
              (my-newline))))
        (begin
          (if fast-relop
            (begin
              (write-arm-branch-negate fast-relop)
              (my-display-label label)
              (my-newline))
            (begin
              (if (eq? version 'aarch64)
                (begin
                  (my-display "        ldr    w5, [x3, -4]!") (my-newline)
                  (my-display "        cmp    w5, 0") (my-newline))
                (begin
                  (my-display "        ldr    r5, [r3, $-4]!") (my-newline)
                  (my-display "        cmp    r5, $0") (my-newline)))
              (my-display "        beq    ") (my-display-label label)
	      (my-newline)))))
      (set! fast-relop #f)) ; reset
    ((x86)
      (if fast-expression
        (begin
          (if (not fast-relop)
	    (begin
              (write-x86-opcode 'X86_TEST)
              (my-display "%eax, %eax")
              (my-newline)
              (write-x86-opcode 'X86_BEQ)
              (my-display-label label)
              (my-newline))
	    (begin
              (write-x86-branch-negate fast-relop)
              (my-display-label label)
              (my-newline)
              (set! fast-relop #f))))
	(begin
          (write-x86-opcode 'X86_SUB)
          (my-display "$4, %rdi")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "(%rdi), %eax")
          (my-newline)
          (write-x86-opcode 'X86_TEST)
          (my-display "%eax, %eax")
          (my-newline)
          (write-x86-opcode 'X86_BEQ)
          (my-display-label label)
          (my-newline)
          (set! fast-relop #f))))
    ((riscv)
      (if fast-expression
        (begin
          (write-riscv-opcode 'RISCV_BEQ)
          (my-display "s0, zero, ")
          (my-display-label label)
          (my-newline))
        (begin
          (write-riscv-opcode 'RISCV_ADDI)
            (my-display "s3, s3, -4") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s5, (s3)") (my-newline)
          (write-riscv-opcode 'RISCV_BEQ)
            (my-display "s5, zero, ")
          (my-display-label label)
          (my-newline))))
    ((m68k)
      (if fast-expression
        (begin
          (if (not fast-relop)
	    (begin
              (write-m68k-opcode 'M68K_TST)
              (my-display "d0")
              (my-newline)
              (write-m68k-opcode 'M68K_BEQ)
              (my-display-label label)
              (my-newline))
	    (begin
              (write-m68k-branch-negate fast-relop)
              (my-display-label label) (my-newline)
              (set! fast-relop #f))))
	(begin
          (write-m68k-opcode 'M68K_SUBQ)
          (my-display "#4, a2")
          (my-newline)
          (write-m68k-opcode 'M68K_MOV)
          (my-display "(a2), d0")
          (my-newline)
          (write-m68k-opcode 'M68K_TST)
          (my-display "d0")
          (my-newline)
          (write-m68k-opcode 'M68K_BEQ)
          (my-display-label label)
          (my-newline)
          (set! fast-relop #f))))
))

(define (br target label)
  (case target
    ((arm)
      (my-display "        b      ") (my-display-label label) (my-newline)
      (ltorg))
    ((x86)
      (write-x86-opcode 'X86_B)
      (my-display-label label)
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_J)
      (my-display-label label)
      (my-newline))
    ((m68k)
      (write-m68k-opcode 'M68K_B)
      (my-display-label label)
      (my-newline))))

(define (not_ target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_CMP)
              (write-register-minus-one)
              (my-display ", 0") (my-newline)
            (write-arm-opcode 'ARM_CSET)
              (write-register-minus-one)
              (my-display ", eq") (my-newline))
          (begin
            (my-display "        sub    x4, x3, 4") (my-newline)
            (my-display "        ldr    w5, [x4]") (my-newline)
            (my-display "        cmp    w5, 0") (my-newline)
            (my-display "        cset   w1, eq") (my-newline)
            (my-display "        str    w1, [x4]") (my-newline)))
        (if fast-expression
          (begin
            (write-arm-opcode 'ARM_CMP)
            (write-register-minus-one)
            (my-display ", $0")
            (my-newline)
            (write-arm-opcode 'ARM_MOVEQ)
            (write-register-minus-one)
            (my-display ", $1")
            (my-newline)
            (write-arm-opcode 'ARM_MOVNE)
            (write-register-minus-one)
            (my-display ", $0")
            (my-newline))
          (begin
            (my-display "        sub    r4, r3, $4") (my-newline)
            (my-display "        ldr    r5, [r4]") (my-newline)
            (my-display "        cmp    r5, $0") (my-newline)
            (my-display "        moveq  r1, $1") (my-newline)
            (my-display "        movne  r1, $0") (my-newline)
            (my-display "        str    r1, [r4]") (my-newline)))))
    ((x86)
      (if fast-expression
	(begin
          (write-x86-opcode 'X86_NOT)
          (write-register-minus-one)
          (my-newline)
          (write-x86-opcode 'X86_AND)
          (my-display "$1, ")
          (write-register-minus-one)
          (my-newline))
	(begin
          (write-x86-opcode 'X86_MOV)
            (my-display "%rdi, %rcx") (my-newline)
          (write-x86-opcode 'X86_SUB)
            (my-display "$4, %rcx") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "(%rcx), %eax") (my-newline)
          (write-x86-opcode 'X86_NOT)
            (my-display "%eax") (my-newline)
          (write-x86-opcode 'X86_AND)
            (my-display "$1, %eax") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "%eax, (%rcx)") (my-newline))))
    ((riscv)
      (if fast-expression
        (begin
          (write-riscv-opcode 'RISCV_XORI)
            (write-register-minus-one) (my-display ", ")
            (write-register-minus-one) (my-display ", 1") (my-newline))
        (begin
          (write-riscv-opcode 'RISCV_ADDI)
            (my-display "s4, s3, -4") (my-newline)
          (write-riscv-opcode 'RISCV_LW)
            (my-display "s5, (s4)") (my-newline)
          (write-riscv-opcode 'RISCV_XORI)
            (my-display "s1, s5, 1") (my-newline)
          (write-riscv-opcode 'RISCV_SW)
            (my-display "s1, (s4)") (my-newline))))
    ((m68k)
      (if fast-expression
	(begin
          (write-m68k-opcode 'M68K_NOT)
            (write-register-minus-one) (my-newline)
          (write-m68k-opcode 'M68K_AND)
            (my-display "#1, ") (write-register-minus-one) (my-newline))
	(begin
          (write-m68k-opcode 'M68K_MOVA)
            (my-display "a2, a3") (my-newline)
          (write-m68k-opcode 'M68K_SUBQ)
            (my-display "#4, a3") (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "(a3), d0") (my-newline)
          (write-m68k-opcode 'M68K_NOT)
            (my-display "d0") (my-newline)
          (write-m68k-opcode 'M68K_AND)
            (my-display "#1, d0") (my-newline)
          (write-m68k-opcode 'M68K_MOV)
            (my-display "d0, (a3)") (my-newline))))
))

(define (display-name name)
  (if (eq? name 'main)
    (display '__main)
    (display name)))

(define (my-display-name name)
  (if (eq? name 'main)
    (my-display '__main)
    (my-display name)))

(define (call target name)
  (case target
    ((arm)
      (my-display "        bl     ") (my-display-name name) (my-newline))
    ((x86)
      (write-x86-opcode 'X86_CALL) (my-display-name name) (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_CALL) (my-display-name name) (my-newline))
    ((m68k)
    ; (write-m68k-opcode 'M68K_CALL) (my-display-name name) (my-newline))))
      (write-m68k-opcode 'M68K_LEA)
        (my-display-name name) (my-display ", a3") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a3)") (my-newline))))

(define (return target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (begin
          (my-display "        ldr    x30, [sp], 16") (my-newline)
          (my-display "        ret") (my-newline))
        (begin
          (my-display "        ldmfd  sp!, {fp, pc}") (my-newline)))
      (ltorg))
    ((x86)
      (write-x86-opcode 'X86_RET)
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_LD)
        (my-display "ra, (sp)") (my-newline)
      (write-riscv-opcode 'RISCV_ADD)
        (my-display "sp, sp, 8") (my-newline)
      (write-riscv-opcode 'RISCV_JR)
        (my-display "ra") (my-newline))
    ((m68k)
      (write-m68k-opcode 'M68K_RET)
      (my-newline))))

(define (read-char_ target)
  (case target
    ((arm)
      (my-display "        bl     _read_char") (my-newline)
      (if (eq? version 'aarch64)
        (my-display "        str    w0, [x3], 4")
        (my-display "        str    r0, [r3], $4"))
      (my-newline))
    ((x86)
      (write-x86-opcode 'X86_CALL)
      (my-display "_read_char")
      (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "%eax, (%rdi)")
      (my-newline)
      (write-x86-opcode 'X86_ADD)
      (my-display "$4, %rdi")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_CALL)
        (my-display "_read_char") (my-newline)
      (write-riscv-opcode 'RISCV_SW)
        (my-display "s0, (s3)") (my-newline)
      (write-riscv-opcode 'RISCV_ADDI)
        (my-display "s3, s3, 4") (my-newline))
    ((m68k)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "#10, a4") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a4)") (my-newline)
      (write-m68k-opcode 'M68K_MOV)
        (my-display "d0, (a2)") (my-newline)
      (write-m68k-opcode 'M68K_ADDQ)
        (my-display "#4, a2") (my-newline))))

(define (display_ target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (my-display "        ldr    w0, [x3, -4]!")
        (my-display "        ldr    r0, [r3, $-4]!"))
      (my-newline)
      (my-display "        bl     print_integer") (my-newline))
    ((x86)
      (write-x86-opcode 'X86_CALL)
        (my-display "_write_int") (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_LW)
        (my-display "s0, -4(s3)") (my-newline)
      (write-riscv-opcode 'RISCV_ADDI)
        (my-display "s3, s3, -4") (my-newline)
      (write-riscv-opcode 'RISCV_CALL)
        (my-display "print_integer") (my-newline))
    ((m68k)
    ; (write-m68k-opcode 'M68K_CALL)
    ;   (my-display "print_integer") (my-newline))))
      (write-m68k-opcode 'M68K_LEA)
        (my-display "print_integer, a3") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a3)") (my-newline))))

(define (newline_ target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (my-display "        mov    w2, 10")
        (my-display "        mov    r2, 10"))
      (my-newline)
      (my-display "        bl     _print_character") (my-newline))
    ((x86)
      (write-x86-opcode 'X86_CALL)
      (my-display "my_newline")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_LI)
        (my-display "s0, 10")
        (my-newline)
      (write-riscv-opcode 'RISCV_CALL)
        (my-display "print_character")
        (my-newline))
    ((m68k)
    ; (write-m68k-opcode 'M68K_CALL)
    ; (my-display "my_newline")
    ; (my-newline))))
      (write-m68k-opcode 'M68K_LEA)
        (my-display "my_newline, a3") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a3)") (my-newline))))

(define (exit_ target)
  (case target
    ((arm)
      (my-display "        b      _cleanup") (my-newline))
    ((x86)
      (call target '_my_exit))
    ((riscv)
      (write-riscv-opcode 'RISCV_J)
      (my-display "_cleanup") (my-newline))
    ((m68k)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "#0, a4") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a4)") (my-newline))))

(define (write-char_ target)
  (case target
    ((arm)
      (if (eq? version 'aarch64)
        (my-display "        ldr    w2, [x3, -4]!")
        (my-display "        ldr    r2, [r3, $-4]!"))
      (my-newline)
      (my-display "        bl     _print_character") (my-newline))
    ((x86)
      (write-x86-opcode 'X86_CALL)
      (my-display "_write_char")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_LW)
        (my-display "s0, -4(s3)") (my-newline)
      (write-riscv-opcode 'RISCV_ADDI)
        (my-display "s3, s3, -4") (my-newline)
      (write-riscv-opcode 'RISCV_CALL)
        (my-display "print_character") (my-newline))
    ((m68k)
      (write-m68k-opcode 'M68K_MOV)
        (my-display "-4(a2), d0") (my-newline)
      (write-m68k-opcode 'M68K_SUBQ)
        (my-display "#4, a2") (my-newline)
      (write-m68k-opcode 'M68K_MOVA)
        (my-display "#20, a4") (my-newline)
      (write-m68k-opcode 'M68K_JSR)
        (my-display "(a4)") (my-newline))))

(define (display-brtable-labels target labels)
  (if (not (null? labels))
    (let
      ((label (cadr (car labels))))
      (case target
	((arm)
          (my-display "        b      ") (my-display-label label) (my-newline))
	((x86)
	  (write-x86-opcode 'X86_B)
          (my-display-label label)
          (my-newline)
	  (write-x86-opcode 'X86_ALIGN) (my-display 16) (my-newline))
        ((riscv)
          (write-riscv-opcode 'RISCV_J)
          (my-display-label label)
          (my-newline))
        ((m68k)
          (write-m68k-opcode 'M68K_B)
          (my-display-label label) (my-newline)
          (write-m68k-opcode 'M68K_NOP)
          (my-newline)))
      (display-brtable-labels target (cdr labels)))))

(define (brtable target labels)
  (case target
    ((arm)
      (let
        ((branch-table-label (gen)))
        (if (eq? version 'aarch64)
          (begin
            (my-display "        ldr    w0, [x3, -4]!") (my-newline)
            (my-display "        adr    x1, .l")
              (my-display branch-table-label) (my-newline)
            (my-display "        add    x1, x1, x0, lsl 2") (my-newline)
            (my-display "        br     x1") (my-newline))
          (begin
            (my-display "        ldr    r0, [r3, $-4]!") (my-newline)
            (my-display "        ldr    r1, =.l")
              (my-display branch-table-label) (my-newline)
            (my-display "        add    pc, r1, r0, lsl $2") (my-newline)))
        (my-display-label branch-table-label)
          (my-display ":") (my-newline)
        (display-brtable-labels target labels)))
    ((x86)
      (let
        ((branch-table-label (gen)))
        (write-x86-opcode 'X86_SUB) (my-display "$4, %rdi") (my-newline)
        (write-x86-opcode 'X86_MOV) (my-display "(%rdi), %eax") (my-newline)
        (write-x86-opcode 'X86_SHL) (my-display "$4, %eax") (my-newline)
        (write-x86-opcode 'X86_LEA)
	  (my-display ".l") 
          (my-display branch-table-label)
          (my-display "(%rax), %rax")
	  (my-newline)
        (write-x86-opcode 'X86_B) (my-display "*%rax")
          (my-newline)
        (write-x86-opcode 'X86_ALIGN) (my-display "16") (my-newline)
        (my-display-label branch-table-label) (my-display ":")
          (my-newline)
        (display-brtable-labels target labels)))
    ((riscv)
      (let
        ((branch-table-label (gen)))
        (write-riscv-opcode 'RISCV_ADDI)
          (my-display "s3, s3, -4") (my-newline)
        (write-riscv-opcode 'RISCV_LW)
          (my-display "s0, (s3)") (my-newline)
        (write-riscv-opcode 'RISCV_SLLI)
          (my-display "s0, s0, 2") (my-newline)
        (write-riscv-opcode 'RISCV_LA)
          (my-display "s2, ")
          (my-display-label branch-table-label) (my-newline)
        (write-riscv-opcode 'RISCV_ADD)
          (my-display "s0, s2, s0") (my-newline)
        (write-riscv-opcode 'RISCV_JALR)
          (my-display "x0, s0, 0") (my-newline)
        (my-display-label branch-table-label)
          (my-display ":") (my-newline)
        (display-brtable-labels target labels)))
    ((m68k)
      (let
        ((branch-table-label (gen)))
        (write-m68k-opcode 'M68K_SUBQ) (my-display "#4, a2") (my-newline)
        (write-m68k-opcode 'M68K_MOV) (my-display "(a2), d0") (my-newline)
        (write-m68k-opcode 'M68K_LSL) (my-display "#3, d0") (my-newline)
        (write-m68k-opcode 'M68K_LEA)
	  (my-display ".l") 
          (my-display branch-table-label)
          (my-display ", a3")
	  (my-newline)
        (write-m68k-opcode 'M68K_B) (my-display "(a3, d0)")
          (my-newline)
        (my-display-label branch-table-label) (my-display ":")
          (my-newline)
        (display-brtable-labels target labels)))))

;;; end of armv6 code generation

(define (lookup-formal vars x n)
  (if (null? vars)
    #f
    (let
      ((var (car vars))) 
      (if (eq? x var)
	(list 'stack-ref-n n)
	(lookup-formal (cdr vars) x (+ n 1))))))

(define (lookup-local vars x n)
  (if (null? vars)
    #f
    (let
      ((var (car vars))) 
      (if (eq? x (car var))
	(list 'stack-ref-n n)
	(lookup-local (cdr vars) x (+ n 1))))))

(define (lookup-global vars x n)
  (if (null? vars)
    #f
    (let
      ((var (car vars)))
      (if (eq? x (car var))
	(list 'global n (cadr var))
	(lookup-global (cdr vars) x
	  (if (number? (cadr var)) (+ n 1) (+ n (cadr (cadr var)))))))))

(define (lookup x)
  (let
    ((result (lookup-formal formal-parameters x 0)))
    (if (not result)
      (let
        ((result (lookup-local local-vars x (length formal-parameters))))
        (if (not result)
          (let
            ((result (lookup-global global-vars x 0)))
            (if (not result)
	      (begin
		(display-comment)
		(display "*** ERROR ")
		(display "variable ")
		(display x)
		(display " not found")
		(newline)
		#f)
	      result))
	  result))
      result)))

(define (get-globals-size vars n)
  (if (null? vars)
    n
    (let
      ((var (car vars)))
      (get-globals-size (cdr vars)
        (if (number? (cadr var)) (+ n 1) (+ n (cadr (cadr var))))))))

(define (letrec? x)
  (eq? (car x) 'letrec))
(define (let? x)
  (eq? (car x) 'let))
(define (let-loop? x)
  (and (eq? (car x) 'let) (eq? (cadr x) 'loop)))
(define (if? x)
  (eq? (car x) 'if))
(define (begin? x)
  (eq? (car x) 'begin))
(define (case? x)
  (eq? (car x) 'case))

(define (immediate-value? op)
  (if (memq op '(or and))
    #f
    (if (null? immediate-list)
      #f
      (if (= (- register-idx 2) (caar immediate-list))
        (let
	  ((immediate-value (car immediate-list)))
	  (display-comment)
	  (my-display "* use immediate constant ")
	  (my-display (cadr immediate-value))
	  (my-newline)
	 ;(display-comment)
	 ;(my-display immediate-list)
	 ;(my-newline)
	  (set! immediate-list (cdr immediate-list))
	  (cadr immediate-value))
        #f))))

(define instructions '())
(define cache-instructions #f)

(define (add-to-instructions instruction)
  (set! instructions (cons instruction instructions)))

(define (display-instruction instruction)
  (let
    ((opcode (car instruction))
     (operands (cdr instruction)))
    (if (not (or (eq? opcode 'imm) (eq? opcode 'expr)))
      (begin
        (set! instruction-run-count (+ instruction-run-count 1))
        (poolgap)))
    (if (not (eq? target 'vm))
      (display-comment))
    (if (not (memq opcode '(br btr bfl brtable)))
      (begin
	(if (eq? target 'vm)
	  (log-code-instruction instruction)
	  (begin
            (my-display instruction) (my-newline)))))
    (case opcode
      ; (expr ...) will be sluffed off at the end
      ((imm)
        (if fast-expression
          (set! immediate-push #t)))
      ((top-level-begin)
        (top-level-begin target (car operands) (cadr operands)))
      ((function-proc-begin)
        (function-proc-begin target
          (car operands) (cadr operands) (car (cddr operands))))
      ((function-end)
        (function-end target (car operands)))
      ((proc-end)
        (proc-end target (car operands)))
      ((stack-ref)
        (stack-ref target))
      ((stack-ref-n)
        (stack-ref-n target (car operands)))
      ((stack-set)
        (stack-set target))
      ((stack-set-n)
        (stack-set-n target (car operands)))
      ((push)
        (push target (car operands)))
      ((add sub mul shl shr)
        (numeric-binary-function target opcode opcode))
      ((div)
        (if (eq? target 'riscv)
          (numeric-binary-function target opcode opcode)
          (div target)))
      ((mod)
        (if (eq? target 'riscv)
          (numeric-binary-function target opcode opcode)
          (mod target)))
      ((abs)
        (abs_ target))
      ((negate)
        (negate target))
      ((bitor bitand bitxor or and)
        (if (or (eq? target 'riscv) (eq? target 'm68k))
          (numeric-binary-function target opcode opcode)
	  (let
	    ((mnemonic
	      (cadr (assq
	        opcode '((bitor orr) (bitand and) (bitxor eor)
	                 (or orr) (and and))))))
            (numeric-binary-function target mnemonic opcode))))
      ((bitnot)
        (bitnot target))
      ((eq lt gt le ge ne)
	(let
	  ((mnemonic
	    (cadr (assq
	      opcode '((eq =) (lt <) (gt >) (le <=) (ge >=) (ne ne))))))
          (predicate-binary-function target mnemonic opcode)))
      ((btr bfl br)
	(if (eq? target 'vm)
          (begin
	    (log-code-instruction (list opcode (car operands)))
            (set! fast-relop #f))
	  (begin
            (my-display "(") (my-display opcode)
	    (my-display " l") (my-display (car operands)) (my-display ")")
	    (my-newline)
	    (case opcode
	      ((btr) (btr target (car operands)))
	      ((bfl) (bfl target (car operands)))
	      ((br) (br target (car operands)))))))
      ((not)
        (not_ target))
      ((call)
        (call target (car operands)))
      ((return)
        (return target))
      ((display)
        (display_ target))
      ((newline)
        (newline_ target))
      ((exit)
        (exit_ target))
      ((write-char)
        (write-char_ target))
      ((read-char)
        (read-char_ target))
      ((inc) ; pseudo op for x86
        (write-inc-x86 (car operands)))
      ((dec) ; pseudo op for x86
        (write-dec-x86 (car operands)))
      ((brtable)
	(if (eq? target 'vm)
	  (log-code-instruction (list opcode operands))
	  (begin
            (my-display "(") (my-display opcode)
	    (do ((i 0 (+ i 1))) ((= i (length operands)))
	      (my-display " (") (my-display i)
	      (my-display " l") (my-display (cadr (list-ref operands i))) (my-display ")"))
	    (my-display ")")
	    (my-newline)))
        (brtable target operands)))))

(define (display-label label)
  (set! target target-save) ; TODO remove
  (log-code-instruction label)
  (set! target 'vm)) ; TODO remove

(define (display-instructions instructions)
  (if (not (null? instructions))
    (let
      ((instruction (car instructions)))
      (display-instruction instruction)
      (display-instructions (cdr instructions)))))

(define (translate-symbol-arguments argument)
  (let
    ((value (lookup argument)))
    (if (eq? (car value) 'global)
      (begin
	(add-to-instructions (list 'push (cadr value)))
        (if (number? (cadr (cdr value))) ; its 0 so its not an array
	  (add-to-instructions (list 'stack-ref))))
      (add-to-instructions value))))

(define (translate-actual-arguments
	  operator arguments force-not-immediate)
  (if (not (null? arguments))
    (let
      ((argument (car arguments)))
      (cond
	((number? argument)
          (if force-not-immediate
	    (add-to-instructions (list 'push argument))
            (begin
              (if (immediate-candidate operator argument)
	        (add-to-instructions (list 'imm)))
	      (add-to-instructions (list 'push argument)))))
	((symbol? argument)
          (translate-symbol-arguments argument))
	(else
	  (translate-expr argument)))
      (translate-actual-arguments
        operator (cdr arguments) force-not-immediate))))

(define (translate-operator operator)
  (case operator
    ((+)
      (list 'add))
    ((-)
      (list 'sub))
    ((*)
      (list 'mul))
    ((quotient)
      (list 'div))
    ((remainder)
      (list 'mod))
    ((=)
      (list 'eq))
    ((!=)
      (list 'ne))
    ((<)
      (list 'lt))
    ((>)
      (list 'gt))
    ((<=)
      (list 'le))
    ((>=)
      (list 'ge))
    ((shl)
      (list 'shl))
    ((shr)
      (list 'shr))
    ((!)
      (list 'not))
    ((&&)
      (list 'and))
    ((||)
      (list 'or))
    ((bitwise-or)
      (list 'bitor))
    ((bitwise-and)
      (list 'bitand))
    ((bitwise-xor)
      (list 'bitxor))
    ((bitwise-not)
      (list 'bitnot))
    ((abs)
      (list 'abs))
    ((vector-ref)
      (add-to-instructions (list 'add))
      (list 'stack-ref))
    ((vector-set!)
      (add-to-instructions (list 'add))
      (list 'stack-set))
    ((display)
      (list 'display))
    ((putchar)
      (list 'write-char))
    ((getchar)
      (list 'read-char))
    ((return)
      (add-to-instructions (list 'stack-set-n 0))
      (add-to-instructions (list 'function-end dynamic-link))
      (list 'return))
    ((return-from-procedure)
      (add-to-instructions (list 'proc-end dynamic-link))
      (list 'return))
    ((exit)
      (list 'exit))
    (else
      (list 'call operator))))

(define (immediate-candidate operator n)
  (if (eq? target-save 'riscv)
    #f
    (if (number? n)
      (if (and (>= n 0) (<= n 255)) ; TODO verify for x86 etc
        (memq operator '(
          + -                           
          shl shr ; TODO get to work. Now causes r4rs test to fail.
	          ; temporary fix is to define FF global var in schant-bigfloat8
          = != < > <= >=
          bitwise-or bitwise-and bitwise-xor bitwise-not))
        #f)
      #f)))

(define (expr-doesnt-have-function? expr)
  (cond
    ((null? expr) #t)
    ((not (pair? expr)) #t)
    ((memq (car expr)
      '(abs display newline getchar putchar exit)) #f)
    ((and (or (eq? target-save 'x86)
              (eq? target-save 'arm)
              (eq? target-save 'm68k))
          (memq (car expr) '(remainder quotient))) #f)
    ((and (or (eq? target-save 'x86)
              (eq? target-save 'm68k))
          (memq (car expr) '(*))) #f)
    ((find-function functions (car expr)) #f)
    (else
      (if (= (length (cdr expr)) 0)
	#t
        (if (= (length (cdr expr)) 1)
	  (expr-doesnt-have-function? (cadr expr))
          (if (= (length (cdr expr)) 2)
	    (and (expr-doesnt-have-function? (cadr expr))
	         (expr-doesnt-have-function? (cadr (cdr expr))))
	    ; else length is 3
	    (and (expr-doesnt-have-function? (cadr expr))
	         (expr-doesnt-have-function? (cadr (cdr expr)))
	         (expr-doesnt-have-function? (cadr (cddr expr))))))))))

(define (reverse-operands-if-primitive operator operands)
  (if (memq operator '(+ - * quotient remainder = != < > <= >= shl shr
                       bitwise-or bitwise-and bitwise-xor
                       && ||
                       vector-ref vector-set!))
    (reverse operands)
    operands))

(define (simplify-add-mul fn op const expr)
  (let
    ((operand1 (simplify-expr (cadr expr)))
     (operand2 (simplify-expr (cadr (cdr expr)))))
    (if (and (number? operand1) (number? operand2))
      (fn operand1 operand2)
      (if (number? operand1)
        (if (= operand1 const)
          operand2
          (list op operand2 operand1)) ; makes number second arg
        (if (number? operand2)
          (if (= operand2 const)
            operand1
            (list op operand1 operand2))
          (list op operand1 operand2))))))

(define (simplify-sub expr)
  (let
    ((operand1 (simplify-expr (cadr expr)))
     (operand2 (simplify-expr (cadr (cdr expr)))))
    (if (and (number? operand1) (number? operand2))
      (- operand1 operand2)
      (if (number? operand1)
        (if (= operand1 0)
          (list '- operand2)
          (list '+ (list '- operand2) operand1)) ; makes number second arg
        (if (number? operand2)
          (if (= operand2 0)
            operand1
            (list '- operand1 operand2))
          (list '- operand1 operand2))))))

(define (simplify-shr expr)
  (let
    ((operand1 (simplify-expr (cadr expr)))
     (operand2 (simplify-expr (cadr (cdr expr)))))
    (if (and (number? operand1) (number? operand2))
      (arithmetic-shift operand1 (- operand2))
      (begin
	(if (number? operand1)
	  (set! operand1-is-num #t))
        (list 'shr operand1 operand2)))))

(define (simplify-shl expr)
  (let
    ((operand1 (simplify-expr (cadr expr)))
     (operand2 (simplify-expr (cadr (cdr expr)))))
    (if (and (number? operand1) (number? operand2))
      (arithmetic-shift operand1 operand2)
      (begin
	(if (number? operand1)
	  (set! operand1-is-num #t))
        (list 'shl operand1 operand2)))))

(define (simplify-generic fn result1 result2 op1 op2 expr)
  (let
    ((operand1 (simplify-expr (cadr expr)))
     (operand2 (simplify-expr (cadr (cdr expr)))))
    (if (and (number? operand1) (number? operand2))
      (if (fn operand1 operand2)
	result1
	result2)
      (if (number? operand1)
        (list op1 operand2 operand1) ; makes number second arg
        (list op2 operand1 operand2)))))

(define (simplify-bitwise fn op expr)
  (let
    ((operand1 (simplify-expr (cadr expr)))
     (operand2 (simplify-expr (cadr (cdr expr)))))
    (if (and (number? operand1) (number? operand2))
      (fn operand1 operand2)
      (if (number? operand1)
        (list op operand2 operand1) ; makes number second arg
        (list op operand1 operand2)))))

(define (simplify-bitwise-or fn op expr)
  (let
    ((operand1 (simplify-expr (cadr expr)))
     (operand2 (simplify-expr (cadr (cdr expr)))))
    (if (and (number? operand1) (number? operand2))
      (fn operand1 operand2)
      (if (number? operand1)
        (if (= operand1 0)
          operand2
          (list op operand2 operand1)) ; makes number second arg
        (if (number? operand2)
          (if (= operand2 0)
            operand1
            (list op operand1 operand2))
          (list op operand1 operand2))))))

(define (pairlis vars vals)
  (if (null? vars)
    '()
    (cons (list (car vars) (car vals))
	  (pairlis (cdr vars) (cdr vals)))))

(define (expand-actual-arguments arguments env)
  (if (null? arguments)
    '()
    (let
      ((argument (car arguments)))
      (cond
	((number? argument)
	  (cons argument (expand-actual-arguments (cdr arguments) env)))
	((symbol? argument)
	  (let
	    ((s (assq argument env)))
	    (if s
	      (cons (cadr s) (expand-actual-arguments (cdr arguments) env))
	      (cons argument (expand-actual-arguments (cdr arguments) env)))))
	(else
	  (cons (expand-expr argument env) (expand-actual-arguments (cdr arguments) env)))))))

(define (expandable-fn? fn)
  (let
    ((found (find-function functions fn)))
    (if found
      (if (eq? (car (cadr (cdr (cadr found)))) 'return)
         found
	 #f)
      #f)))

(define (expandable-proc? proc)
  (let
    ((found (find-function functions proc)))
    (if found
      (if (= (length (cddr (cadr found))) 2) ; proc expression and return
        (if (and (eq? (caar (cdr (cddr (cadr found)))) 'return-from-procedure)
                 (not (memq (caar (cddr (cadr found))) '(if let begin display newline exit))))
          found
          #f)
        #f)
      #f)))
 
(define (expand-expr expr env)
  (cond
    ((null? expr)
      expr)
    ((number? expr)
      expr)
    ((symbol? expr) ; boolean expression is a variable
      (let
        ((s (assq expr env)))
        (if s
	  (cadr s)
          expr)))
    (else
      (let
        ((operator (car expr))
         (operands (cdr expr)))
	(let
	  ((expandable-fn (expandable-fn? operator)))
          ; (display "; expandable ") (display expandable-fn) (newline)
	  (if expandable-fn
	    (expand-expr
	      (cadr (cadr (cdr (cadr expandable-fn)))) ; TODO cleanup cars cdrs
	      (pairlis (cadr (cadr expandable-fn))
                       (expand-actual-arguments operands env)))
	    (let
	      ((expandable-proc (expandable-proc? operator)))
              ;(display "; expandable ") (display expandable-proc) (newline)
	      (if expandable-proc
	        (expand-expr
	          (cadr (cdr (cadr expandable-proc))) ; proc statement
	          (pairlis (cadr (cadr expandable-proc))
                           (expand-actual-arguments operands env)))
	        (cons operator (expand-actual-arguments operands env))))))))))

(define (simplify-expr expr)
  (cond
    ((null? expr) '())
    ((not (pair? expr)) expr)
    (else
      (let
        ((op (car expr)))
        (cond
          ((eq? op '+)
            (simplify-add-mul + '+ 0 expr))
          ((and (eq? op '-) (= (length expr) 3))
            (simplify-sub expr))
          ((eq? op '*)
            (simplify-add-mul * '* 1 expr))
          ((eq? op 'bitwise-and)
            (simplify-bitwise bitwise-and 'bitwise-and expr))
          ((eq? op 'bitwise-or)
            (simplify-bitwise-or bitwise-or 'bitwise-or expr))
          ((eq? op 'bitwise-xor)
            (simplify-bitwise bitwise-xor 'bitwise-xor expr))
          ((eq? op 'shr)
            (simplify-shr expr))
          ((eq? op 'shl)
            (simplify-shl expr))
          ((eq? op '=)
            (simplify-generic = 1 0 '= '= expr))
          ((eq? op '!=)
            (simplify-generic (lambda (x y) (not (= x y))) 1 0 '!= '!= expr))
          ((eq? op '<)
            (simplify-generic < 1 0 '>= '< expr))
          ((eq? op '>)
            (simplify-generic > 1 0 '<= '> expr))
          ((eq? op '<=)
            (simplify-generic <= 1 0 '> '<= expr))
          ((eq? op '>=)
            (simplify-generic >= 1 0 '< '>= expr)) ; TODO generic -> predicate
          (else
            (cons (simplify-expr op)
                  (simplify-expr (cdr expr)))))))))

(define (translate-expr expr)
  (set! operand1-is-num #f)
  (let
    ((expr (simplify-expr expr)))
    ;(display ";;; ") (display expr) (newline)
    (if (number? expr)
      (add-to-instructions (list 'push expr))
      (if (symbol? expr) ; boolean expression is a variable
        (translate-symbol-arguments expr)
        (let
          ((operator (car expr))
           (operands (cdr expr)))
          (if (eq? operator 'set!)
	    (let
	      ((var (car operands)))
              (translate-actual-arguments operator (cdr operands) #f)
	      (let
	        ((lookup-var (lookup var)))
	        (if (eq? (car lookup-var) 'global)
	          (begin
                    (add-to-instructions (list 'push (cadr lookup-var)))
	            (add-to-instructions (list 'stack-set)))
	          (begin ; local var
                    (add-to-instructions (list 'stack-set-n (cadr lookup-var)))))))
            (if (and (eq? operator '-) (= (length operands) 1))
              (begin
                (translate-actual-arguments operator operands #t)
                (add-to-instructions (list 'negate)))
              (begin
                (translate-actual-arguments operator
	          (reverse-operands-if-primitive operator operands) #f)
                (add-to-instructions (translate-operator operator))))))))))

(define (add-zero? instructions)
  (if (null? instructions)
    #f
    (let
      ((instruction1 (car instructions)))
      (if (null? (cdr instructions))
        #f
        (let
          ((instruction2 (cadr instructions)))
          (and (equal? instruction1 '(push 0))
               (equal? instruction2 '(add))))))))

(define (ref-set? instructions)
  (if (null? instructions)
    #f
    (if (not (pair? instructions))
      #f
      (if (null? (cdr instructions))
        #f
        (if (not (pair? (cdr instructions)))
          #f
          (let
            ((instruction1 (car instructions))
             (instruction2 (cadr instructions)))
	    (if (and (pair? instruction1) (pair? instruction2))
	      (if (and (= (length instruction1) 2) (= (length instruction2) 2))
	        (if (and (number? (cadr instruction1))
	                 (number? (cadr instruction2)))
                  (and (eq? (car instruction1) 'stack-ref-n)
                       (eq? (car instruction2) 'stack-set-n)
	               (= (cadr instruction1) (cadr instruction2)))
	          #f)
	        #f)
	      #f)))))))

(define (peephole instructions)
  (cond
    ((null? instructions) '())
    ((add-zero? instructions)
      (peephole (cddr instructions)))
    ((ref-set? instructions)
      (peephole (cddr instructions)))
    (else
      (cons (car instructions) (peephole (cdr instructions))))))

(define (translate-expr-and-display expr force-slow)
  (set! expr (expand-expr expr '()))
  (set! cache-instructions #f)
  (if force-slow
    (set! fast-expression #f)
    (if (expr-doesnt-have-function? expr) ; fast expression candidate
      (begin
        (set! quiet #t)
        (set! instructions '())
       ;(if (not (null? immediate-list)) ; debug
       ;  (begin
       ;    (display "* unconsumed ") (display immediate-list) (newline)))
        (set! immediate-list '())
        (set! register-idx 0)
        (set! max-register-idx 0)
        (set! fast-expression #t) ; assume to find number of registers to use
        (set! target target-save) ; TODO remove
        (translate-expr expr)
	(set! cache-instructions #t)
	(set! instructions (peephole (reverse instructions)))
        (display-instructions instructions)
        (set! target 'vm) ; TODO remove
        (set! quiet #f)
        (if (and (not operand1-is-num)
	         (not (= max-register-idx 0))
		 (< max-register-idx MAXIMUM-FREE-REGISTERS))
          (set! fast-expression #t)
          (set! fast-expression #f)))
      (set! fast-expression #f)))

  (set! quiet #f)
  (set! immediate-list '())
  (if (not cache-instructions)
    (begin
      (set! instructions '())
     ;(if (not (null? immediate-list)) ; debug
     ;  (begin
     ;    (display "* unconsumed ") (display immediate-list) (newline)))
      (set! register-idx 0)
      (set! max-register-idx 0)
      (translate-expr expr)
      (set! instructions (peephole (reverse instructions)))))
    ; else instructions have already been calculated. use them again
  (display-instruction
    ; pseudo instruction
    (list 'expr fast-expression max-register-idx fast-relop expr))
  (display-instructions instructions))

(define (translate-predicate-expr-and-display predicate force-slow)
  (set! predicate (expand-expr predicate '()))
  (set! fast-relop #f)
  (if (pair? predicate)
    (if (= (length predicate) 3)
      (if (memq (car predicate) '(= != < > <= >=))
        (if (not (number? (cadr predicate)))
          (begin
            (set! fast-relop (car predicate)))))))
  (translate-expr-and-display predicate force-slow))

(define (translate-statements statements)
  (if (not (null? statements))
    (let
      ((statement (car statements)))
      (my-eval statement)
      (translate-statements (cdr statements)))))

(define (find-function functions name)
  (hash-ref hash-functions name))

(define (flatten x)
  (letrec (
    (flatten-help
      (lambda (x y)
        (cond
          ((null? x) y)
          ((not (pair? x)) (cons x y))
          (else
            (flatten-help
              (car x)
              (flatten-help (cdr x) y)))))))

    (flatten-help x '())))

(define (function-or-proc? function)
  (if (memq 'return (flatten function))
    'function
    'procedure))

(define (fast-function-hook name)
  ; flag functions that can be replaced by fast assembly language
  (if (not (or (eq? target 'vm) (eq? target 'riscv)))
    (if (memq name '(memcmp32 memcpy32 memset32))
      (let
        ((name2
          (cadr (assv name '(
            (memcmp32 __memcmp32)
            (memcpy32 __memcpy32)
            (memset32 __memset32))))))
        (log-code-instruction name2)))))

(define (translate-function function)
  (let
    ((name (car function))
     (value (cadr function))
     (local-vars-size 0))
    ;(display "; ") (display name) (newline)
    (set! formal-parameters (cadr value))
    (set! local-vars '())
    (if (eq? (caar (cddr value)) 'let)
      (if (not (eq? (cadr (car (cddr value))) 'loop))
        (set! local-vars-size  (length (car (cdr (car (cddr value))))))))
    (set! function-type (function-or-proc? (find-function functions name)))
    (if (not function-type)
      (begin
        (my-display name) (my-display " not found") (my-newline)))
    (set! dynamic-link
      (+ (length formal-parameters)
	 local-vars-size
	 (if (eq? function-type 'function) 1 0)))
    (let
      ((body (cdr (cdr value))))
      (set! target target-save) ; TODO remove
      (fast-function-hook name)
      (log-code-instruction name)
      (set! target 'vm) ; TODO remove
      (display-instruction
        (list
          'function-proc-begin
          (length formal-parameters)
          (+ (length formal-parameters)
	     local-vars-size
	     (if (eq? function-type 'function) 2 1))
	  dynamic-link))
      (translate-statements body)
      (set! target target-save) ; TODO remove
      (fast-function-hook name))))

(define (forward? fn)
  (if (symbol? (cadr (cdr (cadr fn))))
    (eq? (cadr (cdr (cadr fn))) '__forward)
    #f))

(define (filter-forward-functions functions)
  (if (null? functions)
    '()
    (let
      ((function (car functions)))
      (if (forward? function) ; ignore function definition
        (filter-forward-functions (cdr functions))
        (cons function (filter-forward-functions (cdr functions)))))))

(define (translate-functions functions)
  (if (not (null? functions))
    (let
      ((function (car functions)))
      (translate-function function)
      (translate-functions (cdr functions)))))

(define (translate-letrec expr)
  (set! functions (filter-forward-functions (car expr)))
  (make-hash-functions functions)
  (let
    ((call (cadr expr)))
    (display-instruction
      (list 'top-level-begin 0 (+ (get-globals-size global-vars 0) 4)))
    (display-instruction (list 'call '__main))
    (display-instruction (list 'exit))
    (translate-functions functions)
    ))

(define (translate-let expr)
  (if (= level 0)
    (begin
      (set! global-vars (car expr))
      (set! level 1))
    (set! local-vars (car expr)))
  (let
    ((vars (car expr))
     (body (cdr expr)))
    (translate-statements body)
  ))

(define (translate-let-loop expr)
  (let
    ((label (gen)))
    (set! loop-label-stack (cons label loop-label-stack))
    (display-label label)
    (translate-statements expr)))

(define (filter-predicate predicate)
  (if (pair? predicate)
    (let
      ((test (car predicate)))
      (if (eq? test '__test)
        (cadr predicate)
        predicate))
    predicate))

(define (translate-if expr)
  (let
    ((predicate (filter-predicate (car expr)))
     (exprs (cdr expr)))
    (if (null? (cdr exprs))
      (let
	((then-part (car exprs))
	 (l0 (gen)))
	(if (equal? predicate 1) ; just use then part without predicate
	  (my-eval then-part)
	  (begin
	    (translate-predicate-expr-and-display predicate #f)
	    (display-instruction (list 'bfl l0))
	    (my-eval then-part)
	    (display-label l0))))
      (let
	((then-part (car exprs))
	 (else-part (cadr exprs))
	 (l0 (gen))
	 (l1 (gen)))
        (translate-predicate-expr-and-display predicate #f)
	(display-instruction (list 'bfl l0))
	(my-eval then-part)
	(display-instruction (list 'br l1))
	(display-label l0)
	(my-eval else-part)
	(display-label l1)))))

(define (translate-case expr)
  (let
    ((n-expr (car expr))
     (cases (cdr expr))
     (n-cases (length (cdr expr)))
     (switch (gen))
     (break (gen))
     (first-case (gen)))
    (do ((i 1 (+ i 1))) ((= i n-cases))
      (gen))
      (translate-expr-and-display n-expr #t)
      (display-instruction (list 'br switch))
    (do ((i 0 (+ i 1))) ((= i n-cases))
      (display-label (+ first-case i))
      (translate-statements (cdar cases))
      (display-instruction (list 'br break))
      (set! cases (cdr cases)))
    (display-label switch)
    (let
      ((brtable-list '()))
      (do ((i 0 (+ i 1))) ((= i n-cases))
	(set! brtable-list
	  (cons
            (list i (+ first-case i))
	    brtable-list)))
      (display-instruction (cons 'brtable (reverse brtable-list))))
    (display-label break)
    ))

(define (my-eval expr)
  (cond
    ((letrec? expr) (translate-letrec (cdr expr)))
    ((let-loop? expr) (translate-let-loop (cdr (cddr expr))))
    ((let? expr) (translate-let (cdr expr)))
    ((begin? expr) (translate-statements (cdr expr)))
    ((case? expr) (translate-case (cdr expr)))
    ((if? expr) (translate-if (cdr expr)))
    ((equal? expr '(loop))
      (display-instruction (list 'br (car loop-label-stack)))
      (set! loop-label-stack (cdr loop-label-stack)))
    (else
      (translate-expr-and-display expr #f))))

(define (set-top-level expr)
  (if (eq? (car expr) 'let) ; top level variables
    (set! level 0)
    (set! level 1))
  expr)

(define (define? expr)
  (eq? (car expr) 'define))

(define defines (make-hash))

(define (process-define expr)
  (let
    ((name (car expr))
     (value (cadr expr)))
  (hash-set! defines name value)))

(define (lookup-define symbol)
  (let
    ((found (hash-ref defines symbol)))
    (if found
      (cadr found) ; numeric value of define
      symbol))) ; no define

(define (filter-defines expr)
  (if (pair? expr)
    (cons (filter-defines (car expr)) (filter-defines (cdr expr)))
    (if (symbol? expr)
      (lookup-define expr)
      expr)))

(define (find-labels code labels)
  (if (null? code)
    labels
    (let
      ((instruction (car code)))
      (if (number? instruction)
	(vector-set! labels instruction (cdr code)))
      (find-labels (cdr code) labels))))

(let loop ()
  (let
    ((form (read)))
    (if (define? form)
      (begin
        (process-define (cdr form))
        (loop))
      (my-eval (set-top-level (filter-defines form))))))

(set! target target-save)
(let
  ((code (reverse code-instructions)))
  (display-code (optimize-code-x86-inc
                  target
                  (optimize-code-x86-dec
                    target
                    (optimize-code
		      code
		      code
		      (find-labels code (make-vector gen-n '())))))))

(set! target target-save)
(if (eq? target 'arm)
  (display-global-constants global-constants)
  (if (eq? target 'm68k)
    (begin
      (my-display "stack:"))))
