ocaml-powerpcfix.patch

   1 diff --exclude=*CVS* -urN ocaml/asmcomp/linearize.ml ocaml+powerpcfix/asmcomp/linearize.ml
   2 --- ocaml/asmcomp/linearize.ml  Mon Feb  5 09:49:10 2001
   3 +++ ocaml+powerpcfix/asmcomp/linearize.ml       Tue Feb 19 18:06:40 2002
   4 @@ -10,7 +10,7 @@
   5  (*                                                                     *)
   6  (***********************************************************************)
   7
   8 -(* $Id$ *)
   9 +(* $Id$ *)
  10
  11  (* Transformation of Mach code into a list of pseudo-instructions. *)
  12
  13 @@ -25,7 +25,7 @@
  14
  15  type instruction =
  16    { mutable desc: instruction_desc;
  17 -    next: instruction;
  18 +    mutable next: instruction;
  19      arg: Reg.t array;
  20      res: Reg.t array;
  21      live: Reg.Set.t }
  22 diff --exclude=*CVS* -urN ocaml/asmcomp/linearize.mli ocaml+powerpcfix/asmcomp/linearize.mli
  23 --- ocaml/asmcomp/linearize.mli Mon Feb  5 09:49:10 2001
  24 +++ ocaml+powerpcfix/asmcomp/linearize.mli      Tue Feb 19 18:06:40 2002
  25 @@ -10,7 +10,7 @@
  26  (*                                                                     *)
  27  (***********************************************************************)
  28
  29 -(* $Id$ *)
  30 +(* $Id$ *)
  31
  32  (* Transformation of Mach code into a list of pseudo-instructions. *)
  33
  34 @@ -19,7 +19,7 @@
  35
  36  type instruction =
  37    { mutable desc: instruction_desc;
  38 -    next: instruction;
  39 +    mutable next: instruction;
  40      arg: Reg.t array;
  41      res: Reg.t array;
  42      live: Reg.Set.t }
  43 @@ -43,6 +43,7 @@
  44  val end_instr: instruction
  45  val instr_cons:
  46    instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction
  47 +val invert_test: Mach.test -> Mach.test
  48
  49  type fundecl =
  50    { fun_name: string;
  51 diff --exclude=*CVS* -urN ocaml/asmcomp/power/arch.ml ocaml+powerpcfix/asmcomp/power/arch.ml
  52 --- ocaml/asmcomp/power/arch.ml Fri Apr 21 10:11:10 2000
  53 +++ ocaml+powerpcfix/asmcomp/power/arch.ml      Tue Feb 19 18:06:42 2002
  54 @@ -10,7 +10,7 @@
  55  (*                                                                     *)
  56  (***********************************************************************)
  57
  58 -(* $Id$ *)
  59 +(* $Id$ *)
  60
  61  (* Specific operations for the PowerPC processor *)
  62
  63 @@ -19,6 +19,7 @@
  64  type specific_operation =
  65      Imultaddf                           (* multiply and add *)
  66    | Imultsubf                           (* multiply and subtract *)
  67 +  | Ialloc_far of int                   (* allocation in large functions *)
  68
  69  (* Addressing modes *)
  70
  71 @@ -71,6 +72,8 @@
  72    | Imultsubf ->
  73        fprintf ppf "%a *f %a -f %a"
  74          printreg arg.(0) printreg arg.(1) printreg arg.(2)
  75 +  | Ialloc_far n ->
  76 +      fprintf ppf "alloc_far %d" n
  77
  78  (* Distinguish between the PowerPC and the Power/RS6000 submodels *)
  79
  80 diff --exclude=*CVS* -urN ocaml/asmcomp/power/emit.mlp ocaml+powerpcfix/asmcomp/power/emit.mlp
  81 --- ocaml/asmcomp/power/emit.mlp        Fri Mar 10 15:31:06 2000
  82 +++ ocaml+powerpcfix/asmcomp/power/emit.mlp     Tue Feb 19 18:06:42 2002
  83 @@ -10,7 +10,7 @@
  84  (*                                                                     *)
  85  (***********************************************************************)
  86
  87 -(* $Id$ *)
  88 +(* $Id$ *)
  89
  90  (* Emission of PowerPC assembly code *)
  91
  92 @@ -349,6 +349,7 @@
  93  let name_for_specific = function
  94      Imultaddf -> "fmadd"
  95    | Imultsubf -> "fmsub"
  96 +  | _ -> Misc.fatal_error "Emit.Ispecific"
  97
  98  (* Name of current function *)
  99  let function_name = ref ""
 100 @@ -365,6 +366,132 @@
 101  (* Number of jumptable entries *)
 102  let num_jumptbl_entries = ref 0
 103
 104 +(* Fixup conditional branches that exceed hardware allowed range *)
 105 +
 106 +let load_store_size = function
 107 +    Ibased(s, d) -> 2
 108 +  | Iindexed ofs -> if is_immediate ofs then 1 else 3
 109 +  | Iindexed2 -> 1
 110 +
 111 +let instr_size = function
 112 +    Lend -> 0
 113 +  | Lop(Imove | Ispill | Ireload) -> 1
 114 +  | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2
 115 +  | Lop(Iconst_float s) -> if toc then 1 else 2
 116 +  | Lop(Iconst_symbol s) -> if toc then 1 else 2
 117 +  | Lop(Icall_ind) -> if toc then 6 else 2
 118 +  | Lop(Icall_imm s) ->
 119 +      if toc && not (StringSet.mem s !defined_functions) then 2 else 1
 120 +  | Lop(Itailcall_ind) -> if toc then 7 else 5
 121 +  | Lop(Itailcall_imm s) ->
 122 +      if s = !function_name then 1
 123 +      else if  not toc || StringSet.mem s !defined_functions then 4
 124 +      else 8
 125 +  | Lop(Iextcall(s, true)) -> if toc then 2 else 3
 126 +  | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1
 127 +  | Lop(Istackoffset n) -> 1
 128 +  | Lop(Iload(chunk, addr)) ->
 129 +      if chunk = Byte_signed
 130 +      then load_store_size addr + 1
 131 +      else load_store_size addr
 132 +  | Lop(Istore(chunk, addr)) -> load_store_size addr
 133 +  | Lop(Ialloc n) -> 4
 134 +  | Lop(Ispecific(Ialloc_far n)) -> 5
 135 +  | Lop(Iintop Imod) -> if powerpc then 3 else 2
 136 +  | Lop(Iintop(Icomp cmp)) -> 4
 137 +  | Lop(Iintop op) -> 1
 138 +  | Lop(Iintop_imm(Idiv, n)) -> 2
 139 +  | Lop(Iintop_imm(Imod, n)) -> 4
 140 +  | Lop(Iintop_imm(Icomp cmp, n)) -> 4
 141 +  | Lop(Iintop_imm(op, n)) -> 1
 142 +  | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1
 143 +  | Lop(Ifloatofint) -> 9
 144 +  | Lop(Iintoffloat) -> 4
 145 +  | Lop(Ispecific sop) -> 1
 146 +  | Lreloadretaddr -> 2
 147 +  | Lreturn -> 2
 148 +  | Llabel lbl -> 0
 149 +  | Lbranch lbl -> 1
 150 +  | Lcondbranch(tst, lbl) -> 2
 151 +  | Lcondbranch3(lbl0, lbl1, lbl2) ->
 152 +      1 + (if lbl0 = None then 0 else 1)
 153 +        + (if lbl1 = None then 0 else 1)
 154 +        + (if lbl2 = None then 0 else 1)
 155 +  | Lswitch jumptbl -> 8
 156 +  | Lsetuptrap lbl -> 1
 157 +  | Lpushtrap -> if toc then 5 else 4
 158 +  | Lpoptrap -> 2
 159 +  | Lraise -> if toc then 7 else 6
 160 +
 161 +let label_map code =
 162 +  let map = Hashtbl.create 37 in
 163 +  let rec fill_map pc instr =
 164 +    match instr.desc with
 165 +      Lend -> (pc, map)
 166 +    | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next
 167 +    | op -> fill_map (pc + instr_size op) instr.next
 168 +  in fill_map 0 code
 169 +
 170 +let max_branch_offset = 8180
 171 +(* 14-bit signed offset in words.  Remember to cut some slack
 172 +   for multi-word instructions where the branch can be anywhere in
 173 +   the middle.  12 words of slack is plenty. *)
 174 +
 175 +let branch_overflows map pc_branch lbl_dest =
 176 +  let pc_dest = Hashtbl.find map lbl_dest in
 177 +  let delta = pc_dest - (pc_branch + 1) in
 178 +  delta <= -max_branch_offset || delta >= max_branch_offset
 179 +
 180 +let opt_branch_overflows map pc_branch opt_lbl_dest =
 181 +  match opt_lbl_dest with
 182 +    None -> false
 183 +  | Some lbl_dest -> branch_overflows map pc_branch lbl_dest
 184 +
 185 +let fixup_branches codesize map code =
 186 +  let expand_optbranch lbl n arg next =
 187 +    match lbl with
 188 +      None -> next
 189 +    | Some l ->
 190 +        instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l))
 191 +                   arg [||] next in
 192 +  let rec fixup did_fix pc instr =
 193 +    match instr.desc with
 194 +      Lend -> did_fix
 195 +    | Lcondbranch(test, lbl) when branch_overflows map pc lbl ->
 196 +        let lbl2 = new_label() in
 197 +        let cont =
 198 +          instr_cons (Lbranch lbl) [||] [||]
 199 +            (instr_cons (Llabel lbl2) [||] [||] instr.next) in
 200 +        instr.desc <- Lcondbranch(invert_test test, lbl2);
 201 +        instr.next <- cont;
 202 +        fixup true (pc + 2) instr.next
 203 +    | Lcondbranch3(lbl0, lbl1, lbl2)
 204 +      when opt_branch_overflows map pc lbl0
 205 +        || opt_branch_overflows map pc lbl1
 206 +        || opt_branch_overflows map pc lbl2 ->
 207 +        let cont =
 208 +          expand_optbranch lbl0 0 instr.arg
 209 +            (expand_optbranch lbl1 1 instr.arg
 210 +              (expand_optbranch lbl2 2 instr.arg instr.next)) in
 211 +        instr.desc <- cont.desc;
 212 +        instr.next <- cont.next;
 213 +        fixup true pc instr
 214 +    | Lop(Ialloc n) when codesize - pc >= max_branch_offset ->
 215 +        instr.desc <- Lop(Ispecific(Ialloc_far n));
 216 +        fixup true (pc + 4) instr.next
 217 +    | op ->
 218 +        fixup did_fix (pc + instr_size op) instr.next
 219 +  in fixup false 0 code
 220 +
 221 +(* Iterate branch expansion till all conditional branches are OK *)
 222 +
 223 +let rec branch_normalization code =
 224 +  let (codesize, map) = label_map code in
 225 +  if codesize >= max_branch_offset && fixup_branches codesize map code
 226 +  then branch_normalization code
 227 +  else ()
 228 +
 229 +
 230  (* Output the assembly code for an instruction *)
 231
 232  let rec emit_instr i dslot =
 233 @@ -551,6 +678,15 @@
 234          `      addi    {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n`;
 235          record_frame i.live;
 236          `      bltl    {emit_label !call_gc_label}\n`
 237 +    | Lop(Ispecific(Ialloc_far n)) ->
 238 +        if !call_gc_label = 0 then call_gc_label := new_label();
 239 +        let lbl = new_label() in
 240 +        `      addi    {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`;
 241 +        `      cmplw   {emit_gpr 31}, {emit_gpr 30}\n`;
 242 +        `      bge     {emit_label lbl}\n`;
 243 +        record_frame i.live;
 244 +        `      bl      {emit_label !call_gc_label}\n`;
 245 +        `{emit_label lbl}:     addi    {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n`
 246      | Lop(Iintop Isub) ->               (* subf has swapped arguments *)
 247          (* Use subfc instead of subf for RS6000 compatibility. *)
 248          `      subfc   {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
 249 @@ -749,7 +885,7 @@
 250          `      lwz     {emit_gpr 29}, 4({emit_gpr 1})\n`;
 251          if toc then
 252            `    lwz     {emit_gpr 2}, 20({emit_gpr 1})\n`;
 253 -        `      addi    {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n\n`;
 254 +        `      addi    {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n`;
 255          `      blr\n`
 256
 257  and emit_delay = function
 258 @@ -831,6 +967,7 @@
 259        `        addi    {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n`
 260    end;
 261    `{emit_label !tailrec_entry_point}:\n`;
 262 +  branch_normalization fundecl.fun_body;
 263    emit_all fundecl.fun_body;
 264    (* Emit the glue code to call the GC *)
 265    if !call_gc_label > 0 then begin