(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))
    (set! MAXIMUM-FREE-REGISTERS 7))
  (if (eq? target 'x86)
    ; 7 almost works results in illegal instruction esi, [esi]
    (set! MAXIMUM-FREE-REGISTERS 6)
    (if (eq? target 'riscv)
      (set! MAXIMUM-FREE-REGISTERS 5)))) ; TODO I think 6 will work

(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 'riscv))
    (display ".")))

(define (display-label-character target)
  (if (or (eq? target 'arm) (eq? target 'x86) (eq? target 'riscv))
    (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))
            (display-comment))
	  (display "(") (display (car instruction)) (display " l")
	  (display (cadr instruction)) (display ")")
          (newline)
	  (case (car instruction) ; arm, x86 or riscv
	    ((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))
            (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)
  (if (null? code)
    #f
    (if (equal? label (car code)) ; TODO skip possible labels before instruction
      (if (not (null? (cdr code)))
        (if (pair? (cadr code))
          (if (eq? (car (cadr code)) 'br)
            (cadr code) ; new branch
            (find-label-followed-by-branch label (cdr code)))
          (find-label-followed-by-branch label (cdr code)))
        (find-label-followed-by-branch label (cdr code)))
      (find-label-followed-by-branch label (cdr code)))))

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

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

(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 (display-comment)
  (if (not quiet)
    (case target
      ((vm) (my-display "; ")) ; scheme comment
      ((arm) (my-display "@ "))
      ((riscv) (my-display "# "))
      ((x86) (my-display "; ")))))

;;; armv6 x86 riscv 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)
      (my-display "s"))
    (else
      (my-display "?"))))

(define (write-register)
  (case target
    ((arm)
      (my-display "r")
      (case register-idx
        ((0) (my-display "0"))
        ((1) (my-display "2"))
        ((2) (my-display "4"))
        ((3) (my-display "5"))
        ((4) (my-display "6"))
        ((5) (my-display "7"))
        ((6) (my-display "9"))
        (else
          (my-display "?"))))
    ((x86)
      (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")
      (case register-idx
        ((0) (my-display "0"))
        ((1) (my-display "2"))
        ((2) (my-display "4"))
        ((3) (my-display "5"))
        ((4) (my-display "6"))
        ((5) (my-display "7"))
        ((6) (my-display "9"))
        (else
          (my-display "?"))))))

(define (write-push-register n)
  (if fast-expression
    (write-register)
    (begin
      (case target
	((arm)
          (my-display "r")
          (my-display n))
	((x86)
          (my-display "?") ; TODO document
          (my-display n))
	((riscv)
          (my-display "s")
          (my-display n))))))

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

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

(define (write-register-minus-two-or-constant immediate-constant)
  (if immediate-constant
    (begin
      (if (eq? target 'arm)
        (my-display "$"))
      (my-display immediate-constant))
    (write-register-minus-two)))

(define (write-register-lo-x86)
  (if (>= register-idx 4) ; edi or more. TODO 3 should be 4
    (my-display "?")
    (write-register-type-x86))
  (my-display "l"))

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

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

(define (write-arm-opcode opcode)
  (my-display "        ")
  (case opcode
    ((ARM_MOV)
      (my-display "mov    "))
    ((ARM_MVN)
      (my-display "mvn    "))
    ((ARM_LDR)
      (my-display "ldr    "))
    ((ARM_STR)
      (my-display "str    "))
    ((ARM_ADD)
      (my-display "add    "))
    ((ARM_SUB)
      (my-display "sub    "))
    ((ARM_MUL)
      (my-display "mul    "))
    ((ARM_CMP)
      (my-display "cmp    "))
    ((ARM_BGE)
      (my-display "bge    "))
    ((ARM_BEQ)
      (my-display "beq    "))
    ((ARM_BNE)
      (my-display "bne    "))
    ((ARM_BL)
      (my-display "bl     "))
    ((ARM_B)
      (my-display "b      "))
    ((ARM_MOVEQ)
      (my-display "moveq  "))
    ((ARM_MOVNE)
      (my-display "movne  "))
    ((ARM_LDMFD)
      (my-display "ldmfd  "))
    ((ARM_STMFD)
      (my-display "stmfd  "))))

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

(define (write-riscv-opcode opcode)
  (my-display "        ")
  (case opcode
    ((RISCV_MV)
      (my-display "mv    "))
    ((RISCV_LI)
      (my-display "li    "))
    ((RISCV_LW)
      (my-display "lw    "))
    ((RISCV_LD)
      (my-display "ld    "))
    ((RISCV_LUI)
      (my-display "lui   "))
    ((RISCV_SW)
      (my-display "sw    "))
    ((RISCV_SD)
      (my-display "sd    "))
    ((RISCV_ADD)
      (my-display "add   "))
    ((RISCV_ADDI)
      (my-display "addi  "))
    ((RISCV_SUB)
      (my-display "sub   "))
    ((RISCV_BEQ)
      (my-display "beq   "))
    ((RISCV_BNE)
      (my-display "bne   "))
    ((RISCV_BGE)
      (my-display "bge   "))
    ((RISCV_J)
      (my-display "j     "))
    ((RISCV_JR)
      (my-display "jr    "))
    ((RISCV_CALL)
      (my-display "call  "))
    ((RISCV_OR)
      (my-display "or    "))
    ((RISCV_AND)
      (my-display "and   "))
    ((RISCV_XOR)
      (my-display "xor   "))
    ((RISCV_SLLI)
      (my-display "slli  "))
    ((RISCV_XORI)
      (my-display "xori  "))
    ((RISCV_JALR)
      (my-display "jalr  "))))

(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  "))))
    ((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-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  "))))
    ((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 "        ")
  (case target
    ((arm)
      (case opcode
        ((+)
          (my-display "add   "))
        ((-)
          (my-display "sub   "))
        ((*)
          (my-display "mul   "))
        ((^)
          (my-display "eor   "))
        ((|| |)
          (my-display "orr   "))
        ((&& &)
          (my-display "and   "))))
    ((x86)
      (case opcode
        ((+ add)
          (my-display "add    "))
        ((- sub)
          (my-display "sub    "))
        ((*) ; TODO mul etc
          (my-display "mul    "))
        ((^ eor bitxor) ; TODO shouldnt have all the alias cases
          (my-display "xor    "))
	((shl)
          (my-display "shl    "))
	((shr)
          (my-display "sar    ")) ; actually arithmetic shift
        ((|| | or orr bitor)
          (my-display "or     "))
        ((&& & and bitand)
          (my-display "and    "))))
    ((riscv)
      (case opcode
        ((+ add) ; TODO may need more alias cases like in x86
          (my-display "add   "))
        ((- sub)
          (my-display "sub   "))
        ((* mul)
          (my-display "mul   "))
        ((/ div)
          (my-display "div   "))
        ((% mod)
          (my-display "rem   "))
	((shl)
          (my-display "sll    "))
	((shr)
          (my-display "sra    "))
        ((^ bitxor)
          (my-display "xor   "))
        ((|| | or bitor)
          (my-display "or    "))
        ((&& & and bitand)
          (my-display "and   "))))))

(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 (numeric-binary-function-fast target op immediate-constant)
  (case target
    ((arm)
      (if (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 (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 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-one)
              (my-display ", ")
              (write-register-minus-two-or-constant immediate-constant)
              (my-newline)
              (write-x86-opcode 'X86_MOV)
              (write-register-minus-two)
              (my-display ", ")
              (write-register-minus-one)
              (my-newline)
              (pop-x86-register-if-max)
              (decrement-register))
	    (begin ; have to use cl register for the shift
              (my-display "        push  ebx") (my-newline) ; save ebx
              (my-display "        push  ecx") (my-newline) ; save ecx
              (my-display "        push  ")
                (write-register-minus-two) (my-newline)
              (my-display "        push  ")
                (write-register-minus-one) (my-newline)
              (write-x86-opcode 'X86_SUB) ; reserve stack slot for return shift value
                (my-display "rsp, 4") (my-newline)
              (write-x86-opcode 'X86_MOV)
                (my-display "ecx, [rsp + 8]") (my-newline)
              (write-x86-opcode 'X86_MOV)
                (my-display "ebx, [rsp + 4]") (my-newline)
              (write-binary-opcode target op)
	        (my-display "ebx, cl") (my-newline)
              (write-x86-opcode 'X86_MOV) ; return shifted value
                (my-display "[rsp], ebx") (my-newline)
              (write-x86-opcode 'X86_MOV) ; restore ecx
                (my-display "ecx, [rsp + 12]") (my-newline)
              (write-x86-opcode 'X86_MOV) ; restore ebx
                (my-display "ebx, [rsp + 16]") (my-newline)
              (write-x86-opcode 'X86_MOV) ; move return value to free register
                (write-register-minus-two) (my-display ", [rsp]") (my-newline)
              (write-x86-opcode 'X86_ADD) (my-display "rsp, 20") (my-newline)
              (pop-x86-register-if-max)
              (decrement-register))))
	(begin
          (write-binary-opcode target op)
          (write-register-minus-one)
          (my-display ", ")
          (write-register-minus-two-or-constant immediate-constant)
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (write-register-minus-two)
          (my-display ", ")
          (write-register-minus-one)
          (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))))

(define (numeric-binary-function target op op2)
  (if fast-expression
    (numeric-binary-function-fast target op (immediate-value? op2))
    ; not fast
    (case target
      ((arm)
        (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 "edi, 4")
            (my-newline)
            (write-x86-opcode 'X86_MOV)
            (my-display "eax, [edi]")
            (my-newline)
            (write-x86-opcode 'X86_MOV)
            (my-display "cl, [edi - 4]")
            (my-newline)
            (write-binary-opcode target op)
            (my-display "eax, cl")
            (my-newline)
            (write-x86-opcode 'X86_MOV)
            (my-display "[edi - 4], eax")
            (my-newline))
	  (else
            (write-x86-opcode 'X86_SUB)
              (my-display "edi, 4") (my-newline)
            (write-x86-opcode 'X86_MOV)
              (my-display "eax, [edi]") (my-newline)
            (write-x86-opcode 'X86_MOV)
              (my-display "ebx, [edi - 4]") (my-newline)
            (write-binary-opcode target op)
              (my-display "eax, ebx") (my-newline)
            (write-x86-opcode 'X86_MOV)
              (my-display "[edi - 4], eax") (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)))))

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

(define (get-not-predicate op)
  (case 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)
        (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-one)
      (my-display ", ")
      (write-register-minus-two-or-constant immediate-constant)
      (my-newline)
      (if (not fast-relop)
        (begin
          (write-predicate-set-op-x86 opcode)
	  (write-register-lo-minus-two-x86)
          (my-newline)
	  (write-x86-opcode 'X86_AND)
	  (write-register-minus-two)
	  (my-display ", 255")
          (my-newline)))
      (pop-x86-register-if-max)
      (decrement-register))
    ((riscv)
      (let
        ((lbl1 (gen))
         (lbl2 (gen)))
        (my-display "        b") (write-predicate-op target opcode)
        (my-display " ")
        (write-register-minus-one)
        (my-display ", ")
        (write-register-minus-two)
        (my-display ", ")
        (my-display-label lbl1)
        (my-newline)
        (write-riscv-opcode 'RISCV_LI)
        (write-register-minus-two)
        (my-display ", 0")
        (my-newline)
        (write-riscv-opcode 'RISCV_J)
        (my-display-label lbl2)
        (my-newline)
        (my-display-label lbl1)
        (my-display ":")
        (my-newline)
        (write-riscv-opcode 'RISCV_LI)
        (write-register-minus-two)
        (my-display ", 1")
        (my-newline)
        (my-display-label lbl2)
        (my-display ":")
        (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)
        (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)
          (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 "edi, 4") (my-newline)
        (write-x86-opcode 'X86_MOV)
          (my-display "eax, [edi]") (my-newline)
        (write-x86-opcode 'X86_MOV)
          (my-display "ebx, [edi - 4]") (my-newline)
        (write-x86-opcode 'X86_CMP)
          (my-display "eax, ebx") (my-newline)
        (write-predicate-set-op-x86 op)
          (my-display "al") (my-newline)
        (write-x86-opcode 'X86_AND)
          (my-display "eax, 255") (my-newline)
        (write-x86-opcode 'X86_MOV)
          (my-display "[edi - 4], eax") (my-newline))
      ((riscv)
        (let
          ((lbl1 (gen))
           (lbl2 (gen)))
          (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)))
          (my-newline)
          (if (not fast-relop)
            (begin
              (my-display "        b")
                (write-predicate-op target op)
                (my-display "  s7, s5, ")
                (my-display-label lbl1)
                (my-newline)
              (write-riscv-opcode 'RISCV_LI)
                (my-display "  s1, 0") (my-newline)
              (write-riscv-opcode 'RISCV_J)
                (my-display "     ")
                (my-display-label lbl2)
                (my-newline)
              (my-display-label lbl1)
                (my-display ":") (my-newline)
              (write-riscv-opcode 'RISCV_LI)
                (my-display "  s1, 1") (my-newline)
              (my-display-label lbl2)
                (my-display ":") (my-newline)
              (write-riscv-opcode 'RISCV_SW)
                (my-display "s1, -4(s3)")
                (my-newline))))))))

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

(define (write-riscv-load-number-or-symbol mode numeric-value register-number)
  ; TODO if numeric-value 0 .. 2^12 dont generate upper half
  (if (and (= mode 0) (>= numeric-value -2048) (< numeric-value 2048))
    (begin
      (write-riscv-opcode 'RISCV_ADDI)
        (write-push-register register-number)
        (my-display ", zero, ")
        (my-display numeric-value) (my-newline))
    (begin
      (write-riscv-opcode 'RISCV_LUI)
        (write-push-register register-number)
        (my-display ", %")
        ; upper half word
        (my-display "hi(")
        (if (= mode 0)
          (my-display numeric-value)
          (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 0)
          (my-display numeric-value)
          (if (= mode 1)
            (write-riscv-special-symbol numeric-value)
            (begin
              (my-display-label numeric-value))))
        (my-display ")") (my-newline))))

(define (top-level-begin target one two)
  (case target
    ((arm)
      (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, #")
            (my-display (bitwise-and two 65535)) ; mask out lower half word
	    (my-newline)
          (my-display "        movt   r4, #")
            (my-display
	      (bitwise-and (arithmetic-shift two -16) 65535)) ; mask out upper half word
	    (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 "eax, stack")
      (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "esi, eax")
      (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "ebp, eax")
      (my-newline)
      (write-x86-opcode 'X86_ADD)
      (my-display "eax, ")
        (my-display two)
        (my-display " * 4")
        (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "edi, eax")
      (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))))

(define (function-proc-begin target one two dynamic-link)
  (case target
    ((arm)
      (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 "ecx, ebp")
      (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "edx, edi")
      (my-newline)
      (if (not (= one 0))
        (begin
          (write-x86-opcode 'X86_SUB)
          (my-display "edx, 4 * ")
          (my-display one)
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "ebp, edx")
      (my-newline)
      (if (not (= two 0))
        (begin
          (write-x86-opcode 'X86_ADD)
          (my-display "edi, 4 * ")
          (my-display two)
          (my-newline)))
      (if (not (= dynamic-link 0))
        (begin
          (write-x86-opcode 'X86_ADD)
          (my-display "edx, 4 * ")
          (my-display dynamic-link)
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "[edx], ecx")
      (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, ")
        (my-display (* two 4))
        (my-display " + 4") ; riscv 64 needs an extra 4 bytes to save the 64bits
        (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))))

(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-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-edi)
  (my-display "        push  edi") ; save edi
  (my-newline))

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

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

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

(define (write-inc-x86 offset)
  (my-display "        inc dword [ebp + ") ; TODO use mnemonic
  (my-display (* offset 4))
  (my-display "]")
  (my-newline))

(define (write-dec-x86 offset)
  (my-display "        dec dword [ebp + ") ; TODO use mnemonic
  (my-display (* offset 4))
  (my-display "]")
  (my-newline))

(define (function-end target dynamic-link)
  (case target
    ((arm)
      (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 "edi, ebp")
      (my-newline)
      (write-x86-opcode 'X86_ADD)
      (my-display "edi, 4")
      (my-newline)
      (if (not (= dynamic-link 0))
	(begin
          (write-x86-opcode 'X86_ADD)
          (my-display "ebp, 4 * ")
          (my-display dynamic-link)
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "ebp, [ebp]")
      (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))))

(define (proc-end target dynamic-link)
  (case target
    ((arm)
      (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 "edi, ebp")
      (my-newline)
      (if (not (= dynamic-link 0))
        (begin
          (write-x86-opcode 'X86_ADD)
          (my-display "ebp, 4 * ")
          (my-display dynamic-link)
          (my-newline)))
      (write-x86-opcode 'X86_MOV)
      (my-display "ebp, [ebp]")
      (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))))))

(define (stack-ref target)
  (case target
    ((arm)
      (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)
          (write-register-minus-one)
          (my-display ", [esi + ")
          (write-register-minus-one)
          (my-display " * 4]")
          (my-newline))
        (begin
          (write-x86-opcode 'X86_MOV) (my-display "ebx, edi") (my-newline)
          (write-x86-opcode 'X86_SUB) (my-display "ebx, 4") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "ecx, [ebx]") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "edx, [esi + ecx * 4]")
	    (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "[ebx], edx")
	    (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))))))

(define (stack-ref-n target n)
  (case target
    ((arm)
      (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) (write-register)
                (my-display ", [ebp]") (my-newline))
            (begin
              (write-x86-opcode 'X86_MOV) (write-register)
                (my-display ", [ebp + ") (my-display (* n 4)) (my-display "]")
                (my-newline)))
          (increment-register)
          (push-x86-register-if-max))
        (begin
          (if (= n 0)
	    (begin
              (write-x86-opcode 'X86_MOV) (my-display "eax, [ebp]")
	        (my-newline))
	    (begin
              (write-x86-opcode 'X86_MOV)
              (my-display "eax, [ebp + ")
                (my-display (* n 4)) (my-display "]") (my-newline)))
          (write-x86-opcode 'X86_MOV) (my-display "[edi], eax") (my-newline)
          (write-x86-opcode 'X86_ADD) (my-display "edi, 4") (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))))))))

(define (stack-set target)
  (case target
    ((arm)
      (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)))
; (my-display "@@ ") (my-display instruction-run-count) (my-newline)
        )
    ((x86)
      (if fast-expression
	(begin
          (write-x86-opcode 'X86_MOV)
          (my-display "[esi + ebx * 4], eax")
          (my-newline))
        (begin
          (write-x86-opcode 'X86_SUB) (my-display "edi, 8") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "ecx, [edi]") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "edx, [edi + 4]") (my-newline)
          (write-x86-opcode 'X86_MOV) (my-display "[esi + edx * 4], ecx")
            (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))))))

(define (stack-set-n target n)
  (case target
    ((arm)
      (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 "[ebp], eax")
	      (my-newline))
          (begin
            (write-x86-opcode 'X86_MOV)
              (my-display "[ebp + ") (my-display (* n 4))
	      (my-display "], eax") (my-newline)))
	(begin
          (write-x86-opcode 'X86_SUB)
          (my-display "edi, 4")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "edx, [edi]")
          (my-newline)
          (if (not (= n 0))
            (begin
              (write-x86-opcode 'X86_MOV)
                (my-display "[ebp + 4 * ")
                (my-display n)
                (my-display "], edx")
                (my-newline))
            (begin
              (write-x86-opcode 'X86_MOV)
              (my-display "[ebp], edx")
              (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))))))))

(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)
  (my-display ", $")
  (my-display n1)
  (my-newline)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (my-display ", ")
  (write-push-register 5)
  (my-display ", ror $")
  (my-display n2)
  (my-newline))

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

(define (push-mov-lsl n1 n2)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (my-display ", $")
  (my-display n1)
  (my-newline)
  (write-arm-opcode 'ARM_MOV)
  (write-push-register 5)
  (my-display ", ")
  (write-push-register 5)
  (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)
        (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)
        (my-display ", $1")
	(my-newline))
      (else
        (cond
          ((and (< n 256) (>= n 0))
            (write-arm-opcode 'ARM_MOV)
            (write-push-register 5)
            (my-display ", $")
            (my-display n)
            (my-newline))
          ((and (< n 0) (>= n -255))
            (write-arm-opcode 'ARM_MVN)
            (write-push-register 5)
            (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))
	      (begin
                (my-display "        movw  ")
                (write-push-register 5)
                (my-display ", #")
                (my-display (bitwise-and n 65535)) ; mask out lower half word
		(my-newline)
		(if (> n 65535)
		  (begin
                    (my-display "        movt  ")
                    (write-push-register 5)
                    (my-display ", #")
                    (my-display (bitwise-and (arithmetic-shift n -16) 65535)) ; mask out upper half word
		    (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))
	      (begin
                (my-display "        movw  ")
                (write-push-register 5)
                (my-display ", #")
                (my-display (bitwise-and n 65535)) ; mask out lower half word
		(my-newline)
                (my-display "        movt  ")
                (write-push-register 5)
                (my-display ", #")
                (my-display (bitwise-and (arithmetic-shift n -16) 65535)) ; mask out upper half word
		(my-newline)
	      ))) ; end else
	  ))))
    (if fast-expression
      (increment-register)
      (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)
            (write-push-register n)
            (my-display ", ")
            (my-display n)))
        (my-newline)
        (increment-register)
        (push-x86-register-if-max))
      (begin
        (write-x86-opcode 'X86_MOV)
          (my-display "dword [edi], ") (my-display n) (my-newline)
        (write-x86-opcode 'X86_ADD)
          (my-display "edi, 4") (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))))

(define (div target)
  (case target
    ((arm)
      (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))))

(define (mod target)
  (case target
    ((arm)
      (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))))

(define (abs_ target)
  (case target
    ((arm)
      (let
        ((label (gen)))
        (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)))))

(define (negate target)
  (case target
    ((arm)
      (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 "ecx, edi") (my-newline)
          (write-x86-opcode 'X86_SUB)
            (my-display "ecx, 4") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "eax, [ecx]") (my-newline)
          (write-x86-opcode 'X86_NEG)
            (my-display "eax") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "[ecx], eax") (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))))))

(define (bitnot target)
  (case target
    ((arm)
      (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 "ecx, edi")
          (my-newline)
          (write-x86-opcode 'X86_SUB)
          (my-display "ecx, 4")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "eax, [ecx]")
          (my-newline)
          (write-x86-opcode 'X86_NOT)
          (my-display "eax")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "[ecx], eax")
          (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))))))

(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)
              (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
              (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 "eax, 1")
              (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 "edi, 4")
              (my-newline)
              (write-x86-opcode 'X86_MOV)
              (my-display "eax, [edi]")
              (my-newline)
              (write-x86-opcode 'X86_CMP)
              (my-display "eax, 1")
              (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))))))

(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)
              (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
              (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 "edi, 4")
          (my-newline)
          (write-x86-opcode 'X86_MOV)
          (my-display "eax, [edi]")
          (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))))))

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

(define (not_ target)
  (case target
    ((arm)
      (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)
          (write-register-minus-one)
          (my-display ", 1")
          (my-newline))
	(begin
          (write-x86-opcode 'X86_MOV)
            (my-display "ecx, edi") (my-newline)
          (write-x86-opcode 'X86_SUB)
            (my-display "ecx, 4") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "eax, [ecx]") (my-newline)
          (write-x86-opcode 'X86_NOT)
            (my-display "eax") (my-newline)
          (write-x86-opcode 'X86_AND)
            (my-display "eax, 1") (my-newline)
          (write-x86-opcode 'X86_MOV)
            (my-display "[ecx], eax") (my-newline))))
    ((riscv)
      (let
        ((lbl1 (gen))
         (lbl2 (gen)))
        (if fast-expression
	  (begin
            (write-riscv-opcode 'RISCV_BEQ)
              (write-register-minus-one)
              (my-display ", zero, ")
              (my-display-label lbl1) (my-newline)
            (write-riscv-opcode 'RISCV_LI)
              (write-register-minus-one)
              (my-display ", 0") (my-newline)
            (write-riscv-opcode 'RISCV_J)
              (my-display-label lbl2)
              (my-newline)
            (my-display-label lbl1)
              (my-display ":") (my-newline)
            (write-riscv-opcode 'RISCV_LI)
              (write-register-minus-one)
              (my-display ", 1") (my-newline)
            (my-display-label lbl2)
              (my-display ":") (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_BEQ)
              (my-display "s5, zero, ")
              (my-display-label lbl1) (my-newline)
            (write-riscv-opcode 'RISCV_LI)
              (my-display "s1, 0") (my-newline)
            (write-riscv-opcode 'RISCV_J)
              (my-display-label lbl2)
              (my-newline)
              (my-display-label lbl1)
              (my-display ":") (my-newline)
            (write-riscv-opcode 'RISCV_LI)
              (my-display "s1, 1") (my-newline)
              (my-display-label lbl2)
              (my-display ":") (my-newline)
            (write-riscv-opcode 'RISCV_SW)
              (my-display "s1, (s4)") (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))))

(define (return target)
  (case target
    ((arm)
      (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))))

(define (read-char_ target)
  (case target
    ((arm)
      (let
        ((label1 (gen))
         (label2 (gen)))
        (my-display "        ldr    r0, =eof_reached") (my-newline)
        (my-display "        ldr    r0, [r0]") (my-newline)
        (my-display "        cmp    r0, $0") (my-newline)
        (my-display "        bne    ") (my-display-label label1) (my-newline)
        (my-display "        bl     _read_char") (my-newline)
        (my-display "        b      ") (my-display-label label2) (my-newline)
        (ltorg)
        (my-display-label label1) (my-display ":") (my-newline)
        (my-display "        ldr    r0, =in_ch") (my-newline)
        (my-display "        mvn    r1, $0") (my-newline)
        (my-display "        str    r1, [r0]") (my-newline)
        (my-display-label label2) (my-display ":") (my-newline)
        (my-display "        ldr    r1, =in_ch") (my-newline)
        (my-display "        ldr    r1, [r1]") (my-newline)
        (my-display "        str    r1, [r3], $4") (my-newline)))
    ((x86)
      (write-x86-opcode 'X86_CALL)
      (my-display "_read_char")
      (my-newline)
      (write-x86-opcode 'X86_MOV)
      (my-display "[edi], eax")
      (my-newline)
      (write-x86-opcode 'X86_ADD)
      (my-display "edi, 4")
      (my-newline))
    ((riscv)
      (let
        ((lbl1 (gen))
         (lbl2 (gen)))
        (write-riscv-load-number-or-symbol 1 0 0) ; eof reached
          (write-riscv-opcode 'RISCV_LW)
          (my-display "s0, (s0)") (my-newline)
        (write-riscv-opcode 'RISCV_BNE)
          (my-display "s0, zero, ")
          (my-display-label lbl1) (my-newline)
        (write-riscv-opcode 'RISCV_CALL)
          (my-display "_read_char") (my-newline)
        (write-riscv-opcode 'RISCV_J)
          (my-display-label lbl2) (my-newline)
        (my-display-label lbl1)
          (my-display ":") (my-newline)
        (write-riscv-load-number-or-symbol 1 1 0) ; in_ch
          (write-riscv-opcode 'RISCV_ADDI)
          (my-display "s1, zero, -1") (my-newline)
        (write-riscv-opcode 'RISCV_SW)
          (my-display "s1, (s0)") (my-newline)
        (my-display-label lbl2) (my-display ":")
          (my-newline)
        (write-riscv-load-number-or-symbol 1 1 1) ; in_ch
          (write-riscv-opcode 'RISCV_LW)
          (my-display "s1, (s1)") (my-newline)
        (write-riscv-opcode 'RISCV_SW)
          (my-display "s1, (s3)") (my-newline)
        (write-riscv-opcode 'RISCV_ADDI)
          (my-display "s3, s3, 4") (my-newline)))))

(define (display_ target)
  (case target
    ((arm)
      (my-display "        ldr    r0, [r3, $-4]!") (my-newline)
      (my-display "        bl     print_integer") (my-newline))
    ((x86)
      (write-x86-opcode 'X86_SUB)
        (my-display "edi, 4") (my-newline)
      (write-x86-opcode 'X86_MOV)
        (my-display "eax, [edi]") (my-newline)
      (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))))

(define (newline_ target)
  (case target
    ((arm)
      (my-display "        ldr    r0, =newline") (my-newline)
      (my-display "        bl     my_printf") (my-newline))
    ((x86)
      (write-x86-opcode 'X86_CALL)
      (my-display "my_newline")
      (my-newline))
    ((riscv)
      (write-riscv-opcode 'RISCV_LI)
        (my-display "t0, 10")
        (my-newline)
      (write-riscv-opcode 'RISCV_CALL)
        (my-display "print_character")
        (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))))

(define (write-char_ target)
  (case target
    ((arm)
      (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 "t0, -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))))

(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)))
      (display-brtable-labels target (cdr labels)))))

(define (brtable target labels)
  (case target
    ((arm)
      (let
        ((branch-table-label (gen)))
        (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 "edi, 4") (my-newline)
        (write-x86-opcode 'X86_MOV) (my-display "eax, [edi]") (my-newline)
        (write-x86-opcode 'X86_SHL) (my-display "eax, 4") (my-newline)
        (write-x86-opcode 'X86_ADD) (my-display "eax, .l")
          (my-display branch-table-label) (my-newline)
        (write-x86-opcode 'X86_B) (my-display "rax") ; TODO eax when 32 bit
          (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-load-number-or-symbol 2 branch-table-label 2)
        (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)))))

;;; 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 (emit-write-string s)
  (let
    ((n (string-length s))
     (idx2 0)
     (lst (list 'write-string)))
    (set! lst (cons n lst))
    (do ((i 0 (+ i 1))) ((= i (quotient n 2)))
      (set! lst
        (cons
          (bitwise-or
            (char->integer (string-ref s idx2))
            (arithmetic-shift
              (char->integer (string-ref s (+ idx2 1)))
              8))
          lst))
      (set! idx2 (+ idx2 2)))
 
    (if (= (bitwise-and n 1) 1) ; last odd byte
      (set! lst
        (cons
          (char->integer (string-ref s (- n 1)))
          lst)))

    (reverse lst)))

(define (write-string x)
(set! fast-expression #f) ; force slow
(let
  ((count (car x))
   (chars (cdr x)))
  (let
    ((temp2 0))
    (let loop ()
      (if (< temp2 (- count 2))
	(let
	  ((temp3 (car chars)))
	  (push target (bitwise-and temp3 255))
          (set! instruction-run-count (+ instruction-run-count 1))
          (poolgap)
          (write-char_ target)
	  (push target (bitwise-and (arithmetic-shift temp3 -8) 255))
          (write-char_ target)
	  (set! chars (cdr chars))
	  (set! temp2 (+ temp2 2))
	  (loop))))
    ; process last word separately because of odd even last bytes
    (let
      ((temp3 (car chars)))
      (push target (bitwise-and temp3 255))
      (write-char_ target)
      (if (= (remainder count 2) 0) ; even
	(begin
	  (push target (bitwise-and (arithmetic-shift temp3 -8) 255))
          (write-char_ target))))
    (set! instruction-run-count (+ instruction-run-count 1))
    (poolgap)
    )))

(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 (display-string? x)
  (if (eq? (car x) 'display)
    (string? (cadr x))
    #f))

(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 (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 (eq? target 'riscv)
          (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)))
      ((write-string)
	(if (or (eq? target 'arm) (eq? target 'x86) (eq? target 'riscv))
          (write-string 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))
    ((newline)
      (list 'write-string 1 10))
    ((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))
          (memq (car expr) '(remainder quotient))) #f)
    ((and (eq? target-save 'x86) (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 (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)
    ((eq? (car expr) '+)
      (simplify-add-mul + '+ 0 expr))
    ((and (eq? (car expr) '-) (= (length expr) 3))
      (simplify-sub expr))
    ((eq? (car expr) '*)
      (simplify-add-mul * '* 1 expr))
    ((eq? (car expr) 'bitwise-and)
      (simplify-bitwise bitwise-and 'bitwise-and expr))
    ((eq? (car expr) 'bitwise-or)
      (simplify-bitwise bitwise-or 'bitwise-or expr))
    ((eq? (car expr) 'bitwise-xor)
      (simplify-bitwise bitwise-xor 'bitwise-xor expr))
    ((eq? (car expr) 'shr)
      (simplify-shr expr))
    ((eq? (car expr) 'shl)
      (simplify-shl expr))
    ((eq? (car expr) '=)
      (simplify-generic = 1 0 '= '= expr))
    ((eq? (car expr) '!=)
      (simplify-generic (lambda (x y) (not (= x y))) 1 0 '!= '!= expr))
    ((eq? (car expr) '<)
      (simplify-generic < 1 0 '>= '< expr))
    ((eq? (car expr) '>)
      (simplify-generic > 1 0 '<= '> expr))
    ((eq? (car expr) '<=)
      (simplify-generic <= 1 0 '> '<= expr))
    ((eq? (car expr) '>=)
      (simplify-generic >= 1 0 '< '>= expr)) ; TODO generic -> predicate
    (else
      (cons (simplify-expr (car expr))
            (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
    (let
      ((instruction1 (car instructions)))
      (if (null? (cdr instructions))
        #f
        (let
          ((instruction2 (cadr instructions)))
          (and (equal? instruction1 '(stack-ref-n 0)) ; TODO could work for n!=0
               (equal? instruction2 '(stack-set-n 0))))))))

(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 '()))
  (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)
        (display-instructions (peephole (reverse 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! instructions '())
 ;(if (not (null? immediate-list)) ; debug
 ;  (begin
 ;    (display "* unconsumed ") (display immediate-list) (newline)))
  (set! immediate-list '())
  (display-instruction
    (list 'expr fast-expression max-register-idx fast-relop expr)) ; pseudo instruction
  (set! register-idx 0)
  (set! max-register-idx 0)
  (translate-expr expr)
  (display-instructions
    (peephole (reverse 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)
  (assq name functions))

(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 (translate-functions functions)
  (if (not (null? functions))
    (let
      ((function (car functions)))
      (translate-function function)
      (translate-functions (cdr functions)))))

(define (translate-letrec expr)
  (set! functions (car expr))
  (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)))
    ((display-string? expr)
      (let
        ((s (emit-write-string (cadr expr))))
        (if (eq? target 'vm)
          (log-code-instruction s)
          (if (or (eq? target 'arm) (eq? target 'x86) (eq? target 'riscv))
            (begin
              (display-comment) (my-display s) (my-newline)
              (write-string (cdr s)))))))
    ((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 '())

(define (process-define expr)
  (set! defines (cons expr defines)))

(define (lookup-define symbol)
  (let
    ((found (assq symbol defines)))
    (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)))

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

(set! target target-save)
(if (eq? target 'arm)
  (display-global-constants global-constants))
