(* AU Compilation 2016                  *)
(* DO NOT DISTRIBUTE                    *)


(* LLVM-- to x86 backend skeleton file  *)
(* Based on LLVMLite X86 backend@UPenn  *)




(* ll ir compilation -------------------------------------------------------- *)


signature X86BACKEND =
sig
  val compile_prog: ll.prog -> X86.prog
end


structure X86Backend :> X86BACKEND =
struct


structure S = Symbol

open X86
open ll
open Asm


exception IlegalPointer
exception NotImplemented
exception BackEndFatal

fun CallOwnPrint(s) = ()
fun errorFunc s = (print ("==> ERROR: " ^ s ^ "\n"); raise BackEndFatal)
fun TODO(s) = (print("We hit a TODO. Implement: " ^ s ^ " \n"); raise NotImplemented)



(* Helpers ------------------------------------------------------------------ *)


(* Platform-specific generation of symbols *)

val mangle =
 fn s =>
    (case LocalOS.os of
	      LocalOS.Linux =>   (Symbol.name s)
     |  LocalOS.Darwin => "_" ^ (Symbol.name s))


(* Map ll comparison operations to X86 condition codes *)
fun compile_cnd (c:ll.cnd) : X86.cnd =
  case c of
    ll.Eq  => X86.Eq
  | ll.Ne  => X86.Neq
  | ll.Slt => X86.Lt
  | ll.Sle => X86.Le
  | ll.Sgt => X86.Gt
  | ll.Sge => X86.Ge



(* locals and layout -------------------------------------------------------- *)
(* We call the datastructure that maps each %uid to its stack slot a
   'stack layout'.  A stack layout maps a uid to an X86 operand for
   accessing its contents.  For this compilation strategy, the operand
   is always an offset from rbp (in bytes) that represents a storage slot in
   the stack.
*)

type layout = (ll.uid * X86.operand) list

(* A context contains the global type declarations (needed for getelementptr
   calculations) and a stack layout. *)
type ctxt = { tdecls : (ll.tid * ll.ty) list
            , layout : layout}

(* useful for looking up items in tdecls or layouts *)
fun lookup layout (uid:ll.uid) =
let
  val (_, operand) = (valOf (List.find (fn (y, _) => uid = y) layout))
in
  operand
end handle _ => errorFunc("lookup fail: " ^(Symbol.name uid) ^ " not found")

fun getListElement(list, i) =
  if ((List.length list) <= i) then
    errorFunc("getListElement " ^ Int.toString(i) ^ " called on list of length " ^ Int.toString(List.length list) ^ "\n")
  else List.nth(list, i)


fun getFirstNelementOfList(list, i) =
  if ((List.length list) <= i) then
    errorFunc("getFirstNelementOfList " ^ Int.toString(i) ^ " called on list of length " ^ Int.toString(List.length list) ^ "\n")
  else List.take(list, i)

fun getLastNelements(list, i) =
  if ((List.length list) <= i) then
    errorFunc("getLastNelements " ^ Int.toString(i) ^ " called on list of length " ^ Int.toString(List.length list) ^ "\n")
  else List.drop(list, i)


(* compiling operands  ------------------------------------------------------ *)

(* LLVM IR instructions support several kinds of operands.

   LL local %uids live in stack slots, whereas global ids live at
   global addresses that must be computed from a label.  Constants are
   immediately available, and the operand Null is the 64-bit 0 value.

     NOTE: two important facts about global identifiers:

     (1) You should use (mangle gid) to obtain a string
     suitable for naming a global label on your platform (macOS expects
     "_main" while linux expects "main").

     (2) 64-bit assembly labels are not allowed as immediate operands.
     That is, the X86 code: movq _gid %rax which looks like it should
     put the address denoted by _gid into %rax is not allowed.
     Instead, you need to compute an %rip-relative address using the
     leaq instruction:   leaq _gid(%rip).

   One strategy for compiling instruction operands is to use a
   designated register (or registers) for holding the values being
   manipulated by the LLVM IR instruction. You might find it useful to
   implement the following helper function, whose job is to generate
   the X86 instruction that moves an LLVM operand into a designated
   destination (usually a register).
*)

fun compile_operand (ctxt as {tdecls, layout}) (dest:X86.reg) (oper:ll.operand) : X86.ins =
let
  (* val _ = CallOwnPrint("Called='compile_operand'\n") *)
  val casing = case oper of
     Null         => (Movq, [(Imm (Lit 0))                  , Reg dest]) (*As described in comments null is 64 bit 0 value*)
    |  Gid (gid)  => (Leaq, [Ind3 ((Lbl (mangle gid )), Rip), Reg dest]) (*LEA = load effitice address*)
    | Const(int_o)=> (Movq, [(Imm (Lit int_o))              , Reg dest]) (*Const is an int ready to convert*)
    | Id(uid)     => (Movq, [(lookup layout uid )           , Reg dest]) (*find the id in the lookup*)
in
  casing
end

fun trans_operand (ctxt as {tdecls, layout}) oper : X86.operand =
let
  val _ = CallOwnPrint("Called='trans_operand'\n")
  val casing = case oper of
      Gid (gid)   => TODO("trans_operand= Gid") (*Remember leaq*)
    | Null        => Imm (Lit 0)
    | Const(int_o)=> Imm (Lit int_o)
    | Id(uid)     => lookup layout uid
in
  casing
end

(* compiling call  ---------------------------------------------------------- *)

(* You will probably find it helpful to implement a helper function that
   generates code for the LLVM IR call instruction.

   The code you generate should follow the x64 System V AMD64 ABI
   calling conventions, which places the first six 64-bit (or smaller)
   values in registers and pushes the rest onto the stack.  Note that,
   since all LLVM IR operands are 64-bit values, the first six
   operands will always be placed in registers.  (See the notes about
   compiling fdecl below.)

   [ NOTE: It is the caller's responsibility to clean up arguments
   pushed onto the stack, so you must free the stack space after the
   call returns. ]

   [ NOTE: Don't forget to preserve caller-save registers (only if
   needed). ]
*)

(*Calling conventions on page 136. *)
fun compile_call (uid_opt, ctxt as {tdecls, layout}, ty, oper, tyOperList) =
let
  val _ = CallOwnPrint("Called='compile_insn.ll.Call.compile_call'\n")
  val gid = case oper of
      Gid x => x
    | _     => errorFunc("compile_call gid not found.")

  (* val _ = CallOwnPrint("GID: " ^ (S.name gid) ^ "\n") *)
  val funName = mangle gid
  val numberOfArguments = ref 0
  val tyOperListFirst6 =  if (List.length tyOperList < 6) then
                            tyOperList
                          else
                            getFirstNelementOfList(tyOperList, 6)

  (*Handle the first six arguments to function call *)
  val first6insns =
    map (fn (tyArg, operArg) =>
      let
          val target = case (!numberOfArguments) of
                      0 => Rdi
                    | 1 => Rsi
                    | 2 => Rdx
                    | 3 => Rcx
                    | 4 => R08
                    | 5 => R09
                    | _ => errorFunc("compile_call: we fucked up found to many arguments. Errorcode 4")
          val insn_src = compile_operand ctxt target operArg
          val temp = !numberOfArguments
      in
        (numberOfArguments := temp +1; [insn_src])
      end
    ) tyOperListFirst6

  (*Remove the first six since we have allready done those... *)
  val removeFirstSix =  if (List.length tyOperList > 6) then
                          getLastNelements(tyOperList, 6)
                        else
                          []

  (*Get the last argumetns to function *)
  val lastInsns =
    map (fn (tyArg, operArg) =>
      let
          val insn_src = compile_operand ctxt R11 operArg
          val push_insn = (Pushq, [Reg R11])
          (* val _ = CallOwnPrint("-------> " ^ (ll.string_of_ty tyArg) ^ ":" ^(ll.string_of_operand operArg) ^ "\n") *)
          (* val source = trans_operand ctxt operArg  *)
          (* val push_insn = (Pushq, [source]) kan evt. bruges når Mark har løst den.*)
      in
        [insn_src, push_insn]
      end
      (*Reverse the list so the order they get on the stack is correct. *)
    ) (List.rev removeFirstSix)


  val allInsns = (List.concat first6insns) @ (List.concat lastInsns)

  (*call the function*)
  val call_insn = (Callq, [(Imm (Lbl funName))])

  (*Get how many arguments we pushed to the stack*)
  val offset = (List.length removeFirstSix ) * 8

  (* val _ = CallOwnPrint("-------> Offset: " ^ (Int.toString offset) ^ "\n") *)

  (* Reset stackpointer *)
  val resetSP = (Addq, [ Asm.~$ offset, Reg(Rsp) ] )
  val res = case uid_opt of
      SOME x =>
        let
          val target = lookup layout x
          val save_res_insn = (Movq, [(Reg Rax), target])
        in
          allInsns @ [call_insn, resetSP, save_res_insn]
        end
    | _   =>
        allInsns @ [call_insn, resetSP]

in
  res
end














(* Function size_ty maps an LLVMlite type to a size in bytes.
   (needed for getelementptr)

   - the size of a struct is the sum of the sizes of each component
   - the size of an array of t's with n elements is n * the size of t
   - all pointers, I1, and I64 are 8 bytes
   - the size of a named type is the size of its definition

   - Void, i8, and functions have undefined sizes according to LLVMlite
     your function should simply return 0
*)

fun size_ty (tdecls, ty) : int =
  case ty of
   ll.Void              => 0
  | ll.I1               => 8
  | ll.I8               => 0
  | ll.I64              => 8
  | ll.Ptr ty           => 8
  | ll.Struct tys       => 8*(List.length tys)
  | ll.Array (size, ty) => (size_ty(tdecls, ty)) * size
  | ll.Fun fty          => 0
  | ll.Namedt tid       => size_ty(tdecls, (lookup tdecls tid))


fun get_namedt(tdecls, typeid:ll.tid) =
  let
    val type_opt = List.find (fn (tid, ty) => tid=typeid) tdecls
    val _ = if not (isSome type_opt) then errorFunc("get_namdt failed. tid not found") else ()
  in
    #2 (valOf type_opt)
  end



(* compiling getelementptr (gep)  ------------------------------------------- *)

(* The getelementptr instruction computes an address by indexing into
   a datastructure, following a path of offsets.  It computes the
   address based on the size of the data, which is dictated by the
   data's type.

   To compile getelmentptr, you must generate x86 code that performs
   the appropriate arithemetic calculations.
*)


(* Function compile_gep generates code that computes a pointer value.

   1. op must be of pointer type: t*

   2. the value of op is the base address of the calculation

   3. the first index in the path is treated as the index into an array
     of elements of type t located at the base address

   4. subsequent indices are interpreted according to the type t:

     - if t is a struct, the index must be a constant n and it
       picks out the n'th element of the struct. [ NOTE: the offset
       within the struct of the n'th element is determined by the
       sizes of the types of the previous elements ]

     - if t is an array, the index can be any operand, and its
       value determines the offset within the array.

     - if t is any other type, the path is invalid

   5. if the index is valid, the remainder of the path is computed as
      in (4), but relative to the type of the sub-element picked out
      by the path so far
*)

fun compile_gep (ctxt as {tdecls, layout} :ctxt)
                (oper : ll.ty * ll.operand)
                ([]: ll.operand list) : X86.ins list = errorFunc("Gep called with empty path.")
| compile_gep (ctxt as {tdecls, layout} :ctxt)
                (oper : ll.ty * ll.operand)
                (paths: ll.operand list) : X86.ins list =
let
  val _ = CallOwnPrint(".compile_gep'\n")
  val base_ty = (#1 oper)

  val base:X86.operand = case (#2 oper) of
                            Id uid => lookup layout uid
                          | Null => ~$ 0
                          | _ => errorFunc("Gep operand not an Id: " ^ (ll.string_of_operand (#2 oper)))

  (* Init result register to base *)
  val initbase_insn = (Movq, [base, Reg R11])

  (* Store param in R11 *)
  val a = compile_operand ctxt Rax (hd paths)

  (* Store size in R10 *)
  val elem_size = size_ty(tdecls, base_ty)
  val b = (Movq, [Imm (Lit elem_size), Reg R10])

  (* compute offset *)
  (* %rax = %rax * %r10 *)
  val c = (Imulq, [Reg R10])

  (* add offset *)
  (* %r11 =  %r11 - %rax *)
  val d = (Addq, [Reg Rax, Reg R11])


  (* Compute pointer, stores result in %r11 *)
  fun gep (ty_old, []) = []
  |   gep (ty_old, path::paths) =
      let
          (* val _ = CallOwnPrint("gep recursion on " ^ (ll.string_of_ty(ty_old)) ^ " with oper: " ^(ll.string_of_operand path) ^ "\n") *)
      in
        case ty_old of
          ll.Struct tys =>
            let
              (* Operand is always const in struct gep *)
              val num : int =
                case path of ll.Const num => num
                | _ => errorFunc("Gep path on struct must be ll.Const")

              val ty = getListElement(tys, num)
              val offset = 8 * num  (* All values have size 8 *)

              (* add offset from result register r11 *)
              val a = (Addq, [Imm (Lit offset), Reg R11])

              val rest = (gep(ty, paths))
            in
              a::rest
            end
        | ll.Ptr ty =>
            let
              (* Store param in R11 *)
              val a = compile_operand ctxt Rax path

              (* Store size in R10 *)
              val elem_size = size_ty(tdecls, ty_old)
              val b = (Movq, [Imm (Lit elem_size), Reg R10])

              (* compute offset *)
              (* %rax = %rax * %r10 *)
              val c = (Imulq, [Reg R10])

              (* add offset *)
              (* %r11 =  %r11 - %rax *)
              val d = (Addq, [Reg Rax, Reg R11])

              val rest = (gep(ty, paths))
            in
              a::b::c::d::rest
            end
        | ll.Namedt tid => gep(get_namedt(tdecls, tid), path::paths)
        | ll.Array (size, ty)=> TODO("gep array not implemented, and not used in our LLVM implementation\n")
        | _ => errorFunc("Illegal gep type in path. Type = " ^ (ll.string_of_ty(ty_old)))
      end

in
  (* Stores ptr result in %r11 *)
  initbase_insn::a::b::c::d::gep(base_ty, tl paths)
end




(* compiling instructions  -------------------------------------------------- *)

(* The result of compiling a single LLVM instruction might be many x86
   instructions.  We have not determined the structure of this code
   for you. Some of the instructions require only a couple assembly
   instructions, while others require more.  We have suggested that
   you need at least compile_operand, compile_call, and compile_gep
   helpers; you may introduce more as you see fit.

   Here are a few notes:

   - Icmp:  the Set instruction may be of use.  Depending on how you
     compile Cbr, you may want to ensure that the value produced by
     Icmp is exactly 0 or 1.

   - Load & Store: these need to dereference the pointers. Const and
     Null operands aren't valid pointers.  Don't forget to mangle
     the global identifier.

   - Alloca: needs to return a pointer into the stack

   - Bitcast, Ptrtoint, Zext: do nothing interesting at the assembly level
*)

fun lookup_uid_opt(uid_opt,layout ,s) = case uid_opt of
        SOME x  => (lookup layout x )
        | _     => errorFunc("Could not find 'uid_opt' in " ^ s ^ " errorcode 3")



(* Should dereference?, as in (%reg), not %reg, as we do now??? *)
fun deref_ptr (ctxt as {tdecls, layout}) (oper:ll.operand) : X86.operand =
let
  val _ = CallOwnPrint("Called='trans_operand'\n")
  val casing = case oper of
      Gid (gid)   => TODO("trans_operand= Gid") (*Remember leaq*)
    | Null        => raise IlegalPointer
    | Const(int_o)=> raise IlegalPointer
    | Id(uid)     => (lookup layout uid)
in
  casing
end

fun compile_insn (ctxt as {tdecls, layout}) (uid_opt, insn:ll.insn) : X86.ins list =
  case insn of
    ll.Binop (bop, ty, oper1, oper2) =>
    let
        val _ = CallOwnPrint("Called='compile_insn.ll.Binop'\n")

        (*Find et register til oper1 og oper2*)
        val oper1_insn = compile_operand ctxt Rax oper1 (*dest. register Should be Rax*)
        val oper2_insn = compile_operand ctxt R10 oper2

        (* Where should be put the result on the stack *)
        val destBop = lookup_uid_opt(uid_opt, layout, "binop uid_opt")

        val binop_insns = case bop of
              Add   => [(Addq  , [Reg(R10), Reg(Rax)])]
            | Sub   => [(Subq  , [Reg(R10), Reg(Rax)])]
            | Mul   => [(Imulq , [Reg(R10)])]
            | SDiv  => [(Cqto  , []), (Idivq, [Reg(R10)])]
            | Shl   => [(Shlq  , [Reg(R10), Reg(Rax)])]
            | Lshr  => [(Shrq  , [Reg(R10), Reg(Rax)])]
            | Ashr  => [(Sarq  , [Reg(R10), Reg(Rax)])]
            | And   => [(Andq  , [Reg(R10), Reg(Rax)])]
            | Or    => [(Orq   , [Reg(R10), Reg(Rax)])]
            | Xor   => [(Xorq  , [Reg(R10), Reg(Rax)])]

        val c  = (Movq, [Reg(Rax), destBop])
    in
      (* TODO("Binop") *)
      oper1_insn::oper2_insn::(binop_insns @ [c])
    end
  | ll.Alloca ty =>
    let
      val _ = CallOwnPrint("Called='compile_insn.ll.Alloca'\n")

      val alloc_oper = lookup_uid_opt(uid_opt, layout, "binop uid_opt")
      val byte_size = size_ty(tdecls, ty)

      val grow_stack_insn = (Subq, [Asm.~$ byte_size, Asm.~% Rsp]) (* Alloc on heap *)
      val store_ptr_insn = (Movq, [Reg Rsp, alloc_oper])
    in
      [grow_stack_insn, store_ptr_insn]
    end

  | ll.Load (ty, oper) =>
    let
      val _ = CallOwnPrint("Called='compile_insn.ll.Load'\n")
      val oper_insn = compile_operand ctxt Rax oper
      val deref_insn = (Movq, [Ind2 Rax, Reg Rax])  (* We dereference rax to load value into rax again*)
      val dest_oper = lookup layout (valOf uid_opt)
      val load_insn = (Movq, [Reg Rax, dest_oper])
    in
      [oper_insn, deref_insn, load_insn]
    end

  | ll.Store (ty, val_oper, dest_oper) =>
    let
      val _ = CallOwnPrint("Called='compile_insn.ll.Store'\n")
      val oper_insn = compile_operand ctxt Rax val_oper
      (* Move pointer into register, so we can dereference with Ind2 *)
      val move_ptr_insn = compile_operand ctxt R10 dest_oper

      (* Move the value from the compiled lloperand, into the dereferenced destination *)
      val move_insn = (Movq, [Reg Rax, Ind2 R10])

    in
      [oper_insn, move_ptr_insn, move_insn]
    end

  | ll.Icmp (cnd, ty, oper1, oper2) =>
      let
        val _ = CallOwnPrint("Called='compile_insn.ll.Icmp'\n")

        (* Where should be put the result on the stack *)
        val dest = lookup_uid_opt(uid_opt, layout ,"cmp uid_opt")

        val oper1_insn = compile_operand ctxt Rax oper1 (*dest. register Should be Rax*)
        val oper2_insn = compile_operand ctxt R11 oper2
        val compare_insn = (Cmpq, [Reg(R11), Reg(Rax)])   (* compares and sets flags *)

        val clear_insn = (Movq, [~$ 0, dest])
        val set_insn = (Set (compile_cnd cnd), [dest])
      in
        [oper1_insn, oper2_insn, compare_insn, clear_insn, set_insn]
      end
  | ll.Gep (ty, oper, operList) =>
      let
        val _ = CallOwnPrint("Called='compile_insn.ll.Gep")

        (* Where should be put the result on the stack *)
        val dest = lookup_uid_opt(uid_opt, layout ,"ll.Gep")
        val insns:X86.ins list = compile_gep ctxt (ty, oper) operList
        val endInsn = (Movq, [(Reg R11), dest])
      in
        insns @ [endInsn]
      end
  | ll.Call(ty, oper, tyOperList) => compile_call(uid_opt, ctxt, ty, oper, tyOperList)
  | ll.Bitcast (ty1, oper, ty2)  => handlePtrtoIntZextAndBitcast(uid_opt, ctxt, oper, layout, "Bitcast")
  | ll.Zext (ty1, oper, ty2)     => handlePtrtoIntZextAndBitcast(uid_opt, ctxt, oper, layout, "Zext")
  | ll.Ptrtoint (ty1, oper, ty2) => handlePtrtoIntZextAndBitcast(uid_opt, ctxt, oper, layout, "Ptrtoint")


and handlePtrtoIntZextAndBitcast(uid_opt, ctxt, oper ,layout, s) =
let
  val _ = CallOwnPrint("Called='compile_insn.ll."^ s ^"'\n")

  (* Where should be put the result on the stack *)
  val target = lookup_uid_opt(uid_opt, layout ,s)
  val src = compile_operand ctxt R11 oper
  val insn_move = (Movq, [Reg R11, target])
in
  [src, insn_move ]
end

(* compiling terminators  --------------------------------------------------- *)

(* Compile block terminators is not too difficult:

   - Ret should properly exit the function: freeing stack space,
     restoring the value of %rbp, and putting the return value (if
     any) in %rax.

   - Br should jump

   - Cbr branch should treat its operand as a boolean conditional
*)

fun compile_terminator ctxt terminator =
let
  val _ = CallOwnPrint("Called='compile_terminator'\n")

  (**************
  (* Block terminators *)
  datatype terminator
    = Ret of ty * operand option (* ret i64 %s                     *)
    | Br of lbl                  (* br label %lbl                  *)
    | Cbr of operand * lbl * lbl (* br i1 %s, label %l1, label %l2 *)
  *)
  val res =
    case terminator of
      ll.Ret (ty, oper_option) =>
      let
        (*
        *)
        val _ = CallOwnPrint("Called='compile_terminator.ll.Ret'\n")

        (* If we should return a value,  *)
        val optional_move_insn =
          if isSome oper_option then
            [compile_operand ctxt Rax (valOf oper_option)]
          else
            [(Movq, [~$ 0, ~% Rax])]

        val a = (Movq, [~% Rbp, ~% Rsp])  (* Reset %rsp to the value stored in %rbp *)
        val b = (Popq, [~% Rbp])              (* Pop old base pointer from stack into %rbp*)
        val c = (Retq, [])                        (* Return instruction *)
      in
        optional_move_insn @ [a,b,c]
      end

    | ll.Br  (lbl)             => [(X86.Jmp, [X86.Imm (X86.Lbl (S.name lbl))])] (* Jump to label *)
    | ll.Cbr (oper, lbl1, lbl2) =>
    let
      val _ = CallOwnPrint("Called='compile_terminator.ll.Cbr'\n")
      val oper_insn = compile_operand ctxt Rax oper
      val cmp_insn = (Cmpq, [ ~$ 0, ~% Rax])

      val jmp1 = (J(X86.Neq) , [~$$ (S.name lbl1)])
      val jmp2 = (Jmp, [~$$ (S.name lbl2)])
    in
      [oper_insn, cmp_insn, jmp1, jmp2]
    end
in
  res
end


(* compiling blocks --------------------------------------------------------- *)

(* We have left this helper function here for you to complete. *)
fun compile_block ctxt (block as {insns, terminator}) : X86.ins list =
let
  val _ = CallOwnPrint("Called='compile_block'\n")

  val block_insns = map (fn (uid_opt, insn) => compile_insn ctxt (uid_opt, insn)) insns
  val terminator_insn = compile_terminator ctxt terminator

in
  ((List.concat block_insns) @ terminator_insn)
  (* TODO("compile_block") *)
end

fun compile_lbl_block (lbl:ll.lbl) (ctxt:ctxt) (block:ll.block) : X86.elem =
  X86.Asm.text (S.name lbl) (compile_block ctxt block)


(* compile_fdecl ------------------------------------------------------------ *)


(* This helper function computes the location of the nth incoming
   function argument: either in a register or relative to %rbp,
   according to the calling conventions.  You might find it useful for
   compile_fdecl.

   [ NOTE: the first six arguments are numbered 0 .. 5 ]
*)

fun arg_loc (n : int) : X86.operand =
  case n of
      0   => ~% Rdi
    | 1   => ~% Rsi
    | 2   => ~% Rdx
    | 3   => ~% Rcx
    | 4   => ~% R08
    | 5   => ~% R09
    | _ => errorFunc("arg_loc called with number: " ^ (Int.toString n))

(* The code for the entry-point of a function must do several things:

   - since our simple compiler maps local %uids to stack slots,
     compiling the control-flow-graph body of an fdecl requires us to
     compute the layout (see the discussion of locals and layout)

   - the function code should also comply with the calling
     conventions, typically by moving arguments out of the parameter
     registers (or stack slots) into local storage space.  For our
     simple compilation strategy, that local storage space should be
     in the stack. (So the function parameters can also be accounted
     for in the layout.)

   - the function entry code should allocate the stack storage needed
     to hold all of the local stack slots.
*)
(*
  tdecls = (tid * ty) list
*)


fun compile_fdecl tdecls (name:ll.gid) ({fty, param=params, cfg as (block, labled_blocks)}:ll.fdecl) : X86.prog =
let
  val _ = CallOwnPrint("\n"^(S.name name)^":\nCalled='compile_fdecl' with: \n")
  (*
  val head = hd tdecls  (*tiger main locals struct*)
  val (tid, ty) = head
  val _ = CallOwnPrint("tid: " ^ (S.name tid)^ "\n") *)

  fun getUidOptFromCfg ((block, lbl_blocks):ll.cfg) : (ll.uid option) list =
    let
      (* Extract uid*insns from lbl_block, and concat to one (uid*insn)list *)
      val lbl_block_insns_list = map (fn(lbl, block) => (#insns block)) lbl_blocks  (* lblblock => insns *)
      val uidOption_insn_list = List.concat((#insns block)::lbl_block_insns_list)                 (* Make long list of insns *)
      val uidOption_list = map (fn (uid_opt, _) => uid_opt) uidOption_insn_list
    in
      uidOption_list
    end

  (*create the layout *)
  fun createLayout (insns) =
    let
        val result = foldl (fn (uid_option, layout) =>
          case uid_option
          of NONE => layout
          | SOME uid =>
            let
                val length = List.length layout
                val entry = (uid, Ind3 (Lit (~8*(length + 1)), Rbp ))
                (* val _ = CallOwnPrint((Int.toString length) ^" " ^ (S.name uid) ^" \n" ) *)
            in
                entry::layout
            end
        ) [] insns
    in
      result
    end


  (* params are uids, we make them uid options to fit. *)
  val params_uidOption_list = map (fn uid => SOME uid) params

  val bodyUidOption_list = getUidOptFromCfg(block, labled_blocks)
  val uidOption_list = params_uidOption_list @ bodyUidOption_list
  val layout = createLayout(uidOption_list)

  (* Create the instructions that stores the arguments on the stack *)
  fun store_arg(i):X86.ins list =
    let
      val param:ll.uid = getListElement(params, i)
      val dest = (lookup layout param)

      val insns =
        if i < 6 then
          (*First*)
          [(Movq, [arg_loc i, dest])]
        else
          (*Rest*)
          (* Remaining params will be on stack above Rbp after the prologue *)
          [(Movq, [Ind3(Lit(16+8*(i-6)), Rbp), ~% Rax]),
          (Movq, [~% Rax, dest])]
    in
      insns
    end

  (* Function prologue *)
  val a = (Pushq, [Reg Rbp])
  val b = (Movq, [Reg Rsp, Reg Rbp])
  val c = (Subq, [Asm.~$ (8*List.length layout), Reg Rsp])

  val store_args_insns_list = List.tabulate(List.length params, store_arg)
  val store_args_insns = List.concat store_args_insns_list
  val prologue = a::b::c::store_args_insns

  val ctxt: ctxt = {tdecls = tdecls, layout = layout}

  val firstInstructions : X86.ins list = compile_block ctxt block
  val firstElement : elem = Asm.gtext (mangle name) (prologue @ firstInstructions)  (* Prepend calling conventions *)

  val restElements = map (fn (lbl, block_arg) => compile_lbl_block lbl ctxt block_arg) labled_blocks
  (* val _ = CallOwnPrint("Restelements.length=" ^ (Int.toString(List.length(restElements)) ^ "\n")) *)
in
  firstElement::restElements  (* {lbl, global:bool, asm}list *)
end

(*
  val uid = S.symbol "uid_anders_test"
  val layoutP:layout = [(uid, Imm (Lbl "====tester===="))] (* Get from cfg*)
  *)

  (*
  val lengthParams = List.length params
  (*create the initial layout *)
  fun createLayout (block, blocks) =
    let
      fun visit {insns, terminator} layout =
        foldl (fn ((uid_option, _), lay_out) =>
          case uid_option
          of SOME uid =>
            let
                val length = List.length lay_out
                val entry = (uid, Ind3 (Lit (~8*(length + lengthParams + 1  )), Rbp ))
                val _ = CallOwnPrint((Int.toString length) ^" " ^ (S.name uid) ^" \n" )
            in
                entry :: lay_out
            end
          | NONE => lay_out
        ) layout insns

      val init_layout = visit block []
      val result = foldl (fn ((_, blk), layout_foldl) => visit blk layout_foldl) init_layout labled_blocks
    in
      result
    end
  *)

(* compile_gdecl ------------------------------------------------------------ *)

(* Compile a global value into an X86 global data declaration and map
   a global uid to its associated X86 label.
   Returns asm
*)

fun compile_ginit ll.GNull        = [X86.Quad (X86.Lit 0)]
  | compile_ginit (ll.GGid gid)   = [X86.Quad (X86.Lbl (mangle gid))]
  | compile_ginit (ll.GInt c)     = [X86.Quad (X86.Lit c)]
  | compile_ginit (ll.GString s)  = [X86.Asciz s] (* Asciz = string *)
  | compile_ginit (ll.GArray gs)  = List.concat (List.map compile_gdecl gs)
  | compile_ginit (ll.GStruct gs) = List.concat (List.map compile_gdecl gs)

and compile_gdecl (llty, ginit) = compile_ginit ginit

(* compile_prog ------------------------------------------------------------- *)

fun compile_prog ({tdecls, gdecls, fdecls}:ll.prog) : X86.prog =
let
  fun g (gid, gdecl) = X86.Asm.data (mangle gid) (compile_gdecl gdecl)  (* Translate a global to a {lbl:S.symbol, global:bool, asm:asm} *)
  fun f (gid_name, fdecl) = compile_fdecl tdecls gid_name fdecl             (* Translate a function to a {same...} *)
in
   (List.map g gdecls) @ (List.concat (List.map f fdecls))   (* program returns elem list AKA {lbl, bool. asm} *)
end
handle _ => errorFunc("x86 crashed\n")

end (* structure X86Backend *)



(* TO PRINT THE BASTARD


val a = Parse.parse "../testcases/test55.tig";
val b = Semant.transProg a;
val c = AugmentOffset.offsetAugmentProg b;
val d = LLCodegen.codegen_prog c;
val e = X86Backend.compile_prog d;


print:
X86Backend.compile_prog (LLCodegen.codegen_prog(AugmentOffset.offsetAugmentProg(Semant.transProg(Parse.parse "../testcases/test55.tig"))));
X86.string_of_prog (X86Backend.compile_prog Example.prog);


To use with gdb

disassemble tigermain
break *tigermain+21 (or otherthing)
info registers


To use with lldb

lldb ./out/test55.bin
disassemble --name tigermain
breakpoint set --name tigermain
run
register read
step
register read r11
register read/d r11
*)