- rename doc-ps package to doc.

[packages/ocaml.git] / ocaml-powerpcfix.patch

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