From 29987b56e1dafff4a850eef4e668a364340fc59b Mon Sep 17 00:00:00 2001 From: Graydon Hoare Date: Thu, 5 Aug 2010 10:04:11 -0700 Subject: Move 'as' precedence up to just above relational; support indexing str and vec by all integral types. Closes #94. --- src/boot/me/trans.ml | 3 ++- src/boot/me/type.ml | 9 +++++---- 2 files changed, 7 insertions(+), 5 deletions(-) (limited to 'src/boot/me') diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index f2bb2287..f54a5d65 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -914,7 +914,8 @@ let trans_visitor let atop = trans_atom at in let unit_sz = ty_sz_in_current_frame ty in let idx = next_vreg_cell word_sty in - emit (Il.binary Il.UMUL idx atop unit_sz); + mov idx atop; + emit (Il.binary Il.UMUL idx (Il.Cell idx) unit_sz); let elt_mem = trans_bounds_check (deref cell) (Il.Cell idx) in (Il.Mem (elt_mem, referent_type abi ty), ty) in diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml index 787855f0..23210ea1 100644 --- a/src/boot/me/type.ml +++ b/src/boot/me/type.ml @@ -380,19 +380,20 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) = sprintf_itype () | `Type (Ast.TY_vec ty_vec), Ast.COMP_atom atom -> - demand Ast.TY_int (check_atom atom); + demand_integer (check_atom atom); LTYPE_mono ty_vec | `Type (Ast.TY_vec _), _ -> - Common.err None "the vector type '%a' must be indexed via an int" + Common.err None + "the vector type '%a' must be indexed by an integral type" sprintf_itype () | `Type Ast.TY_str, Ast.COMP_atom atom -> - demand Ast.TY_int (check_atom atom); + demand_integer (check_atom atom); LTYPE_mono (Ast.TY_mach Common.TY_u8) | `Type Ast.TY_str, _ -> - Common.err None "strings must be indexed via an int" + Common.err None "strings must be indexed by an integral type" | `Type (Ast.TY_box ty_box), Ast.COMP_deref -> LTYPE_mono ty_box -- cgit v1.2.3 From 9da8101cc83116c3804393a1abe3eb5e1d0dc02a Mon Sep 17 00:00:00 2001 From: Graydon Hoare Date: Thu, 5 Aug 2010 13:26:28 -0700 Subject: Something is wrong with the emitter size cache; disable for now, possibly put out flaming tinderboxes. --- src/boot/me/trans.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/boot/me') diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index f54a5d65..8c280ebd 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -674,7 +674,9 @@ let trans_visitor (Printf.sprintf "calculated size %s is %s" (string_of_size size) (oper_str res))); - htab_put (emitter_size_cache()) size res; + + (* FIXME: this appears to be incorrect; investigate why.*) + (* htab_put (emitter_size_cache()) size res; *) res -- cgit v1.2.3 From db561b52fff4466ac4de4fc807ebc0c253c7cd73 Mon Sep 17 00:00:00 2001 From: Graydon Hoare Date: Thu, 5 Aug 2010 17:44:35 -0700 Subject: Degrade emitter size cache to just a flat hashtable with regular flushes (sigh) and re-introduce horrible bounce-off-spill hack for DIV, MUL, etc. --- src/boot/me/trans.ml | 60 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 25 deletions(-) (limited to 'src/boot/me') diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml index 8c280ebd..b708bb26 100644 --- a/src/boot/me/trans.ml +++ b/src/boot/me/trans.ml @@ -163,7 +163,6 @@ let trans_visitor abi.Abi.abi_emit_target_specific vregs_ok fnid in - Stack.push (Hashtbl.create 0) e.Il.emit_size_cache; Stack.push e emitters; in @@ -172,16 +171,20 @@ let trans_visitor let pop_emitter _ = ignore (Stack.pop emitters) in let emitter _ = Stack.top emitters in - let emitter_size_cache _ = Stack.top (emitter()).Il.emit_size_cache in - let push_emitter_size_cache _ = - Stack.push - (Hashtbl.copy (emitter_size_cache())) - (emitter()).Il.emit_size_cache + let emitter_size_cache _ = (emitter()).Il.emit_size_cache in + let flush_emitter_size_cache _ = + Hashtbl.clear (emitter_size_cache()) in - let pop_emitter_size_cache _ = - ignore (Stack.pop (emitter()).Il.emit_size_cache) + + let emit q = + begin + match q with + Il.Jmp _ -> flush_emitter_size_cache(); + | _ -> () + end; + Il.emit (emitter()) q in - let emit q = Il.emit (emitter()) q in + let next_vreg _ = Il.next_vreg (emitter()) in let next_vreg_cell t = Il.next_vreg_cell (emitter()) t in let next_spill_cell t = @@ -190,12 +193,17 @@ let trans_visitor let spill_ta = (spill_mem, Il.ScalarTy t) in Il.Mem spill_ta in - let mark _ : quad_idx = (emitter()).Il.emit_pc in + let mark _ : quad_idx = + flush_emitter_size_cache (); + (emitter()).Il.emit_pc + in let patch_existing (jmp:quad_idx) (targ:quad_idx) : unit = - Il.patch_jump (emitter()) jmp targ + Il.patch_jump (emitter()) jmp targ; + flush_emitter_size_cache (); in let patch (i:quad_idx) : unit = Il.patch_jump (emitter()) i (mark()); + flush_emitter_size_cache (); (* Insert a dead quad to ensure there's an otherwise-unused * jump-target here. *) @@ -583,7 +591,13 @@ let trans_visitor (string_of_size size))); let sub_sz = calculate_sz ty_params in match htab_search (emitter_size_cache()) size with - Some op -> op + Some op -> + iflog (fun _ -> annotate + (Printf.sprintf "cached size %s is %s" + (string_of_size size) + (oper_str op))); + op + | _ -> let res = match size with @@ -674,9 +688,7 @@ let trans_visitor (Printf.sprintf "calculated size %s is %s" (string_of_size size) (oper_str res))); - - (* FIXME: this appears to be incorrect; investigate why.*) - (* htab_put (emitter_size_cache()) size res; *) + htab_put (emitter_size_cache()) size res; res @@ -1926,8 +1938,8 @@ let trans_visitor : quad_idx list = emit (Il.cmp (Il.Cell (Il.Reg (force_to_reg lhs))) rhs); let jmp = mark() in - emit (Il.jmp cjmp Il.CodeNone); - [ jmp ] + emit (Il.jmp cjmp Il.CodeNone); + [ jmp ] and trans_compare ?ty_params:(ty_params=get_ty_params_of_current_frame()) @@ -1946,7 +1958,6 @@ let trans_visitor | _ -> trans_compare_simple cjmp lhs rhs and trans_cond (invert:bool) (expr:Ast.expr) : quad_idx list = - let anno _ = iflog begin @@ -2078,15 +2089,14 @@ let trans_visitor trans_atom a and trans_block (block:Ast.block) : unit = + flush_emitter_size_cache(); trace_str cx.ctxt_sess.Session.sess_trace_block "entering block"; - push_emitter_size_cache (); emit (Il.Enter (Hashtbl.find cx.ctxt_block_fixups block.id)); Array.iter trans_stmt block.node; trace_str cx.ctxt_sess.Session.sess_trace_block "exiting block"; emit Il.Leave; - pop_emitter_size_cache (); trace_str cx.ctxt_sess.Session.sess_trace_block "exited block"; @@ -4398,11 +4408,11 @@ let trans_visitor let back_jmp = trans_compare_simple Il.JB (Il.Cell dptr) (Il.Cell dlim) in - List.iter - (fun j -> patch_existing j back_jmp_targ) back_jmp; - let v = next_vreg_cell word_sty in - mov v (Il.Cell src_fill); - add_to dst_fill (Il.Cell v); + List.iter + (fun j -> patch_existing j back_jmp_targ) back_jmp; + let v = next_vreg_cell word_sty in + mov v (Il.Cell src_fill); + add_to dst_fill (Il.Cell v); | t -> begin bug () "unsupported vector-append type %a" Ast.sprintf_ty t -- cgit v1.2.3 From a0cc4817e952f1a022b1ad9c01793db1735a579e Mon Sep 17 00:00:00 2001 From: Or Brostovski Date: Thu, 5 Aug 2010 03:44:29 +0300 Subject: Added AST logging, and modified AST for consistent handling of alt stmts. - Modified the arm types, instead of a single arm type, there are now 2 (soon to be 3) arm types, one for each type of alt statement - Added AST logging for constrained type (see fmt_constrained) - Added AST logging for STMT_alt_type - Created a generic fmt_arm for use with all alt statements --- src/boot/me/dead.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/boot/me') diff --git a/src/boot/me/dead.ml b/src/boot/me/dead.ml index 61aa846a..7ef4bf8e 100644 --- a/src/boot/me/dead.ml +++ b/src/boot/me/dead.ml @@ -70,7 +70,8 @@ let dead_code_visitor | Ast.STMT_alt_type { Ast.alt_type_arms = arms; Ast.alt_type_else = alt_type_else } -> - let arm_ids = Array.map (fun (_, _, block) -> block.id) arms in + let arm_ids = Array.map (fun { node = (_, _, block) } -> + block.id) arms in let else_ids = begin match alt_type_else with -- cgit v1.2.3