+++ /dev/null
-diff --exclude=*CVS* -urN ocaml/asmcomp/linearize.ml ocaml+powerpcfix/asmcomp/linearize.ml
---- ocaml/asmcomp/linearize.ml Mon Feb 5 09:49:10 2001
-+++ ocaml+powerpcfix/asmcomp/linearize.ml Tue Feb 19 18:06:40 2002
-@@ -10,7 +10,7 @@
- (* *)
- (***********************************************************************)
-
--(* $Id$ *)
-+(* $Id$ *)
-
- (* Transformation of Mach code into a list of pseudo-instructions. *)
-
-@@ -25,7 +25,7 @@
-
- type instruction =
- { mutable desc: instruction_desc;
-- next: instruction;
-+ mutable next: instruction;
- arg: Reg.t array;
- res: Reg.t array;
- live: Reg.Set.t }
-diff --exclude=*CVS* -urN ocaml/asmcomp/linearize.mli ocaml+powerpcfix/asmcomp/linearize.mli
---- ocaml/asmcomp/linearize.mli Mon Feb 5 09:49:10 2001
-+++ ocaml+powerpcfix/asmcomp/linearize.mli Tue Feb 19 18:06:40 2002
-@@ -10,7 +10,7 @@
- (* *)
- (***********************************************************************)
-
--(* $Id$ *)
-+(* $Id$ *)
-
- (* Transformation of Mach code into a list of pseudo-instructions. *)
-
-@@ -19,7 +19,7 @@
-
- type instruction =
- { mutable desc: instruction_desc;
-- next: instruction;
-+ mutable next: instruction;
- arg: Reg.t array;
- res: Reg.t array;
- live: Reg.Set.t }
-@@ -43,6 +43,7 @@
- val end_instr: instruction
- val instr_cons:
- instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction
-+val invert_test: Mach.test -> Mach.test
-
- type fundecl =
- { fun_name: string;
-diff --exclude=*CVS* -urN ocaml/asmcomp/power/arch.ml ocaml+powerpcfix/asmcomp/power/arch.ml
---- ocaml/asmcomp/power/arch.ml Fri Apr 21 10:11:10 2000
-+++ ocaml+powerpcfix/asmcomp/power/arch.ml Tue Feb 19 18:06:42 2002
-@@ -10,7 +10,7 @@
- (* *)
- (***********************************************************************)
-
--(* $Id$ *)
-+(* $Id$ *)
-
- (* Specific operations for the PowerPC processor *)
-
-@@ -19,6 +19,7 @@
- type specific_operation =
- Imultaddf (* multiply and add *)
- | Imultsubf (* multiply and subtract *)
-+ | Ialloc_far of int (* allocation in large functions *)
-
- (* Addressing modes *)
-
-@@ -71,6 +72,8 @@
- | Imultsubf ->
- fprintf ppf "%a *f %a -f %a"
- printreg arg.(0) printreg arg.(1) printreg arg.(2)
-+ | Ialloc_far n ->
-+ fprintf ppf "alloc_far %d" n
-
- (* Distinguish between the PowerPC and the Power/RS6000 submodels *)
-
-diff --exclude=*CVS* -urN ocaml/asmcomp/power/emit.mlp ocaml+powerpcfix/asmcomp/power/emit.mlp
---- ocaml/asmcomp/power/emit.mlp Fri Mar 10 15:31:06 2000
-+++ ocaml+powerpcfix/asmcomp/power/emit.mlp Tue Feb 19 18:06:42 2002
-@@ -10,7 +10,7 @@
- (* *)
- (***********************************************************************)
-
--(* $Id$ *)
-+(* $Id$ *)
-
- (* Emission of PowerPC assembly code *)
-
-@@ -349,6 +349,7 @@
- let name_for_specific = function
- Imultaddf -> "fmadd"
- | Imultsubf -> "fmsub"
-+ | _ -> Misc.fatal_error "Emit.Ispecific"
-
- (* Name of current function *)
- let function_name = ref ""
-@@ -365,6 +366,132 @@
- (* Number of jumptable entries *)
- let num_jumptbl_entries = ref 0
-
-+(* Fixup conditional branches that exceed hardware allowed range *)
-+
-+let load_store_size = function
-+ Ibased(s, d) -> 2
-+ | Iindexed ofs -> if is_immediate ofs then 1 else 3
-+ | Iindexed2 -> 1
-+
-+let instr_size = function
-+ Lend -> 0
-+ | Lop(Imove | Ispill | Ireload) -> 1
-+ | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2
-+ | Lop(Iconst_float s) -> if toc then 1 else 2
-+ | Lop(Iconst_symbol s) -> if toc then 1 else 2
-+ | Lop(Icall_ind) -> if toc then 6 else 2
-+ | Lop(Icall_imm s) ->
-+ if toc && not (StringSet.mem s !defined_functions) then 2 else 1
-+ | Lop(Itailcall_ind) -> if toc then 7 else 5
-+ | Lop(Itailcall_imm s) ->
-+ if s = !function_name then 1
-+ else if not toc || StringSet.mem s !defined_functions then 4
-+ else 8
-+ | Lop(Iextcall(s, true)) -> if toc then 2 else 3
-+ | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1
-+ | Lop(Istackoffset n) -> 1
-+ | Lop(Iload(chunk, addr)) ->
-+ if chunk = Byte_signed
-+ then load_store_size addr + 1
-+ else load_store_size addr
-+ | Lop(Istore(chunk, addr)) -> load_store_size addr
-+ | Lop(Ialloc n) -> 4
-+ | Lop(Ispecific(Ialloc_far n)) -> 5
-+ | Lop(Iintop Imod) -> if powerpc then 3 else 2
-+ | Lop(Iintop(Icomp cmp)) -> 4
-+ | Lop(Iintop op) -> 1
-+ | Lop(Iintop_imm(Idiv, n)) -> 2
-+ | Lop(Iintop_imm(Imod, n)) -> 4
-+ | Lop(Iintop_imm(Icomp cmp, n)) -> 4
-+ | Lop(Iintop_imm(op, n)) -> 1
-+ | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1
-+ | Lop(Ifloatofint) -> 9
-+ | Lop(Iintoffloat) -> 4
-+ | Lop(Ispecific sop) -> 1
-+ | Lreloadretaddr -> 2
-+ | Lreturn -> 2
-+ | Llabel lbl -> 0
-+ | Lbranch lbl -> 1
-+ | Lcondbranch(tst, lbl) -> 2
-+ | Lcondbranch3(lbl0, lbl1, lbl2) ->
-+ 1 + (if lbl0 = None then 0 else 1)
-+ + (if lbl1 = None then 0 else 1)
-+ + (if lbl2 = None then 0 else 1)
-+ | Lswitch jumptbl -> 8
-+ | Lsetuptrap lbl -> 1
-+ | Lpushtrap -> if toc then 5 else 4
-+ | Lpoptrap -> 2
-+ | Lraise -> if toc then 7 else 6
-+
-+let label_map code =
-+ let map = Hashtbl.create 37 in
-+ let rec fill_map pc instr =
-+ match instr.desc with
-+ Lend -> (pc, map)
-+ | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next
-+ | op -> fill_map (pc + instr_size op) instr.next
-+ in fill_map 0 code
-+
-+let max_branch_offset = 8180
-+(* 14-bit signed offset in words. Remember to cut some slack
-+ for multi-word instructions where the branch can be anywhere in
-+ the middle. 12 words of slack is plenty. *)
-+
-+let branch_overflows map pc_branch lbl_dest =
-+ let pc_dest = Hashtbl.find map lbl_dest in
-+ let delta = pc_dest - (pc_branch + 1) in
-+ delta <= -max_branch_offset || delta >= max_branch_offset
-+
-+let opt_branch_overflows map pc_branch opt_lbl_dest =
-+ match opt_lbl_dest with
-+ None -> false
-+ | Some lbl_dest -> branch_overflows map pc_branch lbl_dest
-+
-+let fixup_branches codesize map code =
-+ let expand_optbranch lbl n arg next =
-+ match lbl with
-+ None -> next
-+ | Some l ->
-+ instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l))
-+ arg [||] next in
-+ let rec fixup did_fix pc instr =
-+ match instr.desc with
-+ Lend -> did_fix
-+ | Lcondbranch(test, lbl) when branch_overflows map pc lbl ->
-+ let lbl2 = new_label() in
-+ let cont =
-+ instr_cons (Lbranch lbl) [||] [||]
-+ (instr_cons (Llabel lbl2) [||] [||] instr.next) in
-+ instr.desc <- Lcondbranch(invert_test test, lbl2);
-+ instr.next <- cont;
-+ fixup true (pc + 2) instr.next
-+ | Lcondbranch3(lbl0, lbl1, lbl2)
-+ when opt_branch_overflows map pc lbl0
-+ || opt_branch_overflows map pc lbl1
-+ || opt_branch_overflows map pc lbl2 ->
-+ let cont =
-+ expand_optbranch lbl0 0 instr.arg
-+ (expand_optbranch lbl1 1 instr.arg
-+ (expand_optbranch lbl2 2 instr.arg instr.next)) in
-+ instr.desc <- cont.desc;
-+ instr.next <- cont.next;
-+ fixup true pc instr
-+ | Lop(Ialloc n) when codesize - pc >= max_branch_offset ->
-+ instr.desc <- Lop(Ispecific(Ialloc_far n));
-+ fixup true (pc + 4) instr.next
-+ | op ->
-+ fixup did_fix (pc + instr_size op) instr.next
-+ in fixup false 0 code
-+
-+(* Iterate branch expansion till all conditional branches are OK *)
-+
-+let rec branch_normalization code =
-+ let (codesize, map) = label_map code in
-+ if codesize >= max_branch_offset && fixup_branches codesize map code
-+ then branch_normalization code
-+ else ()
-+
-+
- (* Output the assembly code for an instruction *)
-
- let rec emit_instr i dslot =
-@@ -551,6 +678,15 @@
- ` addi {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n`;
- record_frame i.live;
- ` bltl {emit_label !call_gc_label}\n`
-+ | Lop(Ispecific(Ialloc_far n)) ->
-+ if !call_gc_label = 0 then call_gc_label := new_label();
-+ let lbl = new_label() in
-+ ` addi {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`;
-+ ` cmplw {emit_gpr 31}, {emit_gpr 30}\n`;
-+ ` bge {emit_label lbl}\n`;
-+ record_frame i.live;
-+ ` bl {emit_label !call_gc_label}\n`;
-+ `{emit_label lbl}: addi {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n`
- | Lop(Iintop Isub) -> (* subf has swapped arguments *)
- (* Use subfc instead of subf for RS6000 compatibility. *)
- ` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
-@@ -749,7 +885,7 @@
- ` lwz {emit_gpr 29}, 4({emit_gpr 1})\n`;
- if toc then
- ` lwz {emit_gpr 2}, 20({emit_gpr 1})\n`;
-- ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n\n`;
-+ ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n`;
- ` blr\n`
-
- and emit_delay = function
-@@ -831,6 +967,7 @@
- ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n`
- end;
- `{emit_label !tailrec_entry_point}:\n`;
-+ branch_normalization fundecl.fun_body;
- emit_all fundecl.fun_body;
- (* Emit the glue code to call the GC *)
- if !call_gc_label > 0 then begin
projects / packages / ocaml.git / commitdiff