rpms
/
ocaml
2
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
ocaml/0018-Fix-PR-6878-AArch64-co...

1220 lines
54 KiB
Diff
Raw Blame History

From 2a2f55156c3d53f22095968f1785e79cca7676e7 Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@janestreet.com>
Date: Wed, 10 Jun 2015 09:27:36 +0000
Subject: [PATCH 18/18] Fix PR#6878: AArch64 conditional branches out of range.
(Introduces new, generic branch relaxation module.)
git-svn-id: http://caml.inria.fr/svn/ocaml/version/4.02@16168 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
(cherry picked from commit d2a9da66eca1cb769e555b79a23b1ac64c01d1b5)
---
.depend | 130 +++++++++--------
Makefile | 2 +
asmcomp/amd64/emit.mlp | 6 +
asmcomp/arm64/arch.ml | 13 ++
asmcomp/arm64/emit.mlp | 294 +++++++++++++++++++++++++++++++++++---
asmcomp/branch_relaxation.ml | 138 ++++++++++++++++++
asmcomp/branch_relaxation.mli | 26 ++++
asmcomp/branch_relaxation_intf.ml | 63 ++++++++
asmcomp/power/emit.mlp | 190 ++++++++++--------------
9 files changed, 666 insertions(+), 196 deletions(-)
create mode 100644 asmcomp/branch_relaxation.ml
create mode 100644 asmcomp/branch_relaxation.mli
create mode 100644 asmcomp/branch_relaxation_intf.ml
diff --git a/.depend b/.depend
index 5d95a9b..813fbd7 100644
--- a/.depend
+++ b/.depend
@@ -94,10 +94,10 @@ typing/ctype.cmi : typing/types.cmi typing/path.cmi parsing/longident.cmi \
typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
typing/datarepr.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi \
parsing/asttypes.cmi
+typing/envaux.cmi : typing/subst.cmi typing/path.cmi typing/env.cmi
typing/env.cmi : utils/warnings.cmi typing/types.cmi typing/subst.cmi \
typing/path.cmi parsing/longident.cmi parsing/location.cmi \
typing/ident.cmi utils/consistbl.cmi parsing/asttypes.cmi
-typing/envaux.cmi : typing/subst.cmi typing/path.cmi typing/env.cmi
typing/ident.cmi :
typing/includeclass.cmi : typing/types.cmi typing/env.cmi typing/ctype.cmi
typing/includecore.cmi : typing/types.cmi typing/typedtree.cmi \
@@ -115,10 +115,10 @@ typing/parmatch.cmi : typing/types.cmi typing/typedtree.cmi \
typing/path.cmi : typing/ident.cmi
typing/predef.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi
typing/primitive.cmi :
+typing/printtyped.cmi : typing/typedtree.cmi
typing/printtyp.cmi : typing/types.cmi typing/path.cmi \
typing/outcometree.cmi parsing/longident.cmi typing/ident.cmi \
typing/env.cmi
-typing/printtyped.cmi : typing/typedtree.cmi
typing/stypes.cmi : typing/typedtree.cmi parsing/location.cmi \
typing/annot.cmi
typing/subst.cmi : typing/types.cmi typing/path.cmi typing/ident.cmi
@@ -131,11 +131,11 @@ typing/typecore.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
typing/typedecl.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
typing/includecore.cmi typing/ident.cmi typing/env.cmi
-typing/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \
- parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
- typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
typing/typedtreeIter.cmi : typing/typedtree.cmi parsing/asttypes.cmi
typing/typedtreeMap.cmi : typing/typedtree.cmi
+typing/typedtree.cmi : typing/types.cmi typing/primitive.cmi typing/path.cmi \
+ parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
+ typing/ident.cmi typing/env.cmi parsing/asttypes.cmi
typing/typemod.cmi : typing/types.cmi typing/typedtree.cmi typing/path.cmi \
parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
typing/includemod.cmi typing/ident.cmi typing/env.cmi \
@@ -176,6 +176,12 @@ typing/datarepr.cmo : typing/types.cmi typing/path.cmi parsing/location.cmi \
typing/datarepr.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \
typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi \
typing/datarepr.cmi
+typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \
+ typing/path.cmi utils/misc.cmi typing/ident.cmi typing/env.cmi \
+ parsing/asttypes.cmi typing/envaux.cmi
+typing/envaux.cmx : typing/types.cmx typing/subst.cmx typing/printtyp.cmx \
+ typing/path.cmx utils/misc.cmx typing/ident.cmx typing/env.cmx \
+ parsing/asttypes.cmi typing/envaux.cmi
typing/env.cmo : utils/warnings.cmi typing/types.cmi utils/tbl.cmi \
typing/subst.cmi typing/predef.cmi typing/path.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
@@ -188,12 +194,6 @@ typing/env.cmx : utils/warnings.cmx typing/types.cmx utils/tbl.cmx \
typing/datarepr.cmx utils/consistbl.cmx utils/config.cmx \
typing/cmi_format.cmx utils/clflags.cmx typing/btype.cmx \
parsing/asttypes.cmi typing/env.cmi
-typing/envaux.cmo : typing/types.cmi typing/subst.cmi typing/printtyp.cmi \
- typing/path.cmi utils/misc.cmi typing/ident.cmi typing/env.cmi \
- parsing/asttypes.cmi typing/envaux.cmi
-typing/envaux.cmx : typing/types.cmx typing/subst.cmx typing/printtyp.cmx \
- typing/path.cmx utils/misc.cmx typing/ident.cmx typing/env.cmx \
- parsing/asttypes.cmi typing/envaux.cmi
typing/ident.cmo : typing/ident.cmi
typing/ident.cmx : typing/ident.cmi
typing/includeclass.cmo : typing/types.cmi typing/printtyp.cmi \
@@ -252,24 +252,24 @@ typing/predef.cmx : typing/types.cmx typing/path.cmx parsing/location.cmx \
typing/ident.cmx typing/btype.cmx parsing/asttypes.cmi typing/predef.cmi
typing/primitive.cmo : utils/misc.cmi typing/primitive.cmi
typing/primitive.cmx : utils/misc.cmx typing/primitive.cmi
-typing/printtyp.cmo : typing/types.cmi typing/primitive.cmi \
- typing/predef.cmi typing/path.cmi typing/outcometree.cmi \
- typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
- parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
- utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
- typing/printtyp.cmi
-typing/printtyp.cmx : typing/types.cmx typing/primitive.cmx \
- typing/predef.cmx typing/path.cmx typing/outcometree.cmi \
- typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
- parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
- utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
- typing/printtyp.cmi
typing/printtyped.cmo : typing/typedtree.cmi parsing/printast.cmi \
typing/path.cmi utils/misc.cmi parsing/longident.cmi parsing/location.cmi \
typing/ident.cmi parsing/asttypes.cmi typing/printtyped.cmi
typing/printtyped.cmx : typing/typedtree.cmx parsing/printast.cmx \
typing/path.cmx utils/misc.cmx parsing/longident.cmx parsing/location.cmx \
typing/ident.cmx parsing/asttypes.cmi typing/printtyped.cmi
+typing/printtyp.cmo : typing/types.cmi typing/primitive.cmi \
+ typing/predef.cmi typing/path.cmi typing/outcometree.cmi \
+ typing/oprint.cmi utils/misc.cmi parsing/longident.cmi \
+ parsing/location.cmi typing/ident.cmi typing/env.cmi typing/ctype.cmi \
+ utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \
+ typing/printtyp.cmi
+typing/printtyp.cmx : typing/types.cmx typing/primitive.cmx \
+ typing/predef.cmx typing/path.cmx typing/outcometree.cmi \
+ typing/oprint.cmx utils/misc.cmx parsing/longident.cmx \
+ parsing/location.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
+ utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
+ typing/printtyp.cmi
typing/stypes.cmo : typing/typedtree.cmi typing/printtyp.cmi \
parsing/location.cmi utils/clflags.cmi typing/annot.cmi typing/stypes.cmi
typing/stypes.cmx : typing/typedtree.cmx typing/printtyp.cmx \
@@ -332,14 +332,6 @@ typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \
typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \
utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
parsing/ast_helper.cmx typing/typedecl.cmi
-typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \
- parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
- parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi \
- typing/typedtree.cmi
-typing/typedtree.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \
- parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
- parsing/location.cmx typing/ident.cmx typing/env.cmx parsing/asttypes.cmi \
- typing/typedtree.cmi
typing/typedtreeIter.cmo : typing/typedtree.cmi utils/misc.cmi \
parsing/asttypes.cmi typing/typedtreeIter.cmi
typing/typedtreeIter.cmx : typing/typedtree.cmx utils/misc.cmx \
@@ -348,6 +340,14 @@ typing/typedtreeMap.cmo : typing/typedtree.cmi utils/misc.cmi \
typing/typedtreeMap.cmi
typing/typedtreeMap.cmx : typing/typedtree.cmx utils/misc.cmx \
typing/typedtreeMap.cmi
+typing/typedtree.cmo : typing/types.cmi typing/primitive.cmi typing/path.cmi \
+ parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
+ parsing/location.cmi typing/ident.cmi typing/env.cmi parsing/asttypes.cmi \
+ typing/typedtree.cmi
+typing/typedtree.cmx : typing/types.cmx typing/primitive.cmx typing/path.cmx \
+ parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
+ parsing/location.cmx typing/ident.cmx typing/env.cmx parsing/asttypes.cmi \
+ typing/typedtree.cmi
typing/typemod.cmo : utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \
@@ -578,27 +578,29 @@ bytecomp/typeopt.cmo : typing/types.cmi typing/typedtree.cmi \
bytecomp/typeopt.cmx : typing/types.cmx typing/typedtree.cmx \
typing/predef.cmx typing/path.cmx bytecomp/lambda.cmx typing/ident.cmx \
typing/env.cmx typing/ctype.cmx bytecomp/typeopt.cmi
-asmcomp/CSEgen.cmi : asmcomp/mach.cmi
asmcomp/asmgen.cmi : bytecomp/lambda.cmi asmcomp/cmm.cmi
asmcomp/asmlibrarian.cmi :
asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi
asmcomp/asmpackager.cmi : typing/env.cmi
+asmcomp/branch_relaxation.cmi : asmcomp/linearize.cmi \
+ asmcomp/branch_relaxation_intf.cmo
asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \
asmcomp/debuginfo.cmi parsing/asttypes.cmi
asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi
-asmcomp/cmm.cmi : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi
asmcomp/cmmgen.cmi : asmcomp/cmx_format.cmi asmcomp/cmm.cmi \
asmcomp/clambda.cmi
+asmcomp/cmm.cmi : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi
asmcomp/cmx_format.cmi : asmcomp/clambda.cmi
asmcomp/codegen.cmi : asmcomp/cmm.cmi
asmcomp/coloring.cmi :
asmcomp/comballoc.cmi : asmcomp/mach.cmi
asmcomp/compilenv.cmi : typing/ident.cmi asmcomp/cmx_format.cmi \
asmcomp/clambda.cmi
+asmcomp/CSEgen.cmi : asmcomp/mach.cmi
asmcomp/deadcode.cmi : asmcomp/mach.cmi
asmcomp/debuginfo.cmi : parsing/location.cmi bytecomp/lambda.cmi
-asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi
asmcomp/emitaux.cmi : asmcomp/debuginfo.cmi
+asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi
asmcomp/interf.cmi : asmcomp/mach.cmi
asmcomp/linearize.cmi : asmcomp/reg.cmi asmcomp/mach.cmi bytecomp/lambda.cmi \
asmcomp/debuginfo.cmi
@@ -611,8 +613,8 @@ asmcomp/printlinear.cmi : asmcomp/linearize.cmi
asmcomp/printmach.cmi : asmcomp/reg.cmi asmcomp/mach.cmi
asmcomp/proc.cmi : asmcomp/reg.cmi asmcomp/mach.cmi
asmcomp/reg.cmi : typing/ident.cmi asmcomp/cmm.cmi
-asmcomp/reload.cmi : asmcomp/mach.cmi
asmcomp/reloadgen.cmi : asmcomp/reg.cmi asmcomp/mach.cmi
+asmcomp/reload.cmi : asmcomp/mach.cmi
asmcomp/schedgen.cmi : asmcomp/mach.cmi asmcomp/linearize.cmi
asmcomp/scheduling.cmi : asmcomp/linearize.cmi
asmcomp/selectgen.cmi : utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
@@ -621,12 +623,6 @@ asmcomp/selection.cmi : asmcomp/mach.cmi asmcomp/cmm.cmi
asmcomp/spill.cmi : asmcomp/mach.cmi
asmcomp/split.cmi : asmcomp/mach.cmi
asmcomp/strmatch.cmi : asmcomp/cmm.cmi
-asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo
-asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx
-asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
- asmcomp/CSEgen.cmi
-asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
- asmcomp/CSEgen.cmi
asmcomp/arch.cmo :
asmcomp/arch.cmx :
asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \
@@ -677,6 +673,14 @@ asmcomp/asmpackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \
utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \
utils/clflags.cmx utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \
asmcomp/asmpackager.cmi
+asmcomp/branch_relaxation_intf.cmo : asmcomp/linearize.cmi asmcomp/arch.cmo
+asmcomp/branch_relaxation_intf.cmx : asmcomp/linearize.cmx asmcomp/arch.cmx
+asmcomp/branch_relaxation.cmo : utils/misc.cmi asmcomp/mach.cmi \
+ asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/branch_relaxation_intf.cmo \
+ asmcomp/branch_relaxation.cmi
+asmcomp/branch_relaxation.cmx : utils/misc.cmx asmcomp/mach.cmx \
+ asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/branch_relaxation_intf.cmx \
+ asmcomp/branch_relaxation.cmi
asmcomp/clambda.cmo : bytecomp/lambda.cmi typing/ident.cmi \
asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/clambda.cmi
asmcomp/clambda.cmx : bytecomp/lambda.cmx typing/ident.cmx \
@@ -691,10 +695,6 @@ asmcomp/closure.cmx : utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \
asmcomp/debuginfo.cmx asmcomp/compilenv.cmx utils/clflags.cmx \
asmcomp/clambda.cmx parsing/asttypes.cmi asmcomp/arch.cmx \
asmcomp/closure.cmi
-asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
- asmcomp/arch.cmo asmcomp/cmm.cmi
-asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \
- asmcomp/arch.cmx asmcomp/cmm.cmi
asmcomp/cmmgen.cmo : typing/types.cmi bytecomp/switch.cmi \
asmcomp/strmatch.cmi asmcomp/proc.cmi typing/primitive.cmi utils/misc.cmi \
bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
@@ -707,6 +707,10 @@ asmcomp/cmmgen.cmx : typing/types.cmx bytecomp/switch.cmx \
utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \
asmcomp/cmm.cmx utils/clflags.cmx asmcomp/clambda.cmx \
parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/cmmgen.cmi
+asmcomp/cmm.cmo : bytecomp/lambda.cmi typing/ident.cmi asmcomp/debuginfo.cmi \
+ asmcomp/arch.cmo asmcomp/cmm.cmi
+asmcomp/cmm.cmx : bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \
+ asmcomp/arch.cmx asmcomp/cmm.cmi
asmcomp/codegen.cmo : asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \
asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \
asmcomp/printcmm.cmi asmcomp/liveness.cmi asmcomp/linearize.cmi \
@@ -729,6 +733,12 @@ asmcomp/compilenv.cmo : utils/misc.cmi parsing/location.cmi typing/ident.cmi \
asmcomp/compilenv.cmx : utils/misc.cmx parsing/location.cmx typing/ident.cmx \
typing/env.cmx utils/config.cmx asmcomp/cmx_format.cmi \
asmcomp/clambda.cmx asmcomp/compilenv.cmi
+asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
+ asmcomp/CSEgen.cmi
+asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
+ asmcomp/CSEgen.cmi
+asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo
+asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx
asmcomp/deadcode.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
asmcomp/deadcode.cmi
asmcomp/deadcode.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
@@ -737,20 +747,20 @@ asmcomp/debuginfo.cmo : parsing/location.cmi bytecomp/lambda.cmi \
asmcomp/debuginfo.cmi
asmcomp/debuginfo.cmx : parsing/location.cmx bytecomp/lambda.cmx \
asmcomp/debuginfo.cmi
+asmcomp/emitaux.cmo : asmcomp/linearize.cmi asmcomp/debuginfo.cmi \
+ utils/config.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emitaux.cmi
+asmcomp/emitaux.cmx : asmcomp/linearize.cmx asmcomp/debuginfo.cmx \
+ utils/config.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emitaux.cmi
asmcomp/emit.cmo : asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
asmcomp/mach.cmi asmcomp/linearize.cmi bytecomp/lambda.cmi \
asmcomp/emitaux.cmi asmcomp/debuginfo.cmi utils/config.cmi \
- asmcomp/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo \
- asmcomp/emit.cmi
+ asmcomp/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi \
+ asmcomp/branch_relaxation.cmi asmcomp/arch.cmo asmcomp/emit.cmi
asmcomp/emit.cmx : asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
asmcomp/mach.cmx asmcomp/linearize.cmx bytecomp/lambda.cmx \
asmcomp/emitaux.cmx asmcomp/debuginfo.cmx utils/config.cmx \
- asmcomp/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx \
- asmcomp/emit.cmi
-asmcomp/emitaux.cmo : asmcomp/linearize.cmi asmcomp/debuginfo.cmi \
- utils/config.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emitaux.cmi
-asmcomp/emitaux.cmx : asmcomp/linearize.cmx asmcomp/debuginfo.cmx \
- utils/config.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emitaux.cmi
+ asmcomp/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx \
+ asmcomp/branch_relaxation.cmx asmcomp/arch.cmx asmcomp/emit.cmi
asmcomp/interf.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
asmcomp/interf.cmi
asmcomp/interf.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
@@ -803,14 +813,14 @@ asmcomp/proc.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
asmcomp/arch.cmx asmcomp/proc.cmi
asmcomp/reg.cmo : typing/ident.cmi asmcomp/cmm.cmi asmcomp/reg.cmi
asmcomp/reg.cmx : typing/ident.cmx asmcomp/cmm.cmx asmcomp/reg.cmi
+asmcomp/reloadgen.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
+ asmcomp/reloadgen.cmi
+asmcomp/reloadgen.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
+ asmcomp/reloadgen.cmi
asmcomp/reload.cmo : asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/reload.cmi
asmcomp/reload.cmx : asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \
asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.cmi
-asmcomp/reloadgen.cmo : asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
- asmcomp/reloadgen.cmi
-asmcomp/reloadgen.cmx : asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
- asmcomp/reloadgen.cmi
asmcomp/schedgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \
asmcomp/schedgen.cmi
@@ -849,8 +859,8 @@ driver/compenv.cmi :
driver/compile.cmi :
driver/compmisc.cmi : typing/env.cmi
driver/errors.cmi :
-driver/main.cmi :
driver/main_args.cmi :
+driver/main.cmi :
driver/optcompile.cmi :
driver/opterrors.cmi :
driver/optmain.cmi :
@@ -885,6 +895,8 @@ driver/compmisc.cmx : typing/typemod.cmx utils/misc.cmx \
parsing/asttypes.cmi driver/compmisc.cmi
driver/errors.cmo : parsing/location.cmi driver/errors.cmi
driver/errors.cmx : parsing/location.cmx driver/errors.cmi
+driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi
+driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi
driver/main.cmo : utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \
parsing/location.cmi utils/config.cmi driver/compmisc.cmi \
driver/compile.cmi driver/compenv.cmi utils/clflags.cmi \
@@ -895,8 +907,6 @@ driver/main.cmx : utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \
driver/compile.cmx driver/compenv.cmx utils/clflags.cmx \
bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \
bytecomp/bytelibrarian.cmx driver/main.cmi
-driver/main_args.cmo : utils/warnings.cmi driver/main_args.cmi
-driver/main_args.cmx : utils/warnings.cmx driver/main_args.cmi
driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \
typing/typedtree.cmi typing/typecore.cmi bytecomp/translmod.cmi \
typing/stypes.cmi bytecomp/simplif.cmi typing/printtyped.cmi \
diff --git a/Makefile b/Makefile
index 6c0e7e6..7a20e2c 100644
--- a/Makefile
+++ b/Makefile
@@ -94,6 +94,8 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \
asmcomp/deadcode.cmo \
asmcomp/printlinear.cmo asmcomp/linearize.cmo \
asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
+ asmcomp/branch_relaxation_intf.cmo \
+ asmcomp/branch_relaxation.cmo \
asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \
driver/opterrors.cmo driver/optcompile.cmo
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index b576ece..d56d0f5 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -20,6 +20,12 @@ open Mach
open Linearize
open Emitaux
+(* [Branch_relaxation] is not used in this file, but is required by
+ emit.mlp files for certain other targets; the reference here ensures
+ that when releases are being prepared the .depend files are correct
+ for all targets. *)
+open! Branch_relaxation
+
let macosx = (Config.system = "macosx")
let mingw64 = (Config.system = "mingw64")
let cygwin = (Config.system = "cygwin")
diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml
index bfbe183..3e62da8 100644
--- a/asmcomp/arm64/arch.ml
+++ b/asmcomp/arm64/arch.ml
@@ -34,8 +34,12 @@ type addressing_mode =
(* Specific operations *)
type specific_operation =
+ | Ifar_alloc of int
+ | Ifar_intop_checkbound
+ | Ifar_intop_imm_checkbound of int
| Ishiftarith of arith_operation * int
| Ishiftcheckbound of int
+ | Ifar_shiftcheckbound of int
| Imuladd (* multiply and add *)
| Imulsub (* multiply and subtract *)
| Inegmulf (* floating-point negate and multiply *)
@@ -91,6 +95,12 @@ let print_addressing printreg addr ppf arg =
let print_specific_operation printreg op ppf arg =
match op with
+ | Ifar_alloc n ->
+ fprintf ppf "(far) alloc %i" n
+ | Ifar_intop_checkbound ->
+ fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1)
+ | Ifar_intop_imm_checkbound n ->
+ fprintf ppf "%a (far) check > %i" printreg arg.(0) n
| Ishiftarith(op, shift) ->
let op_name = function
| Ishiftadd -> "+"
@@ -103,6 +113,9 @@ let print_specific_operation printreg op ppf arg =
printreg arg.(0) (op_name op) printreg arg.(1) shift_mark
| Ishiftcheckbound n ->
fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1)
+ | Ifar_shiftcheckbound n ->
+ fprintf ppf
+ "(far) check %a >> %i > %a" printreg arg.(0) n printreg arg.(1)
| Imuladd ->
fprintf ppf "(%a * %a) + %a"
printreg arg.(0)
diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
index c5c30d4..8576eeb 100644
--- a/asmcomp/arm64/emit.mlp
+++ b/asmcomp/arm64/emit.mlp
@@ -231,6 +231,32 @@ let emit_intconst dst n =
in
if n < 0n then emit_neg true 48 else emit_pos true 48
+let num_instructions_for_intconst n =
+ let num_instructions = ref 0 in
+ let rec count_pos first shift =
+ if shift < 0 then begin
+ if first then incr num_instructions
+ end else begin
+ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+ if s = 0n then count_pos first (shift - 16) else begin
+ incr num_instructions;
+ count_pos false (shift - 16)
+ end
+ end
+ and count_neg first shift =
+ if shift < 0 then begin
+ if first then incr num_instructions
+ end else begin
+ let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
+ if s = 0xFFFFn then count_neg first (shift - 16) else begin
+ incr num_instructions;
+ count_neg false (shift - 16)
+ end
+ end
+ in
+ if n < 0n then count_neg true 48 else count_pos true 48;
+ !num_instructions
+
(* Recognize float constants appropriate for FMOV dst, #fpimm instruction:
"a normalized binary floating point encoding with 1 sign bit, 4
bits of fraction and a 3-bit exponent" *)
@@ -302,6 +328,217 @@ let emit_load_symbol_addr dst s =
` ldr {emit_reg dst}, [{emit_reg dst}, #:got_lo12:{emit_symbol s}]\n`
end
+(* The following functions are used for calculating the sizes of the
+ call GC and bounds check points emitted out-of-line from the function
+ body. See branch_relaxation.mli. *)
+
+let num_call_gc_and_check_bound_points instr =
+ let rec loop instr ((call_gc, check_bound) as totals) =
+ match instr.desc with
+ | Lend -> totals
+ | Lop (Ialloc _) when !fastcode_flag ->
+ loop instr.next (call_gc + 1, check_bound)
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
+ | Lop (Ispecific (Ishiftcheckbound _)) ->
+ let check_bound =
+ (* When not in debug mode, there is at most one check-bound point. *)
+ if not !Clflags.debug then 1
+ else check_bound + 1
+ in
+ loop instr.next (call_gc, check_bound)
+ (* The following four should never be seen, since this function is run
+ before branch relaxation. *)
+ | Lop (Ispecific (Ifar_alloc _))
+ | Lop (Ispecific Ifar_intop_checkbound)
+ | Lop (Ispecific (Ifar_intop_imm_checkbound _))
+ | Lop (Ispecific (Ifar_shiftcheckbound _)) -> assert false
+ | _ -> loop instr.next totals
+ in
+ loop instr (0, 0)
+
+let max_out_of_line_code_offset instr ~num_call_gc ~num_check_bound =
+ if num_call_gc < 1 && num_check_bound < 1 then 0
+ else begin
+ let size_of_call_gc = 2 in
+ let size_of_check_bound = 1 in
+ let size_of_last_thing =
+ (* Call-GC points come before check-bound points. *)
+ if num_check_bound >= 1 then size_of_check_bound else size_of_call_gc
+ in
+ let total_size =
+ size_of_call_gc*num_call_gc + size_of_check_bound*num_check_bound
+ in
+ let max_offset = total_size - size_of_last_thing in
+ assert (max_offset >= 0);
+ max_offset
+ end
+
+module BR = Branch_relaxation.Make (struct
+ (* CR-someday mshinwell: B and BL have +/- 128Mb ranges; for the moment we
+ assume we will never exceed this. It would seem to be most likely to
+ occur for branches between functions; in this case, the linker should be
+ able to insert veneers anyway. (See section 4.6.7 of the document
+ "ELF for the ARM 64-bit architecture (AArch64)".) *)
+
+ type distance = int
+
+ module Cond_branch = struct
+ type t = TB | CB | Bcc
+
+ let all = [TB; CB; Bcc]
+
+ (* AArch64 instructions are 32 bits wide, so [distance] in this module
+ means units of 32-bit words. *)
+ let max_displacement = function
+ | TB -> 32 * 1024 / 4 (* +/- 32Kb *)
+ | CB | Bcc -> 1 * 1024 * 1024 / 4 (* +/- 1Mb *)
+
+ let classify_instr = function
+ | Lop (Ialloc _)
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
+ | Lop (Ispecific (Ishiftcheckbound _)) -> Some Bcc
+ (* The various "far" variants in [specific_operation] don't need to
+ return [Some] here, since their code sequences never contain any
+ conditional branches that might need relaxing. *)
+ | Lcondbranch (Itruetest, _)
+ | Lcondbranch (Ifalsetest, _) -> Some CB
+ | Lcondbranch (Iinttest _, _)
+ | Lcondbranch (Iinttest_imm _, _)
+ | Lcondbranch (Ifloattest _, _) -> Some Bcc
+ | Lcondbranch (Ioddtest, _)
+ | Lcondbranch (Ieventest, _) -> Some TB
+ | Lcondbranch3 _ -> Some Bcc
+ | _ -> None
+ end
+
+ let offset_pc_at_branch = 0
+
+ let epilogue_size () =
+ if !contains_calls then 3 else 2
+
+ let instr_size = function
+ | Lend -> 0
+ | Lop (Imove | Ispill | Ireload) -> 1
+ | Lop (Iconst_int n | Iconst_blockheader n) ->
+ num_instructions_for_intconst n
+ | Lop (Iconst_float _) -> 2
+ | Lop (Iconst_symbol _) -> 2
+ | Lop (Icall_ind) -> 1
+ | Lop (Icall_imm _) -> 1
+ | Lop (Itailcall_ind) -> epilogue_size ()
+ | Lop (Itailcall_imm s) ->
+ if s = !function_name then 1 else epilogue_size ()
+ | Lop (Iextcall (_, false)) -> 1
+ | Lop (Iextcall (_, true)) -> 3
+ | Lop (Istackoffset _) -> 2
+ | Lop (Iload (size, addr)) | Lop (Istore (size, addr, _)) ->
+ let based = match addr with Iindexed _ -> 0 | Ibased _ -> 1 in
+ based + begin match size with Single -> 2 | _ -> 1 end
+ | Lop (Ialloc _) when !fastcode_flag -> 4
+ | Lop (Ispecific (Ifar_alloc _)) when !fastcode_flag -> 5
+ | Lop (Ialloc num_words) | Lop (Ispecific (Ifar_alloc num_words)) ->
+ begin match num_words with
+ | 16 | 24 | 32 -> 1
+ | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_words)
+ end
+ | Lop (Iintop (Icomp _)) -> 2
+ | Lop (Iintop_imm (Icomp _, _)) -> 2
+ | Lop (Iintop Icheckbound) -> 2
+ | Lop (Ispecific Ifar_intop_checkbound) -> 3
+ | Lop (Iintop_imm (Icheckbound, _)) -> 2
+ | Lop (Ispecific (Ifar_intop_imm_checkbound _)) -> 3
+ | Lop (Ispecific (Ishiftcheckbound _)) -> 2
+ | Lop (Ispecific (Ifar_shiftcheckbound _)) -> 3
+ | Lop (Iintop Imod) -> 2
+ | Lop (Iintop Imulh) -> 1
+ | Lop (Iintop _) -> 1
+ | Lop (Iintop_imm _) -> 1
+ | Lop (Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf) -> 1
+ | Lop (Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf) -> 1
+ | Lop (Ispecific (Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)) -> 1
+ | Lop (Ispecific (Ishiftarith _)) -> 1
+ | Lop (Ispecific (Imuladd | Imulsub)) -> 1
+ | Lop (Ispecific (Ibswap 16)) -> 2
+ | Lop (Ispecific (Ibswap _)) -> 1
+ | Lreloadretaddr -> 0
+ | Lreturn -> epilogue_size ()
+ | Llabel _ -> 0
+ | Lbranch _ -> 1
+ | Lcondbranch (tst, _) ->
+ begin match tst with
+ | Itruetest -> 1
+ | Ifalsetest -> 1
+ | Iinttest _ -> 2
+ | Iinttest_imm _ -> 2
+ | Ifloattest _ -> 2
+ | Ioddtest -> 1
+ | Ieventest -> 1
+ end
+ | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+ 1 + begin match lbl0 with None -> 0 | Some _ -> 1 end
+ + begin match lbl1 with None -> 0 | Some _ -> 1 end
+ + begin match lbl2 with None -> 0 | Some _ -> 1 end
+ | Lswitch jumptbl -> 3 + Array.length jumptbl
+ | Lsetuptrap _ -> 2
+ | Lpushtrap -> 3
+ | Lpoptrap -> 1
+ | Lraise k ->
+ begin match !Clflags.debug, k with
+ | true, (Lambda.Raise_regular | Lambda.Raise_reraise) -> 1
+ | false, _
+ | true, Lambda.Raise_notrace -> 4
+ end
+
+ let relax_allocation ~num_words =
+ Lop (Ispecific (Ifar_alloc num_words))
+
+ let relax_intop_checkbound () =
+ Lop (Ispecific Ifar_intop_checkbound)
+
+ let relax_intop_imm_checkbound ~bound =
+ Lop (Ispecific (Ifar_intop_imm_checkbound bound))
+
+ let relax_specific_op = function
+ | Ishiftcheckbound shift -> Lop (Ispecific (Ifar_shiftcheckbound shift))
+ | _ -> assert false
+end)
+
+(* Output the assembly code for allocation. *)
+
+let assembly_code_for_allocation i ~n ~far =
+ let lbl_frame = record_frame_label i.live i.dbg in
+ if !fastcode_flag then begin
+ let lbl_redo = new_label() in
+ let lbl_call_gc = new_label() in
+ `{emit_label lbl_redo}:`;
+ ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
+ ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
+ ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
+ if not far then begin
+ ` b.lo {emit_label lbl_call_gc}\n`
+ end else begin
+ let lbl = new_label () in
+ ` b.cs {emit_label lbl}\n`;
+ ` b {emit_label lbl_call_gc}\n`;
+ `{emit_label lbl}:\n`
+ end;
+ call_gc_sites :=
+ { gc_lbl = lbl_call_gc;
+ gc_return_lbl = lbl_redo;
+ gc_frame_lbl = lbl_frame } :: !call_gc_sites
+ end else begin
+ begin match n with
+ | 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
+ | 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
+ | 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
+ | _ -> emit_intconst reg_x15 (Nativeint.of_int n);
+ ` bl {emit_symbol "caml_allocN"}\n`
+ end;
+ `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
+ end
+
(* Output the assembly code for an instruction *)
let emit_instr i =
@@ -410,29 +647,9 @@ let emit_instr i =
` str {emit_reg src}, {emit_addressing addr base}\n`
end
| Lop(Ialloc n) ->
- let lbl_frame = record_frame_label i.live i.dbg in
- if !fastcode_flag then begin
- let lbl_redo = new_label() in
- let lbl_call_gc = new_label() in
- `{emit_label lbl_redo}:`;
- ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
- ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
- ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
- ` b.lo {emit_label lbl_call_gc}\n`;
- call_gc_sites :=
- { gc_lbl = lbl_call_gc;
- gc_return_lbl = lbl_redo;
- gc_frame_lbl = lbl_frame } :: !call_gc_sites
- end else begin
- begin match n with
- | 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
- | 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
- | 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
- | _ -> emit_intconst reg_x15 (Nativeint.of_int n);
- ` bl {emit_symbol "caml_allocN"}\n`
- end;
- `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
- end
+ assembly_code_for_allocation i ~n ~far:false
+ | Lop(Ispecific (Ifar_alloc n)) ->
+ assembly_code_for_allocation i ~n ~far:true
| Lop(Iintop(Icomp cmp)) ->
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
@@ -443,14 +660,35 @@ let emit_instr i =
let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` b.ls {emit_label lbl}\n`
+ | Lop(Ispecific Ifar_intop_checkbound) ->
+ let lbl = bound_error_label i.dbg in
+ let lbl2 = new_label () in
+ ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
+ ` b.hi {emit_label lbl2}\n`;
+ ` b {emit_label lbl}\n`;
+ `{emit_label lbl2}:\n`;
| Lop(Iintop_imm(Icheckbound, n)) ->
let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
` b.ls {emit_label lbl}\n`
+ | Lop(Ispecific(Ifar_intop_imm_checkbound bound)) ->
+ let lbl = bound_error_label i.dbg in
+ let lbl2 = new_label () in
+ ` cmp {emit_reg i.arg.(0)}, #{emit_int bound}\n`;
+ ` b.hi {emit_label lbl2}\n`;
+ ` b {emit_label lbl}\n`;
+ `{emit_label lbl2}:\n`;
| Lop(Ispecific(Ishiftcheckbound shift)) ->
let lbl = bound_error_label i.dbg in
` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
` b.cs {emit_label lbl}\n`
+ | Lop(Ispecific(Ifar_shiftcheckbound shift)) ->
+ let lbl = bound_error_label i.dbg in
+ let lbl2 = new_label () in
+ ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
+ ` b.lo {emit_label lbl2}\n`;
+ ` b {emit_label lbl}\n`;
+ `{emit_label lbl2}:\n`;
| Lop(Iintop Imod) ->
` sdiv {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` msub {emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
@@ -659,9 +897,19 @@ let fundecl fundecl =
` str x30, [sp, #{emit_int (n-8)}]\n`
end;
`{emit_label !tailrec_entry_point}:\n`;
+ let num_call_gc, num_check_bound =
+ num_call_gc_and_check_bound_points fundecl.fun_body
+ in
+ let max_out_of_line_code_offset =
+ max_out_of_line_code_offset fundecl.fun_body ~num_call_gc
+ ~num_check_bound
+ in
+ BR.relax fundecl.fun_body ~max_out_of_line_code_offset;
emit_all fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
List.iter emit_call_bound_error !bound_error_sites;
+ assert (List.length !call_gc_sites = num_call_gc);
+ assert (List.length !bound_error_sites = num_check_bound);
cfi_endproc();
` .type {emit_symbol fundecl.fun_name}, %function\n`;
` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
diff --git a/asmcomp/branch_relaxation.ml b/asmcomp/branch_relaxation.ml
new file mode 100644
index 0000000..d4609e4
--- /dev/null
+++ b/asmcomp/branch_relaxation.ml
@@ -0,0 +1,138 @@
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Mark Shinwell, Jane Street Europe *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+open Mach
+open Linearize
+
+module Make (T : Branch_relaxation_intf.S) = struct
+ 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 + T.instr_size op) instr.next
+ in
+ fill_map 0 code
+
+ let branch_overflows map pc_branch lbl_dest max_branch_offset =
+ let pc_dest = Hashtbl.find map lbl_dest in
+ let delta = pc_dest - (pc_branch + T.offset_pc_at_branch) in
+ delta <= -max_branch_offset || delta >= max_branch_offset
+
+ let opt_branch_overflows map pc_branch opt_lbl_dest max_branch_offset =
+ match opt_lbl_dest with
+ | None -> false
+ | Some lbl_dest ->
+ branch_overflows map pc_branch lbl_dest max_branch_offset
+
+ let instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc =
+ match T.Cond_branch.classify_instr instr.desc with
+ | None -> false
+ | Some branch ->
+ let max_branch_offset =
+ (* Remember to cut some slack for multi-word instructions (in the
+ [Linearize] sense of the word) where the branch can be anywhere in
+ the middle. 12 words of slack is plenty. *)
+ T.Cond_branch.max_displacement branch - 12
+ in
+ match instr.desc with
+ | Lop (Ialloc _)
+ | Lop (Iintop Icheckbound)
+ | Lop (Iintop_imm (Icheckbound, _))
+ | Lop (Ispecific _) ->
+ (* We assume that any branches eligible for relaxation generated
+ by these instructions only branch forward. We further assume
+ that any of these may branch to an out-of-line code block. *)
+ code_size + max_out_of_line_code_offset - pc >= max_branch_offset
+ | Lcondbranch (_, lbl) ->
+ branch_overflows map pc lbl max_branch_offset
+ | Lcondbranch3 (lbl0, lbl1, lbl2) ->
+ opt_branch_overflows map pc lbl0 max_branch_offset
+ || opt_branch_overflows map pc lbl1 max_branch_offset
+ || opt_branch_overflows map pc lbl2 max_branch_offset
+ | _ ->
+ Misc.fatal_error "Unsupported instruction for branch relaxation"
+
+ let fixup_branches ~code_size ~max_out_of_line_code_offset map code =
+ let expand_optbranch lbl n arg next =
+ match lbl with
+ | None -> next
+ | Some l ->
+ instr_cons (Lcondbranch (Iinttest_imm (Isigned Cmm.Ceq, n), l))
+ arg [||] next
+ in
+ let rec fixup did_fix pc instr =
+ match instr.desc with
+ | Lend -> did_fix
+ | _ ->
+ let overflows =
+ instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc
+ in
+ if not overflows then
+ fixup did_fix (pc + T.instr_size instr.desc) instr.next
+ else
+ match instr.desc with
+ | Lop (Ialloc num_words) ->
+ instr.desc <- T.relax_allocation ~num_words;
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lop (Iintop Icheckbound) ->
+ instr.desc <- T.relax_intop_checkbound ();
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lop (Iintop_imm (Icheckbound, bound)) ->
+ instr.desc <- T.relax_intop_imm_checkbound ~bound;
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lop (Ispecific specific) ->
+ instr.desc <- T.relax_specific_op specific;
+ fixup true (pc + T.instr_size instr.desc) instr.next
+ | Lcondbranch (test, 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 + T.instr_size instr.desc) instr.next
+ | Lcondbranch3 (lbl0, lbl1, 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
+ | _ ->
+ (* Any other instruction has already been rejected in
+ [instr_overflows] above.
+ We can *never* get here. *)
+ assert false
+ in
+ fixup false 0 code
+
+ (* Iterate branch expansion till all conditional branches are OK *)
+
+ let rec relax code ~max_out_of_line_code_offset =
+ let min_of_max_branch_offsets =
+ List.fold_left (fun min_of_max_branch_offsets branch ->
+ min min_of_max_branch_offsets
+ (T.Cond_branch.max_displacement branch))
+ max_int T.Cond_branch.all
+ in
+ let (code_size, map) = label_map code in
+ if code_size >= min_of_max_branch_offsets
+ && fixup_branches ~code_size ~max_out_of_line_code_offset map code
+ then relax code ~max_out_of_line_code_offset
+ else ()
+end
diff --git a/asmcomp/branch_relaxation.mli b/asmcomp/branch_relaxation.mli
new file mode 100644
index 0000000..9d517b1
--- /dev/null
+++ b/asmcomp/branch_relaxation.mli
@@ -0,0 +1,26 @@
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* Mark Shinwell, Jane Street Europe *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+(* Fix up conditional branches that exceed hardware-allowed ranges. *)
+
+module Make (T : Branch_relaxation_intf.S) : sig
+ val relax
+ : Linearize.instruction
+ (* [max_offset_of_out_of_line_code] specifies the furthest distance,
+ measured from the first address immediately after the last instruction
+ of the function, that may be branched to from within the function in
+ order to execute "out of line" code blocks such as call GC and
+ bounds check points. *)
+ -> max_out_of_line_code_offset:T.distance
+ -> unit
+end
diff --git a/asmcomp/branch_relaxation_intf.ml b/asmcomp/branch_relaxation_intf.ml
new file mode 100644
index 0000000..610d0d0
--- /dev/null
+++ b/asmcomp/branch_relaxation_intf.ml
@@ -0,0 +1,63 @@
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Mark Shinwell, Jane Street Europe *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the Q Public License version 1.0. *)
+(* *)
+(***********************************************************************)
+
+module type S = sig
+ (* The distance between two instructions, in arbitrary units (typically
+ the natural word size of instructions). *)
+ type distance = int
+
+ module Cond_branch : sig
+ (* The various types of conditional branches for a given target that
+ may require relaxation. *)
+ type t
+
+ (* All values of type [t] that the emitter may produce. *)
+ val all : t list
+
+ (* If [max_displacement branch] is [n] then [branch] is assumed to
+ reach any address in the range [pc - n, pc + n] (inclusive), after
+ the [pc] of the branch has been adjusted by [offset_pc_at_branch]
+ (see below). *)
+ val max_displacement : t -> distance
+
+ (* Which variety of conditional branch may be produced by the emitter for a
+ given instruction description. For the moment we assume that only one
+ such variety per instruction description is needed.
+
+ N.B. The only instructions supported are the following:
+ - Lop (Ialloc _)
+ - Lop (Iintop Icheckbound)
+ - Lop (Iintop_imm (Icheckbound, _))
+ - Lop (Ispecific _)
+ - Lcondbranch (_, _)
+ - Lcondbranch3 (_, _, _)
+ [classify_instr] is expected to return [None] when called on any
+ instruction not in this list. *)
+ val classify_instr : Linearize.instruction_desc -> t option
+ end
+
+ (* The value to be added to the program counter (in [distance] units)
+ when it is at a branch instruction, prior to calculating the distance
+ to a branch target. *)
+ val offset_pc_at_branch : distance
+
+ (* The maximum size of a given instruction. *)
+ val instr_size : Linearize.instruction_desc -> distance
+
+ (* Insertion of target-specific code to relax operations that cannot be
+ relaxed generically. It is assumed that these rewrites do not change
+ the size of out-of-line code (cf. branch_relaxation.mli). *)
+ val relax_allocation : num_words:int -> Linearize.instruction_desc
+ val relax_intop_checkbound : unit -> Linearize.instruction_desc
+ val relax_intop_imm_checkbound : bound:int -> Linearize.instruction_desc
+ val relax_specific_op : Arch.specific_operation -> Linearize.instruction_desc
+end
diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index 8e31b58..717ab12 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -308,126 +308,87 @@ let defined_functions = ref StringSet.empty
(* Label of glue code for calling the GC *)
let call_gc_label = ref 0
-(* Fixup conditional branches that exceed hardware allowed range *)
+module BR = Branch_relaxation.Make (struct
+ type distance = int
-let load_store_size = function
- Ibased(s, d) -> 2
- | Iindexed ofs -> if is_immediate ofs then 1 else 3
- | Iindexed2 -> 1
+ module Cond_branch = struct
+ type t = Branch
-let instr_size = function
- Lend -> 0
- | Lop(Imove | Ispill | Ireload) -> 1
- | Lop(Iconst_int n | Iconst_blockheader n) ->
- if is_native_immediate n then 1 else 2
- | Lop(Iconst_float s) -> 2
- | Lop(Iconst_symbol s) -> 2
- | Lop(Icall_ind) -> 2
- | Lop(Icall_imm s) -> 1
- | Lop(Itailcall_ind) -> 5
- | Lop(Itailcall_imm s) -> if s = !function_name then 1 else 4
- | Lop(Iextcall(s, true)) -> 3
- | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1
- | Lop(Istackoffset n) -> 1
- | Lop(Iload(chunk, addr)) ->
+ let all = [Branch]
+
+ let max_displacement = function
+ (* 14-bit signed offset in words. *)
+ | Branch -> 8192
+
+ let classify_instr = function
+ | Lop (Ialloc _)
+ (* [Ialloc_far] does not need to be here, since its code sequence
+ never involves any conditional branches that might need relaxing. *)
+ | Lcondbranch _
+ | Lcondbranch3 _ -> Some Branch
+ | _ -> None
+ end
+
+ let offset_pc_at_branch = 1
+
+ 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 | Iconst_blockheader n) ->
+ if is_native_immediate n then 1 else 2
+ | Lop(Iconst_float s) -> 2
+ | Lop(Iconst_symbol s) -> 2
+ | Lop(Icall_ind) -> 2
+ | Lop(Icall_imm s) -> 1
+ | Lop(Itailcall_ind) -> 5
+ | Lop(Itailcall_imm s) -> if s = !function_name then 1 else 4
+ | Lop(Iextcall(s, true)) -> 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) -> 3
- | Lop(Iintop(Icomp cmp)) -> 4
- | Lop(Iintop op) -> 1
- | 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) ->
+ | Lop(Istore(chunk, addr, _)) -> load_store_size addr
+ | Lop(Ialloc n) -> 4
+ | Lop(Ispecific(Ialloc_far n)) -> 5
+ | Lop(Iintop Imod) -> 3
+ | Lop(Iintop(Icomp cmp)) -> 4
+ | Lop(Iintop op) -> 1
+ | 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 -> 4
- | Lpoptrap -> 2
- | Lraise _ -> 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 ()
-
+ | Lswitch jumptbl -> 8
+ | Lsetuptrap lbl -> 1
+ | Lpushtrap -> 4
+ | Lpoptrap -> 2
+ | Lraise _ -> 6
+
+ let relax_allocation ~num_words = Lop (Ispecific (Ialloc_far num_words))
+
+ (* [classify_addr], above, never identifies these instructions as needing
+ relaxing. As such, these functions should never be called. *)
+ let relax_specific_op _ = assert false
+ let relax_intop_checkbound () = assert false
+ let relax_intop_imm_checkbound ~bound:_ = assert false
+end)
(* Output the assembly code for an instruction *)
@@ -848,7 +809,10 @@ let fundecl fundecl =
` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n`
end;
`{emit_label !tailrec_entry_point}:\n`;
- branch_normalization fundecl.fun_body;
+ (* On this target, there is at most one "out of line" code block per
+ function: a single "call GC" point. It comes immediately after the
+ function's body. *)
+ BR.relax fundecl.fun_body ~max_out_of_line_code_offset:0;
emit_all fundecl.fun_body;
(* Emit the glue code to call the GC *)
if !call_gc_label > 0 then begin
--
2.3.1
Reference in New Issue View Git Blame Copy Permalink