open SparcAsm

(*************************************************************************)
(* stack set *)
let stackset = ref S.empty
let stackmap = ref []

(*************************************************************************)
(* prints message intended tb times*)
let rec wr tb msg =
	if tb > 0
		then (Format.print_string "\t"; (wr (tb-1) msg))
		else (Format.print_string msg)

(*************************************************************************)
(* write line *)
let wrl tb msg = wr tb (msg ^ "\n")

(*************************************************************************)
(* int to string *)
let itos x = Format.sprintf "%d" x

(*************************************************************************)
(* id_or_imm to string *)
let idtos = function
	| V(x) -> x
	| C(i) -> Format.sprintf "%d" i

(*************************************************************************)
(* not implemented warring *) 
let niw s = wrl 1 ("; NOT IMPLEMENTED !!! : " ^ s)

(*************************************************************************)
(* where to put result - return value / some other value *)
type dest = Tail | NonTail of Id.t

(*************************************************************************)
(* emiting expression *)
let rec printExpression = function
	| dest, Ans(exp) -> printCommand (dest, exp)
	| dest, Let((x, t), exp, e) ->
		printCommand (NonTail(x), exp);
		printExpression (dest, e)
	| _, Forget _ -> assert false

(*************************************************************************)
and printCommand = function

	(* basic NonTail operations *)
	| NonTail(_), Nop -> ()
	| NonTail(x), Set(i) -> wrl 1 ("MOV\t" ^ x ^ ",\t" ^ (itos i))
	| NonTail(x), SetL(Id.L(y)) -> niw "SetL"
	| NonTail(x), Mov(y) when x = y -> ()
	| NonTail(x), Mov(y) -> wrl 1 ("MOV\t" ^ x ^ ",\t" ^ y)
	| NonTail(x), Neg(y) -> printCommand (NonTail(x), Mov(y)); wrl 1 ("NEG\t" ^ x)
	| NonTail(x), Add(y, z) -> printCommand (NonTail(x), Mov(y)); wrl 1 ("ADD\t" ^ x ^ ",\t" ^ (idtos z))
	| NonTail(x), Sub(y, z) -> printCommand (NonTail(x), Mov(y)); wrl 1 ("SUB\t" ^ x ^ ",\t" ^ (idtos z))
	| NonTail(x), SLL(y, z) -> printCommand (NonTail(x), Mov(y)); wrl 1 ("SHL\t" ^ x ^ ",\t" ^ (idtos z))
	| NonTail(x), Ld(y, z) -> wrl 1 ("MOV\t" ^ x ^ ",\t" ^ "[" ^ y ^ " + " ^ (idtos z) ^ "]")
	| NonTail(_), St(x, y, z) -> wrl 1 ("MOV\t" ^ "[" ^ y ^ " + " ^ (idtos z) ^ "],\t" ^ x)
	| NonTail(x), FMovD(y) -> niw "FModD"
	| NonTail(x), FNegD(y) -> niw "FNegD"
	| NonTail(x), FAddD(y, z) -> niw "FAddD"
	| NonTail(x), FSubD(y, z) -> niw "FSubD"
	| NonTail(x), FMulD(y, z) -> niw "FMulD"
	| NonTail(x), FDivD(y, z) -> niw "FDivD"
	| NonTail(x), LdDF(y, z) -> niw "LdDF"
	| NonTail(_), StDF(x, y, z) -> niw "StDF"
	| NonTail(_), Comment(s) -> wrl 0 (";" ^ s)
	| NonTail(_), Save(x, y) -> niw "Save"
	| NonTail(_), Restore(y) -> niw "Restore"

	(* basic Tail operations *)
	| Tail, (Nop | St _ | StDF _ | Comment _ | Save _ as exp) ->
		printCommand (NonTail(Id.gentmp Type.Unit), exp);
		wrl 1 "RET";
	| Tail, (Set _ | SetL _ | Mov _ | Neg _ | Add _ | Sub _ | SLL _ | Ld _ as exp) ->
		niw "Need to find a place for result!";
		printCommand (NonTail(regs.(0)), exp);
		wrl 1 "RET";
	| Tail, (FMovD _ | FNegD _ | FAddD _ | FSubD _ | FMulD _ | FDivD _ | LdDF _  as exp) ->
		niw "Floaing point tail value";
		wrl 1 "RET";
	| Tail, (Restore(x) as exp) ->
		niw "Tail Restore...";
		wrl 1 "RET";

	(* Tail if statements *)
	| Tail, IfEq(x, y, e1, e2) -> wrl 1 ("CMP\t" ^ x ^ ",\t" ^ (idtos y)); printTailIf e1 e2 "JZ" "JNZ"
	| Tail, IfLE(x, y, e1, e2) -> wrl 1 ("CMP\t" ^ x ^ ",\t" ^ (idtos y)); printTailIf e1 e2 "JLE" "JG"
	| Tail, IfGE(x, y, e1, e2) -> wrl 1 ("CMP\t" ^ x ^ ",\t" ^ (idtos y)); printTailIf e1 e2 "JGE" "JL"
	| Tail, IfFEq(x, y, e1, e2) -> niw "Floaing point tail IF"
	| Tail, IfFLE(x, y, e1, e2) -> niw "Floaing point tail IF"

	(* NonTail if statements *)
	| NonTail(z), IfEq(x, y, e1, e2) -> wrl 1 ("CMP\t" ^ x ^ ",\t" ^ (idtos y)); printNonTailIf (NonTail(z)) e1 e2 "JZ" "JNZ"
	| NonTail(z), IfLE(x, y, e1, e2) -> wrl 1 ("CMP\t" ^ x ^ ",\t" ^ (idtos y)); printNonTailIf (NonTail(z)) e1 e2 "JLE" "JG"
	| NonTail(z), IfGE(x, y, e1, e2) -> wrl 1 ("CMP\t" ^ x ^ ",\t" ^ (idtos y)); printNonTailIf (NonTail(z)) e1 e2 "JGE" "JL"
	| NonTail(z), IfFEq(x, y, e1, e2) -> niw "Floaing point non tail IF"
	| NonTail(z), IfFLE(x, y, e1, e2) -> niw "Floaing point non tail IF"

	(* Tail closure calls *)
	| Tail, CallCls(x, ys, zs) -> niw ("Tail closure call to " ^ x)
	| Tail, CallDir(Id.L(x), ys, zs) -> niw ("Tail direct call to " ^ x)
	
	(* NonTail closure calls *)
	| NonTail(a), CallCls(x, ys, zs) -> niw ("NonTail closure call to " ^ x)
	| NonTail(a), CallDir(Id.L(x), ys, zs) -> niw ("NonTail direct call to " ^ x)

(*************************************************************************)
and printTailIf e1 e2 b bn =
	let b_else = Id.genid (b ^ "_else") in
	wrl 1 (bn ^ "\t" ^ b_else);

	let stackset_back1 = !stackset in (* keep track of what we have on the stack *)
	printExpression (Tail, e1);
	stackset := stackset_back1;
	
	wrl 0 (b_else ^ ":");
	printExpression (Tail, e2);

(*************************************************************************)
and printNonTailIf dest e1 e2 b bn =
	let b_else = Id.genid (b ^ "_else") in
	let b_cont = Id.genid (b ^ "_cont") in
	wrl 1 (bn ^ "\t" ^ b_else);

	let stackset_back1 = !stackset in (* keep track of what we have on the stack *)
	printExpression (dest, e1);
	stackset := stackset_back1;

	wrl 1 ("JMP\t" ^ b_cont);
	wrl 0 (b_else ^ ":");

	let stackset_back2 = !stackset in (* keep track of what we have on the stack *)
	printExpression (dest, e2);
	stackset := stackset_back2;

	wrl 0 (b_cont ^ ":")

(*************************************************************************)
(* emiting single function code *)
let printFunction { name = Id.L(x); args = ys; fargs = zs; body = e; ret = t } =
	wrl 0 (x ^ ":");
	stackset := S.empty;
	stackmap := [];
	printExpression (Tail, e);
	(* wrl 1 "RET"; *)
	niw "RET n - need to calculate size of parameters!";
	wrl 0 ""
	
(*************************************************************************)
(* main function emiting informal assembly code *)
let f oc (SparcAsm.Prog(data, fundefs, e)) =
	wrl 0 ";============================";
	wrl 0 "; informal Intel Asm:";
	wrl 0 ";============================";
	wrl 0 "";
	wrl 0 "section .data";
	(* List.map printData data; *)
	wrl 0 "section .text";
	wrl 1 "global _start";
	List.iter printFunction fundefs;
	wrl 0 "_start:";
	printExpression (Tail, e);
	wrl 0 ";============================"
