finish project seven backend compiler

compiler/bin/compiler.ml

@@ -6,11 +6,12 @@ let read_file file =
   List.filter (In_channel.read_lines file) ~f:not_empty
 ;;
 
+let classname file = Filename.chop_extension (Filename.basename file)
 let outfile file = String.concat [ Filename.chop_extension file; ".asm" ]
 
 let gen_hack file =
   let ircode = read_file file in
-  let assembly = Be_translate.translate ircode in
+  let assembly = Be_translate.translate (classname file) ircode in
   let outchan = Out_channel.create (outfile file) in
   Out_channel.output_lines outchan assembly;
   Out_channel.close outchan

compiler/lib/be_predef.ml

@@ -48,34 +48,30 @@ let _lt loc =
     ]
 ;;
 
-let a_command ?(loc = 0) a =
+let push = [ "@SP"; "A=M"; "M=D"; "@SP"; "M=M+1" ]
-  let suffix = Int.to_string loc in
+let pop = [ "@R13"; "M=D"; "@SP"; "AM=M-1"; "D=M"; "@R13"; "A=M"; "M=D" ]
-  match a with
+
-  | "add" -> _add
+let s_pointer = function
-  | "sub" -> _sub
+  | "0" -> "@THIS"
-  | "neg" -> _neg
+  | "1" -> "@THAT"
-  | "eq" -> _eq suffix
+  | _ -> failwith "Invalid Pointer"
-  | "gt" -> _gt suffix
-  | "lt" -> _lt suffix
-  | "and" -> _and
-  | "or" -> _or
-  | "not" -> _not
-  | _ -> failwith "a_command: Invalid Command"
 ;;
 
-let addr a = [ String.concat [ "@"; a ] ]
+let s_common = function
-let push_constant = [ "D=A"; "@SP"; "A=M"; "M=D"; "@SP"; "M=M+1" ]
+  | "local" -> "@LCL"
-
+  | "this" -> "@THIS"
-let _end = ["(TERMINATE)"; "@TERMINATE"; "0;JMP"]
+  | "that" -> "@THAT"
-
+  | "argument" -> "@ARG"
-let _process_push s a =
-  match s with
-  | "constant" -> addr a @ push_constant
   | _ -> failwith "Invalid Segment"
 ;;
 
-let m_command (c, s, a) =
+let push_constant a = [ "@" ^ a; "D=A" ] @ push
-  match c with
+let push_common a sp = [ "@" ^ a; "D=A"; s_common sp; "A=D+M"; "D=M" ] @ push
-  | "push" -> _process_push s a
+let push_temp a = [ "@" ^ a; "D=A"; "@R5"; "A=D+A"; "D=M" ] @ push
-  | _ -> failwith "m_command: Invalid Command"
+let push_pointer a = [ s_pointer a; "D=M" ] @ push
-;;
+let push_static a cn = [ "@" ^ cn ^ "." ^ a; "D=M" ] @ push
+let pop_common a sp = [ "@" ^ a; "D=A"; s_common sp; "D=D+M" ] @ pop
+let pop_temp a = [ "@" ^ a; "D=A"; "@R5"; "D=D+A" ] @ pop
+let pop_pointer a = [ "@SP"; "AM=M-1"; "D=M"; s_pointer a; "M=D" ]
+let pop_static a cn = [ "@SP"; "AM=M-1"; "D=M"; "@" ^ cn ^ "." ^ a; "M=D" ]
+let _end = [ "(TERMINATE)"; "@TERMINATE"; "0;JMP" ]

compiler/lib/be_translate.ml

@@ -10,15 +10,56 @@ let parse s =
 
 let generate_exprs lines = List.map lines ~f:parse
 
-let rec _translate expr loc tt = 
+let a_command loc a =
-  match expr with
+  let suffix = Int.to_string loc in
-  | [] -> tt
+  match a with
-  | Acommand a :: t -> a_command ?loc:(Some loc) a @ _translate t (loc+1) tt
+  | "add" -> _add
-  | Mcommand (c, s, a) :: t -> m_command (c, s, a) @ _translate t loc tt
+  | "sub" -> _sub
-  | _ :: t -> _translate t loc tt
+  | "neg" -> _neg
+  | "eq" -> _eq suffix
+  | "gt" -> _gt suffix
+  | "lt" -> _lt suffix
+  | "and" -> _and
+  | "or" -> _or
+  | "not" -> _not
+  | _ -> failwith "a_command: Invalid Command"
 ;;
 
-let translate lines =
+let process_push cn sp a =
-  let exprs = generate_exprs lines in
+  match sp with
-  _translate exprs 0 [] @ _end
+  | "local" | "argument" | "this" | "that" -> push_common a sp
+  | "constant" -> push_constant a
+  | "temp" -> push_temp a
+  | "static" -> push_static a cn
+  | "pointer" -> push_pointer a
+  | _ -> failwith "PROCESS PUSH: Invalid Segment"
+;;
+
+let process_pop cn sp a =
+  match sp with
+  | "local" | "argument" | "this" | "that" -> pop_common a sp
+  | "temp" -> pop_temp a
+  | "static" -> pop_static a cn
+  | "pointer" -> pop_pointer a
+  | _ -> failwith "PROCESS POP: Invalid Segment"
+;;
+
+let m_command cn (c, s, a) =
+  match c with
+  | "pop" -> process_pop cn s a
+  | "push" -> process_push cn s a
+  | _ -> failwith "m_command: Invalid Command"
+;;
+
+let rec _translate expr cn loc tt =
+  match expr with
+  | [] -> tt
+  | Acommand a :: t -> a_command loc a @ _translate t cn (loc + 1) tt
+  | Mcommand (c, s, a) :: t -> m_command cn (c, s, a) @ _translate t cn loc tt
+  | _ :: t -> _translate t cn loc tt
+;;
+
+let translate cn lines =
+  let exprs = generate_exprs lines in
+  _translate exprs cn 0 [] @ _end
 ;;