;; BF x86m Assembly Emitter
;; Jon Simons (simonsj at ccs dot neu dot edu)
;; April, 2008
;; -------------------------------------------------------------------------
;; This module emits x86 MASM Assembly for the BF IR.  The emitted code
;; uses DOS syscalls, and will be limited by a 16-bit segmented linker to
;; code segments less than 64kb.
;;
;;   A 30000 byte space is reserved in the data segment for use as the
;;   the BF "memory".
;;
;;   Registers are used as follows:
;;
;;     DS is pointed to the BF memory
;;
;;     DI is used to index into DS, as "the pointer"
;;
;;     CL, CX are used for comparisons for loops
;;
;;     AH, AL, DL are use for syscall arguments and return values
;;
;;     AL, BL are used for multiplications
;;
;;     BX is used only at initialization for setting DS
;;
;;   Emitted code was tested using Microsoft Macro Assembler version
;;   6.14.8444 for assembling, and the Microsoft Segmented Executable
;;   Linker version 5.60.339 for linking as a standalone program.
;;
;;   The assembler is available from:
;;     http://www.masm32.com/masmdl.htm
;;
;;   The segmented linker (not included with the masm32 distribution)
;;   is available here:
;;     http://win32assembly.online.fr/download.html
;;     
;;   This module emits code which is completely oblivious to any integer
;;   wrapping issues.
;; -------------------------------------------------------------------------
(module bf-emit-x86m mzscheme
  
  (provide emit)
  
  ;; For AST structs
  (require "../bf-ast-to-ir.scm")
  ;; Emit Utils
  (require "bf-emit-util.scm")
  
  (require scheme/list)
  
  ;; emit : (list of EXPRs) -> string
  (define (emit AST)
    (string-append (emit-prologue)
                   (emit-program AST)
                   (emit-epilogue)))
  
  ;; emit-prologue : -> string
  (define (emit-prologue)
    (string-append ".model HUGE~%"
                   ".386~%"
                   "~%"
                   ".stack 0~%"
                   "~%"
                   ".data~%"
                   "BFmem db 30000 dup(0)~%"
                   "~%"
                   ".code~%"
                   "main proc~%"
                   "  mov BX, @data~%"
                   "  mov DS, BX~%"
                   "  mov DI, offset BFmem~%"
                   "~%"))
  
  ;; emit-epilogue : -> string
  (define (emit-epilogue)
    (string-append "~%"
                   "  mov AX, 4C00h~%"
                   "  int 21h~%"
                   "~%"
                   "main endp~%"
                   "end main"))
  
  ;; emit-program : (list of EXPRs) -> string
  (define (emit-program AST)
    (apply string-append (emit-exprs AST #f 2 ())))
  
  ;; Emits a list of strings which correspond to the given
  ;; list of EXPRs, using the given indentation level.
  ;;
  ;; The argument "mult-mode" should be #f for normal emitting,
  ;; and #t for multiplication emitting.
  ;;
  ;; emit-exprs : (list of EXPRs) boolean number (list of strings)
  ;;              -> (list of strings)
  (define (emit-exprs lst mult-mode indent acc)
    ;; Here emit is a helper for padding and formatting
    ;; strings to be emitted
    (let ((emit  (case-lambda
                   (()   (error "emitting nothing?"))
                   ((x)  (pad x indent))
                   (args (pad (apply format args) indent)))))
      (if (null? lst)
          (reverse acc)
          (let* ((e   (car lst))
                 (ptr (EXPR-ptr e))
                 (N   (EXPR-N   e))
                 (str (case (EXPR-type e)
                        ((inc) (if mult-mode
                                   (string-append
                                    (emit "xor AX, AX~%")
                                    (emit "mov AL, ~v~%" N)
                                    (emit "mul BL~%")
                                    (emit "add byte ptr [DI + ~v], AL~%" ptr))
                                   (emit "add byte ptr [DI + ~v], ~v~%"
                                         ptr
                                         N)))
                        ((dec) (if mult-mode
                                   (string-append
                                    (emit "xor AX, AX~%")
                                    (emit "mov AL, ~v~%" N)
                                    (emit "mul BL~%")
                                    (emit "sub byte ptr [DI + ~v], AL~%" ptr))
                                   (emit "sub byte ptr [DI + ~v], ~v~%"
                                         ptr
                                         N)))
                        ((lt)   (emit "sub DI, ~v~%" N))
                        ((rt)   (emit "add DI, ~v~%" N))
                        ((out)  (string-append
                                 (emit "mov AH, 2~%")
                                 (emit "mov DL, [DI + ~v]~%" ptr)
                                 (emit "int 21h~%")))
                        ((in)   (string-append
                                 (emit "mov AH, 1~%")
                                 (emit "int 21h~%")
                                 (emit "mov [DI + ~v], AL~%" ptr)))
                        ((loop)  (let* ((loop-tmp (gen-loop))
                                        (start    (GENLOOP-start loop-tmp))
                                        (end      (GENLOOP-end   loop-tmp)))
                                   (string-append
                                    (format "~a:~%" start)
                                    (emit "xor CX, CX~%")
                                    (emit "cmp CL, [DI + ~v]~%" ptr)
                                    (emit "jz ~a~%" end)
                                    (apply string-append
                                           (emit-exprs (EXPR-exprs e)
                                                       #f
                                                       indent
                                                       ()))
                                    (emit "jmp ~a~%" start)
                                    (format "~a:~%" end))))
                        ((mul)  (let ((skip-label (mul-skip)))
                                  (string-append
                                   (emit "xor CX, CX~%")
                                   (emit "cmp CL, [DI + ~v]~%" ptr)
                                   (emit "jz ~a~%" skip-label)
                                   (emit "mov BL, byte ptr [DI + ~v]~%"
                                         ptr)
                                   (apply string-append
                                          (emit-exprs (EXPR-exprs e)
                                                      #t
                                                      indent
                                                      ()))
                                   (format "~a:~%" skip-label))))
                        ((zero) (emit "shr byte ptr [DI + ~v], 8~%" ptr))
                        (else  (error "unknown token, can't emit")))))
            (emit-exprs (cdr lst) mult-mode indent (cons str acc))))))
  
  )