summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.depend79
-rw-r--r--Makefile3
-rw-r--r--Makefile.nt3
-rw-r--r--asmcomp/asmgen.ml2
-rw-r--r--asmcomp/comballoc.ml88
-rw-r--r--asmcomp/comballoc.mli16
-rw-r--r--asmcomp/selectgen.ml126
7 files changed, 185 insertions, 132 deletions
diff --git a/.depend b/.depend
index 7fff8d312..112100725 100644
--- a/.depend
+++ b/.depend
@@ -10,6 +10,8 @@ utils/misc.cmo: utils/misc.cmi
utils/misc.cmx: utils/misc.cmi
utils/nativeint.cmo: utils/nativeint.cmi
utils/nativeint.cmx: utils/nativeint.cmi
+utils/safearith.cmo: utils/safearith.cmi
+utils/safearith.cmx: utils/safearith.cmi
utils/tbl.cmo: utils/tbl.cmi
utils/tbl.cmx: utils/tbl.cmi
utils/terminfo.cmo: utils/terminfo.cmi
@@ -368,6 +370,7 @@ asmcomp/closure.cmi: asmcomp/clambda.cmi bytecomp/lambda.cmi
asmcomp/cmm.cmi: typing/ident.cmi utils/nativeint.cmi
asmcomp/cmmgen.cmi: asmcomp/clambda.cmi asmcomp/cmm.cmi
asmcomp/codegen.cmi: asmcomp/cmm.cmi
+asmcomp/comballoc.cmi: asmcomp/mach.cmi
asmcomp/compilenv.cmi: asmcomp/clambda.cmi typing/ident.cmi
asmcomp/emit.cmi: asmcomp/cmm.cmi asmcomp/linearize.cmi
asmcomp/emitaux.cmi: utils/nativeint.cmi
@@ -390,24 +393,24 @@ asmcomp/selectgen.cmi: asmcomp/arch.cmo asmcomp/cmm.cmi typing/ident.cmi \
asmcomp/selection.cmi: asmcomp/cmm.cmi asmcomp/mach.cmi
asmcomp/spill.cmi: asmcomp/mach.cmi
asmcomp/split.cmi: asmcomp/mach.cmi
-asmcomp/arch.cmo: utils/config.cmi
-asmcomp/arch.cmx: utils/config.cmx
+asmcomp/arch.cmo: utils/nativeint.cmi
+asmcomp/arch.cmx: utils/nativeint.cmx
asmcomp/asmgen.cmo: utils/clflags.cmo asmcomp/closure.cmi asmcomp/cmm.cmi \
- asmcomp/cmmgen.cmi asmcomp/coloring.cmi utils/config.cmi asmcomp/emit.cmi \
- asmcomp/emitaux.cmi asmcomp/interf.cmi asmcomp/linearize.cmi \
- asmcomp/liveness.cmi asmcomp/mach.cmi utils/misc.cmi asmcomp/printcmm.cmi \
- asmcomp/printlinear.cmi asmcomp/printmach.cmi asmcomp/proc.cmi \
- asmcomp/reg.cmi asmcomp/reload.cmi asmcomp/scheduling.cmi \
- asmcomp/selection.cmi asmcomp/spill.cmi asmcomp/split.cmi \
- asmcomp/asmgen.cmi
+ asmcomp/cmmgen.cmi asmcomp/coloring.cmi asmcomp/comballoc.cmi \
+ utils/config.cmi asmcomp/emit.cmi asmcomp/emitaux.cmi asmcomp/interf.cmi \
+ asmcomp/linearize.cmi asmcomp/liveness.cmi asmcomp/mach.cmi \
+ utils/misc.cmi asmcomp/printcmm.cmi asmcomp/printlinear.cmi \
+ asmcomp/printmach.cmi asmcomp/proc.cmi asmcomp/reg.cmi asmcomp/reload.cmi \
+ asmcomp/scheduling.cmi asmcomp/selection.cmi asmcomp/spill.cmi \
+ asmcomp/split.cmi asmcomp/asmgen.cmi
asmcomp/asmgen.cmx: utils/clflags.cmx asmcomp/closure.cmx asmcomp/cmm.cmx \
- asmcomp/cmmgen.cmx asmcomp/coloring.cmx utils/config.cmx asmcomp/emit.cmx \
- asmcomp/emitaux.cmx asmcomp/interf.cmx asmcomp/linearize.cmx \
- asmcomp/liveness.cmx asmcomp/mach.cmx utils/misc.cmx asmcomp/printcmm.cmx \
- asmcomp/printlinear.cmx asmcomp/printmach.cmx asmcomp/proc.cmx \
- asmcomp/reg.cmx asmcomp/reload.cmx asmcomp/scheduling.cmx \
- asmcomp/selection.cmx asmcomp/spill.cmx asmcomp/split.cmx \
- asmcomp/asmgen.cmi
+ asmcomp/cmmgen.cmx asmcomp/coloring.cmx asmcomp/comballoc.cmx \
+ utils/config.cmx asmcomp/emit.cmx asmcomp/emitaux.cmx asmcomp/interf.cmx \
+ asmcomp/linearize.cmx asmcomp/liveness.cmx asmcomp/mach.cmx \
+ utils/misc.cmx asmcomp/printcmm.cmx asmcomp/printlinear.cmx \
+ asmcomp/printmach.cmx asmcomp/proc.cmx asmcomp/reg.cmx asmcomp/reload.cmx \
+ asmcomp/scheduling.cmx asmcomp/selection.cmx asmcomp/spill.cmx \
+ asmcomp/split.cmx asmcomp/asmgen.cmi
asmcomp/asmlibrarian.cmo: utils/ccomp.cmi asmcomp/clambda.cmi \
utils/clflags.cmo asmcomp/compilenv.cmi utils/config.cmi utils/misc.cmi \
asmcomp/asmlibrarian.cmi
@@ -458,17 +461,19 @@ asmcomp/codegen.cmx: asmcomp/cmm.cmx asmcomp/coloring.cmx asmcomp/emit.cmx \
asmcomp/codegen.cmi
asmcomp/coloring.cmo: asmcomp/proc.cmi asmcomp/reg.cmi asmcomp/coloring.cmi
asmcomp/coloring.cmx: asmcomp/proc.cmx asmcomp/reg.cmx asmcomp/coloring.cmi
+asmcomp/comballoc.cmo: utils/config.cmi asmcomp/reg.cmi asmcomp/comballoc.cmi
+asmcomp/comballoc.cmx: utils/config.cmx asmcomp/reg.cmx asmcomp/comballoc.cmi
asmcomp/compilenv.cmo: asmcomp/clambda.cmi utils/config.cmi typing/env.cmi \
typing/ident.cmi utils/misc.cmi asmcomp/compilenv.cmi
asmcomp/compilenv.cmx: asmcomp/clambda.cmx utils/config.cmx typing/env.cmx \
typing/ident.cmx utils/misc.cmx asmcomp/compilenv.cmi
-asmcomp/emit.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/compilenv.cmi \
- utils/config.cmi asmcomp/emitaux.cmi asmcomp/linearize.cmi \
- parsing/location.cmi asmcomp/mach.cmi utils/misc.cmi utils/nativeint.cmi \
+asmcomp/emit.cmo: asmcomp/arch.cmo utils/clflags.cmo asmcomp/cmm.cmi \
+ asmcomp/compilenv.cmi utils/config.cmi asmcomp/emitaux.cmi \
+ asmcomp/linearize.cmi asmcomp/mach.cmi utils/misc.cmi utils/nativeint.cmi \
asmcomp/proc.cmi asmcomp/reg.cmi asmcomp/emit.cmi
-asmcomp/emit.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/compilenv.cmx \
- utils/config.cmx asmcomp/emitaux.cmx asmcomp/linearize.cmx \
- parsing/location.cmx asmcomp/mach.cmx utils/misc.cmx utils/nativeint.cmx \
+asmcomp/emit.cmx: asmcomp/arch.cmx utils/clflags.cmx asmcomp/cmm.cmx \
+ asmcomp/compilenv.cmx utils/config.cmx asmcomp/emitaux.cmx \
+ asmcomp/linearize.cmx asmcomp/mach.cmx utils/misc.cmx utils/nativeint.cmx \
asmcomp/proc.cmx asmcomp/reg.cmx asmcomp/emit.cmi
asmcomp/emitaux.cmo: utils/nativeint.cmi asmcomp/emitaux.cmi
asmcomp/emitaux.cmx: utils/nativeint.cmx asmcomp/emitaux.cmi
@@ -502,16 +507,16 @@ asmcomp/printmach.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/mach.cmi \
asmcomp/printmach.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/mach.cmx \
utils/nativeint.cmx asmcomp/printcmm.cmx asmcomp/proc.cmx asmcomp/reg.cmx \
asmcomp/printmach.cmi
-asmcomp/proc.cmo: asmcomp/arch.cmo utils/ccomp.cmi utils/clflags.cmo \
- asmcomp/cmm.cmi asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi \
- asmcomp/proc.cmi
-asmcomp/proc.cmx: asmcomp/arch.cmx utils/ccomp.cmx utils/clflags.cmx \
- asmcomp/cmm.cmx asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx \
- asmcomp/proc.cmi
+asmcomp/proc.cmo: asmcomp/arch.cmo utils/ccomp.cmi asmcomp/cmm.cmi \
+ asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi asmcomp/proc.cmi
+asmcomp/proc.cmx: asmcomp/arch.cmx utils/ccomp.cmx asmcomp/cmm.cmx \
+ asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx asmcomp/proc.cmi
asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi
asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi
-asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reload.cmi
-asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reload.cmi
+asmcomp/reload.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/mach.cmi \
+ asmcomp/reg.cmi asmcomp/reloadgen.cmi asmcomp/reload.cmi
+asmcomp/reload.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/mach.cmx \
+ asmcomp/reg.cmx asmcomp/reloadgen.cmx asmcomp/reload.cmi
asmcomp/reloadgen.cmo: asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi \
asmcomp/reloadgen.cmi
asmcomp/reloadgen.cmx: asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx \
@@ -520,10 +525,8 @@ asmcomp/schedgen.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/linearize.cmi \
asmcomp/mach.cmi utils/misc.cmi asmcomp/reg.cmi asmcomp/schedgen.cmi
asmcomp/schedgen.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/linearize.cmx \
asmcomp/mach.cmx utils/misc.cmx asmcomp/reg.cmx asmcomp/schedgen.cmi
-asmcomp/scheduling.cmo: asmcomp/arch.cmo asmcomp/mach.cmi \
- asmcomp/schedgen.cmi asmcomp/scheduling.cmi
-asmcomp/scheduling.cmx: asmcomp/arch.cmx asmcomp/mach.cmx \
- asmcomp/schedgen.cmx asmcomp/scheduling.cmi
+asmcomp/scheduling.cmo: asmcomp/schedgen.cmi asmcomp/scheduling.cmi
+asmcomp/scheduling.cmx: asmcomp/schedgen.cmx asmcomp/scheduling.cmi
asmcomp/selectgen.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi typing/ident.cmi \
asmcomp/mach.cmi utils/misc.cmi utils/nativeint.cmi asmcomp/proc.cmi \
asmcomp/reg.cmi utils/tbl.cmi asmcomp/selectgen.cmi
@@ -531,11 +534,11 @@ asmcomp/selectgen.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx typing/ident.cmx \
asmcomp/mach.cmx utils/misc.cmx utils/nativeint.cmx asmcomp/proc.cmx \
asmcomp/reg.cmx utils/tbl.cmx asmcomp/selectgen.cmi
asmcomp/selection.cmo: asmcomp/arch.cmo asmcomp/cmm.cmi asmcomp/mach.cmi \
- utils/misc.cmi asmcomp/reg.cmi asmcomp/selectgen.cmi \
- asmcomp/selection.cmi
+ utils/misc.cmi utils/nativeint.cmi asmcomp/proc.cmi asmcomp/reg.cmi \
+ asmcomp/selectgen.cmi asmcomp/selection.cmi
asmcomp/selection.cmx: asmcomp/arch.cmx asmcomp/cmm.cmx asmcomp/mach.cmx \
- utils/misc.cmx asmcomp/reg.cmx asmcomp/selectgen.cmx \
- asmcomp/selection.cmi
+ utils/misc.cmx utils/nativeint.cmx asmcomp/proc.cmx asmcomp/reg.cmx \
+ asmcomp/selectgen.cmx asmcomp/selection.cmi
asmcomp/spill.cmo: asmcomp/mach.cmi asmcomp/proc.cmi asmcomp/reg.cmi \
asmcomp/spill.cmi
asmcomp/spill.cmx: asmcomp/mach.cmx asmcomp/proc.cmx asmcomp/reg.cmx \
diff --git a/Makefile b/Makefile
index dc955c9d4..c160f5f72 100644
--- a/Makefile
+++ b/Makefile
@@ -54,7 +54,8 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/cmm.cmo asmcomp/printcmm.cmo \
asmcomp/clambda.cmo asmcomp/compilenv.cmo \
asmcomp/closure.cmo asmcomp/cmmgen.cmo \
asmcomp/printmach.cmo asmcomp/selectgen.cmo asmcomp/selection.cmo \
- asmcomp/liveness.cmo asmcomp/spill.cmo asmcomp/split.cmo \
+ asmcomp/comballoc.cmo asmcomp/liveness.cmo \
+ asmcomp/spill.cmo asmcomp/split.cmo \
asmcomp/interf.cmo asmcomp/coloring.cmo \
asmcomp/reloadgen.cmo asmcomp/reload.cmo \
asmcomp/printlinear.cmo asmcomp/linearize.cmo \
diff --git a/Makefile.nt b/Makefile.nt
index 461ac1d1f..594c690e1 100644
--- a/Makefile.nt
+++ b/Makefile.nt
@@ -52,7 +52,8 @@ ASMCOMP=asmcomp\arch.cmo asmcomp\cmm.cmo asmcomp\printcmm.cmo \
asmcomp\clambda.cmo asmcomp\compilenv.cmo \
asmcomp\closure.cmo asmcomp\cmmgen.cmo \
asmcomp\printmach.cmo asmcomp\selectgen.cmo asmcomp\selection.cmo \
- asmcomp\liveness.cmo asmcomp\spill.cmo asmcomp\split.cmo \
+ amscomp\comballoc.cmo asmcomp\liveness.cmo \
+ asmcomp\spill.cmo asmcomp\split.cmo \
asmcomp\interf.cmo asmcomp\coloring.cmo \
asmcomp\reloadgen.cmo asmcomp\reload.cmo \
asmcomp\printlinear.cmo asmcomp\linearize.cmo \
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index 358f8528e..460408ab6 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -62,6 +62,8 @@ let compile_fundecl fd_cmm =
fd_cmm
++ Selection.fundecl
++ pass_dump_if dump_selection "After instruction selection"
+ ++ Comballoc.fundecl
+ ++ pass_dump_if dump_combine "After allocation combining"
++ liveness
++ pass_dump_if dump_live "Liveness analysis"
++ Spill.fundecl
diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml
new file mode 100644
index 000000000..1eb361df2
--- /dev/null
+++ b/asmcomp/comballoc.ml
@@ -0,0 +1,88 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1999 Institut National de Recherche en Informatique et *)
+(* en Automatique. Distributed only by permission. *)
+(* *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Combine heap allocations occurring in the same basic block *)
+
+open Mach
+
+type allocation_state =
+ No_alloc (* no allocation is pending *)
+ | Pending_alloc of Reg.t * int (* an allocation is pending *)
+(* The arguments of Pending_alloc(reg, ofs) are:
+ reg the register holding the result of the last allocation
+ ofs the alloc position in the allocated block *)
+
+let allocated_size = function
+ No_alloc -> 0
+ | Pending_alloc(reg, ofs) -> ofs
+
+let rec combine i allocstate =
+ match i.desc with
+ Iend | Ireturn | Iexit | Iraise ->
+ (i, allocated_size allocstate)
+ | Iop(Ialloc sz) ->
+ begin match allocstate with
+ No_alloc ->
+ let (newnext, newsz) =
+ combine i.next (Pending_alloc(i.res.(0), sz)) in
+ (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, 0)
+ | Pending_alloc(reg, ofs) ->
+ if ofs + sz < Config.max_young_wosize then begin
+ let (newnext, newsz) =
+ combine i.next (Pending_alloc(reg, ofs + sz)) in
+ (instr_cons (Iop(Iintop_imm(Iadd, ofs))) [| reg |] i.res newnext,
+ newsz)
+ end else begin
+ let (newnext, newsz) =
+ combine i.next (Pending_alloc(i.res.(0), sz)) in
+ (instr_cons (Iop(Ialloc newsz)) i.arg i.res newnext, ofs)
+ end
+ end
+ | Iop(Icall_ind | Icall_imm _ | Iextcall(_, _) |
+ Itailcall_ind | Itailcall_imm _) ->
+ let newnext = combine_restart i.next in
+ (instr_cons i.desc i.arg i.res newnext, allocated_size allocstate)
+ | Iop op ->
+ let (newnext, sz) = combine i.next allocstate in
+ (instr_cons i.desc i.arg i.res newnext, sz)
+ | Iifthenelse(test, ifso, ifnot) ->
+ let newifso = combine_restart ifso in
+ let newifnot = combine_restart ifnot in
+ let newnext = combine_restart i.next in
+ (instr_cons (Iifthenelse(test, newifso, newifnot)) i.arg i.res newnext,
+ allocated_size allocstate)
+ | Iswitch(table, cases) ->
+ let newcases = Array.map combine_restart cases in
+ let newnext = combine_restart i.next in
+ (instr_cons (Iswitch(table, newcases)) i.arg i.res newnext,
+ allocated_size allocstate)
+ | Iloop(body) ->
+ let newbody = combine_restart body in
+ (instr_cons (Iloop(newbody)) i.arg i.res i.next,
+ allocated_size allocstate)
+ | Icatch(body, handler) ->
+ let (newbody, sz) = combine body allocstate in
+ let newhandler = combine_restart handler in
+ let newnext = combine_restart i.next in
+ (instr_cons (Icatch(newbody, newhandler)) i.arg i.res newnext, sz)
+ | Itrywith(body, handler) ->
+ let (newbody, sz) = combine body allocstate in
+ let newhandler = combine_restart handler in
+ let newnext = combine_restart i.next in
+ (instr_cons (Itrywith(newbody, newhandler)) i.arg i.res newnext, sz)
+
+and combine_restart i =
+ let (newi, _) = combine i No_alloc in newi
+
+let fundecl f =
+ {f with fun_body = combine_restart f.fun_body}
diff --git a/asmcomp/comballoc.mli b/asmcomp/comballoc.mli
new file mode 100644
index 000000000..903c1605c
--- /dev/null
+++ b/asmcomp/comballoc.mli
@@ -0,0 +1,16 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1999 Institut National de Recherche en Informatique et *)
+(* en Automatique. Distributed only by permission. *)
+(* *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Combine heap allocations occurring in the same basic block *)
+
+val fundecl: Mach.fundecl -> Mach.fundecl
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index 5da131c88..fe4269313 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -44,60 +44,33 @@ let oper_result_type = function
(* Infer the size in bytes of the result of a simple expression *)
-let rec size env localenv = function
- Cconst_int _ | Cconst_natint _ -> Arch.size_int
- | Cconst_symbol _ | Cconst_pointer _ -> Arch.size_addr
- | Cconst_float _ -> Arch.size_float
- | Cvar id ->
- begin try
- Tbl.find id localenv
- with Not_found ->
- try
- let regs = Tbl.find id env in
- size_machtype (Array.map (fun r -> r.typ) regs)
- with Not_found ->
- fatal_error("Selection.size_expr: unbound var " ^
- Ident.unique_name id)
- end
- | Ctuple el ->
- size_list env localenv el
- | Cop(op, args) ->
- size_machtype(oper_result_type op)
- | Clet(id, arg, body) ->
- size env (Tbl.add id (size env localenv arg) localenv) body
- | Csequence(e1, e2) ->
- size env localenv e2
- | _ ->
- fatal_error "Selection.size"
-
-and size_list env localenv el =
- List.fold_right (fun e sz -> size env localenv e + sz) el 0
-
-let size_expr env exp = size env Tbl.empty exp
-
-(* Compute the total size (in bytes) of memory allocated by
- a simple expression *)
-
-let rec alloc_sz env localenv = function
- Ctuple el ->
- alloc_sz_list env localenv el
- | Cop(op, args) ->
- let s = alloc_sz_list env localenv args in
- begin match op with
- Calloc -> s + size_list env localenv args
- | _ -> s
- end
- | Clet(id, arg, body) ->
- alloc_sz env localenv arg +
- alloc_sz env (Tbl.add id (size env localenv arg) localenv) body
- | Csequence(e1, e2) ->
- alloc_sz env localenv e1 + alloc_sz env localenv e2
- | _ -> 0
-
-and alloc_sz_list env localenv el =
- List.fold_right (fun e sz -> alloc_sz env localenv e + sz) el 0
-
-let alloc_size env exp = alloc_sz env Tbl.empty exp
+let size_expr env exp =
+ let rec size localenv = function
+ Cconst_int _ | Cconst_natint _ -> Arch.size_int
+ | Cconst_symbol _ | Cconst_pointer _ -> Arch.size_addr
+ | Cconst_float _ -> Arch.size_float
+ | Cvar id ->
+ begin try
+ Tbl.find id localenv
+ with Not_found ->
+ try
+ let regs = Tbl.find id env in
+ size_machtype (Array.map (fun r -> r.typ) regs)
+ with Not_found ->
+ fatal_error("Selection.size_expr: unbound var " ^
+ Ident.unique_name id)
+ end
+ | Ctuple el ->
+ List.fold_right (fun e sz -> size localenv e + sz) el 0
+ | Cop(op, args) ->
+ size_machtype(oper_result_type op)
+ | Clet(id, arg, body) ->
+ size (Tbl.add id (size localenv arg) localenv) body
+ | Csequence(e1, e2) ->
+ size localenv e2
+ | _ ->
+ fatal_error "Selection.size_expr"
+ in size Tbl.empty exp
(* Says if an expression is "simple". A "simple" expression has no
side-effects and its execution can be delayed until its value
@@ -119,7 +92,7 @@ let rec is_simple_expr = function
| Cop(op, args) ->
begin match op with
(* The following may have side effects *)
- Capply _ | Cextcall(_, _, _) | Cstore | Cstorechunk _ |
+ Capply _ | Cextcall(_, _, _) | Calloc | Cstore | Cstorechunk _ |
Craise -> false
(* The remaining operations are simple if their args are *)
| _ -> List.for_all is_simple_expr args
@@ -197,11 +170,6 @@ let join_array rs =
res
end
-(* Addressing mode to refer to the header word of a newly allocated object *)
-
-let header_addressing =
- Arch.offset_addressing Arch.identity_addressing (-Arch.size_int)
-
(* The default instruction selection class *)
class virtual selector_generic = object (self)
@@ -357,14 +325,6 @@ method extract =
else extract (instr_cons i.desc i.arg i.res res) i.next in
extract (end_instr()) instr_seq
-(* Are we inside a combined allocation? *)
-
-val mutable alloc_state = (None : (Reg.t array * int) option)
-
-(* None: no combined allocation
- Some(r, n): earlier allocation left result in register [r],
- current offset in allocated block is [n]. *)
-
(* Insert a sequence of moves from one pseudoreg set to another. *)
method insert_move src dst =
@@ -491,35 +451,17 @@ method emit_expr env exp =
Proc.contains_calls := true;
let rd = Reg.createv typ_addr in
let size = size_expr env (Ctuple new_args) in
- begin match alloc_state with
- None ->
- let total_size = alloc_size env (Cop(Calloc, new_args)) in
- self#insert (Iop(Ialloc total_size)) [||] rd;
- alloc_state <- Some(rd, size);
- self#emit_stores env new_args rd header_addressing;
- alloc_state <- None;
- rd
- | Some(ralloc, ofs) ->
- if self#is_immediate ofs then
- ignore(self#insert_op (Iintop_imm(Iadd, ofs)) ralloc rd)
- else begin
- let r = Reg.createv typ_int in
- ignore(self#insert_op (Iconst_int(Nativeint.from ofs)) [||] r);
- ignore(self#insert_op (Iintop Iadd)
- (Array.append ralloc r) rd)
- end;
- alloc_state <- Some(ralloc, ofs + size);
- self#emit_stores env new_args ralloc
- (Arch.offset_addressing header_addressing ofs);
- rd
- end
+ self#insert (Iop(Ialloc size)) [||] rd;
+ self#emit_stores env new_args rd
+ (Arch.offset_addressing Arch.identity_addressing (-Arch.size_int));
+ rd
| op ->
let r1 = self#emit_tuple env new_args in
let rd = Reg.createv ty in
self#insert_op op r1 rd
end
| Csequence(e1, e2) ->
- ignore(self#emit_expr env e1);
+ let _ = self#emit_expr env e1 in
self#emit_expr env e2
| Cifthenelse(econd, eif, eelse) ->
let (cond, earg) = self#select_condition econd in
@@ -695,7 +637,7 @@ method emit_tail env exp =
self#insert (Iop Imove) r1 rd;
self#insert Iraise rd [||]
| Csequence(e1, e2) ->
- ignore(self#emit_expr env e1);
+ let _ = self#emit_expr env e1 in
self#emit_tail env e2
| Cifthenelse(econd, eif, eelse) ->
let (cond, earg) = self#select_condition econd in
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-24 12:51:51 +0000