summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorXavier Leroy <xavier.leroy@inria.fr>1997-03-07 15:32:54 +0000
committerXavier Leroy <xavier.leroy@inria.fr>1997-03-07 15:32:54 +0000
commit917193dacda2987c72c5fa656132dbf3ad413af6 (patch)
tree50635f664136d7ecb60d6aeb94a1c77596d2376a
parent6a0ea6385b1fbd656d9a1e3848f00f7fe5bdc13a (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.mlp168
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();