Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added and used Reg.createv_like. 

Selectgen: new methods regs_for, enables ports to store float values
in pairs of integer registers.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9210 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 2009-03-31 09:44:50 +00:00
parent aa3a23cd3d
commit 1a7d4a3293
4 changed files with 53 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
asmcomp/reg.ml
View File

@ -59,6 +59,12 @@ let createv tyv =
for i = 0 to n-1 do rv.(i) <- create tyv.(i) done; for i = 0 to n-1 do rv.(i) <- create tyv.(i) done;
rv rv
let createv_like rv =
let n = Array.length rv in
let rv' = Array.create n dummy in
for i = 0 to n-1 do rv'.(i) <- create rv.(i).typ done;
rv'
let clone r = let clone r =
let nr = create r.typ in let nr = create r.typ in
nr.name <- r.name; nr.name <- r.name;

1
asmcomp/reg.mli
View File

@ -39,6 +39,7 @@ and stack_location =
val dummy: t val dummy: t
val create: Cmm.machtype_component -> t val create: Cmm.machtype_component -> t
val createv: Cmm.machtype -> t array val createv: Cmm.machtype -> t array
val createv_like: t array -> t array
val clone: t -> t val clone: t -> t
val at_location: Cmm.machtype_component -> location -> t val at_location: Cmm.machtype_component -> location -> t

70
asmcomp/selectgen.ml
View File

@ -335,6 +335,13 @@ method select_condition = function
| arg -> | arg ->
(Itruetest, arg) (Itruetest, arg)
(* Return an array of fresh registers of the given type.
Normally implemented as Reg.createv, but some
ports (e.g. Arm) can override this definition to store float values
in pairs of integer registers. *)
method regs_for tys = Reg.createv tys
(* Buffering of instruction sequences *) (* Buffering of instruction sequences *)
val mutable instr_seq = dummy_instr val mutable instr_seq = dummy_instr
@ -391,22 +398,22 @@ method insert_op op rs rd =
method emit_expr env exp = method emit_expr env exp =
match exp with match exp with
Cconst_int n -> Cconst_int n ->
let r = Reg.createv typ_int in let r = self#regs_for typ_int in
Some(self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r) Some(self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r)
| Cconst_natint n -> | Cconst_natint n ->
let r = Reg.createv typ_int in let r = self#regs_for typ_int in
Some(self#insert_op (Iconst_int n) [||] r) Some(self#insert_op (Iconst_int n) [||] r)
| Cconst_float n -> | Cconst_float n ->
let r = Reg.createv typ_float in let r = self#regs_for typ_float in
Some(self#insert_op (Iconst_float n) [||] r) Some(self#insert_op (Iconst_float n) [||] r)
| Cconst_symbol n -> | Cconst_symbol n ->
let r = Reg.createv typ_addr in let r = self#regs_for typ_addr in
Some(self#insert_op (Iconst_symbol n) [||] r) Some(self#insert_op (Iconst_symbol n) [||] r)
| Cconst_pointer n -> | Cconst_pointer n ->
let r = Reg.createv typ_addr in let r = self#regs_for typ_addr in
Some(self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r) Some(self#insert_op (Iconst_int(Nativeint.of_int n)) [||] r)
| Cconst_natpointer n -> | Cconst_natpointer n ->
let r = Reg.createv typ_addr in let r = self#regs_for typ_addr in
Some(self#insert_op (Iconst_int n) [||] r) Some(self#insert_op (Iconst_int n) [||] r)
| Cvar v -> | Cvar v ->
begin try begin try
@ -460,7 +467,7 @@ method emit_expr env exp =
Proc.contains_calls := true; Proc.contains_calls := true;
let r1 = self#emit_tuple env new_args in let r1 = self#emit_tuple env new_args in
let rarg = Array.sub r1 1 (Array.length r1 - 1) in let rarg = Array.sub r1 1 (Array.length r1 - 1) in
let rd = Reg.createv ty in let rd = self#regs_for ty in
let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in let (loc_arg, stack_ofs) = Proc.loc_arguments rarg in
let loc_res = Proc.loc_results rd in let loc_res = Proc.loc_results rd in
self#insert_move_args rarg loc_arg stack_ofs; self#insert_move_args rarg loc_arg stack_ofs;
@ -471,7 +478,7 @@ method emit_expr env exp =
| Icall_imm lbl -> | Icall_imm lbl ->
Proc.contains_calls := true; Proc.contains_calls := true;
let r1 = self#emit_tuple env new_args in let r1 = self#emit_tuple env new_args in
let rd = Reg.createv ty in let rd = self#regs_for ty in
let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in let (loc_arg, stack_ofs) = Proc.loc_arguments r1 in
let loc_res = Proc.loc_results rd in let loc_res = Proc.loc_results rd in
self#insert_move_args r1 loc_arg stack_ofs; self#insert_move_args r1 loc_arg stack_ofs;
@ -482,7 +489,7 @@ method emit_expr env exp =
Proc.contains_calls := true; Proc.contains_calls := true;
let (loc_arg, stack_ofs) = let (loc_arg, stack_ofs) =
self#emit_extcall_args env new_args in self#emit_extcall_args env new_args in
let rd = Reg.createv ty in let rd = self#regs_for ty in
let loc_res = Proc.loc_external_results rd in let loc_res = Proc.loc_external_results rd in
self#insert_debug (Iop(Iextcall(lbl, alloc))) dbg self#insert_debug (Iop(Iextcall(lbl, alloc))) dbg
loc_arg loc_res; loc_arg loc_res;
@ -490,14 +497,14 @@ method emit_expr env exp =
Some rd Some rd
| Ialloc _ -> | Ialloc _ ->
Proc.contains_calls := true; Proc.contains_calls := true;
let rd = Reg.createv typ_addr in let rd = self#regs_for typ_addr in
let size = size_expr env (Ctuple new_args) in let size = size_expr env (Ctuple new_args) in
self#insert (Iop(Ialloc size)) [||] rd; self#insert (Iop(Ialloc size)) [||] rd;
self#emit_stores env new_args rd; self#emit_stores env new_args rd;
Some rd Some rd
| op -> | op ->
let r1 = self#emit_tuple env new_args in let r1 = self#emit_tuple env new_args in
let rd = Reg.createv ty in let rd = self#regs_for ty in
Some (self#insert_op_debug op dbg r1 rd) Some (self#insert_op_debug op dbg r1 rd)
end end
| Csequence(e1, e2) -> | Csequence(e1, e2) ->
@ -536,7 +543,7 @@ method emit_expr env exp =
let rs = let rs =
List.map List.map
(fun id -> (fun id ->
let r = Reg.createv typ_addr in name_regs id r; r) let r = self#regs_for typ_addr in name_regs id r; r)
ids in ids in
catch_regs := (nfail, Array.concat rs) :: !catch_regs ; catch_regs := (nfail, Array.concat rs) :: !catch_regs ;
let (r1, s1) = self#emit_sequence env e1 in let (r1, s1) = self#emit_sequence env e1 in
@ -566,7 +573,7 @@ method emit_expr env exp =
| Ctrywith(e1, v, e2) -> | Ctrywith(e1, v, e2) ->
Proc.contains_calls := true; Proc.contains_calls := true;
let (r1, s1) = self#emit_sequence env e1 in let (r1, s1) = self#emit_sequence env e1 in
let rv = Reg.createv typ_addr in let rv = self#regs_for typ_addr in
let (r2, s2) = self#emit_sequence (Tbl.add v rv env) e2 in let (r2, s2) = self#emit_sequence (Tbl.add v rv env) e2 in
let r = join r1 s1 r2 s2 in let r = join r1 s1 r2 s2 in
self#insert self#insert
@ -586,10 +593,7 @@ method private bind_let env v r1 =
name_regs v r1; name_regs v r1;
Tbl.add v r1 env Tbl.add v r1 env
end else begin end else begin
let rv = Array.create (Array.length r1) Reg.dummy in let rv = Reg.createv_like r1 in
for i = 0 to Array.length r1 - 1 do
rv.(i) <- Reg.create r1.(i).typ
done;
name_regs v rv; name_regs v rv;
self#insert_moves r1 rv; self#insert_moves r1 rv;
Tbl.add v rv env Tbl.add v rv env
@ -602,25 +606,21 @@ method private emit_parts env exp =
match self#emit_expr env exp with match self#emit_expr env exp with
None -> None None -> None
| Some r -> | Some r ->
match Array.length r with if Array.length r = 0 then
0 ->
Some (Ctuple [], env) Some (Ctuple [], env)
| 1 -> else begin
(* The normal case *) (* The normal case *)
let id = Ident.create "bind" in let id = Ident.create "bind" in
let r0 = r.(0) in if all_regs_anonymous r then
if String.length r0.name = 0 then (* r is an anonymous, unshared register; use it directly *)
(* r0 is an anonymous, unshared register; use it directly *)
Some (Cvar id, Tbl.add id r env) Some (Cvar id, Tbl.add id r env)
else begin else begin
(* Introduce a fresh temp reg to hold the result *) (* Introduce a fresh temp to hold the result *)
let v0 = Reg.create r0.typ in let tmp = Reg.createv_like r in
self#insert_move r0 v0; self#insert_moves r tmp;
Some (Cvar id, Tbl.add id [|v0|] env) Some (Cvar id, Tbl.add id tmp env)
end
end end
| _ ->
(* Must not happen, we no longer support nested tuples *)
assert false
end end
method private emit_parts_list env exp_list = method private emit_parts_list env exp_list =
@ -709,7 +709,7 @@ method emit_tail env exp =
(Array.append [|r1.(0)|] loc_arg) [||] (Array.append [|r1.(0)|] loc_arg) [||]
end else begin end else begin
Proc.contains_calls := true; Proc.contains_calls := true;
let rd = Reg.createv ty in let rd = self#regs_for ty in
let loc_res = Proc.loc_results rd in let loc_res = Proc.loc_results rd in
self#insert_move_args rarg loc_arg stack_ofs; self#insert_move_args rarg loc_arg stack_ofs;
self#insert_debug (Iop Icall_ind) dbg self#insert_debug (Iop Icall_ind) dbg
@ -729,7 +729,7 @@ method emit_tail env exp =
self#insert (Iop(Itailcall_imm lbl)) loc_arg' [||] self#insert (Iop(Itailcall_imm lbl)) loc_arg' [||]
end else begin end else begin
Proc.contains_calls := true; Proc.contains_calls := true;
let rd = Reg.createv ty in let rd = self#regs_for ty in
let loc_res = Proc.loc_results rd in let loc_res = Proc.loc_results rd in
self#insert_move_args r1 loc_arg stack_ofs; self#insert_move_args r1 loc_arg stack_ofs;
self#insert_debug (Iop(Icall_imm lbl)) dbg loc_arg loc_res; self#insert_debug (Iop(Icall_imm lbl)) dbg loc_arg loc_res;
@ -764,7 +764,7 @@ method emit_tail env exp =
let rs = let rs =
List.map List.map
(fun id -> (fun id ->
let r = Reg.createv typ_addr in let r = self#regs_for typ_addr in
name_regs id r ; name_regs id r ;
r) r)
ids in ids in
@ -780,7 +780,7 @@ method emit_tail env exp =
| Ctrywith(e1, v, e2) -> | Ctrywith(e1, v, e2) ->
Proc.contains_calls := true; Proc.contains_calls := true;
let (opt_r1, s1) = self#emit_sequence env e1 in let (opt_r1, s1) = self#emit_sequence env e1 in
let rv = Reg.createv typ_addr in let rv = self#regs_for typ_addr in
let s2 = self#emit_tail_sequence (Tbl.add v rv env) e2 in let s2 = self#emit_tail_sequence (Tbl.add v rv env) e2 in
self#insert self#insert
(Itrywith(s1#extract, (Itrywith(s1#extract,
@ -808,7 +808,7 @@ method emit_fundecl f =
current_function_name := f.Cmm.fun_name; current_function_name := f.Cmm.fun_name;
let rargs = let rargs =
List.map List.map
(fun (id, ty) -> let r = Reg.createv ty in name_regs id r; r) (fun (id, ty) -> let r = self#regs_for ty in name_regs id r; r)
f.Cmm.fun_args in f.Cmm.fun_args in
let rarg = Array.concat rargs in let rarg = Array.concat rargs in
let loc_arg = Proc.loc_parameters rarg in let loc_arg = Proc.loc_parameters rarg in

5
asmcomp/selectgen.mli
View File

@ -39,6 +39,11 @@ class virtual selector_generic : object
method select_store : method select_store :
Arch.addressing_mode -> Cmm.expression -> Mach.operation * Cmm.expression Arch.addressing_mode -> Cmm.expression -> Mach.operation * Cmm.expression
(* Can be overriden to deal with special store constant instructions *) (* Can be overriden to deal with special store constant instructions *)
method regs_for : Cmm.machtype -> Reg.t array
(* Return an array of fresh registers of the given type.
Default implementation is like Reg.createv.
Can be overriden if float values are stored as pairs of
integer registers. *)
method insert_op : method insert_op :
Mach.operation -> Reg.t array -> Reg.t array -> Reg.t array Mach.operation -> Reg.t array -> Reg.t array -> Reg.t array
(* Can be overriden to deal with 2-address instructions (* Can be overriden to deal with 2-address instructions