Commits

Paweł Wieczorek committed 8546c1f

Alignment in WHILE PrettyPrinter due to last changes in language [calling routines]

  • Participants
  • Parent commits d7a0b2c
  • Branches very_simple_while_compiler

Comments (0)

Files changed (3)

File source/Command/ParserCommandMaker.ml

         try
             List.iter (handle_file true) args;
             0
-        with _ ->
+        with exc ->
+            Printf.printf "exception: %s%!\n" (Printexc.to_string exc);
             print_endline "error not handled";
             -1
 

File source/Compiler/WhileX86Compiler.ml

 
 module Context = struct 
     
-    type scope_block =
-        { local_variable_map       : (AST.variable, memory_location) FrozenHashtbl.t
-        }
-
     type frame =
-        { scope_blocks              : scope_block list ref
-        ; leave_symbol              : symbol
+        { leave_symbol              : symbol
+        ; local_variable_map       : (AST.variable, memory_location) FrozenHashtbl.t
         }
 
     type context =
         let symbol = make_symbol (Printf.sprintf "_L%04u%s" num suffix) in
         symbol
 
+    let compute_memory_locations_for_arguments formal_arguments =
+        let map = Hashtbl.create 7 in
+        let address_argument i argument =
+            let index   = Int32.of_int (8 + (4 * i)) in
+            let address = MEM_Address (index, Some EBP, None) in
+            Hashtbl.replace map argument address
+            in
+        List.iteri address_argument formal_arguments;
+        FrozenHashtbl.freeze map
+
+
     let inside_frame context formal_arguments cont =
         assert (Option.is_none !(context.current_frame));
         let leave_symbol = create_fresh_local_symbol ~suffix:"_frame_leave"  context in
         let frame = 
-            { scope_blocks = ref []
-            ; leave_symbol = leave_symbol
+            { local_variable_map = compute_memory_locations_for_arguments  formal_arguments 
+            ; leave_symbol       = leave_symbol
             } in
         context.current_frame := Some frame;
         let r = cont leave_symbol in
         context.current_frame := None;
         r
 
+    let lookup_for_variable_memory_location context variable =
+        try match !(context.current_frame) with
+            | Some frame ->
+                FrozenHashtbl.find frame.local_variable_map variable
+            | None ->
+                raise Not_found
+        with Not_found ->
+            MEM_Symbol (lookup_for_variable_symbol context variable)
+
+    let lookup_for_variable_loc32 context variable =
+        LOC32_Memory (lookup_for_variable_memory_location context variable)
+
+    let lookup_for_variable_lv32 context variable =
+        LV32_Location (lookup_for_variable_loc32 context variable)
 
 end
 
         (* Indirect transfer *)
         | EMIT_Instruction (MOVL (lv32_a, loc32_a))                     :: prev_emits
         , EMIT_Instruction (MOVL ((LV32_Location loc32_b), loc32_c))    :: next_emits
-        when loc32_a = loc32_b && not_both (lv32_is_memref lv32_a) (loc32_is_memref loc32_c) ->
+        when loc32_a = loc32_b && not_both (lv32_is_memref lv32_a) (loc32_is_memref loc32_c) && not (loc32_is_memref loc32_a)->
             incr ticks;
             let new_emit = emit_MOVL lv32_a loc32_c in
             shrink_emits ticks prev_emits (new_emit::next_emits)
         (* Silly pushing *)
         | EMIT_Instruction (MOVL (lv32_a, loc32_a))         :: prev_emits
         , EMIT_Instruction (PUSHL (LV32_Location loc32_b))  :: next_emits
-        when loc32_a = loc32_b ->
+        when loc32_a = loc32_b && not (loc32_is_memref loc32_a) ->
             incr ticks;
             let new_emit = emit_PUSHL lv32_a in
             shrink_emits ticks prev_emits (new_emit::next_emits)
             (code, EAX)
 
         | AST.AE_Variable variable ->
-            let symbol = Context.lookup_for_variable_symbol context variable in
+            let var_lv32 = Context.lookup_for_variable_lv32 context variable in
             let code =
-                [ emit_MOVL (lv32_symbol symbol) (loc32_reg EAX)
+                [ emit_MOVL var_lv32 (loc32_reg EAX)
                 ] in
             (code, EAX)
 
 
         | AST.CMD_Assign (variable, arithmetic_expression) ->
             let (expr_code, expr_reg)   = compile_arithmetic_expression context arithmetic_expression in
-            let variable_symbol         = Context.lookup_for_variable_symbol context variable in
+            let var_loc32               = Context.lookup_for_variable_loc32 context variable in
 
             let store_code =
-                [ emit_MOVL (lv32_reg expr_reg) (loc32_symbol variable_symbol) 
+                [ emit_MOVL (lv32_reg expr_reg) var_loc32
                 ] in
 
             List.concat
                 ]
 
         | AST.CMD_Read variable ->
-            let variable_symbol = Context.lookup_for_variable_symbol context variable in
+            let variable_loc32 = Context.lookup_for_variable_loc32 context variable in
             [ emit_CALL (loc32_symbol Runtime.read_procedure_symbol)
-            ; emit_MOVL (lv32_reg EAX) (loc32_symbol variable_symbol)
+            ; emit_MOVL (lv32_reg EAX) variable_loc32
             ]
 
         | AST.CMD_Write variable ->
-            let variable_symbol = Context.lookup_for_variable_symbol context variable in
-            call_routine_symbol_lv32_args Runtime.write_procedure_symbol [lv32_symbol variable_symbol]
+            let variable_lv32 = Context.lookup_for_variable_lv32 context variable in
+            call_routine_symbol_lv32_args Runtime.write_procedure_symbol [variable_lv32]
 
         | AST.CMD_While (cond, body) ->
             let symbol_loop_begin = Context.create_fresh_local_symbol ~suffix:"_loop_begin" context in

File source/Lang/While/PrettyPrinter.ml

     | AE_Constant constant ->
         psp_max_priority
 
+    | AE_Call (_, _) -> psp_max_priority
+
     | AE_Variable variable ->
         psp_max_priority