open IntelVars

type returnType = Tail | NonTail

let output_str = ref stdout

(*************************************************************************)
(* prints message intended tb times*)
let rec wr tb msg =
	if tb > 0
		then (output_string !output_str "         "; (wr (tb-1) msg))
		else (output_string !output_str msg)

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

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

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

(*************************************************************************)
(* prints floating point constants to data sector *)
let rec printData = function
	| [] -> ()
	| (FloatData(f, off))::y ->
		printData y;
		wrl 0 ("float_constant" ^ (string_of_int off) ^ "      DQ   " ^ (string_of_float f))

(*************************************************************************)
(* prints expression *)
let get_mem (seg, off) = (*"[" ^ seg ^ ":" ^    --- ignore segment!!! *)	
	match off with
		| Reg(x) -> "[" ^ x ^ "]"
		| Imm(x) -> "[" ^ (string_of_int x) ^ "]"
		| RegImm(x, y) -> "[" ^ x ^ (if y < 0 then string_of_int y else "+" ^ (string_of_int y)) ^ "]"
		| RegValue(x) -> x

(*************************************************************************)
(* increase address by integer value *)
let inc_addr (seg, off) v =
	match off with
	| Reg(x) -> (seg, RegImm(x, v))
	| Imm(x) -> (seg, Imm(x+v))
	| RegImm(x, y) -> (seg, RegImm(x, y+v))
	| RegValue(x) -> 
		dbg ("*** DEBUG: can not increase memory offset on register!"); (* debug *)
		assert false

(*************************************************************************)
(* prints memory word move *)
let mem_mov dst src =
	wrl 1 ("MOV   EAX,  " ^ (get_mem src));
	wrl 1 ("MOV   " ^ (get_mem dst ) ^ ",  EAX")
	
(*************************************************************************)
(* move list of variables to heap (at location EDI)*)
let rec putToHeap fv offset =
	match fv with
	| [] -> ()
	| m::l -> 
		(match m.id_type with
		| Type.Float -> 
			wrl 1 ("FLD   qword ptr " ^ (get_mem m.mem));
			wrl 1 ("FSTP  qword ptr [EDI + " ^ (string_of_int offset) ^ "]");
			putToHeap l (offset + 8)
		| _ ->
			mem_mov ("DS", RegImm("EDI", offset)) m.mem ;
			putToHeap l (offset + 4))
		

(*************************************************************************)
(* prints expression *)
let rec pushArguments args =
	match args with
	| [] -> ()
	| a::y ->		
		pushArguments y;
		(match a.id_type with
		| Type.Unit -> ()
		| Type.Float ->	
			wrl 1 ("PUSH  dword ptr " ^ (get_mem (inc_addr a.mem 4)));
			wrl 1 ("PUSH  dword ptr " ^ (get_mem a.mem))
		| _ -> wrl 1 ("PUSH  dword ptr " ^ (get_mem a.mem)))		

(*************************************************************************)
(* prints expression *)
let rec getTuple vars offset =
	match vars with
	| [] -> ()
	| v::y ->
		(match v.id_type with
		| Type.Unit -> ()
		| Type.Float ->
			wrl 1 ("FLD   qword ptr [EDI+" ^ (string_of_int offset) ^ "]");
			wrl 1 ("FSTP  qword ptr " ^ (get_mem v.mem))
		| _ ->
			wrl 1 ("MOV   EAX,  [EDI+" ^ (string_of_int offset) ^ "]");
			wrl 1 ("MOV   " ^ (get_mem v.mem) ^ ",  EAX")
		);
		getTuple y (offset + (get_size v.id_type))
	
(*************************************************************************)
(* counts size of arguments *)
let rec count_args_size = function
	| [] -> 0
	| {id_name = _; mem = _; id_type = tp}::y ->
		match tp with
		| Type.Unit -> count_args_size y
		| Type.Float -> 8 + count_args_size y
		| _ -> 4 + count_args_size y
		
(*************************************************************************)
(* prints expression *)
let rec printExpression ret tp dest body memory =
	match (body, ret, tp) with
	| Unit, _, _ ->
		wrl 1 "; Unit"
	
	| Int(x), NonTail, _ ->
		wrl 1 ("; Integer " ^ (string_of_int x));
		wrl 1 ("MOV   EAX,  " ^ (string_of_int x));
		wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX")
		
	| Int(x), Tail, _ ->
		wrl 1 ("; Integer " ^ (string_of_int x));
		wrl 1 ("MOV   EAX,  " ^ (string_of_int x))
		
	| Float(v, x), NonTail, _ ->
		wrl 1 ("; Double " ^ (string_of_float v));
		wrl 1 ("FLD   qword ptr " ^ (get_mem x));
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem))
		
	| Float(v, x), Tail, _ ->
		wrl 1 ("; Double " ^ (string_of_float v));
		wrl 1 ("FLD   qword ptr " ^ (get_mem x))	
		
	| Neg(x), NonTail, _ ->
		wrl 1 ("; Neg " ^ x.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem));
		wrl 1 ("NEG   EAX");
		wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX")
		
	| Neg(x), Tail, _ ->
		wrl 1 ("; Neg " ^ x.id_name);		
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem));
		wrl 1 ("NEG   EAX")
		
	| Add(x, y), NonTail, _ ->
		wrl 1 ("; Add " ^ x.id_name ^ " + " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem));
		wrl 1 ("ADD   EAX,  " ^ (get_mem y.mem));
		wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX")
		
	| Add(x, y), Tail, _ ->
		wrl 1 ("; Add " ^ x.id_name ^ " + " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem));
		wrl 1 ("ADD   EAX,  " ^ (get_mem y.mem))
		
	| Sub(x, y), NonTail, _ ->
		wrl 1 ("; Sub " ^ x.id_name ^ " - " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem));
		wrl 1 ("SUB   EAX,  " ^ (get_mem y.mem));
		wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX")
		
	| Sub(x, y), Tail, _ ->
		wrl 1 ("; Sub " ^ x.id_name ^ " - " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem));
		wrl 1 ("SUB   EAX,  " ^ (get_mem y.mem))
		
	| FNeg(x), NonTail, _ ->
		wrl 1 ("; FNeg " ^ x.id_name);
		wrl 1 "FLDZ"; (* load zero *)
		wrl 1 ("FSUB  qword ptr " ^ (get_mem x.mem)); (* negate *)		
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem)) (* store and pop *)
		
	| FNeg(x), Tail, _ ->
		wrl 1 ("; FNeg " ^ x.id_name);
		wrl 1 "FLDZ"; (* load zero *)
		wrl 1 ("FSUB  qword ptr " ^ (get_mem x.mem)) (* negate *)		
		
	| FAdd(x, y), NonTail, _ ->
		wrl 1 ("; FAdd " ^ x.id_name ^ " + " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FADD  qword ptr " ^ (get_mem y.mem)); (* add second argument *)
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem)) (* store and pop *)
		
	| FAdd(x, y), Tail, _ ->
		wrl 1 ("; FAdd " ^ x.id_name ^ " + " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FADD  qword ptr " ^ (get_mem y.mem)) (* add second argument *)
		
	| FSub(x, y), NonTail, _ ->
		wrl 1 ("; FSub " ^ x.id_name ^ " - " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FSUB  qword ptr " ^ (get_mem y.mem)); (* sub second argument *)
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem)) (* store and pop *)
		
	| FSub(x, y), Tail, _ ->
		wrl 1 ("; FSub " ^ x.id_name ^ " - " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FSUB  qword ptr " ^ (get_mem y.mem)) (* sub second argument *)
		
	| FMul(x, y), NonTail, _ ->
		wrl 1 ("; FMul " ^ x.id_name ^ " * " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FMUL  qword ptr " ^ (get_mem y.mem)); (* multiply by second argument *)
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem)) (* store and pop *)
		
	| FMul(x, y), Tail, _ ->
		wrl 1 ("; FMul " ^ x.id_name ^ " * " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FMUL  qword ptr " ^ (get_mem y.mem)) (* multiply by second argument *)
		
	| FDiv(x, y), NonTail, _ ->
		wrl 1 ("; FDiv " ^ x.id_name ^ " / " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FDIV  qword ptr " ^ (get_mem y.mem)); (* divide by second argument *)
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem)) (* store and pop *)
		
	| FDiv(x, y), Tail, _ ->
		wrl 1 ("; FDiv " ^ x.id_name ^ " / " ^ y.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("FDIV  qword ptr " ^ (get_mem y.mem)) (* divide by second argument *)
		
	| IfEq(x, y, e1, e2), NonTail, _ ->
		wrl 1 ("; If " ^ x.id_name ^ " == " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("CMP   EAX,  " ^ (get_mem y.mem)); (* compare with second argument *)
		let else_label = Id.genid "else" in		
		let cont_label = Id.genid "cont" in
		wrl 1 ("JNE   " ^ else_label); (* then begin *)
		printExpression ret tp dest e1 memory;
		wrl 1 ("JMP   " ^ cont_label); (* then end *)
		wrl 0 (else_label ^ ":"); (* else begin *)
		printExpression ret tp dest e2 memory;
		wrl 0 (cont_label ^ ":") (* else end*)
		
	| IfEq(x, y, e1, e2), Tail, _ ->
		wrl 1 ("; If " ^ x.id_name ^ " == " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("CMP   EAX,  " ^ (get_mem y.mem)); (* compare with second argument *)
		let else_label = Id.genid "else" in
		wrl 1 ("JNE   " ^ else_label); (* then begin *)
		printExpression ret tp dest e1 memory;
		wrl 1 "MOV   ESP,  EBP";
		wrl 1 "POP   EBP";
		wrl 1 "RET"; (* then end *)
		wrl 0 (else_label ^ ":"); (* else begin *)
		printExpression ret tp dest e2 memory
		(*function_ret*) (* else end*)
		
	| IfLE(x, y, e1, e2), NonTail, _ ->
		wrl 1 ("; If " ^ x.id_name ^ " <= " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("CMP   EAX,  " ^ (get_mem y.mem)); (* compare with second argument *)
		let else_label = Id.genid "else" in
		let cont_label = Id.genid "cont" in
		wrl 1 ("JG    " ^ else_label); (* then begin *)
		printExpression ret tp dest e1 memory;
		wrl 1 ("JMP   " ^ cont_label); (* then end *)
		wrl 0 (else_label ^ ":"); (* else begin *)
		printExpression ret tp dest e2 memory;
		wrl 0 (cont_label ^ ":") (* else end*)
		
	| IfLE(x, y, e1, e2), Tail, _ ->
		wrl 1 ("; If " ^ x.id_name ^ " <= " ^ y.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem)); (* load first argument *)
		wrl 1 ("CMP   EAX,  " ^ (get_mem y.mem)); (* compare with second argument *)
		let else_label = Id.genid "else" in
		wrl 1 ("JG    " ^ else_label); (* then begin *)
		printExpression ret tp dest e1 memory;
		wrl 1 "MOV   ESP,  EBP";
		wrl 1 "POP   EBP";
		wrl 1 "RET"; (* then end *)
		wrl 0 (else_label ^ ":"); (* else begin *)
		printExpression ret tp dest e2 memory
		(*function_ret*) (* else end*)
		
	| Let(x, e1, e2), _, _ ->
		wrl 1 ("; Let " ^ x.id_name ^ " = ");
		printExpression NonTail x.id_type x e1 memory; (* calculate let *)
		printExpression ret tp dest e2 memory
		
	| Var(x), NonTail, Type.Float ->
		wrl 1 ("; Var " ^ x.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem));
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem))
		
	| Var(x), NonTail, _ ->
		wrl 1 ("; Var " ^ x.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem));
		wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX")
		
	| Var(x), Tail, Type.Float ->
		wrl 1 ("; Var " ^ x.id_name);
		wrl 1 ("FLD   qword ptr " ^ (get_mem x.mem))
		
	| Var(x), Tail, _ ->
		wrl 1 ("; Var " ^ x.id_name);
		wrl 1 ("MOV   EAX,  " ^ (get_mem x.mem))
		
	| MakeCls(x, { entry = Id.L(code); actual_fv = fv } , e), _, _ ->
		wrl 1 ("; Make closure " ^ code);
		let alloc_size = (count_args_size fv) + 4 in
		wrl 1 ("PUSH  " ^ (string_of_int alloc_size));
		wrl 1 ("CALL  min_caml_malloc");
		wrl	1 ("ADD   ESP,  4");
		wrl 1 ("MOV   " ^ (get_mem x.mem) ^ ",  EAX"); (* save heap pointer *)
		wrl 1 ("MOV   EDI,  EAX"); (* use EDI as pointer to heap location *)
		wrl 1 ("MOV   [EDI],  " ^ code); (* add code location *)
		putToHeap fv 4; (* move free variables to heap *)
		printExpression ret tp dest e memory
		
	| AppCls(x, args), NonTail, _ ->
		wrl 1 ("; Apply closure " ^ x.id_name);
		wrl 1 ("PUSH  ESI"); (* push old closure pointer *)
		wrl 1 ("MOV   ESI,  " ^ (get_mem x.mem)); (* getting new closure pointer *)
		wrl 1 ("MOV   EAX, [ESI]"); (* get function entry pointer*)
		pushArguments args; (* push arguments *)
		wrl 1 ("CALL  EAX"); (* call closure *)
		wrl 1 ("ADD   ESP,  " ^ (string_of_int (count_args_size args))); (* clean arguments *)
		wrl 1 ("POP   ESI"); (* restore closure pointer *)
		(match tp with
		| Type.Float -> wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem))
		| Type.Unit -> ()
		| _ -> wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX"))
		
	| AppCls(x, args), Tail, _ ->
		wrl 1 ("; Apply closure " ^ x.id_name);
		wrl 1 ("MOV   ESI,  " ^ (get_mem x.mem)); (* getting new closure pointer *)
		wrl 1 ("MOV   EAX, [ESI]"); (* get function entry pointer*)
		pushArguments args; (* push arguments *)
		wrl 1 ("CALL  EAX"); (* call closure *)
		wrl 1 ("ADD   ESP,  " ^ (string_of_int (count_args_size args))) (* clean arguments *)
		
	| AppDir(Id.L(x), args), NonTail, _ ->
		wrl 1 ("; Apply direct " ^ x);
		pushArguments args; (* pass arguments *)
		wrl 1 ("CALL  " ^ x); (* call function *)
		wrl 1 ("ADD   ESP,  " ^ (string_of_int (count_args_size args))); (* clean arguments *)
		(match tp with
		| Type.Float -> wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem))
		| Type.Unit -> ()
		| _ -> wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX"))

	| AppDir(Id.L(x), args), Tail, _ ->
		wrl 1 ("; Apply direct " ^ x);
		pushArguments args; (* pass arguments *)
		wrl 1 ("CALL  " ^ x); (* call function *)
		wrl 1 ("ADD   ESP,  " ^ (string_of_int (count_args_size args))) (* clean arguments *)
		
	| Tuple args, _, _ ->
		wrl 1 ("; Tuple");
		let alloc_size = (count_args_size args) + 4 in
		wrl 1 ("PUSH  " ^ (string_of_int alloc_size));
		wrl 1 ("CALL  min_caml_malloc");
		wrl 1 ("ADD   ESP,  4");
		wrl 1 ("MOV   EDI,  EAX"); (* save heap pointer *)
		putToHeap args 0;
		(match ret with
		| Tail -> wrl 1 ("MOV   EAX,  EDI")
		| NonTail -> wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX"))
		
	| LetTuple (vars, src, e), _, _ ->
		wrl 1 ("; Let tuple = " ^ src.id_name);
		wrl 1 ("MOV   EDI,  " ^ (get_mem src.mem));
		getTuple vars 0; (* get values from heap *)
		printExpression ret tp dest e memory
		
	| Get(arr, index), NonTail, Type.Float ->
		wrl 1 ("; Array " ^ arr.id_name ^ "[" ^ index.id_name ^ "]");
		wrl 1 ("MOV   EBX,  " ^ (get_mem index.mem)); (* get index *)
		wrl 1 ("SHL   EBX,  3"); (* calculate index offset *)
		wrl 1 ("ADD   EBX,  " ^ (get_mem arr.mem)); (* get pointer to data *)	
		wrl 1 ("FLD   qword ptr [EBX]"); (* get value *)
		wrl 1 ("FSTP  qword ptr " ^ (get_mem dest.mem))

	| Get(arr, index), NonTail, _ ->
		wrl 1 ("; Array " ^ arr.id_name ^ "[" ^ index.id_name ^ "]");
		wrl 1 ("MOV   EBX,  " ^ (get_mem index.mem)); (* get index *)
		wrl 1 ("SHL   EBX,  2"); (* calculate index offset *)
		wrl 1 ("ADD   EBX,  " ^ (get_mem arr.mem)); (* get pointer to data *)	
		wrl 1 ("MOV   EAX,  [EBX]"); (* get value *)
		wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX")
		
	| Get(arr, index), Tail, Type.Float ->
		wrl 1 ("; Array " ^ arr.id_name ^ "[" ^ index.id_name ^ "]");
		wrl 1 ("MOV   EBX,  " ^ (get_mem index.mem)); (* get index *)
		wrl 1 ("SHL   EBX,  3"); (* calculate index offset *)
		wrl 1 ("ADD   EBX,  " ^ (get_mem arr.mem)); (* get pointer to data *)	
		wrl 1 ("FLD   qword ptr [EBX]") (* get value *)

	| Get(arr, index), Tail, _ ->
		wrl 1 ("; Array " ^ arr.id_name ^ "[" ^ index.id_name ^ "]");
		wrl 1 ("MOV   EBX,  " ^ (get_mem index.mem)); (* get index *)
		wrl 1 ("SHL   EBX,  2"); (* calculate index offset *)
		wrl 1 ("ADD   EBX,  " ^ (get_mem arr.mem)); (* get pointer to data *)	
		wrl 1 ("MOV   EAX,  [EBX]") (* get value *)
		
	| Put(value, arr, index), _, Type.Float ->
		wrl 1 ("; Array " ^ arr.id_name ^ "[" ^ index.id_name ^ "] = " ^ value.id_name);
		wrl 1 ("MOV   EBX,  " ^ (get_mem index.mem)); (* get index *)
		wrl 1 ("SHL   EBX,  3"); (* calculate index offset *)
		wrl 1 ("ADD   EBX,  " ^ (get_mem arr.mem)); (* get pointer to data *)
		wrl 1 ("FLD   qword ptr " ^ (get_mem value.mem)); (* get value *)
		wrl 1 ("FSTP  qword ptr [EBX]") (* put value *)

	| Put(value, arr, index), _, _ ->
		wrl 1 ("; Array " ^ arr.id_name ^ "[" ^ index.id_name ^ "] = " ^ value.id_name);
		wrl 1 ("MOV   EBX,  " ^ (get_mem index.mem)); (* get index *)
		wrl 1 ("SHL   EBX,  2"); (* calculate index offset *)
		wrl 1 ("ADD   EBX,  " ^ (get_mem arr.mem)); (* get pointer to data *)
		wrl 1 ("MOV   EAX,  " ^ (get_mem value.mem)); (* get value *)
		wrl 1 ("MOV   [EBX],  EAX") (* put value *)
		
	| ExtArray Id.L(x), NonTail, Type.Float -> (* how does this work???   where to pass parameters ???*)
		wrl 1 ("CALL  " ^ x);
		wrl 1 ("FSTP  " ^ (get_mem dest.mem))

	| ExtArray Id.L(x), NonTail, Type.Unit ->
		wrl 1 ("CALL  " ^ x)

	| ExtArray Id.L(x), NonTail, _ ->
		wrl 1 ("CALL  " ^ x);
		wrl 1 ("MOV   " ^ (get_mem dest.mem) ^ ",  EAX")

	| ExtArray Id.L(x), Tail, Type.Float -> (* how does this work???   where to pass parameters ???*)
		wrl 1 ("CALL  " ^ x)

	| ExtArray Id.L(x), Tail, Type.Unit ->
		wrl 1 ("CALL  " ^ x)

	| ExtArray Id.L(x), Tail, _ ->
		wrl 1 ("CALL  " ^ x)

(*************************************************************************)
(* prints function definitions *)
let printFunction { 
		name = (Id.L(f_name), tp);
		args = f_args;
		formal_fv = f_fv;
		cv = f_cv;
		stacksize = ssize;
		body = cbody } =
			match tp with
			| Type.Fun(_, f_type) ->
				wrl 0 "";
				wrl 0 ";==============================================================";
				wrl 0 ("; Function " ^ f_name ^ ":\n");
				wrl 0 (f_name ^ " proc");
				wrl 1 ("PUSH  EBP");
				wrl 1 ("MOV   EBP,  ESP");
				wrl 1 ("SUB   ESP,  " ^ (string_of_int ssize)); (*allocate stack *)
				let memory = f_args @ f_fv @ f_cv in
				let dummy_var = {id_name = "dummy"; mem = ("XX", Imm(0)); id_type = Type.Unit } in
				printExpression Tail f_type dummy_var cbody memory; (* print body *)
				wrl 1 "MOV   ESP,  EBP";
				wrl 1 "POP   EBP";
				wrl 1 "RET"; (* return from function *)
				wrl 0 (f_name ^ " endp")
			| _ -> 
				dbg ("*** DEBUG: function " ^ f_name ^ " has not a function type!"); (* debug *)
				assert false
			

(*************************************************************************)
(* main function emiting intel assembly code *)
let emitCode oc (Prog(data, fundefs, e, main_body_stack, local_vars)) =
	output_str := oc;
	wrl 0 ";==============================================================";
	wrl 0 "; Intel Asm";
	wrl 0 ";==============================================================";
	wrl 1 ".486";
	wrl 1 ".model flat, stdcall";
	wrl 1 "option casemap :none";
	wrl 1 "include \\masm32\\include\\windows.inc";
	wrl 1 "include \\masm32\\include\\masm32.inc";
	wrl 1 "include \\masm32\\include\\kernel32.inc";
	wrl 1 "include \\masm32\\macros\\macros.asm";
	wrl 0 "";
	wrl 1 "includelib \\masm32\\lib\\masm32.lib";
	wrl 1 "includelib \\masm32\\lib\\kernel32.lib";
	wrl 0 "";
	wrl 0 ";==============================================================";
	wrl 1 ".data";
	wrl 0 "Txt db ?, 0";
	
	printData data;
	
	wrl 0 "";
	wrl 0 ";==============================================================";
	wrl 0 "; Entry point:";	
	wrl 1 ".code";
	
	wrl 0 "start:";
	wrl 1 "FINIT"; (* initialize floating point unit  *)
	wrl 1 "PUSH  EBP";
	wrl 1 "MOV   EBP,  ESP";
	wrl 1 ("SUB   ESP,  " ^ (string_of_int main_body_stack)); (* allocate stack *)
	
	let dummy_var = {id_name = "dummy"; mem = ("XX", Imm(0)); id_type = Type.Unit } in
	printExpression NonTail Type.Unit dummy_var e local_vars;
	
	wrl 1 "MOV   ESP,  EBP";
	wrl 1 "POP   EBP";
	
	wrl 1 "PUSH  0";
	wrl 1 "CALL  ExitProcess";
	
	List.iter printFunction fundefs;
	
	wrl 0 "\n;==============================================================";
	wrl 0 "; need to copy min_caml_intel.asm from min-caml directory to output directoty";
	wrl 0 "include min_caml_intel.asm";
	wrl 0 "";
	wrl 0 "END start";
	wrl 0 "\n;==============================================================";
	wrl 0 ""