diff options
author | Xavier Leroy <xavier.leroy@inria.fr> | 1997-03-07 15:32:54 +0000 |
---|---|---|
committer | Xavier Leroy <xavier.leroy@inria.fr> | 1997-03-07 15:32:54 +0000 |
commit | 917193dacda2987c72c5fa656132dbf3ad413af6 (patch) | |
tree | 50635f664136d7ecb60d6aeb94a1c77596d2376a | |
parent | 6a0ea6385b1fbd656d9a1e3848f00f7fe5bdc13a (diff) |
Premiere tentative de traitement des branchements conditionnels longs
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1327 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r-- | asmcomp/emit_hppa.mlp | 168 |
1 files changed, 150 insertions, 18 deletions
diff --git a/asmcomp/emit_hppa.mlp b/asmcomp/emit_hppa.mlp index 988ea208b..62da15884 100644 --- a/asmcomp/emit_hppa.mlp +++ b/asmcomp/emit_hppa.mlp @@ -603,8 +603,8 @@ let rec emit_instr i dslot = ` ldi 1, {emit_reg i.res.(0)}\n` | Lop(Iintop Icheckbound) -> if !range_check_trap = 0 then range_check_trap := new_label(); - ` comb,<<=,n {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label !range_check_trap}\n` - (* Forward branch -> nullify if taken *) + ` comclr,>> {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, %r0\n`; + ` b,n {emit_label !range_check_trap}\n` | Lop(Iintop op) -> let instr = name_for_int_operation op in ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n` @@ -640,8 +640,8 @@ let rec emit_instr i dslot = ` ldi 1, {emit_reg i.res.(0)}\n` | Lop(Iintop_imm(Icheckbound, n)) -> if !range_check_trap = 0 then range_check_trap := new_label(); - ` comib,>>=,n {emit_int n}, {emit_reg i.arg.(0)}, {emit_label !range_check_trap}\n` - (* Forward branch -> nullify if taken *) + ` comiclr,<< {emit_int n}, {emit_reg i.arg.(0)}, %r0\n`; + ` b,n {emit_label !range_check_trap}\n` | Lop(Iintop_imm(op, n)) -> fatal_error "Emit_hppa: Iintop_imm" | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> @@ -682,38 +682,43 @@ let rec emit_instr i dslot = | Lcondbranch(tst, lbl) -> begin match tst with Itruetest -> - ` comib,<> 0, {emit_reg i.arg.(0)}, {emit_label lbl}\n` + emit_comib "<>" "=" 0 i.arg lbl dslot | Ifalsetest -> - ` comib,= 0, {emit_reg i.arg.(0)}, {emit_label lbl}\n` + emit_comib "=" "<>" 0 i.arg lbl dslot | Iinttest cmp -> - let comp = name_for_int_comparison cmp in - ` comb,{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` + let comp = name_for_int_comparison cmp + and negcomp = + name_for_int_comparison(negate_int_comparison cmp) in + emit_comb comp negcomp i.arg lbl dslot | Iinttest_imm(cmp, n) -> - let comp = name_for_int_comparison(swap_int_comparison cmp) in - ` comib,{emit_string comp} {emit_int n}, {emit_reg i.arg.(0)}, {emit_label lbl}\n` + let scmp = swap_int_comparison cmp in + let comp = name_for_int_comparison scmp + and negcomp = + name_for_int_comparison(negate_int_comparison scmp) in + emit_comib comp negcomp n i.arg lbl dslot | Ifloattest(cmp, neg) -> let comp = name_for_float_comparison cmp neg in ` fcmp,dbl,{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ` ftest\n`; - ` b {emit_label lbl}\n` + ` b {emit_label lbl}\n`; + fill_delay_slot dslot | Ioddtest -> - ` comib,OD 0, {emit_reg i.arg.(0)}, {emit_label lbl}\n` + emit_comib "OD" "EV" 0 i.arg lbl dslot | Ieventest -> - ` comib,EV 0, {emit_reg i.arg.(0)}, {emit_label lbl}\n` - end; - fill_delay_slot dslot + emit_comib "EV" "OD" 0 i.arg lbl dslot + end | Lcondbranch3(lbl0, lbl1, lbl2) -> begin match lbl0 with None -> () - | Some lbl -> ` comib,= 0, {emit_reg i.arg.(0)}, {emit_label lbl}\n nop\n` + | Some lbl -> emit_comib "=" "<>" 0 i.arg lbl None end; begin match lbl1 with None -> () - | Some lbl -> ` comib,= 1, {emit_reg i.arg.(0)}, {emit_label lbl}\n nop\n` + | Some lbl -> emit_comib "=" "<>" 1 i.arg lbl None end; begin match lbl2 with None -> () - | Some lbl -> ` comib,= 2, {emit_reg i.arg.(0)}, {emit_label lbl}\n nop\n` + | Some lbl -> emit_comib "=" "<>" 2 i.arg lbl None end | Lswitch jumptbl -> ` blr {emit_reg i.arg.(0)}, 0\n`; @@ -743,6 +748,30 @@ and fill_delay_slot = function None -> ` nop\n` | Some i -> emit_instr i None +and emit_delay_slot = function + None -> () + | Some i -> emit_instr i None + +and emit_comb comp negcomp arg lbl dslot = + if lbl >= 0 then begin + ` comb,{emit_string comp} {emit_reg arg.(0)}, {emit_reg arg.(1)}, {emit_label lbl}\n`; + fill_delay_slot dslot + end else begin + emit_delay_slot dslot; + ` comclr,{emit_string negcomp} {emit_reg arg.(0)}, {emit_reg arg.(1)}, %r0\n`; + ` b,n {emit_label (-lbl)}\n` + end + +and emit_comib comp negcomp cst arg lbl dslot = + if lbl >= 0 then begin + ` comib,{emit_string comp} {emit_int cst}, {emit_reg arg.(0)}, {emit_label lbl}\n`; + fill_delay_slot dslot + end else begin + emit_delay_slot dslot; + ` comiclr,{emit_string negcomp} {emit_int cst}, {emit_reg arg.(0)}, %r0\n`; + ` b,n {emit_label (-lbl)}\n` + end + (* Checks if a pseudo-instruction expands to exactly one machine instruction that does not branch. *) @@ -801,9 +830,112 @@ let rec emit_all i = emit_instr i None; emit_all i.next +(* Estimate the size of an instruction, in actual HPPA instructions *) + +let is_float_stack r = + match r with {loc = Stack _; typ = Float} -> true | _ -> false + +let sizeof_instr i = + match i.desc with + Lend -> 0 + | Lop op -> + begin match op with + Imove | Ispill | Ireload -> + if is_float_stack i.arg.(0) || is_float_stack i.res.(0) + then 2 (* ldo/fxxx *) else 1 + | Iconst_int n -> + if is_offset_native n then 1 else 2 (* ldi or ldil/ldo *) + | Iconst_float _ -> 3 (* ldil/ldo/fldds *) + | Iconst_symbol _ -> 2 (* addil/ldo *) + | Icall_ind -> 2 (* ble/copy *) + | Icall_imm _ -> 2 (* bl/nop *) + | Itailcall_ind -> 2 (* bv/ldwm *) + | Itailcall_imm _ -> 2 (* bl/ldwm *) + | Iextcall(_, alloc) -> + if alloc then 3 (* ldil/bl/ldo *) else 2 (* bl/nop *) + | Istackoffset _ -> 1 (* ldo *) + | Iload(chunk, addr) -> + if i.res.(0).typ = Float + then 4 (* addil/ldo/fldws/fldws *) + else (match addr with Iindexed ofs when is_offset ofs -> 1 | _ -> 2) + + (match chunk with Byte_signed -> 1 | Sixteen_signed -> 1 | _ -> 0) + | Istore(chunk, addr) -> + if i.res.(0).typ = Float + then 4 (* addil/ldo/fstws/fstws *) + else (match addr with Iindexed ofs when is_offset ofs -> 1 | _ -> 2) + | Ialloc _ -> if !fastcode_flag then 7 else 3 + | Iintop Imul -> 7 + | Iintop(Idiv | Imod) -> 3 (* ldil/ble/nop *) + | Iintop Ilsl -> 3 (* subi/mtsar/zvdep *) + | Iintop Ilsr -> 2 (* mtsar/vshd *) + | Iintop Iasr -> 3 (* subi/mtsar/vextrs *) + | Iintop(Icomp _) -> 2 (* comclr/ldi *) + | Iintop Icheckbound -> 2 (* comclr/b,n *) + | Iintop _ -> 1 + | Iintop_imm(Idiv, _) -> 4 (* comclr/zdepi/add/extrs *) + | Iintop_imm(Imod, _) -> 5 (* comclr/zdepi/add/extrs/sub *) + | Iintop_imm(Icomp _, _) -> 2 (* comiclr/ldi *) + | Iintop_imm(Icheckbound, _) -> 2 (* comiclr/b,n *) + | Iintop_imm(_, _) -> 1 + | Ifloatofint -> 3 (* stws,ma/fldws,mb/fcnvxf *) + | Iintoffloat -> 3 (* fcnfxt/fstws/ldws *) + | _ (* Inegf|Iabsf|Iaddf|Isubf|Imulf|Idivf|Ispecific _ *) -> 1 + end + | Lreloadretaddr -> 1 + | Lreturn -> 2 + | Llabel _ -> 0 + | Lbranch _ -> 1 (* b,n *) + | Lcondbranch(Ifloattest(_, _), _) -> 4 (* fcmp/ftest/b/nop *) + | Lcondbranch(_, _) -> 2 (* comb/nop or comclr/b,n *) + | Lcondbranch3(_, _, _) -> 6 (* worst case: three comib/nop or comclr/b,n *) + | Lswitch tbl -> 2 + 2 * Array.length tbl (* blr/nop b/nop *) + | Lsetuptrap _ -> 2 (* bl/nop *) + | Lpushtrap -> 3 (* stws,ma/stw/copy *) + | Lpoptrap -> 1 (* ldws,mb *) + | Lraise -> 4 (* ldw/copy/bv/ldws,mb *) + +(* Estimate the position of all labels in function body + and rewrite long conditional branches with a negative label. *) + +let fixup_cond_branches funbody = + let label_position = + (Hashtbl.create 87 : (label, int) Hashtbl.t) in + let rec estimate_labels pos i = + match i.desc with + Lend -> () + | Llabel lbl -> + Hashtbl.add label_position lbl pos; estimate_labels pos i.next + | _ -> estimate_labels (pos + sizeof_instr i) i.next in + let long_branch currpos lbl = + try + let displ = Hashtbl.find label_position lbl - currpos in + (* Branch offset is stored in 12 bits, giving a range of + -2048 to +2047. Here, we allow 10% error in estimating + the code positions. *) + displ < -1843 && displ > 1842 + with Not_found -> + fatal_error "Emit_hppa.long_branch" in + let rec fix_branches pos i = + match i.desc with + Lend -> () + | Lcondbranch(tst, lbl) -> + if long_branch pos lbl then i.desc <- Lcondbranch(tst, -lbl); + fix_branches (pos + sizeof_instr i) i.next + | Lcondbranch3(opt1, opt2, opt3) -> + let fix_opt = function + None -> None + | Some lbl -> Some(if long_branch pos lbl then -lbl else lbl) in + i.desc <- Lcondbranch3(fix_opt opt1, fix_opt opt2, fix_opt opt3); + fix_branches (pos + sizeof_instr i) i.next + | _ -> + fix_branches (pos + sizeof_instr i) i.next in + estimate_labels 0 funbody; + fix_branches 0 funbody + (* Emission of a function declaration *) let fundecl fundecl = + fixup_cond_branches fundecl.fun_body; function_name := fundecl.fun_name; fastcode_flag := fundecl.fun_fast; tailrec_entry_point := new_label(); |