diff --git a/.depend b/.depend
index be224c41019c4af9ce0e436a019ea041f4f0666f..b0f9868c362553f143135f618bdde09a97f54654 100644
--- a/.depend
+++ b/.depend
@@ -1,82 +1,85 @@
lib/Coqlib.vo: lib/Coqlib.v
-lib/Maps.vo: lib/Maps.v lib/Coqlib.vo
+lib/Floats.vo: lib/Floats.v lib/Coqlib.vo lib/Integers.vo
+lib/Inclusion.vo: lib/Inclusion.v
+lib/Integers.vo: lib/Integers.v lib/Coqlib.vo
+lib/Iteration.vo: lib/Iteration.v lib/Coqlib.vo
lib/Lattice.vo: lib/Lattice.v lib/Coqlib.vo lib/Maps.vo
+lib/Maps.vo: lib/Maps.v lib/Coqlib.vo
lib/Ordered.vo: lib/Ordered.v lib/Coqlib.vo lib/Maps.vo
-lib/Iteration.vo: lib/Iteration.v lib/Coqlib.vo
-lib/Integers.vo: lib/Integers.v lib/Coqlib.vo
-lib/Floats.vo: lib/Floats.v lib/Coqlib.vo lib/Integers.vo
lib/Parmov.vo: lib/Parmov.v lib/Coqlib.vo
-common/Errors.vo: common/Errors.v lib/Coqlib.vo
common/AST.vo: common/AST.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo
+common/Errors.vo: common/Errors.v lib/Coqlib.vo
common/Events.vo: common/Events.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo
common/Globalenvs.vo: common/Globalenvs.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo
common/Mem.vo: common/Mem.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo
-common/Values.vo: common/Values.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo
common/Smallstep.vo: common/Smallstep.v lib/Coqlib.vo common/AST.vo common/Events.vo common/Globalenvs.vo lib/Integers.vo
common/Switch.vo: common/Switch.v lib/Coqlib.vo lib/Integers.vo
-common/Main.vo: common/Main.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo common/Values.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Csharpminor.vo backend/Cminor.vo backend/CminorSel.vo backend/RTL.vo backend/LTL.vo backend/LTLin.vo backend/Linear.vo backend/Mach.vo backend/PPC.vo cfrontend/Cshmgen.vo cfrontend/Cminorgen.vo backend/Selection.vo backend/RTLgen.vo backend/Constprop.vo backend/CSE.vo backend/Allocation.vo backend/Tunneling.vo backend/Linearize.vo backend/Reload.vo backend/Stacking.vo backend/PPCgen.vo cfrontend/Ctyping.vo backend/RTLtyping.vo backend/LTLtyping.vo backend/LTLintyping.vo backend/Lineartyping.vo backend/Machtyping.vo cfrontend/Cshmgenproof3.vo cfrontend/Cminorgenproof.vo backend/Selectionproof.vo backend/RTLgenproof.vo backend/Constpropproof.vo backend/CSEproof.vo backend/Allocproof.vo backend/Alloctyping.vo backend/Tunnelingproof.vo backend/Tunnelingtyping.vo backend/Linearizeproof.vo backend/Linearizetyping.vo backend/Reloadproof.vo backend/Reloadtyping.vo backend/Stackingproof.vo backend/Stackingtyping.vo backend/Machabstr2concr.vo backend/PPCgenproof.vo
-common/Complements.vo: common/Complements.v lib/Coqlib.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo backend/PPC.vo common/Main.vo common/Errors.vo
+common/Values.vo: common/Values.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo
+$(ARCH)/$(VARIANT)/Conventions.vo: $(ARCH)/$(VARIANT)/Conventions.v lib/Coqlib.vo common/AST.vo backend/Locations.vo
+$(ARCH)/$(VARIANT)/Stacklayout.vo: $(ARCH)/$(VARIANT)/Stacklayout.v lib/Coqlib.vo backend/Bounds.vo
+$(ARCH)/Asmgenproof1.vo: $(ARCH)/Asmgenproof1.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo backend/Mach.vo backend/Machconcr.vo backend/Machtyping.vo $(ARCH)/Asm.vo $(ARCH)/Asmgen.vo $(ARCH)/$(VARIANT)/Conventions.vo
+$(ARCH)/Asmgenproof.vo: $(ARCH)/Asmgenproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo backend/Mach.vo backend/Machconcr.vo backend/Machtyping.vo $(ARCH)/Asm.vo $(ARCH)/Asmgen.vo $(ARCH)/Asmgenretaddr.vo $(ARCH)/Asmgenproof1.vo
+$(ARCH)/Asmgenretaddr.vo: $(ARCH)/Asmgenretaddr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo backend/Mach.vo $(ARCH)/Asm.vo $(ARCH)/Asmgen.vo
+$(ARCH)/Asmgen.vo: $(ARCH)/Asmgen.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo backend/Mach.vo $(ARCH)/Asm.vo
+$(ARCH)/Asm.vo: $(ARCH)/Asm.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Stacklayout.vo $(ARCH)/$(VARIANT)/Conventions.vo
+$(ARCH)/Constpropproof.vo: $(ARCH)/Constpropproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo $(ARCH)/Constprop.vo
+$(ARCH)/Constprop.vo: $(ARCH)/Constprop.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo
+$(ARCH)/Machregs.vo: $(ARCH)/Machregs.v lib/Coqlib.vo lib/Maps.vo common/AST.vo
+$(ARCH)/Op.vo: $(ARCH)/Op.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo
+$(ARCH)/Selectionproof.vo: $(ARCH)/Selectionproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/Selection.vo
+$(ARCH)/Selection.vo: $(ARCH)/Selection.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo
+backend/Allocation.vo: backend/Allocation.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Lattice.vo common/AST.vo lib/Integers.vo common/Values.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Kildall.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Coloring.vo backend/LTL.vo
+backend/Allocproof.vo: backend/Allocproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Smallstep.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Coloring.vo backend/Coloringproof.vo backend/Allocation.vo backend/LTL.vo
+backend/Alloctyping.vo: backend/Alloctyping.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Locations.vo backend/LTL.vo backend/Coloring.vo backend/Coloringproof.vo backend/Allocation.vo backend/Allocproof.vo backend/RTLtyping.vo backend/LTLtyping.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/Bounds.vo: backend/Bounds.v lib/Coqlib.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/Locations.vo backend/Linear.vo backend/Lineartyping.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/CminorSel.vo: backend/CminorSel.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Events.vo common/Values.vo common/Mem.vo backend/Cminor.vo $(ARCH)/Op.vo common/Globalenvs.vo common/Switch.vo common/Smallstep.vo
backend/Cminor.vo: backend/Cminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Events.vo common/Values.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo common/Switch.vo
-backend/Op.vo: backend/Op.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo
-backend/CminorSel.vo: backend/CminorSel.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Events.vo common/Values.vo common/Mem.vo backend/Cminor.vo backend/Op.vo common/Globalenvs.vo common/Switch.vo common/Smallstep.vo
-backend/Selection.vo: backend/Selection.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Cminor.vo backend/Op.vo backend/CminorSel.vo
-backend/Selectionproof.vo: backend/Selectionproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Cminor.vo backend/Op.vo backend/CminorSel.vo backend/Selection.vo
-backend/Registers.vo: backend/Registers.v lib/Coqlib.vo common/AST.vo lib/Maps.vo lib/Ordered.vo
-backend/RTL.vo: backend/RTL.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Registers.vo
-backend/RTLgen.vo: backend/RTLgen.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Switch.vo backend/Op.vo backend/Registers.vo backend/CminorSel.vo backend/RTL.vo
-backend/RTLgenspec.vo: backend/RTLgenspec.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Switch.vo backend/Op.vo backend/Registers.vo backend/CminorSel.vo backend/RTL.vo backend/RTLgen.vo
-backend/RTLgenproof.vo: backend/RTLgenproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Smallstep.vo common/Globalenvs.vo common/Switch.vo backend/Registers.vo backend/Cminor.vo backend/Op.vo backend/CminorSel.vo backend/RTL.vo backend/RTLgen.vo backend/RTLgenspec.vo common/Errors.vo
-backend/RTLtyping.vo: backend/RTLtyping.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/Conventions.vo common/Globalenvs.vo common/Values.vo common/Mem.vo lib/Integers.vo common/Events.vo common/Smallstep.vo
-backend/Kildall.vo: backend/Kildall.v lib/Coqlib.vo lib/Iteration.vo lib/Maps.vo lib/Lattice.vo lib/Ordered.vo
-backend/Constprop.vo: backend/Constprop.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo
-backend/Constpropproof.vo: backend/Constpropproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo backend/Constprop.vo
-backend/CSE.vo: backend/CSE.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/Kildall.vo
-backend/CSEproof.vo: backend/CSEproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/Kildall.vo backend/CSE.vo
-backend/Locations.vo: backend/Locations.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo
-backend/Conventions.vo: backend/Conventions.v lib/Coqlib.vo common/AST.vo backend/Locations.vo
-backend/LTL.vo: backend/LTL.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo
-backend/LTLtyping.vo: backend/LTLtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/RTL.vo backend/Locations.vo backend/LTL.vo backend/Conventions.vo
+backend/Coloringproof.vo: backend/Coloringproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/InterfGraph.vo backend/Coloring.vo
+backend/Coloring.vo: backend/Coloring.v lib/Coqlib.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/InterfGraph.vo
+backend/CSEproof.vo: backend/CSEproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Kildall.vo backend/CSE.vo
+backend/CSE.vo: backend/CSE.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Kildall.vo
backend/InterfGraph.vo: backend/InterfGraph.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo backend/Registers.vo backend/Locations.vo
-backend/Coloring.vo: backend/Coloring.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Locations.vo backend/Conventions.vo backend/InterfGraph.vo
-backend/Coloringproof.vo: backend/Coloringproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Locations.vo backend/Conventions.vo backend/InterfGraph.vo backend/Coloring.vo
-backend/Allocation.vo: backend/Allocation.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Lattice.vo common/AST.vo lib/Integers.vo common/Values.vo common/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Kildall.vo backend/Locations.vo backend/Conventions.vo backend/Coloring.vo backend/LTL.vo
-backend/Allocproof.vo: backend/Allocproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Smallstep.vo common/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/RTLtyping.vo backend/Locations.vo backend/Conventions.vo backend/Coloring.vo backend/Coloringproof.vo backend/Allocation.vo backend/LTL.vo
-backend/Alloctyping.vo: backend/Alloctyping.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/Locations.vo backend/LTL.vo backend/Coloring.vo backend/Coloringproof.vo backend/Allocation.vo backend/Allocproof.vo backend/RTLtyping.vo backend/LTLtyping.vo backend/Conventions.vo
-backend/Tunneling.vo: backend/Tunneling.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo
-backend/Tunnelingproof.vo: backend/Tunnelingproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Tunneling.vo
-backend/Tunnelingtyping.vo: backend/Tunnelingtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLtyping.vo backend/Tunneling.vo backend/Tunnelingproof.vo
-backend/LTLin.vo: backend/LTLin.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Conventions.vo
-backend/LTLintyping.vo: backend/LTLintyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/RTL.vo backend/Locations.vo backend/LTLin.vo backend/LTLtyping.vo backend/Conventions.vo
-backend/Linearize.vo: backend/Linearize.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo common/AST.vo common/Values.vo common/Globalenvs.vo common/Errors.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLin.vo backend/Kildall.vo lib/Lattice.vo
-backend/Linearizeproof.vo: backend/Linearizeproof.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Errors.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLtyping.vo backend/LTLin.vo backend/Linearize.vo lib/Lattice.vo
-backend/Linearizetyping.vo: backend/Linearizetyping.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLtyping.vo backend/LTLin.vo backend/Linearize.vo backend/LTLintyping.vo backend/Conventions.vo
-backend/Linear.vo: backend/Linear.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Conventions.vo
-backend/Lineartyping.vo: backend/Lineartyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/RTL.vo backend/Locations.vo backend/Linear.vo backend/Conventions.vo
-backend/Parallelmove.vo: backend/Parallelmove.v lib/Coqlib.vo lib/Parmov.vo common/Values.vo common/Events.vo common/AST.vo backend/Locations.vo backend/Conventions.vo
-backend/Reload.vo: backend/Reload.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTLin.vo backend/Conventions.vo backend/Parallelmove.vo backend/Linear.vo
-backend/Reloadproof.vo: backend/Reloadproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Allocproof.vo backend/LTLin.vo backend/LTLintyping.vo backend/Linear.vo backend/Parallelmove.vo backend/Reload.vo
-backend/Reloadtyping.vo: backend/Reloadtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/Locations.vo backend/LTLin.vo backend/LTLintyping.vo backend/Linear.vo backend/Lineartyping.vo backend/Conventions.vo backend/Parallelmove.vo backend/Reload.vo backend/Reloadproof.vo
-backend/Mach.vo: backend/Mach.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo
-backend/Machabstr.vo: backend/Machabstr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Mem.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Mach.vo backend/Stacking.vo
-backend/Machtyping.vo: backend/Machtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Mem.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Mach.vo backend/Machabstr.vo
-backend/Bounds.vo: backend/Bounds.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Op.vo backend/Locations.vo backend/Linear.vo backend/Lineartyping.vo backend/Conventions.vo
-backend/Stacking.vo: backend/Stacking.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo backend/Op.vo backend/RTL.vo backend/Locations.vo backend/Linear.vo backend/Bounds.vo backend/Mach.vo backend/Conventions.vo
-backend/Stackingproof.vo: backend/Stackingproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo common/Values.vo backend/Op.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Locations.vo backend/Linear.vo backend/Lineartyping.vo backend/Mach.vo backend/Machabstr.vo backend/Bounds.vo backend/Conventions.vo backend/Stacking.vo
-backend/Stackingtyping.vo: backend/Stackingtyping.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo common/AST.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Linear.vo backend/Lineartyping.vo backend/Mach.vo backend/Machtyping.vo backend/Bounds.vo backend/Stacking.vo backend/Stackingproof.vo
-backend/Machconcr.vo: backend/Machconcr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Mach.vo backend/Stacking.vo backend/PPCgenretaddr.vo
-backend/Machabstr2concr.vo: backend/Machabstr2concr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machtyping.vo backend/Machabstr.vo backend/Machconcr.vo backend/PPCgenretaddr.vo
-backend/PPC.vo: backend/PPC.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo
-backend/PPCgen.vo: backend/PPCgen.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/PPC.vo
-backend/PPCgenretaddr.vo: backend/PPCgenretaddr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/PPC.vo backend/PPCgen.vo
-backend/PPCgenproof1.vo: backend/PPCgenproof1.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machconcr.vo backend/Machtyping.vo backend/PPC.vo backend/PPCgen.vo backend/Conventions.vo
-backend/PPCgenproof.vo: backend/PPCgenproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machconcr.vo backend/Machtyping.vo backend/PPC.vo backend/PPCgen.vo backend/PPCgenretaddr.vo backend/PPCgenproof1.vo
-cfrontend/Csyntax.vo: cfrontend/Csyntax.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo
+backend/Kildall.vo: backend/Kildall.v lib/Coqlib.vo lib/Iteration.vo lib/Maps.vo lib/Lattice.vo lib/Ordered.vo
+backend/Linearizeproof.vo: backend/Linearizeproof.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Errors.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLtyping.vo backend/LTLin.vo backend/Linearize.vo lib/Lattice.vo
+backend/Linearizetyping.vo: backend/Linearizetyping.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLtyping.vo backend/LTLin.vo backend/Linearize.vo backend/LTLintyping.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/Linearize.vo: backend/Linearize.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo common/AST.vo common/Values.vo common/Globalenvs.vo common/Errors.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLin.vo backend/Kildall.vo lib/Lattice.vo
+backend/Lineartyping.vo: backend/Lineartyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/RTL.vo backend/Locations.vo backend/Linear.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/Linear.vo: backend/Linear.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/Locations.vo: backend/Locations.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo $(ARCH)/Machregs.vo
+backend/LTLintyping.vo: backend/LTLintyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/RTL.vo backend/Locations.vo backend/LTLin.vo backend/LTLtyping.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/LTLin.vo: backend/LTLin.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/LTLtyping.vo: backend/LTLtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/RTL.vo backend/Locations.vo backend/LTL.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/LTL.vo: backend/LTL.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/Machabstr2concr.vo: backend/Machabstr2concr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo backend/Mach.vo backend/Machtyping.vo backend/Machabstr.vo backend/Machconcr.vo $(ARCH)/Asmgenretaddr.vo
+backend/Machabstr.vo: backend/Machabstr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Mem.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Mach.vo $(ARCH)/$(VARIANT)/Stacklayout.vo
+backend/Machconcr.vo: backend/Machconcr.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Mach.vo $(ARCH)/$(VARIANT)/Stacklayout.vo $(ARCH)/Asmgenretaddr.vo
+backend/Machtyping.vo: backend/Machtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Mem.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Mach.vo backend/Machabstr.vo
+backend/Mach.vo: backend/Mach.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo
+backend/Parallelmove.vo: backend/Parallelmove.v lib/Coqlib.vo lib/Parmov.vo common/Values.vo common/Events.vo common/AST.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo
+backend/Registers.vo: backend/Registers.v lib/Coqlib.vo common/AST.vo lib/Maps.vo lib/Ordered.vo
+backend/Reloadproof.vo: backend/Reloadproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Allocproof.vo backend/LTLin.vo backend/LTLintyping.vo backend/Linear.vo backend/Parallelmove.vo backend/Reload.vo
+backend/Reloadtyping.vo: backend/Reloadtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTLin.vo backend/LTLintyping.vo backend/Linear.vo backend/Lineartyping.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Parallelmove.vo backend/Reload.vo backend/Reloadproof.vo
+backend/Reload.vo: backend/Reload.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTLin.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Parallelmove.vo backend/Linear.vo
+backend/RTLgenproof.vo: backend/RTLgenproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Mem.vo common/Events.vo common/Smallstep.vo common/Globalenvs.vo common/Switch.vo backend/Registers.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo backend/RTL.vo backend/RTLgen.vo backend/RTLgenspec.vo common/Errors.vo
+backend/RTLgenspec.vo: backend/RTLgenspec.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Switch.vo $(ARCH)/Op.vo backend/Registers.vo backend/CminorSel.vo backend/RTL.vo backend/RTLgen.vo
+backend/RTLgen.vo: backend/RTLgen.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Switch.vo $(ARCH)/Op.vo backend/Registers.vo backend/CminorSel.vo backend/RTL.vo
+backend/RTLtyping.vo: backend/RTLtyping.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo $(ARCH)/$(VARIANT)/Conventions.vo common/Globalenvs.vo common/Values.vo common/Mem.vo lib/Integers.vo common/Events.vo common/Smallstep.vo
+backend/RTL.vo: backend/RTL.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo
+backend/Stackingproof.vo: backend/Stackingproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo common/Values.vo $(ARCH)/Op.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Locations.vo backend/Linear.vo backend/Lineartyping.vo backend/Mach.vo backend/Machabstr.vo backend/Bounds.vo $(ARCH)/$(VARIANT)/Conventions.vo $(ARCH)/$(VARIANT)/Stacklayout.vo backend/Stacking.vo
+backend/Stackingtyping.vo: backend/Stackingtyping.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo common/AST.vo $(ARCH)/Op.vo backend/Locations.vo $(ARCH)/$(VARIANT)/Conventions.vo backend/Linear.vo backend/Lineartyping.vo backend/Mach.vo backend/Machtyping.vo backend/Bounds.vo $(ARCH)/$(VARIANT)/Stacklayout.vo backend/Stacking.vo backend/Stackingproof.vo
+backend/Stacking.vo: backend/Stacking.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo $(ARCH)/Op.vo backend/RTL.vo backend/Locations.vo backend/Linear.vo backend/Bounds.vo backend/Mach.vo $(ARCH)/$(VARIANT)/Conventions.vo $(ARCH)/$(VARIANT)/Stacklayout.vo
+backend/Tunnelingproof.vo: backend/Tunnelingproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo backend/Tunneling.vo
+backend/Tunnelingtyping.vo: backend/Tunnelingtyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo common/Mem.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLtyping.vo backend/Tunneling.vo backend/Tunnelingproof.vo
+backend/Tunneling.vo: backend/Tunneling.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo backend/LTL.vo
+cfrontend/Cminorgenproof.vo: cfrontend/Cminorgenproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo cfrontend/Csharpminor.vo $(ARCH)/Op.vo backend/Cminor.vo cfrontend/Cminorgen.vo
+cfrontend/Cminorgen.vo: cfrontend/Cminorgen.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Ordered.vo common/AST.vo lib/Integers.vo common/Mem.vo cfrontend/Csharpminor.vo $(ARCH)/Op.vo backend/Cminor.vo
cfrontend/Csem.vo: cfrontend/Csem.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Mem.vo common/Events.vo common/Globalenvs.vo cfrontend/Csyntax.vo common/Smallstep.vo
-cfrontend/Ctyping.vo: cfrontend/Ctyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo cfrontend/Csyntax.vo
-cfrontend/Cshmgen.vo: cfrontend/Cshmgen.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo cfrontend/Csyntax.vo backend/Cminor.vo cfrontend/Csharpminor.vo
+cfrontend/Csharpminor.vo: cfrontend/Csharpminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo backend/Cminor.vo common/Smallstep.vo
cfrontend/Cshmgenproof1.vo: cfrontend/Cshmgenproof1.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo
cfrontend/Cshmgenproof2.vo: cfrontend/Cshmgenproof2.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo cfrontend/Cshmgenproof1.vo
cfrontend/Cshmgenproof3.vo: cfrontend/Cshmgenproof3.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Mem.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo cfrontend/Cshmgenproof1.vo cfrontend/Cshmgenproof2.vo
-cfrontend/Csharpminor.vo: cfrontend/Csharpminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo backend/Cminor.vo common/Smallstep.vo
-cfrontend/Cminorgen.vo: cfrontend/Cminorgen.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Ordered.vo common/AST.vo lib/Integers.vo common/Mem.vo cfrontend/Csharpminor.vo backend/Op.vo backend/Cminor.vo
-cfrontend/Cminorgenproof.vo: cfrontend/Cminorgenproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Mem.vo common/Events.vo common/Globalenvs.vo cfrontend/Csharpminor.vo backend/Op.vo backend/Cminor.vo cfrontend/Cminorgen.vo
+cfrontend/Cshmgen.vo: cfrontend/Cshmgen.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo cfrontend/Csyntax.vo backend/Cminor.vo cfrontend/Csharpminor.vo
+cfrontend/Csyntax.vo: cfrontend/Csyntax.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo
+cfrontend/Ctyping.vo: cfrontend/Ctyping.v lib/Coqlib.vo lib/Maps.vo common/AST.vo cfrontend/Csyntax.vo
+driver/Compiler.vo: driver/Compiler.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo common/Values.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Csharpminor.vo backend/Cminor.vo backend/CminorSel.vo backend/RTL.vo backend/LTL.vo backend/LTLin.vo backend/Linear.vo backend/Mach.vo $(ARCH)/Asm.vo cfrontend/Cshmgen.vo cfrontend/Cminorgen.vo $(ARCH)/Selection.vo backend/RTLgen.vo $(ARCH)/Constprop.vo backend/CSE.vo backend/Allocation.vo backend/Tunneling.vo backend/Linearize.vo backend/Reload.vo backend/Stacking.vo $(ARCH)/Asmgen.vo cfrontend/Ctyping.vo backend/RTLtyping.vo backend/LTLtyping.vo backend/LTLintyping.vo backend/Lineartyping.vo backend/Machtyping.vo cfrontend/Cshmgenproof3.vo cfrontend/Cminorgenproof.vo $(ARCH)/Selectionproof.vo backend/RTLgenproof.vo $(ARCH)/Constpropproof.vo backend/CSEproof.vo backend/Allocproof.vo backend/Alloctyping.vo backend/Tunnelingproof.vo backend/Tunnelingtyping.vo backend/Linearizeproof.vo backend/Linearizetyping.vo backend/Reloadproof.vo backend/Reloadtyping.vo backend/Stackingproof.vo backend/Stackingtyping.vo backend/Machabstr2concr.vo $(ARCH)/Asmgenproof.vo
+driver/Complements.vo: driver/Complements.v lib/Coqlib.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo $(ARCH)/Asm.vo driver/Compiler.vo common/Errors.vo
diff --git a/Makefile b/Makefile
index 58d494c09fb43c99b72846d27aadc1ce2b6d14f2..c2ffcebd61615761a6fba1808b333e3e3077e900 100644
--- a/Makefile
+++ b/Makefile
@@ -15,20 +15,31 @@ include Makefile.config
COQC=coqc $(INCLUDES)
COQDEP=coqdep $(INCLUDES)
COQDOC=coqdoc
+OCAMLBUILD=ocamlbuild
+OCB_OPTIONS=\
+ -no-hygiene \
+ -I extraction $(INCLUDES) \
+ -cflags -I,`pwd`/cil/obj/$(ARCHOS) \
+ -lflags -I,`pwd`/cil/obj/$(ARCHOS) \
+ -libs unix,str,cil
-INCLUDES=-I lib -I common -I backend -I cfrontend
+DIRS=lib common $(ARCH)/$(VARIANT) $(ARCH) backend cfrontend driver
-# Files in lib/
+VPATH=$(DIRS)
+GPATH=$(DIRS)
+INCLUDES=$(patsubst %,-I %, $(DIRS))
+
+# General-purpose libraries (in lib/)
LIB=Coqlib.v Maps.v Lattice.v Ordered.v \
Iteration.v Integers.v Floats.v Parmov.v
-# Files in common/
+# Parts common to the front-ends and the back-end (in common/)
COMMON=Errors.v AST.v Events.v Globalenvs.v Mem.v Values.v \
- Smallstep.v Switch.v Main.v Complements.v
+ Smallstep.v Switch.v
-# Files in backend/
+# Back-end modules (in backend/, $(ARCH)/, $(ARCH)/$(VARIANT))
BACKEND=\
Cminor.v Op.v CminorSel.v \
@@ -39,7 +50,7 @@ BACKEND=\
Kildall.v \
Constprop.v Constpropproof.v \
CSE.v CSEproof.v \
- Locations.v Conventions.v LTL.v LTLtyping.v \
+ Machregs.v Locations.v Conventions.v LTL.v LTLtyping.v \
InterfGraph.v Coloring.v Coloringproof.v \
Allocation.v Allocproof.v Alloctyping.v \
Tunneling.v Tunnelingproof.v Tunnelingtyping.v \
@@ -48,29 +59,34 @@ BACKEND=\
Linear.v Lineartyping.v \
Parallelmove.v Reload.v Reloadproof.v Reloadtyping.v \
Mach.v Machabstr.v Machtyping.v \
- Bounds.v Stacking.v Stackingproof.v Stackingtyping.v \
+ Bounds.v Stacklayout.v Stacking.v Stackingproof.v Stackingtyping.v \
Machconcr.v Machabstr2concr.v \
- PPC.v PPCgen.v PPCgenretaddr.v PPCgenproof1.v PPCgenproof.v
+ Asm.v Asmgen.v Asmgenretaddr.v Asmgenproof1.v Asmgenproof.v
-# Files in cfrontend/
+# C front-end modules (in cfrontend/)
CFRONTEND=Csyntax.v Csem.v Ctyping.v Cshmgen.v \
Cshmgenproof1.v Cshmgenproof2.v Cshmgenproof3.v \
Csharpminor.v Cminorgen.v Cminorgenproof.v
-# All source files
+# Putting everything together (in driver/)
+
+DRIVER=Compiler.v Complements.v
-FILES=$(LIB:%=lib/%) $(COMMON:%=common/%) $(BACKEND:%=backend/%) $(CFRONTEND:%=cfrontend/%)
+# All source files
-FLATFILES=$(LIB) $(COMMON) $(BACKEND) $(CFRONTEND)
+FILES=$(LIB) $(COMMON) $(BACKEND) $(CFRONTEND) $(DRIVER)
proof: $(FILES:.v=.vo)
+exec:
+ $(OCAMLBUILD) $(OCB_OPTIONS) Driver.native && mv Driver.native ccomp
+
all:
$(MAKE) proof
$(MAKE) -C cil
- $(MAKE) -C extraction extraction
- $(MAKE) -C extraction depend
+ $(MAKE) -C extraction
+ $(MAKE) exec
$(MAKE) -C extraction
$(MAKE) -C runtime
@@ -78,8 +94,8 @@ documentation: doc/removeproofs
@ln -f $(FILES) doc/
@mkdir -p doc/html
cd doc; $(COQDOC) --html -d html \
- $(FLATFILES:%.v=--glob-from %.glob) $(FLATFILES)
- @cd doc; rm -f $(FLATFILES)
+ $(FILES:%.v=--glob-from %.glob) $(FILES)
+ @cd doc; rm -f $(FILES)
cp doc/coqdoc.css doc/html/coqdoc.css
doc/removeproofs doc/html/*.html
@@ -100,14 +116,19 @@ latexdoc:
@$(COQC) -dump-glob doc/$(*F).glob $*.v
depend:
- $(COQDEP) $(FILES) > .depend
+ $(COQDEP) $(patsubst %, %/*.v, $(DIRS)) \
+ | sed -e 's|$(ARCH)/$(VARIANT)/|$$(ARCH)/$$(VARIANT)/|g' \
+ -e 's|$(ARCH)/|$$(ARCH)/|g' \
+ > .depend
install:
- $(MAKE) -C extraction install
+ install -d $(BINDIR)
+ install ../ccomp $(BINDIR)
$(MAKE) -C runtime install
clean:
- rm -f */*.vo *~ */*~
+ rm -f $(patsubst %, %/*.vo, $(DIRS))
+ rm -rf _build
rm -rf doc/html doc/*.glob
rm -f doc/removeproofs.ml doc/removeproofs
$(MAKE) -C extraction clean
diff --git a/arm/Asmgen.v b/arm/Asmgen.v
new file mode 100644
index 0000000000000000000000000000000000000000..a360bded1ba76a74f288677a85d16284b6184220
--- /dev/null
+++ b/arm/Asmgen.v
@@ -0,0 +1,554 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Translation from Mach to ARM. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Errors.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Mem.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Asm.
+
+(** Translation of the LTL/Linear/Mach view of machine registers
+ to the ARM view. ARM has two different types for registers
+ (integer and float) while LTL et al have only one. The
+ [ireg_of] and [freg_of] are therefore partial in principle.
+ To keep things simpler, we make them return nonsensical
+ results when applied to a LTL register of the wrong type.
+ The proof in [ARMgenproof] will show that this never happens.
+
+ Note that no LTL register maps to [IR14].
+ This register is reserved as temporary, to be used
+ by the generated ARM code. *)
+
+Definition ireg_of (r: mreg) : ireg :=
+ match r with
+ | R0 => IR0 | R1 => IR1 | R2 => IR2 | R3 => IR3
+ | R4 => IR4 | R5 => IR5 | R6 => IR6 | R7 => IR7
+ | R8 => IR8 | R9 => IR9 | R11 => IR11
+ | IT1 => IR10 | IT2 => IR12
+ | _ => IR0 (* should not happen *)
+ end.
+
+Definition freg_of (r: mreg) : freg :=
+ match r with
+ | F0 => FR0 | F1 => FR1
+ | F4 => FR4 | F5 => FR5 | F6 => FR6 | F7 => FR7
+ | FT1 => FR2 | FT2 => FR3
+ | _ => FR0 (* should not happen *)
+ end.
+
+(** Recognition of integer immediate arguments.
+- For arithmetic operations, immediates are
+ 8-bit quantities zero-extended and rotated right by 0, 2, 4, ... 30 bits.
+- For memory accesses of type [Mint32], immediate offsets are
+ 12-bit quantities plus a sign bit.
+- For other memory accesses, immediate offsets are
+ 8-bit quantities plus a sign bit. *)
+
+Fixpoint is_immed_arith_aux (n: nat) (x msk: int) {struct n}: bool :=
+ match n with
+ | O => false
+ | Datatypes.S n' =>
+ Int.eq (Int.and x (Int.not msk)) Int.zero ||
+ is_immed_arith_aux n' x (Int.ror msk (Int.repr 2))
+ end.
+
+Definition is_immed_arith (x: int) : bool :=
+ is_immed_arith_aux 16%nat x (Int.repr 255).
+
+Definition is_immed_mem_word (x: int) : bool :=
+ Int.lt x (Int.repr 4096) && Int.lt (Int.repr (-4096)) x.
+
+Definition is_immed_mem_small (x: int) : bool :=
+ Int.lt x (Int.repr 256) && Int.lt (Int.repr (-256)) x.
+
+Definition is_immed_mem_float (x: int) : bool :=
+ Int.eq (Int.and x (Int.repr 3)) Int.zero
+ && Int.lt x (Int.repr 1024) && Int.lt (Int.repr (-1024)) x.
+
+(** Smart constructor for integer immediate arguments. *)
+
+Definition loadimm (r: ireg) (n: int) (k: code) :=
+ if is_immed_arith n then
+ Pmov r (SOimm n) :: k
+ else if is_immed_arith (Int.not n) then
+ Pmvn r (SOimm (Int.not n)) :: k
+ else (* could be much improved! *)
+ Pmov r (SOimm (Int.and n (Int.repr 255))) ::
+ Porr r r (SOimm (Int.and n (Int.repr 65280))) ::
+ Porr r r (SOimm (Int.and n (Int.repr 16711680))) ::
+ Porr r r (SOimm (Int.and n (Int.repr 4278190080))) ::
+ k.
+
+Definition addimm (r1 r2: ireg) (n: int) (k: code) :=
+ if is_immed_arith n then
+ Padd r1 r2 (SOimm n) :: k
+ else if is_immed_arith (Int.neg n) then
+ Psub r1 r2 (SOimm (Int.neg n)) :: k
+ else
+ Padd r1 r2 (SOimm (Int.and n (Int.repr 255))) ::
+ Padd r1 r1 (SOimm (Int.and n (Int.repr 65280))) ::
+ Padd r1 r1 (SOimm (Int.and n (Int.repr 16711680))) ::
+ Padd r1 r1 (SOimm (Int.and n (Int.repr 4278190080))) ::
+ k.
+
+Definition andimm (r1 r2: ireg) (n: int) (k: code) :=
+ if is_immed_arith n then
+ Pand r1 r2 (SOimm n) :: k
+ else if is_immed_arith (Int.not n) then
+ Pbic r1 r2 (SOimm (Int.not n)) :: k
+ else
+ loadimm IR14 n (Pand r1 r2 (SOreg IR14) :: k).
+
+Definition makeimm (instr: ireg -> ireg -> shift_op -> instruction)
+ (r1 r2: ireg) (n: int) (k: code) :=
+ if is_immed_arith n then
+ instr r1 r2 (SOimm n) :: k
+ else
+ loadimm IR14 n (instr r1 r2 (SOreg IR14) :: k).
+
+(** Translation of a shift immediate operation (type [Op.shift]) *)
+
+Definition transl_shift (s: shift) (r: ireg) : shift_op :=
+ match s with
+ | Slsl n => SOlslimm r (s_amount n)
+ | Slsr n => SOlsrimm r (s_amount n)
+ | Sasr n => SOasrimm r (s_amount n)
+ | Sror n => SOrorimm r (s_amount n)
+ end.
+
+(** Translation of a condition. Prepends to [k] the instructions
+ that evaluate the condition and leave its boolean result in one of
+ the bits of the condition register. The bit in question is
+ determined by the [crbit_for_cond] function. *)
+
+Definition transl_cond
+ (cond: condition) (args: list mreg) (k: code) :=
+ match cond, args with
+ | Ccomp c, a1 :: a2 :: nil =>
+ Pcmp (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Ccompu c, a1 :: a2 :: nil =>
+ Pcmp (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Ccompshift c s, a1 :: a2 :: nil =>
+ Pcmp (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Ccompushift c s, a1 :: a2 :: nil =>
+ Pcmp (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Ccompimm c n, a1 :: nil =>
+ if is_immed_arith n then
+ Pcmp (ireg_of a1) (SOimm n) :: k
+ else
+ loadimm IR14 n (Pcmp (ireg_of a1) (SOreg IR14) :: k)
+ | Ccompuimm c n, a1 :: nil =>
+ if is_immed_arith n then
+ Pcmp (ireg_of a1) (SOimm n) :: k
+ else
+ loadimm IR14 n (Pcmp (ireg_of a1) (SOreg IR14) :: k)
+ | Ccompf cmp, a1 :: a2 :: nil =>
+ Pcmf (freg_of a1) (freg_of a2) :: k
+ | Cnotcompf cmp, a1 :: a2 :: nil =>
+ Pcmf (freg_of a1) (freg_of a2) :: k
+ | _, _ =>
+ k (**r never happens for well-typed code *)
+ end.
+
+Definition crbit_for_signed_cmp (cmp: comparison) :=
+ match cmp with
+ | Ceq => CReq
+ | Cne => CRne
+ | Clt => CRlt
+ | Cle => CRle
+ | Cgt => CRgt
+ | Cge => CRge
+ end.
+
+Definition crbit_for_unsigned_cmp (cmp: comparison) :=
+ match cmp with
+ | Ceq => CReq
+ | Cne => CRne
+ | Clt => CRlo
+ | Cle => CRls
+ | Cgt => CRhi
+ | Cge => CRhs
+ end.
+
+Definition crbit_for_float_cmp (cmp: comparison) :=
+ match cmp with
+ | Ceq => CReq
+ | Cne => CRne
+ | Clt => CRmi
+ | Cle => CRls
+ | Cgt => CRgt
+ | Cge => CRge
+ end.
+
+Definition crbit_for_float_not_cmp (cmp: comparison) :=
+ match cmp with
+ | Ceq => CRne
+ | Cne => CReq
+ | Clt => CRpl
+ | Cle => CRhi
+ | Cgt => CRle
+ | Cge => CRlt
+ end.
+
+Definition crbit_for_cond (cond: condition) :=
+ match cond with
+ | Ccomp cmp => crbit_for_signed_cmp cmp
+ | Ccompu cmp => crbit_for_unsigned_cmp cmp
+ | Ccompshift cmp s => crbit_for_signed_cmp cmp
+ | Ccompushift cmp s => crbit_for_unsigned_cmp cmp
+ | Ccompimm cmp n => crbit_for_signed_cmp cmp
+ | Ccompuimm cmp n => crbit_for_unsigned_cmp cmp
+ | Ccompf cmp => crbit_for_float_cmp cmp
+ | Cnotcompf cmp => crbit_for_float_not_cmp cmp
+ end.
+
+(** Translation of the arithmetic operation [r <- op(args)].
+ The corresponding instructions are prepended to [k]. *)
+
+Definition transl_op
+ (op: operation) (args: list mreg) (r: mreg) (k: code) :=
+ match op, args with
+ | Omove, a1 :: nil =>
+ match mreg_type a1 with
+ | Tint => Pmov (ireg_of r) (SOreg (ireg_of a1)) :: k
+ | Tfloat => Pmvfd (freg_of r) (freg_of a1) :: k
+ end
+ | Ointconst n, nil =>
+ loadimm (ireg_of r) n k
+ | Ofloatconst f, nil =>
+ Plifd (freg_of r) f :: k
+ | Oaddrsymbol s ofs, nil =>
+ Ploadsymbol (ireg_of r) s ofs :: k
+ | Oaddrstack n, nil =>
+ addimm (ireg_of r) IR13 n k
+ | Ocast8signed, a1 :: nil =>
+ Pmov (ireg_of r) (SOlslimm (ireg_of a1) (Int.repr 24)) ::
+ Pmov (ireg_of r) (SOasrimm (ireg_of r) (Int.repr 24)) :: k
+ | Ocast8unsigned, a1 :: nil =>
+ Pand (ireg_of r) (ireg_of a1) (SOimm (Int.repr 255)) :: k
+ | Ocast16signed, a1 :: nil =>
+ Pmov (ireg_of r) (SOlslimm (ireg_of a1) (Int.repr 16)) ::
+ Pmov (ireg_of r) (SOasrimm (ireg_of r) (Int.repr 16)) :: k
+ | Ocast16unsigned, a1 :: nil =>
+ Pmov (ireg_of r) (SOlslimm (ireg_of a1) (Int.repr 16)) ::
+ Pmov (ireg_of r) (SOlsrimm (ireg_of r) (Int.repr 16)) :: k
+ | Oadd, a1 :: a2 :: nil =>
+ Padd (ireg_of r) (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Oaddshift s, a1 :: a2 :: nil =>
+ Padd (ireg_of r) (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Oaddimm n, a1 :: nil =>
+ addimm (ireg_of r) (ireg_of a1) n k
+ | Osub, a1 :: a2 :: nil =>
+ Psub (ireg_of r) (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Osubshift s, a1 :: a2 :: nil =>
+ Psub (ireg_of r) (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Orsubshift s, a1 :: a2 :: nil =>
+ Prsb (ireg_of r) (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Orsubimm n, a1 :: nil =>
+ makeimm Prsb (ireg_of r) (ireg_of a1) n k
+ | Omul, a1 :: a2 :: nil =>
+ if ireg_eq (ireg_of r) (ireg_of a1)
+ || ireg_eq (ireg_of r) (ireg_of a2)
+ then Pmul IR14 (ireg_of a1) (ireg_of a2) :: Pmov (ireg_of r) (SOreg IR14) :: k
+ else Pmul (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
+ | Odiv, a1 :: a2 :: nil =>
+ Psdiv (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
+ | Odivu, a1 :: a2 :: nil =>
+ Pudiv (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
+ | Oand, a1 :: a2 :: nil =>
+ Pand (ireg_of r) (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Oandshift s, a1 :: a2 :: nil =>
+ Pand (ireg_of r) (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Oandimm n, a1 :: nil =>
+ andimm (ireg_of r) (ireg_of a1) n k
+ | Oor, a1 :: a2 :: nil =>
+ Porr (ireg_of r) (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Oorshift s, a1 :: a2 :: nil =>
+ Porr (ireg_of r) (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Oorimm n, a1 :: nil =>
+ makeimm Porr (ireg_of r) (ireg_of a1) n k
+ | Oxor, a1 :: a2 :: nil =>
+ Peor (ireg_of r) (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Oxorshift s, a1 :: a2 :: nil =>
+ Peor (ireg_of r) (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Oxorimm n, a1 :: nil =>
+ makeimm Peor (ireg_of r) (ireg_of a1) n k
+ | Obic, a1 :: a2 :: nil =>
+ Pbic (ireg_of r) (ireg_of a1) (SOreg (ireg_of a2)) :: k
+ | Obicshift s, a1 :: a2 :: nil =>
+ Pbic (ireg_of r) (ireg_of a1) (transl_shift s (ireg_of a2)) :: k
+ | Onot, a1 :: nil =>
+ Pmvn (ireg_of r) (SOreg (ireg_of a1)) :: k
+ | Onotshift s, a1 :: nil =>
+ Pmvn (ireg_of r) (transl_shift s (ireg_of a1)) :: k
+ | Oshl, a1 :: a2 :: nil =>
+ Pmov (ireg_of r) (SOlslreg (ireg_of a1) (ireg_of a2)) :: k
+ | Oshr, a1 :: a2 :: nil =>
+ Pmov (ireg_of r) (SOasrreg (ireg_of a1) (ireg_of a2)) :: k
+ | Oshru, a1 :: a2 :: nil =>
+ Pmov (ireg_of r) (SOlsrreg (ireg_of a1) (ireg_of a2)) :: k
+ | Oshift s, a1 :: nil =>
+ Pmov (ireg_of r) (transl_shift s (ireg_of a1)) :: k
+ | Oshrximm n, a1 :: nil =>
+ Pcmp (ireg_of a1) (SOimm Int.zero) ::
+ addimm IR14 (ireg_of a1) (Int.sub (Int.shl Int.one n) Int.one)
+ (Pmovc CRge IR14 (SOreg (ireg_of a1)) ::
+ Pmov (ireg_of r) (SOasrimm IR14 n) :: k)
+ | Onegf, a1 :: nil =>
+ Pmnfd (freg_of r) (freg_of a1) :: k
+ | Oabsf, a1 :: nil =>
+ Pabsd (freg_of r) (freg_of a1) :: k
+ | Oaddf, a1 :: a2 :: nil =>
+ Padfd (freg_of r) (freg_of a1) (freg_of a2) :: k
+ | Osubf, a1 :: a2 :: nil =>
+ Psufd (freg_of r) (freg_of a1) (freg_of a2) :: k
+ | Omulf, a1 :: a2 :: nil =>
+ Pmufd (freg_of r) (freg_of a1) (freg_of a2) :: k
+ | Odivf, a1 :: a2 :: nil =>
+ Pdvfd (freg_of r) (freg_of a1) (freg_of a2) :: k
+ | Osingleoffloat, a1 :: nil =>
+ Pmvfs (freg_of r) (freg_of a1) :: k
+ | Ointoffloat, a1 :: nil =>
+ Pfixz (ireg_of r) (freg_of a1) :: k
+ | Ointuoffloat, a1 :: nil =>
+ Pfixzu (ireg_of r) (freg_of a1) :: k
+ | Ofloatofint, a1 :: nil =>
+ Pfltd (freg_of r) (ireg_of a1) :: k
+ | Ofloatofintu, a1 :: nil =>
+ Pfltud (freg_of r) (ireg_of a1) :: k
+ | Ocmp cmp, _ =>
+ transl_cond cmp args
+ (Pmov (ireg_of r) (SOimm Int.zero) ::
+ Pmovc (crbit_for_cond cmp) (ireg_of r) (SOimm Int.one) ::
+ k)
+ | _, _ =>
+ k (**r never happens for well-typed code *)
+ end.
+
+(** Common code to translate [Mload] and [Mstore] instructions. *)
+
+Definition transl_shift_addr (s: shift) (r: ireg) : shift_addr :=
+ match s with
+ | Slsl n => SAlsl r (s_amount n)
+ | Slsr n => SAlsr r (s_amount n)
+ | Sasr n => SAasr r (s_amount n)
+ | Sror n => SAror r (s_amount n)
+ end.
+
+Definition transl_load_store
+ (mk_instr_imm: ireg -> int -> instruction)
+ (mk_instr_gen: option (ireg -> shift_addr -> instruction))
+ (is_immed: int -> bool)
+ (addr: addressing) (args: list mreg) (k: code) : code :=
+ match addr, args with
+ | Aindexed n, a1 :: nil =>
+ if is_immed n then
+ mk_instr_imm (ireg_of a1) n :: k
+ else
+ addimm IR14 (ireg_of a1) n
+ (mk_instr_imm IR14 Int.zero :: k)
+ | Aindexed2, a1 :: a2 :: nil =>
+ match mk_instr_gen with
+ | Some f =>
+ f (ireg_of a1) (SAreg (ireg_of a2)) :: k
+ | None =>
+ Padd IR14 (ireg_of a1) (SOreg (ireg_of a2)) ::
+ mk_instr_imm IR14 Int.zero :: k
+ end
+ | Aindexed2shift s, a1 :: a2 :: nil =>
+ match mk_instr_gen with
+ | Some f =>
+ f (ireg_of a1) (transl_shift_addr s (ireg_of a2)) :: k
+ | None =>
+ Padd IR14 (ireg_of a1) (transl_shift s (ireg_of a2)) ::
+ mk_instr_imm IR14 Int.zero :: k
+ end
+ | Ainstack n, nil =>
+ if is_immed n then
+ mk_instr_imm IR13 n :: k
+ else
+ addimm IR14 IR13 n
+ (mk_instr_imm IR14 Int.zero :: k)
+ | _, _ =>
+ (* should not happen *) k
+ end.
+
+Definition transl_load_store_int
+ (mk_instr: ireg -> ireg -> shift_addr -> instruction)
+ (is_immed: int -> bool)
+ (rd: mreg) (addr: addressing) (args: list mreg) (k: code) :=
+ transl_load_store
+ (fun r n => mk_instr (ireg_of rd) r (SAimm n))
+ (Some (mk_instr (ireg_of rd)))
+ is_immed addr args k.
+
+Definition transl_load_store_float
+ (mk_instr: freg -> ireg -> int -> instruction)
+ (is_immed: int -> bool)
+ (rd: mreg) (addr: addressing) (args: list mreg) (k: code) :=
+ transl_load_store
+ (mk_instr (freg_of rd))
+ None
+ is_immed addr args k.
+
+Definition loadind_int (base: ireg) (ofs: int) (dst: ireg) (k: code) :=
+ if is_immed_mem_word ofs then
+ Pldr dst base (SAimm ofs) :: k
+ else
+ addimm IR14 base ofs
+ (Pldr dst IR14 (SAimm Int.zero) :: k).
+
+Definition loadind_float (base: ireg) (ofs: int) (dst: freg) (k: code) :=
+ if is_immed_mem_float ofs then
+ Pldfd dst base ofs :: k
+ else
+ addimm IR14 base ofs
+ (Pldfd dst IR14 Int.zero :: k).
+
+Definition loadind (base: ireg) (ofs: int) (ty: typ) (dst: mreg) (k: code) :=
+ match ty with
+ | Tint => loadind_int base ofs (ireg_of dst) k
+ | Tfloat => loadind_float base ofs (freg_of dst) k
+ end.
+
+Definition storeind_int (src: ireg) (base: ireg) (ofs: int) (k: code) :=
+ if is_immed_mem_word ofs then
+ Pstr src base (SAimm ofs) :: k
+ else
+ addimm IR14 base ofs
+ (Pstr src IR14 (SAimm Int.zero) :: k).
+
+Definition storeind_float (src: freg) (base: ireg) (ofs: int) (k: code) :=
+ if is_immed_mem_float ofs then
+ Pstfd src base ofs :: k
+ else
+ addimm IR14 base ofs
+ (Pstfd src IR14 Int.zero :: k).
+
+Definition storeind (src: mreg) (base: ireg) (ofs: int) (ty: typ) (k: code) :=
+ match ty with
+ | Tint => storeind_int (ireg_of src) base ofs k
+ | Tfloat => storeind_float (freg_of src) base ofs k
+ end.
+
+(** Translation of a Mach instruction. *)
+
+Definition transl_instr (f: Mach.function) (i: Mach.instruction) (k: code) :=
+ match i with
+ | Mgetstack ofs ty dst =>
+ loadind IR13 ofs ty dst k
+ | Msetstack src ofs ty =>
+ storeind src IR13 ofs ty k
+ | Mgetparam ofs ty dst =>
+ loadind_int IR13 f.(fn_link_ofs) IR14 (loadind IR14 ofs ty dst k)
+ | Mop op args res =>
+ transl_op op args res k
+ | Mload chunk addr args dst =>
+ match chunk with
+ | Mint8signed =>
+ transl_load_store_int Pldrsb is_immed_mem_small dst addr args k
+ | Mint8unsigned =>
+ transl_load_store_int Pldrb is_immed_mem_small dst addr args k
+ | Mint16signed =>
+ transl_load_store_int Pldrsh is_immed_mem_small dst addr args k
+ | Mint16unsigned =>
+ transl_load_store_int Pldrh is_immed_mem_small dst addr args k
+ | Mint32 =>
+ transl_load_store_int Pldr is_immed_mem_word dst addr args k
+ | Mfloat32 =>
+ transl_load_store_float Pldfs is_immed_mem_float dst addr args k
+ | Mfloat64 =>
+ transl_load_store_float Pldfd is_immed_mem_float dst addr args k
+ end
+ | Mstore chunk addr args src =>
+ match chunk with
+ | Mint8signed =>
+ transl_load_store_int Pstrb is_immed_mem_small src addr args k
+ | Mint8unsigned =>
+ transl_load_store_int Pstrb is_immed_mem_small src addr args k
+ | Mint16signed =>
+ transl_load_store_int Pstrh is_immed_mem_small src addr args k
+ | Mint16unsigned =>
+ transl_load_store_int Pstrh is_immed_mem_small src addr args k
+ | Mint32 =>
+ transl_load_store_int Pstr is_immed_mem_word src addr args k
+ | Mfloat32 =>
+ transl_load_store_float Pstfs is_immed_mem_float src addr args k
+ | Mfloat64 =>
+ transl_load_store_float Pstfd is_immed_mem_float src addr args k
+ end
+ | Mcall sig (inl r) =>
+ Pblreg (ireg_of r) :: k
+ | Mcall sig (inr symb) =>
+ Pblsymb symb :: k
+ | Mtailcall sig (inl r) =>
+ loadind_int IR13 f.(fn_retaddr_ofs) IR14
+ (Pfreeframe f.(fn_link_ofs) :: Pbreg (ireg_of r) :: k)
+ | Mtailcall sig (inr symb) =>
+ loadind_int IR13 f.(fn_retaddr_ofs) IR14
+ (Pfreeframe f.(fn_link_ofs) :: Pbsymb symb :: k)
+ | Malloc =>
+ Pallocblock :: k
+ | Mlabel lbl =>
+ Plabel lbl :: k
+ | Mgoto lbl =>
+ Pb lbl :: k
+ | Mcond cond args lbl =>
+ transl_cond cond args (Pbc (crbit_for_cond cond) lbl :: k)
+ | Mreturn =>
+ loadind_int IR13 f.(fn_retaddr_ofs) IR14
+ (Pfreeframe f.(fn_link_ofs) :: Pbreg IR14 :: k)
+ end.
+
+Definition transl_code (f: Mach.function) (il: list Mach.instruction) :=
+ List.fold_right (transl_instr f) nil il.
+
+(** Translation of a whole function. Note that we must check
+ that the generated code contains less than [2^32] instructions,
+ otherwise the offset part of the [PC] code pointer could wrap
+ around, leading to incorrect executions. *)
+
+Definition transl_function (f: Mach.function) :=
+ Pallocframe (- f.(fn_framesize)) f.(fn_stacksize) f.(fn_link_ofs) ::
+ Pstr IR14 IR13 (SAimm f.(fn_retaddr_ofs)) ::
+ transl_code f f.(fn_code).
+
+Fixpoint code_size (c: code) : Z :=
+ match c with
+ | nil => 0
+ | instr :: c' => code_size c' + 1
+ end.
+
+Open Local Scope string_scope.
+
+Definition transf_function (f: Mach.function) : res Asm.code :=
+ let c := transl_function f in
+ if zlt Int.max_unsigned (code_size c)
+ then Errors.Error (msg "code size exceeded")
+ else Errors.OK c.
+
+Definition transf_fundef (f: Mach.fundef) : res Asm.fundef :=
+ transf_partial_fundef transf_function f.
+
+Definition transf_program (p: Mach.program) : res Asm.program :=
+ transform_partial_program transf_fundef p.
+
diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v
new file mode 100644
index 0000000000000000000000000000000000000000..69a82dea918e6b52afb539c912a65230d3b2efcb
--- /dev/null
+++ b/arm/Asmgenproof.v
@@ -0,0 +1,1246 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Correctness proof for ARM code generation: main proof. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Errors.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Mem.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Machconcr.
+Require Import Machtyping.
+Require Import Asm.
+Require Import Asmgen.
+Require Import Asmgenretaddr.
+Require Import Asmgenproof1.
+
+Section PRESERVATION.
+
+Variable prog: Mach.program.
+Variable tprog: Asm.program.
+Hypothesis TRANSF: transf_program prog = Errors.OK tprog.
+
+Let ge := Genv.globalenv prog.
+Let tge := Genv.globalenv tprog.
+
+Lemma symbols_preserved:
+ forall id, Genv.find_symbol tge id = Genv.find_symbol ge id.
+Proof.
+ intros. unfold ge, tge.
+ apply Genv.find_symbol_transf_partial with transf_fundef.
+ exact TRANSF.
+Qed.
+
+Lemma functions_translated:
+ forall b f,
+ Genv.find_funct_ptr ge b = Some f ->
+ exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = Errors.OK tf.
+Proof
+ (Genv.find_funct_ptr_transf_partial transf_fundef TRANSF).
+
+Lemma functions_transl:
+ forall f b,
+ Genv.find_funct_ptr ge b = Some (Internal f) ->
+ Genv.find_funct_ptr tge b = Some (Internal (transl_function f)).
+Proof.
+ intros.
+ destruct (functions_translated _ _ H) as [tf [A B]].
+ rewrite A. generalize B. unfold transf_fundef, transf_partial_fundef, transf_function.
+ case (zlt Int.max_unsigned (code_size (transl_function f))); simpl; intro.
+ congruence. intro. inv B0. auto.
+Qed.
+
+Lemma functions_transl_no_overflow:
+ forall b f,
+ Genv.find_funct_ptr ge b = Some (Internal f) ->
+ code_size (transl_function f) <= Int.max_unsigned.
+Proof.
+ intros.
+ destruct (functions_translated _ _ H) as [tf [A B]].
+ generalize B. unfold transf_fundef, transf_partial_fundef, transf_function.
+ case (zlt Int.max_unsigned (code_size (transl_function f))); simpl; intro.
+ congruence. intro; omega.
+Qed.
+
+(** * Properties of control flow *)
+
+Lemma find_instr_in:
+ forall c pos i,
+ find_instr pos c = Some i -> In i c.
+Proof.
+ induction c; simpl. intros; discriminate.
+ intros until i. case (zeq pos 0); intros.
+ left; congruence. right; eauto.
+Qed.
+
+Lemma find_instr_tail:
+ forall c1 i c2 pos,
+ code_tail pos c1 (i :: c2) ->
+ find_instr pos c1 = Some i.
+Proof.
+ induction c1; simpl; intros.
+ inv H.
+ destruct (zeq pos 0). subst pos.
+ inv H. auto. generalize (code_tail_pos _ _ _ H4). intro. omegaContradiction.
+ inv H. congruence. replace (pos0 + 1 - 1) with pos0 by omega.
+ eauto.
+Qed.
+
+Remark code_size_pos:
+ forall fn, code_size fn >= 0.
+Proof.
+ induction fn; simpl; omega.
+Qed.
+
+Remark code_tail_bounds:
+ forall fn ofs i c,
+ code_tail ofs fn (i :: c) -> 0 <= ofs < code_size fn.
+Proof.
+ assert (forall ofs fn c, code_tail ofs fn c ->
+ forall i c', c = i :: c' -> 0 <= ofs < code_size fn).
+ induction 1; intros; simpl.
+ rewrite H. simpl. generalize (code_size_pos c'). omega.
+ generalize (IHcode_tail _ _ H0). omega.
+ eauto.
+Qed.
+
+Lemma code_tail_next:
+ forall fn ofs i c,
+ code_tail ofs fn (i :: c) ->
+ code_tail (ofs + 1) fn c.
+Proof.
+ assert (forall ofs fn c, code_tail ofs fn c ->
+ forall i c', c = i :: c' -> code_tail (ofs + 1) fn c').
+ induction 1; intros.
+ subst c. constructor. constructor.
+ constructor. eauto.
+ eauto.
+Qed.
+
+Lemma code_tail_next_int:
+ forall fn ofs i c,
+ code_size fn <= Int.max_unsigned ->
+ code_tail (Int.unsigned ofs) fn (i :: c) ->
+ code_tail (Int.unsigned (Int.add ofs Int.one)) fn c.
+Proof.
+ intros. rewrite Int.add_unsigned.
+ change (Int.unsigned Int.one) with 1.
+ rewrite Int.unsigned_repr. apply code_tail_next with i; auto.
+ generalize (code_tail_bounds _ _ _ _ H0). omega.
+Qed.
+
+(** [transl_code_at_pc pc fn c] holds if the code pointer [pc] points
+ within the ARM code generated by translating Mach function [fn],
+ and [c] is the tail of the generated code at the position corresponding
+ to the code pointer [pc]. *)
+
+Inductive transl_code_at_pc: val -> block -> Mach.function -> Mach.code -> Prop :=
+ transl_code_at_pc_intro:
+ forall b ofs f c,
+ Genv.find_funct_ptr ge b = Some (Internal f) ->
+ code_tail (Int.unsigned ofs) (transl_function f) (transl_code f c) ->
+ transl_code_at_pc (Vptr b ofs) b f c.
+
+(** The following lemmas show that straight-line executions
+ (predicate [exec_straight]) correspond to correct ARM executions
+ (predicate [exec_steps]) under adequate [transl_code_at_pc] hypotheses. *)
+
+Lemma exec_straight_steps_1:
+ forall fn c rs m c' rs' m',
+ exec_straight tge fn c rs m c' rs' m' ->
+ code_size fn <= Int.max_unsigned ->
+ forall b ofs,
+ rs#PC = Vptr b ofs ->
+ Genv.find_funct_ptr tge b = Some (Internal fn) ->
+ code_tail (Int.unsigned ofs) fn c ->
+ plus step tge (State rs m) E0 (State rs' m').
+Proof.
+ induction 1; intros.
+ apply plus_one.
+ econstructor; eauto.
+ eapply find_instr_tail. eauto.
+ eapply plus_left'.
+ econstructor; eauto.
+ eapply find_instr_tail. eauto.
+ apply IHexec_straight with b (Int.add ofs Int.one).
+ auto. rewrite H0. rewrite H3. reflexivity.
+ auto.
+ apply code_tail_next_int with i; auto.
+ traceEq.
+Qed.
+
+Lemma exec_straight_steps_2:
+ forall fn c rs m c' rs' m',
+ exec_straight tge fn c rs m c' rs' m' ->
+ code_size fn <= Int.max_unsigned ->
+ forall b ofs,
+ rs#PC = Vptr b ofs ->
+ Genv.find_funct_ptr tge b = Some (Internal fn) ->
+ code_tail (Int.unsigned ofs) fn c ->
+ exists ofs',
+ rs'#PC = Vptr b ofs'
+ /\ code_tail (Int.unsigned ofs') fn c'.
+Proof.
+ induction 1; intros.
+ exists (Int.add ofs Int.one). split.
+ rewrite H0. rewrite H2. auto.
+ apply code_tail_next_int with i1; auto.
+ apply IHexec_straight with (Int.add ofs Int.one).
+ auto. rewrite H0. rewrite H3. reflexivity. auto.
+ apply code_tail_next_int with i; auto.
+Qed.
+
+Lemma exec_straight_exec:
+ forall fb f c c' rs m rs' m',
+ transl_code_at_pc (rs PC) fb f c ->
+ exec_straight tge (transl_function f)
+ (transl_code f c) rs m c' rs' m' ->
+ plus step tge (State rs m) E0 (State rs' m').
+Proof.
+ intros. inversion H. subst.
+ eapply exec_straight_steps_1; eauto.
+ eapply functions_transl_no_overflow; eauto.
+ eapply functions_transl; eauto.
+Qed.
+
+Lemma exec_straight_at:
+ forall fb f c c' rs m rs' m',
+ transl_code_at_pc (rs PC) fb f c ->
+ exec_straight tge (transl_function f)
+ (transl_code f c) rs m (transl_code f c') rs' m' ->
+ transl_code_at_pc (rs' PC) fb f c'.
+Proof.
+ intros. inversion H. subst.
+ generalize (functions_transl_no_overflow _ _ H2). intro.
+ generalize (functions_transl _ _ H2). intro.
+ generalize (exec_straight_steps_2 _ _ _ _ _ _ _
+ H0 H4 _ _ (sym_equal H1) H5 H3).
+ intros [ofs' [PC' CT']].
+ rewrite PC'. constructor; auto.
+Qed.
+
+(** Correctness of the return addresses predicted by
+ [ARMgen.return_address_offset]. *)
+
+Remark code_tail_no_bigger:
+ forall pos c1 c2, code_tail pos c1 c2 -> (length c2 <= length c1)%nat.
+Proof.
+ induction 1; simpl; omega.
+Qed.
+
+Remark code_tail_unique:
+ forall fn c pos pos',
+ code_tail pos fn c -> code_tail pos' fn c -> pos = pos'.
+Proof.
+ induction fn; intros until pos'; intros ITA CT; inv ITA; inv CT; auto.
+ generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; omega.
+ generalize (code_tail_no_bigger _ _ _ H3); simpl; intro; omega.
+ f_equal. eauto.
+Qed.
+
+Lemma return_address_offset_correct:
+ forall b ofs fb f c ofs',
+ transl_code_at_pc (Vptr b ofs) fb f c ->
+ return_address_offset f c ofs' ->
+ ofs' = ofs.
+Proof.
+ intros. inv H0. inv H.
+ generalize (code_tail_unique _ _ _ _ H1 H7). intro. rewrite H.
+ apply Int.repr_unsigned.
+Qed.
+
+(** The [find_label] function returns the code tail starting at the
+ given label. A connection with [code_tail] is then established. *)
+
+Fixpoint find_label (lbl: label) (c: code) {struct c} : option code :=
+ match c with
+ | nil => None
+ | instr :: c' =>
+ if is_label lbl instr then Some c' else find_label lbl c'
+ end.
+
+Lemma label_pos_code_tail:
+ forall lbl c pos c',
+ find_label lbl c = Some c' ->
+ exists pos',
+ label_pos lbl pos c = Some pos'
+ /\ code_tail (pos' - pos) c c'
+ /\ pos < pos' <= pos + code_size c.
+Proof.
+ induction c.
+ simpl; intros. discriminate.
+ simpl; intros until c'.
+ case (is_label lbl a).
+ intro EQ; injection EQ; intro; subst c'.
+ exists (pos + 1). split. auto. split.
+ replace (pos + 1 - pos) with (0 + 1) by omega. constructor. constructor.
+ generalize (code_size_pos c). omega.
+ intros. generalize (IHc (pos + 1) c' H). intros [pos' [A [B C]]].
+ exists pos'. split. auto. split.
+ replace (pos' - pos) with ((pos' - (pos + 1)) + 1) by omega.
+ constructor. auto.
+ omega.
+Qed.
+
+(** The following lemmas show that the translation from Mach to ARM
+ preserves labels, in the sense that the following diagram commutes:
+<<
+ translation
+ Mach code ------------------------ ARM instr sequence
+ | |
+ | Mach.find_label lbl find_label lbl |
+ | |
+ v v
+ Mach code tail ------------------- ARM instr seq tail
+ translation
+>>
+ The proof demands many boring lemmas showing that ARM constructor
+ functions do not introduce new labels.
+*)
+
+Section TRANSL_LABEL.
+
+Variable lbl: label.
+
+Remark loadimm_label:
+ forall r n k, find_label lbl (loadimm r n k) = find_label lbl k.
+Proof.
+ intros. unfold loadimm.
+ destruct (is_immed_arith n). reflexivity.
+ destruct (is_immed_arith (Int.not n)); reflexivity.
+Qed.
+Hint Rewrite loadimm_label: labels.
+
+Remark addimm_label:
+ forall r1 r2 n k, find_label lbl (addimm r1 r2 n k) = find_label lbl k.
+Proof.
+ intros; unfold addimm.
+ destruct (is_immed_arith n). reflexivity.
+ destruct (is_immed_arith (Int.neg n)). reflexivity.
+ autorewrite with labels. reflexivity.
+Qed.
+Hint Rewrite addimm_label: labels.
+
+Remark andimm_label:
+ forall r1 r2 n k, find_label lbl (andimm r1 r2 n k) = find_label lbl k.
+Proof.
+ intros; unfold andimm.
+ destruct (is_immed_arith n). reflexivity.
+ destruct (is_immed_arith (Int.not n)). reflexivity.
+ autorewrite with labels. reflexivity.
+Qed.
+Hint Rewrite andimm_label: labels.
+
+Remark makeimm_Prsb_label:
+ forall r1 r2 n k, find_label lbl (makeimm Prsb r1 r2 n k) = find_label lbl k.
+Proof.
+ intros; unfold makeimm.
+ destruct (is_immed_arith n). reflexivity. autorewrite with labels; auto.
+Qed.
+Remark makeimm_Porr_label:
+ forall r1 r2 n k, find_label lbl (makeimm Porr r1 r2 n k) = find_label lbl k.
+Proof.
+ intros; unfold makeimm.
+ destruct (is_immed_arith n). reflexivity. autorewrite with labels; auto.
+Qed.
+Remark makeimm_Peor_label:
+ forall r1 r2 n k, find_label lbl (makeimm Peor r1 r2 n k) = find_label lbl k.
+Proof.
+ intros; unfold makeimm.
+ destruct (is_immed_arith n). reflexivity. autorewrite with labels; auto.
+Qed.
+Hint Rewrite makeimm_Prsb_label makeimm_Porr_label makeimm_Peor_label: labels.
+
+Remark loadind_int_label:
+ forall base ofs dst k, find_label lbl (loadind_int base ofs dst k) = find_label lbl k.
+Proof.
+ intros; unfold loadind_int.
+ destruct (is_immed_mem_word ofs); autorewrite with labels; auto.
+Qed.
+
+Remark loadind_label:
+ forall base ofs ty dst k, find_label lbl (loadind base ofs ty dst k) = find_label lbl k.
+Proof.
+ intros; unfold loadind. destruct ty.
+ apply loadind_int_label.
+ unfold loadind_float.
+ destruct (is_immed_mem_float ofs); autorewrite with labels; auto.
+Qed.
+
+Remark storeind_int_label:
+ forall base ofs src k, find_label lbl (storeind_int src base ofs k) = find_label lbl k.
+Proof.
+ intros; unfold storeind_int.
+ destruct (is_immed_mem_word ofs); autorewrite with labels; auto.
+Qed.
+
+Remark storeind_label:
+ forall base ofs ty src k, find_label lbl (storeind src base ofs ty k) = find_label lbl k.
+Proof.
+ intros; unfold storeind. destruct ty.
+ apply storeind_int_label.
+ unfold storeind_float.
+ destruct (is_immed_mem_float ofs); autorewrite with labels; auto.
+Qed.
+Hint Rewrite loadind_int_label loadind_label storeind_int_label storeind_label: labels.
+
+Remark transl_cond_label:
+ forall cond args k, find_label lbl (transl_cond cond args k) = find_label lbl k.
+Proof.
+ intros; unfold transl_cond.
+ destruct cond; (destruct args;
+ [try reflexivity | destruct args;
+ [try reflexivity | destruct args; try reflexivity]]).
+ destruct (is_immed_arith i); autorewrite with labels; auto.
+ destruct (is_immed_arith i); autorewrite with labels; auto.
+Qed.
+Hint Rewrite transl_cond_label: labels.
+
+Remark transl_op_label:
+ forall op args r k, find_label lbl (transl_op op args r k) = find_label lbl k.
+Proof.
+ intros; unfold transl_op;
+ destruct op; destruct args; try (destruct args); try (destruct args); try (destruct args);
+ try reflexivity; autorewrite with labels; try reflexivity.
+ case (mreg_type m); reflexivity.
+ case (ireg_eq (ireg_of r) (ireg_of m) || ireg_eq (ireg_of r) (ireg_of m0)); reflexivity.
+ transitivity (find_label lbl
+ (addimm IR14 (ireg_of m) (Int.sub (Int.shl Int.one i) Int.one)
+ (Pmovc CRge IR14 (SOreg (ireg_of m))
+ :: Pmov (ireg_of r) (SOasrimm IR14 i) :: k))).
+ unfold find_label; auto. autorewrite with labels. reflexivity.
+Qed.
+Hint Rewrite transl_op_label: labels.
+
+Remark transl_load_store_label:
+ forall (mk_instr_imm: ireg -> int -> instruction)
+ (mk_instr_gen: option (ireg -> shift_addr -> instruction))
+ (is_immed: int -> bool)
+ (addr: addressing) (args: list mreg) (k: code),
+ (forall r n, is_label lbl (mk_instr_imm r n) = false) ->
+ (match mk_instr_gen with
+ | None => True
+ | Some f => forall r sa, is_label lbl (f r sa) = false
+ end) ->
+ find_label lbl (transl_load_store mk_instr_imm mk_instr_gen is_immed addr args k) = find_label lbl k.
+Proof.
+ intros; unfold transl_load_store.
+ destruct addr; destruct args; try (destruct args); try (destruct args);
+ try reflexivity.
+ destruct (is_immed i); autorewrite with labels; simpl; rewrite H; auto.
+ destruct mk_instr_gen. simpl. rewrite H0. auto.
+ simpl. rewrite H. auto.
+ destruct mk_instr_gen. simpl. rewrite H0. auto.
+ simpl. rewrite H. auto.
+ destruct (is_immed i); autorewrite with labels; simpl; rewrite H; auto.
+Qed.
+Hint Rewrite transl_load_store_label: labels.
+
+Lemma transl_instr_label:
+ forall f i k,
+ find_label lbl (transl_instr f i k) =
+ if Mach.is_label lbl i then Some k else find_label lbl k.
+Proof.
+ intros. generalize (Mach.is_label_correct lbl i).
+ case (Mach.is_label lbl i); intro.
+ subst i. simpl. rewrite peq_true. auto.
+ destruct i; simpl; autorewrite with labels; try reflexivity.
+ unfold transl_load_store_int, transl_load_store_float.
+ destruct m; rewrite transl_load_store_label; intros; auto.
+ unfold transl_load_store_int, transl_load_store_float.
+ destruct m; rewrite transl_load_store_label; intros; auto.
+ destruct s0; reflexivity.
+ destruct s0; autorewrite with labels; reflexivity.
+ rewrite peq_false. auto. congruence.
+Qed.
+
+Lemma transl_code_label:
+ forall f c,
+ find_label lbl (transl_code f c) =
+ option_map (transl_code f) (Mach.find_label lbl c).
+Proof.
+ induction c; simpl; intros.
+ auto. rewrite transl_instr_label.
+ case (Mach.is_label lbl a). reflexivity.
+ auto.
+Qed.
+
+Lemma transl_find_label:
+ forall f,
+ find_label lbl (transl_function f) =
+ option_map (transl_code f) (Mach.find_label lbl f.(fn_code)).
+Proof.
+ intros. unfold transl_function. simpl. autorewrite with labels. apply transl_code_label.
+Qed.
+
+End TRANSL_LABEL.
+
+(** A valid branch in a piece of Mach code translates to a valid ``go to''
+ transition in the generated ARM code. *)
+
+Lemma find_label_goto_label:
+ forall f lbl rs m c' b ofs,
+ Genv.find_funct_ptr ge b = Some (Internal f) ->
+ rs PC = Vptr b ofs ->
+ Mach.find_label lbl f.(fn_code) = Some c' ->
+ exists rs',
+ goto_label (transl_function f) lbl rs m = OK rs' m
+ /\ transl_code_at_pc (rs' PC) b f c'
+ /\ forall r, r <> PC -> rs'#r = rs#r.
+Proof.
+ intros.
+ generalize (transl_find_label lbl f).
+ rewrite H1; simpl. intro.
+ generalize (label_pos_code_tail lbl (transl_function f) 0
+ (transl_code f c') H2).
+ intros [pos' [A [B C]]].
+ exists (rs#PC <- (Vptr b (Int.repr pos'))).
+ split. unfold goto_label. rewrite A. rewrite H0. auto.
+ split. rewrite Pregmap.gss. constructor; auto.
+ rewrite Int.unsigned_repr. replace (pos' - 0) with pos' in B.
+ auto. omega.
+ generalize (functions_transl_no_overflow _ _ H).
+ omega.
+ intros. apply Pregmap.gso; auto.
+Qed.
+
+(** * Memory properties *)
+
+(** We show that signed 8- and 16-bit stores can be performed
+ like unsigned stores. *)
+
+Remark valid_access_equiv:
+ forall chunk1 chunk2 m b ofs,
+ size_chunk chunk1 = size_chunk chunk2 ->
+ valid_access m chunk1 b ofs ->
+ valid_access m chunk2 b ofs.
+Proof.
+ intros. inv H0. rewrite H in H3. constructor; auto.
+Qed.
+
+Remark in_bounds_equiv:
+ forall chunk1 chunk2 m b ofs (A: Set) (a1 a2: A),
+ size_chunk chunk1 = size_chunk chunk2 ->
+ (if in_bounds m chunk1 b ofs then a1 else a2) =
+ (if in_bounds m chunk2 b ofs then a1 else a2).
+Proof.
+ intros. destruct (in_bounds m chunk1 b ofs).
+ rewrite in_bounds_true. auto. eapply valid_access_equiv; eauto.
+ destruct (in_bounds m chunk2 b ofs); auto.
+ elim n. eapply valid_access_equiv with (chunk1 := chunk2); eauto.
+Qed.
+
+Lemma storev_8_signed_unsigned:
+ forall m a v,
+ Mem.storev Mint8signed m a v = Mem.storev Mint8unsigned m a v.
+Proof.
+ intros. unfold storev. destruct a; auto.
+ unfold store. rewrite (in_bounds_equiv Mint8signed Mint8unsigned).
+ auto. auto.
+Qed.
+
+Lemma storev_16_signed_unsigned:
+ forall m a v,
+ Mem.storev Mint16signed m a v = Mem.storev Mint16unsigned m a v.
+Proof.
+ intros. unfold storev. destruct a; auto.
+ unfold store. rewrite (in_bounds_equiv Mint16signed Mint16unsigned).
+ auto. auto.
+Qed.
+
+(** * Proof of semantic preservation *)
+
+(** Semantic preservation is proved using simulation diagrams
+ of the following form.
+<<
+ st1 --------------- st2
+ | |
+ t| *|t
+ | |
+ v v
+ st1'--------------- st2'
+>>
+ The invariant is the [match_states] predicate below, which includes:
+- The ARM code pointed by the PC register is the translation of
+ the current Mach code sequence.
+- Mach register values and ARM register values agree.
+*)
+
+Inductive match_stack: list Machconcr.stackframe -> Prop :=
+ | match_stack_nil:
+ match_stack nil
+ | match_stack_cons: forall fb sp ra c s f,
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ wt_function f ->
+ incl c f.(fn_code) ->
+ transl_code_at_pc ra fb f c ->
+ match_stack s ->
+ match_stack (Stackframe fb sp ra c :: s).
+
+Inductive match_states: Machconcr.state -> Asm.state -> Prop :=
+ | match_states_intro:
+ forall s fb sp c ms m rs f
+ (STACKS: match_stack s)
+ (FIND: Genv.find_funct_ptr ge fb = Some (Internal f))
+ (WTF: wt_function f)
+ (INCL: incl c f.(fn_code))
+ (AT: transl_code_at_pc (rs PC) fb f c)
+ (AG: agree ms sp rs),
+ match_states (Machconcr.State s fb sp c ms m)
+ (Asm.State rs m)
+ | match_states_call:
+ forall s fb ms m rs
+ (STACKS: match_stack s)
+ (AG: agree ms (parent_sp s) rs)
+ (ATPC: rs PC = Vptr fb Int.zero)
+ (ATLR: rs IR14 = parent_ra s),
+ match_states (Machconcr.Callstate s fb ms m)
+ (Asm.State rs m)
+ | match_states_return:
+ forall s ms m rs
+ (STACKS: match_stack s)
+ (AG: agree ms (parent_sp s) rs)
+ (ATPC: rs PC = parent_ra s),
+ match_states (Machconcr.Returnstate s ms m)
+ (Asm.State rs m).
+
+Lemma exec_straight_steps:
+ forall s fb sp m1 f c1 rs1 c2 m2 ms2,
+ match_stack s ->
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ wt_function f ->
+ incl c2 f.(fn_code) ->
+ transl_code_at_pc (rs1 PC) fb f c1 ->
+ (exists rs2,
+ exec_straight tge (transl_function f) (transl_code f c1) rs1 m1 (transl_code f c2) rs2 m2
+ /\ agree ms2 sp rs2) ->
+ exists st',
+ plus step tge (State rs1 m1) E0 st' /\
+ match_states (Machconcr.State s fb sp c2 ms2 m2) st'.
+Proof.
+ intros. destruct H4 as [rs2 [A B]].
+ exists (State rs2 m2); split.
+ eapply exec_straight_exec; eauto.
+ econstructor; eauto. eapply exec_straight_at; eauto.
+Qed.
+
+(** We need to show that, in the simulation diagram, we cannot
+ take infinitely many Mach transitions that correspond to zero
+ transitions on the ARM side. Actually, all Mach transitions
+ correspond to at least one ARM transition, except the
+ transition from [Machconcr.Returnstate] to [Machconcr.State].
+ So, the following integer measure will suffice to rule out
+ the unwanted behaviour. *)
+
+Definition measure (s: Machconcr.state) : nat :=
+ match s with
+ | Machconcr.State _ _ _ _ _ _ => 0%nat
+ | Machconcr.Callstate _ _ _ _ => 0%nat
+ | Machconcr.Returnstate _ _ _ => 1%nat
+ end.
+
+(** We show the simulation diagram by case analysis on the Mach transition
+ on the left. Since the proof is large, we break it into one lemma
+ per transition. *)
+
+Definition exec_instr_prop (s1: Machconcr.state) (t: trace) (s2: Machconcr.state) : Prop :=
+ forall s1' (MS: match_states s1 s1'),
+ (exists s2', plus step tge s1' t s2' /\ match_states s2 s2')
+ \/ (measure s2 < measure s1 /\ t = E0 /\ match_states s2 s1')%nat.
+
+
+Lemma exec_Mlabel_prop:
+ forall (s : list stackframe) (fb : block) (sp : val)
+ (lbl : Mach.label) (c : list Mach.instruction) (ms : Mach.regset)
+ (m : mem),
+ exec_instr_prop (Machconcr.State s fb sp (Mlabel lbl :: c) ms m) E0
+ (Machconcr.State s fb sp c ms m).
+Proof.
+ intros; red; intros; inv MS.
+ left; eapply exec_straight_steps; eauto with coqlib.
+ exists (nextinstr rs); split.
+ simpl. apply exec_straight_one. reflexivity. reflexivity.
+ apply agree_nextinstr; auto.
+Qed.
+
+Lemma exec_Mgetstack_prop:
+ forall (s : list stackframe) (fb : block) (sp : val) (ofs : int)
+ (ty : typ) (dst : mreg) (c : list Mach.instruction)
+ (ms : Mach.regset) (m : mem) (v : val),
+ load_stack m sp ty ofs = Some v ->
+ exec_instr_prop (Machconcr.State s fb sp (Mgetstack ofs ty dst :: c) ms m) E0
+ (Machconcr.State s fb sp c (Regmap.set dst v ms) m).
+Proof.
+ intros; red; intros; inv MS.
+ unfold load_stack in H.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI. inversion WTI.
+ rewrite (sp_val _ _ _ AG) in H.
+ generalize (loadind_correct tge (transl_function f) IR13 ofs ty
+ dst (transl_code f c) rs m v H H1).
+ intros [rs2 [EX [RES OTH]]].
+ left; eapply exec_straight_steps; eauto with coqlib.
+ simpl. exists rs2; split. auto.
+ apply agree_exten_2 with (rs#(preg_of dst) <- v).
+ auto with ppcgen.
+ intros. case (preg_eq r0 (preg_of dst)); intro.
+ subst r0. rewrite Pregmap.gss. auto.
+ rewrite Pregmap.gso; auto.
+Qed.
+
+Lemma exec_Msetstack_prop:
+ forall (s : list stackframe) (fb : block) (sp : val) (src : mreg)
+ (ofs : int) (ty : typ) (c : list Mach.instruction)
+ (ms : mreg -> val) (m m' : mem),
+ store_stack m sp ty ofs (ms src) = Some m' ->
+ exec_instr_prop (Machconcr.State s fb sp (Msetstack src ofs ty :: c) ms m) E0
+ (Machconcr.State s fb sp c ms m').
+Proof.
+ intros; red; intros; inv MS.
+ unfold store_stack in H.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI. inversion WTI.
+ rewrite (sp_val _ _ _ AG) in H.
+ rewrite (preg_val ms sp rs) in H; auto.
+ assert (NOTE: IR13 <> IR14) by congruence.
+ generalize (storeind_correct tge (transl_function f) IR13 ofs ty
+ src (transl_code f c) rs m m' H H1 NOTE).
+ intros [rs2 [EX OTH]].
+ left; eapply exec_straight_steps; eauto with coqlib.
+ exists rs2; split; auto.
+ apply agree_exten_2 with rs; auto.
+Qed.
+
+Lemma exec_Mgetparam_prop:
+ forall (s : list stackframe) (fb : block) (f: Mach.function) (sp parent : val)
+ (ofs : int) (ty : typ) (dst : mreg) (c : list Mach.instruction)
+ (ms : Mach.regset) (m : mem) (v : val),
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ load_stack m sp Tint f.(fn_link_ofs) = Some parent ->
+ load_stack m parent ty ofs = Some v ->
+ exec_instr_prop (Machconcr.State s fb sp (Mgetparam ofs ty dst :: c) ms m) E0
+ (Machconcr.State s fb sp c (Regmap.set dst v ms) m).
+Proof.
+ intros; red; intros; inv MS.
+ assert (f0 = f) by congruence. subst f0.
+ exploit (loadind_int_correct tge (transl_function f) IR13 f.(fn_link_ofs) IR14
+ rs m parent (loadind IR14 ofs ty dst (transl_code f c))).
+ rewrite <- (sp_val ms sp rs); auto.
+ intros [rs1 [EX1 [RES1 OTH1]]].
+ exploit (loadind_correct tge (transl_function f) IR14 ofs ty dst
+ (transl_code f c) rs1 m v).
+ rewrite RES1. auto.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI. inversion WTI. auto.
+ intros [rs2 [EX2 [RES2 OTH2]]].
+ left. eapply exec_straight_steps; eauto with coqlib.
+ exists rs2; split; simpl.
+ eapply exec_straight_trans; eauto.
+ apply agree_exten_2 with (rs1#(preg_of dst) <- v).
+ apply agree_set_mreg.
+ apply agree_exten_2 with rs; auto.
+ intros. case (preg_eq r (preg_of dst)); intro.
+ subst r. rewrite Pregmap.gss. auto.
+ rewrite Pregmap.gso; auto.
+Qed.
+
+Lemma exec_Mop_prop:
+ forall (s : list stackframe) (fb : block) (sp : val) (op : operation)
+ (args : list mreg) (res : mreg) (c : list Mach.instruction)
+ (ms : mreg -> val) (m : mem) (v : val),
+ eval_operation ge sp op ms ## args m = Some v ->
+ exec_instr_prop (Machconcr.State s fb sp (Mop op args res :: c) ms m) E0
+ (Machconcr.State s fb sp c (Regmap.set res v ms) m).
+Proof.
+ intros; red; intros; inv MS.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI.
+ left; eapply exec_straight_steps; eauto with coqlib.
+ simpl. eapply transl_op_correct; auto.
+ rewrite <- H. apply eval_operation_preserved. exact symbols_preserved.
+Qed.
+
+Lemma exec_Mload_prop:
+ forall (s : list stackframe) (fb : block) (sp : val)
+ (chunk : memory_chunk) (addr : addressing) (args : list mreg)
+ (dst : mreg) (c : list Mach.instruction) (ms : mreg -> val)
+ (m : mem) (a v : val),
+ eval_addressing ge sp addr ms ## args = Some a ->
+ loadv chunk m a = Some v ->
+ exec_instr_prop (Machconcr.State s fb sp (Mload chunk addr args dst :: c) ms m)
+ E0 (Machconcr.State s fb sp c (Regmap.set dst v ms) m).
+Proof.
+ intros; red; intros; inv MS.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI; inv WTI.
+ assert (eval_addressing tge sp addr ms##args = Some a).
+ rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
+ left; eapply exec_straight_steps; eauto with coqlib.
+ destruct chunk; simpl; simpl in H6;
+ (eapply transl_load_int_correct || eapply transl_load_float_correct);
+ eauto; intros; reflexivity.
+Qed.
+
+Lemma exec_Mstore_prop:
+ forall (s : list stackframe) (fb : block) (sp : val)
+ (chunk : memory_chunk) (addr : addressing) (args : list mreg)
+ (src : mreg) (c : list Mach.instruction) (ms : mreg -> val)
+ (m m' : mem) (a : val),
+ eval_addressing ge sp addr ms ## args = Some a ->
+ storev chunk m a (ms src) = Some m' ->
+ exec_instr_prop (Machconcr.State s fb sp (Mstore chunk addr args src :: c) ms m) E0
+ (Machconcr.State s fb sp c ms m').
+Proof.
+ intros; red; intros; inv MS.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI; inv WTI.
+ assert (eval_addressing tge sp addr ms##args = Some a).
+ rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
+ left; eapply exec_straight_steps; eauto with coqlib.
+ destruct chunk; simpl; simpl in H6;
+ try (rewrite storev_8_signed_unsigned in H0);
+ try (rewrite storev_16_signed_unsigned in H0);
+ (eapply transl_store_int_correct || eapply transl_store_float_correct);
+ eauto; intros; reflexivity.
+Qed.
+
+Lemma exec_Mcall_prop:
+ forall (s : list stackframe) (fb : block) (sp : val)
+ (sig : signature) (ros : mreg + ident) (c : Mach.code)
+ (ms : Mach.regset) (m : mem) (f : function) (f' : block)
+ (ra : int),
+ find_function_ptr ge ros ms = Some f' ->
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ return_address_offset f c ra ->
+ exec_instr_prop (Machconcr.State s fb sp (Mcall sig ros :: c) ms m) E0
+ (Callstate (Stackframe fb sp (Vptr fb ra) c :: s) f' ms m).
+Proof.
+ intros; red; intros; inv MS.
+ assert (f0 = f) by congruence. subst f0.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI. inv WTI.
+ inv AT.
+ assert (NOOV: code_size (transl_function f) <= Int.max_unsigned).
+ eapply functions_transl_no_overflow; eauto.
+ assert (CT: code_tail (Int.unsigned (Int.add ofs Int.one)) (transl_function f) (transl_code f c)).
+ destruct ros; simpl in H5; eapply code_tail_next_int; eauto.
+ set (rs2 := rs #IR14 <- (Val.add rs#PC Vone) #PC <- (Vptr f' Int.zero)).
+ exploit return_address_offset_correct; eauto. constructor; eauto.
+ intro RA_EQ.
+ assert (ATLR: rs2 IR14 = Vptr fb ra).
+ rewrite RA_EQ.
+ change (rs2 IR14) with (Val.add (rs PC) Vone).
+ rewrite <- H2. reflexivity.
+ assert (AG3: agree ms sp rs2).
+ unfold rs2; auto 8 with ppcgen.
+ left; exists (State rs2 m); split.
+ apply plus_one.
+ destruct ros; simpl in H5.
+ econstructor. eauto. apply functions_transl. eexact H0.
+ eapply find_instr_tail. eauto.
+ simpl. rewrite <- (ireg_val ms sp rs); auto.
+ simpl in H. destruct (ms m0); try congruence.
+ generalize H; predSpec Int.eq Int.eq_spec i Int.zero; intros; inv H7.
+ auto.
+ econstructor. eauto. apply functions_transl. eexact H0.
+ eapply find_instr_tail. eauto.
+ simpl. unfold symbol_offset. rewrite symbols_preserved.
+ simpl in H. rewrite H. auto.
+ econstructor; eauto.
+ econstructor; eauto with coqlib.
+ rewrite RA_EQ. econstructor; eauto.
+Qed.
+
+Lemma exec_Mtailcall_prop:
+ forall (s : list stackframe) (fb stk : block) (soff : int)
+ (sig : signature) (ros : mreg + ident) (c : list Mach.instruction)
+ (ms : Mach.regset) (m : mem) (f: function) (f' : block),
+ find_function_ptr ge ros ms = Some f' ->
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ load_stack m (Vptr stk soff) Tint f.(fn_link_ofs) = Some (parent_sp s) ->
+ load_stack m (Vptr stk soff) Tint f.(fn_retaddr_ofs) = Some (parent_ra s) ->
+ exec_instr_prop
+ (Machconcr.State s fb (Vptr stk soff) (Mtailcall sig ros :: c) ms m) E0
+ (Callstate s f' ms (free m stk)).
+Proof.
+ intros; red; intros; inv MS.
+ assert (f0 = f) by congruence. subst f0.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI. inv WTI.
+ set (call_instr :=
+ match ros with inl r => Pbreg (ireg_of r) | inr symb => Pbsymb symb end).
+ assert (TR: transl_code f (Mtailcall sig ros :: c) =
+ loadind_int IR13 (fn_retaddr_ofs f) IR14
+ (Pfreeframe (fn_link_ofs f) :: call_instr :: transl_code f c)).
+ unfold call_instr; destruct ros; auto.
+ destruct (loadind_int_correct tge (transl_function f) IR13 f.(fn_retaddr_ofs) IR14
+ rs m (parent_ra s)
+ (Pfreeframe f.(fn_link_ofs) :: call_instr :: transl_code f c))
+ as [rs1 [EXEC1 [RES1 OTH1]]].
+ rewrite <- (sp_val ms (Vptr stk soff) rs); auto.
+ set (rs2 := nextinstr (rs1#IR13 <- (parent_sp s))).
+ assert (EXEC2: exec_straight tge (transl_function f)
+ (transl_code f (Mtailcall sig ros :: c)) rs m
+ (call_instr :: transl_code f c) rs2 (free m stk)).
+ rewrite TR. eapply exec_straight_trans. eexact EXEC1.
+ apply exec_straight_one. simpl.
+ rewrite OTH1; auto with ppcgen.
+ rewrite <- (sp_val ms (Vptr stk soff) rs); auto.
+ unfold load_stack in H1. simpl in H1. simpl. rewrite H1. auto. auto.
+ set (rs3 := rs2#PC <- (Vptr f' Int.zero)).
+ left. exists (State rs3 (free m stk)); split.
+ (* Execution *)
+ eapply plus_right'. eapply exec_straight_exec; eauto.
+ inv AT. exploit exec_straight_steps_2; eauto.
+ eapply functions_transl_no_overflow; eauto.
+ eapply functions_transl; eauto.
+ intros [ofs2 [RS2PC CT]].
+ econstructor. eauto. eapply functions_transl; eauto.
+ eapply find_instr_tail; eauto.
+ unfold call_instr; destruct ros; simpl in H; simpl.
+ replace (rs2 (ireg_of m0)) with (Vptr f' Int.zero). auto.
+ unfold rs2. rewrite nextinstr_inv; auto with ppcgen.
+ rewrite Pregmap.gso. rewrite OTH1; auto with ppcgen.
+ rewrite <- (ireg_val ms (Vptr stk soff) rs); auto.
+ destruct (ms m0); try discriminate.
+ generalize H. predSpec Int.eq Int.eq_spec i Int.zero; intros; inv H9.
+ auto.
+ decEq. auto with ppcgen. decEq. auto with ppcgen. decEq. auto with ppcgen.
+ replace (symbol_offset tge i Int.zero) with (Vptr f' Int.zero). auto.
+ unfold symbol_offset. rewrite symbols_preserved. rewrite H. auto.
+ traceEq.
+ (* Match states *)
+ constructor; auto.
+ assert (AG1: agree ms (Vptr stk soff) rs1).
+ eapply agree_exten_2; eauto.
+ assert (AG2: agree ms (parent_sp s) rs2).
+ inv AG1. constructor. auto. intros. unfold rs2.
+ rewrite nextinstr_inv; auto with ppcgen.
+ rewrite Pregmap.gso. auto. auto with ppcgen.
+ unfold rs3. apply agree_exten_2 with rs2; auto.
+ intros. rewrite Pregmap.gso; auto.
+Qed.
+
+Lemma exec_Malloc_prop:
+ forall (s : list stackframe) (fb : block) (sp : val)
+ (c : list Mach.instruction) (ms : mreg -> val) (m : mem) (sz : int)
+ (m' : mem) (blk : block),
+ ms Conventions.loc_alloc_argument = Vint sz ->
+ alloc m 0 (Int.signed sz) = (m', blk) ->
+ exec_instr_prop (Machconcr.State s fb sp (Malloc :: c) ms m) E0
+ (Machconcr.State s fb sp c
+ (Regmap.set (Conventions.loc_alloc_result) (Vptr blk Int.zero) ms) m').
+Proof.
+ intros; red; intros; inv MS.
+ left; eapply exec_straight_steps; eauto with coqlib.
+ simpl. eapply transl_alloc_correct; eauto.
+Qed.
+
+Lemma exec_Mgoto_prop:
+ forall (s : list stackframe) (fb : block) (f : function) (sp : val)
+ (lbl : Mach.label) (c : list Mach.instruction) (ms : Mach.regset)
+ (m : mem) (c' : Mach.code),
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ Mach.find_label lbl (fn_code f) = Some c' ->
+ exec_instr_prop (Machconcr.State s fb sp (Mgoto lbl :: c) ms m) E0
+ (Machconcr.State s fb sp c' ms m).
+Proof.
+ intros; red; intros; inv MS.
+ assert (f0 = f) by congruence. subst f0.
+ inv AT. simpl in H3.
+ generalize (find_label_goto_label f lbl rs m _ _ _ FIND (sym_equal H1) H0).
+ intros [rs2 [GOTO [AT2 INV]]].
+ left; exists (State rs2 m); split.
+ apply plus_one. econstructor; eauto.
+ apply functions_transl; eauto.
+ eapply find_instr_tail; eauto.
+ simpl; auto.
+ econstructor; eauto.
+ eapply Mach.find_label_incl; eauto.
+ apply agree_exten_2 with rs; auto.
+Qed.
+
+Lemma exec_Mcond_true_prop:
+ forall (s : list stackframe) (fb : block) (f : function) (sp : val)
+ (cond : condition) (args : list mreg) (lbl : Mach.label)
+ (c : list Mach.instruction) (ms : mreg -> val) (m : mem)
+ (c' : Mach.code),
+ eval_condition cond ms ## args m = Some true ->
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ Mach.find_label lbl (fn_code f) = Some c' ->
+ exec_instr_prop (Machconcr.State s fb sp (Mcond cond args lbl :: c) ms m) E0
+ (Machconcr.State s fb sp c' ms m).
+Proof.
+ intros; red; intros; inv MS. assert (f0 = f) by congruence. subst f0.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI. inv WTI.
+ pose (k1 := Pbc (crbit_for_cond cond) lbl :: transl_code f c).
+ generalize (transl_cond_correct tge (transl_function f)
+ cond args k1 ms sp rs m true H3 AG H).
+ simpl. intros [rs2 [EX [RES AG2]]].
+ inv AT. simpl in H5.
+ generalize (functions_transl _ _ H4); intro FN.
+ generalize (functions_transl_no_overflow _ _ H4); intro NOOV.
+ exploit exec_straight_steps_2; eauto.
+ intros [ofs' [PC2 CT2]].
+ generalize (find_label_goto_label f lbl rs2 m _ _ _ FIND PC2 H1).
+ intros [rs3 [GOTO [AT3 INV3]]].
+ left; exists (State rs3 m); split.
+ eapply plus_right'.
+ eapply exec_straight_steps_1; eauto.
+ econstructor; eauto.
+ eapply find_instr_tail. unfold k1 in CT2. eauto.
+ simpl. rewrite RES. simpl. auto.
+ traceEq.
+ econstructor; eauto.
+ eapply Mach.find_label_incl; eauto.
+ apply agree_exten_2 with rs2; auto.
+Qed.
+
+Lemma exec_Mcond_false_prop:
+ forall (s : list stackframe) (fb : block) (sp : val)
+ (cond : condition) (args : list mreg) (lbl : Mach.label)
+ (c : list Mach.instruction) (ms : mreg -> val) (m : mem),
+ eval_condition cond ms ## args m = Some false ->
+ exec_instr_prop (Machconcr.State s fb sp (Mcond cond args lbl :: c) ms m) E0
+ (Machconcr.State s fb sp c ms m).
+Proof.
+ intros; red; intros; inv MS.
+ generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
+ intro WTI. inversion WTI.
+ pose (k1 := Pbc (crbit_for_cond cond) lbl :: transl_code f c).
+ generalize (transl_cond_correct tge (transl_function f)
+ cond args k1 ms sp rs m false H1 AG H).
+ simpl. intros [rs2 [EX [RES AG2]]].
+ left; eapply exec_straight_steps; eauto with coqlib.
+ exists (nextinstr rs2); split.
+ simpl. eapply exec_straight_trans. eexact EX.
+ unfold k1; apply exec_straight_one.
+ simpl. rewrite RES. reflexivity.
+ reflexivity.
+ auto with ppcgen.
+Qed.
+
+Lemma exec_Mreturn_prop:
+ forall (s : list stackframe) (fb stk : block) (soff : int)
+ (c : list Mach.instruction) (ms : Mach.regset) (m : mem) (f: function),
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ load_stack m (Vptr stk soff) Tint f.(fn_link_ofs) = Some (parent_sp s) ->
+ load_stack m (Vptr stk soff) Tint f.(fn_retaddr_ofs) = Some (parent_ra s) ->
+ exec_instr_prop (Machconcr.State s fb (Vptr stk soff) (Mreturn :: c) ms m) E0
+ (Returnstate s ms (free m stk)).
+Proof.
+ intros; red; intros; inv MS.
+ assert (f0 = f) by congruence. subst f0.
+ exploit (loadind_int_correct tge (transl_function f) IR13 f.(fn_retaddr_ofs) IR14
+ rs m (parent_ra s)
+ (Pfreeframe f.(fn_link_ofs) :: Pbreg IR14 :: transl_code f c)).
+ rewrite <- (sp_val ms (Vptr stk soff) rs); auto.
+ intros [rs1 [EXEC1 [RES1 OTH1]]].
+ set (rs2 := nextinstr (rs1#IR13 <- (parent_sp s))).
+ assert (EXEC2: exec_straight tge (transl_function f)
+ (loadind_int IR13 (fn_retaddr_ofs f) IR14
+ (Pfreeframe (fn_link_ofs f) :: Pbreg IR14 :: transl_code f c))
+ rs m (Pbreg IR14 :: transl_code f c) rs2 (free m stk)).
+ eapply exec_straight_trans. eexact EXEC1.
+ apply exec_straight_one. simpl. rewrite OTH1; try congruence.
+ rewrite <- (sp_val ms (Vptr stk soff) rs); auto.
+ unfold load_stack in H0. simpl in H0; simpl; rewrite H0. reflexivity.
+ reflexivity.
+ set (rs3 := rs2#PC <- (parent_ra s)).
+ left; exists (State rs3 (free m stk)); split.
+ (* execution *)
+ eapply plus_right'. eapply exec_straight_exec; eauto.
+ inv AT. exploit exec_straight_steps_2; eauto.
+ eapply functions_transl_no_overflow; eauto.
+ eapply functions_transl; eauto.
+ intros [ofs2 [RS2PC CT]].
+ econstructor. eauto. eapply functions_transl; eauto.
+ eapply find_instr_tail; eauto.
+ simpl. unfold rs3. decEq. decEq. unfold rs2. rewrite nextinstr_inv; auto with ppcgen.
+ traceEq.
+ (* match states *)
+ constructor. auto.
+ assert (AG1: agree ms (Vptr stk soff) rs1).
+ apply agree_exten_2 with rs; auto.
+ assert (AG2: agree ms (parent_sp s) rs2).
+ constructor. reflexivity. intros; unfold rs2.
+ rewrite nextinstr_inv; auto with ppcgen.
+ rewrite Pregmap.gso; auto with ppcgen.
+ inv AG1; auto.
+ unfold rs3. auto with ppcgen.
+ reflexivity.
+Qed.
+
+Hypothesis wt_prog: wt_program prog.
+
+Lemma exec_function_internal_prop:
+ forall (s : list stackframe) (fb : block) (ms : Mach.regset)
+ (m : mem) (f : function) (m1 m2 m3 : mem) (stk : block),
+ Genv.find_funct_ptr ge fb = Some (Internal f) ->
+ alloc m (- fn_framesize f) (fn_stacksize f) = (m1, stk) ->
+ let sp := Vptr stk (Int.repr (- fn_framesize f)) in
+ store_stack m1 sp Tint f.(fn_link_ofs) (parent_sp s) = Some m2 ->
+ store_stack m2 sp Tint f.(fn_retaddr_ofs) (parent_ra s) = Some m3 ->
+ exec_instr_prop (Machconcr.Callstate s fb ms m) E0
+ (Machconcr.State s fb sp (fn_code f) ms m3).
+Proof.
+ intros; red; intros; inv MS.
+ assert (WTF: wt_function f).
+ generalize (Genv.find_funct_ptr_prop wt_fundef wt_prog H); intro TY.
+ inversion TY; auto.
+ exploit functions_transl; eauto. intro TFIND.
+ generalize (functions_transl_no_overflow _ _ H); intro NOOV.
+ set (rs2 := nextinstr (rs#IR13 <- sp)).
+ set (rs3 := nextinstr rs2).
+ (* Execution of function prologue *)
+ assert (EXEC_PROLOGUE:
+ exec_straight tge (transl_function f)
+ (transl_function f) rs m
+ (transl_code f f.(fn_code)) rs3 m3).
+ unfold transl_function at 2.
+ apply exec_straight_two with rs2 m2.
+ unfold exec_instr. rewrite H0. fold sp.
+ rewrite <- (sp_val ms (parent_sp s) rs); auto.
+ unfold store_stack in H1. change Mint32 with (chunk_of_type Tint). rewrite H1.
+ auto.
+ unfold exec_instr. unfold eval_shift_addr. unfold exec_store.
+ change (rs2 IR13) with sp. change (rs2 IR14) with (rs IR14). rewrite ATLR.
+ unfold store_stack in H2. change Mint32 with (chunk_of_type Tint). rewrite H2.
+ auto. auto. auto.
+ (* Agreement at end of prologue *)
+ assert (AT3: transl_code_at_pc rs3#PC fb f f.(fn_code)).
+ change (rs3 PC) with (Val.add (Val.add (rs PC) Vone) Vone).
+ rewrite ATPC. simpl. constructor. auto.
+ eapply code_tail_next_int; auto.
+ eapply code_tail_next_int; auto.
+ change (Int.unsigned Int.zero) with 0.
+ unfold transl_function. constructor.
+ assert (AG2: agree ms sp rs2).
+ split. reflexivity.
+ intros. unfold rs2. rewrite nextinstr_inv.
+ repeat (rewrite Pregmap.gso). elim AG; auto.
+ auto with ppcgen. auto with ppcgen.
+ assert (AG3: agree ms sp rs3).
+ unfold rs3; auto with ppcgen.
+ left; exists (State rs3 m3); split.
+ (* execution *)
+ eapply exec_straight_steps_1; eauto.
+ change (Int.unsigned Int.zero) with 0. constructor.
+ (* match states *)
+ econstructor; eauto with coqlib.
+Qed.
+
+Lemma exec_function_external_prop:
+ forall (s : list stackframe) (fb : block) (ms : Mach.regset)
+ (m : mem) (t0 : trace) (ms' : RegEq.t -> val)
+ (ef : external_function) (args : list val) (res : val),
+ Genv.find_funct_ptr ge fb = Some (External ef) ->
+ event_match ef args t0 res ->
+ Machconcr.extcall_arguments ms m (parent_sp s) (ef_sig ef) args ->
+ ms' = Regmap.set (Conventions.loc_result (ef_sig ef)) res ms ->
+ exec_instr_prop (Machconcr.Callstate s fb ms m)
+ t0 (Machconcr.Returnstate s ms' m).
+Proof.
+ intros; red; intros; inv MS.
+ exploit functions_translated; eauto.
+ intros [tf [A B]]. simpl in B. inv B.
+ left; exists (State (rs#(loc_external_result (ef_sig ef)) <- res #PC <- (rs IR14))
+ m); split.
+ apply plus_one. eapply exec_step_external; eauto.
+ eapply extcall_arguments_match; eauto.
+ econstructor; eauto.
+ unfold loc_external_result. auto with ppcgen.
+Qed.
+
+Lemma exec_return_prop:
+ forall (s : list stackframe) (fb : block) (sp ra : val)
+ (c : Mach.code) (ms : Mach.regset) (m : mem),
+ exec_instr_prop (Machconcr.Returnstate (Stackframe fb sp ra c :: s) ms m) E0
+ (Machconcr.State s fb sp c ms m).
+Proof.
+ intros; red; intros; inv MS. inv STACKS. simpl in *.
+ right. split. omega. split. auto.
+ econstructor; eauto. rewrite ATPC; auto.
+Qed.
+
+Theorem transf_instr_correct:
+ forall s1 t s2, Machconcr.step ge s1 t s2 ->
+ exec_instr_prop s1 t s2.
+Proof
+ (Machconcr.step_ind ge exec_instr_prop
+ exec_Mlabel_prop
+ exec_Mgetstack_prop
+ exec_Msetstack_prop
+ exec_Mgetparam_prop
+ exec_Mop_prop
+ exec_Mload_prop
+ exec_Mstore_prop
+ exec_Mcall_prop
+ exec_Mtailcall_prop
+ exec_Malloc_prop
+ exec_Mgoto_prop
+ exec_Mcond_true_prop
+ exec_Mcond_false_prop
+ exec_Mreturn_prop
+ exec_function_internal_prop
+ exec_function_external_prop
+ exec_return_prop).
+
+Lemma transf_initial_states:
+ forall st1, Machconcr.initial_state prog st1 ->
+ exists st2, Asm.initial_state tprog st2 /\ match_states st1 st2.
+Proof.
+ intros. inversion H. unfold ge0 in *.
+ econstructor; split.
+ econstructor.
+ replace (symbol_offset (Genv.globalenv tprog) (prog_main tprog) Int.zero)
+ with (Vptr fb Int.zero).
+ rewrite (Genv.init_mem_transf_partial _ _ TRANSF).
+ econstructor; eauto. constructor.
+ split. auto. intros. repeat rewrite Pregmap.gso; auto with ppcgen.
+ unfold symbol_offset.
+ rewrite (transform_partial_program_main _ _ TRANSF).
+ rewrite symbols_preserved. unfold ge; rewrite H0. auto.
+Qed.
+
+Lemma transf_final_states:
+ forall st1 st2 r,
+ match_states st1 st2 -> Machconcr.final_state st1 r -> Asm.final_state st2 r.
+Proof.
+ intros. inv H0. inv H. constructor. auto.
+ compute in H1.
+ rewrite (ireg_val _ _ _ R0 AG) in H1. auto. auto.
+Qed.
+
+Theorem transf_program_correct:
+ forall (beh: program_behavior),
+ Machconcr.exec_program prog beh -> Asm.exec_program tprog beh.
+Proof.
+ unfold Machconcr.exec_program, Asm.exec_program; intros.
+ eapply simulation_star_preservation with (measure := measure); eauto.
+ eexact transf_initial_states.
+ eexact transf_final_states.
+ exact transf_instr_correct.
+Qed.
+
+End PRESERVATION.
diff --git a/arm/Asmgenproof1.v b/arm/Asmgenproof1.v
new file mode 100644
index 0000000000000000000000000000000000000000..32fedf315b478af765b70d5c9ef9736311d14e61
--- /dev/null
+++ b/arm/Asmgenproof1.v
@@ -0,0 +1,1507 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Correctness proof for ARM code generation: auxiliary results. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Mem.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Machconcr.
+Require Import Machtyping.
+Require Import Asm.
+Require Import Asmgen.
+Require Conventions.
+
+(** * Correspondence between Mach registers and PPC registers *)
+
+Hint Extern 2 (_ <> _) => discriminate: ppcgen.
+
+(** Mapping from Mach registers to PPC registers. *)
+
+Lemma preg_of_injective:
+ forall r1 r2, preg_of r1 = preg_of r2 -> r1 = r2.
+Proof.
+ destruct r1; destruct r2; simpl; intros; reflexivity || discriminate.
+Qed.
+
+(** Characterization of PPC registers that correspond to Mach registers. *)
+
+Definition is_data_reg (r: preg) : Prop :=
+ match r with
+ | IR IR14 => False
+ | CR _ => False
+ | PC => False
+ | _ => True
+ end.
+
+Lemma ireg_of_is_data_reg:
+ forall (r: mreg), is_data_reg (ireg_of r).
+Proof.
+ destruct r; exact I.
+Qed.
+
+Lemma freg_of_is_data_reg:
+ forall (r: mreg), is_data_reg (ireg_of r).
+Proof.
+ destruct r; exact I.
+Qed.
+
+Lemma preg_of_is_data_reg:
+ forall (r: mreg), is_data_reg (preg_of r).
+Proof.
+ destruct r; exact I.
+Qed.
+
+Lemma ireg_of_not_IR13:
+ forall r, ireg_of r <> IR13.
+Proof.
+ intro. case r; discriminate.
+Qed.
+Lemma ireg_of_not_IR14:
+ forall r, ireg_of r <> IR14.
+Proof.
+ intro. case r; discriminate.
+Qed.
+
+Hint Resolve ireg_of_not_IR13 ireg_of_not_IR14: ppcgen.
+
+Lemma preg_of_not:
+ forall r1 r2, ~(is_data_reg r2) -> preg_of r1 <> r2.
+Proof.
+ intros; red; intro. subst r2. elim H. apply preg_of_is_data_reg.
+Qed.
+Hint Resolve preg_of_not: ppcgen.
+
+Lemma preg_of_not_IR13:
+ forall r, preg_of r <> IR13.
+Proof.
+ intro. case r; discriminate.
+Qed.
+Hint Resolve preg_of_not_IR13: ppcgen.
+
+(** Agreement between Mach register sets and PPC register sets. *)
+
+Definition agree (ms: Mach.regset) (sp: val) (rs: Asm.regset) :=
+ rs#IR13 = sp /\ forall r: mreg, ms r = rs#(preg_of r).
+
+Lemma preg_val:
+ forall ms sp rs r,
+ agree ms sp rs -> ms r = rs#(preg_of r).
+Proof.
+ intros. elim H. auto.
+Qed.
+
+Lemma ireg_val:
+ forall ms sp rs r,
+ agree ms sp rs ->
+ mreg_type r = Tint ->
+ ms r = rs#(ireg_of r).
+Proof.
+ intros. elim H; intros.
+ generalize (H2 r). unfold preg_of. rewrite H0. auto.
+Qed.
+
+Lemma freg_val:
+ forall ms sp rs r,
+ agree ms sp rs ->
+ mreg_type r = Tfloat ->
+ ms r = rs#(freg_of r).
+Proof.
+ intros. elim H; intros.
+ generalize (H2 r). unfold preg_of. rewrite H0. auto.
+Qed.
+
+Lemma sp_val:
+ forall ms sp rs,
+ agree ms sp rs ->
+ sp = rs#IR13.
+Proof.
+ intros. elim H; auto.
+Qed.
+
+Lemma agree_exten_1:
+ forall ms sp rs rs',
+ agree ms sp rs ->
+ (forall r, is_data_reg r -> rs'#r = rs#r) ->
+ agree ms sp rs'.
+Proof.
+ unfold agree; intros. elim H; intros.
+ split. rewrite H0. auto. exact I.
+ intros. rewrite H0. auto. apply preg_of_is_data_reg.
+Qed.
+
+Lemma agree_exten_2:
+ forall ms sp rs rs',
+ agree ms sp rs ->
+ (forall r, r <> PC -> r <> IR14 -> rs'#r = rs#r) ->
+ agree ms sp rs'.
+Proof.
+ intros. eapply agree_exten_1; eauto.
+ intros. apply H0; red; intro; subst r; elim H1.
+Qed.
+
+(** Preservation of register agreement under various assignments. *)
+
+Lemma agree_set_mreg:
+ forall ms sp rs r v,
+ agree ms sp rs ->
+ agree (Regmap.set r v ms) sp (rs#(preg_of r) <- v).
+Proof.
+ unfold agree; intros. elim H; intros; clear H.
+ split. rewrite Pregmap.gso. auto. apply sym_not_eq. apply preg_of_not_IR13.
+ intros. unfold Regmap.set. case (RegEq.eq r0 r); intro.
+ subst r0. rewrite Pregmap.gss. auto.
+ rewrite Pregmap.gso. auto. red; intro.
+ elim n. apply preg_of_injective; auto.
+Qed.
+Hint Resolve agree_set_mreg: ppcgen.
+
+Lemma agree_set_mireg:
+ forall ms sp rs r v,
+ agree ms sp (rs#(preg_of r) <- v) ->
+ mreg_type r = Tint ->
+ agree ms sp (rs#(ireg_of r) <- v).
+Proof.
+ intros. unfold preg_of in H. rewrite H0 in H. auto.
+Qed.
+Hint Resolve agree_set_mireg: ppcgen.
+
+Lemma agree_set_mfreg:
+ forall ms sp rs r v,
+ agree ms sp (rs#(preg_of r) <- v) ->
+ mreg_type r = Tfloat ->
+ agree ms sp (rs#(freg_of r) <- v).
+Proof.
+ intros. unfold preg_of in H. rewrite H0 in H. auto.
+Qed.
+Hint Resolve agree_set_mfreg: ppcgen.
+
+Lemma agree_set_other:
+ forall ms sp rs r v,
+ agree ms sp rs ->
+ ~(is_data_reg r) ->
+ agree ms sp (rs#r <- v).
+Proof.
+ intros. apply agree_exten_1 with rs.
+ auto. intros. apply Pregmap.gso. red; intro; subst r0; contradiction.
+Qed.
+Hint Resolve agree_set_other: ppcgen.
+
+Lemma agree_nextinstr:
+ forall ms sp rs,
+ agree ms sp rs -> agree ms sp (nextinstr rs).
+Proof.
+ intros. unfold nextinstr. apply agree_set_other. auto. auto.
+Qed.
+Hint Resolve agree_nextinstr: ppcgen.
+
+Lemma agree_set_mireg_twice:
+ forall ms sp rs r v v',
+ agree ms sp rs ->
+ mreg_type r = Tint ->
+ agree (Regmap.set r v ms) sp (rs #(ireg_of r) <- v' #(ireg_of r) <- v).
+Proof.
+ intros. replace (IR (ireg_of r)) with (preg_of r). elim H; intros.
+ split. repeat (rewrite Pregmap.gso; auto with ppcgen).
+ intros. case (mreg_eq r r0); intro.
+ subst r0. rewrite Regmap.gss. rewrite Pregmap.gss. auto.
+ assert (preg_of r <> preg_of r0).
+ red; intro. elim n. apply preg_of_injective. auto.
+ rewrite Regmap.gso; auto.
+ repeat (rewrite Pregmap.gso; auto).
+ unfold preg_of. rewrite H0. auto.
+Qed.
+Hint Resolve agree_set_mireg_twice: ppcgen.
+
+Lemma agree_set_twice_mireg:
+ forall ms sp rs r v v',
+ agree (Regmap.set r v' ms) sp rs ->
+ mreg_type r = Tint ->
+ agree (Regmap.set r v ms) sp (rs#(ireg_of r) <- v).
+Proof.
+ intros. elim H; intros.
+ split. rewrite Pregmap.gso. auto.
+ generalize (ireg_of_not_IR13 r); congruence.
+ intros. generalize (H2 r0).
+ case (mreg_eq r0 r); intro.
+ subst r0. repeat rewrite Regmap.gss. unfold preg_of; rewrite H0.
+ rewrite Pregmap.gss. auto.
+ repeat rewrite Regmap.gso; auto.
+ rewrite Pregmap.gso. auto.
+ replace (IR (ireg_of r)) with (preg_of r).
+ red; intros. elim n. apply preg_of_injective; auto.
+ unfold preg_of. rewrite H0. auto.
+Qed.
+Hint Resolve agree_set_twice_mireg: ppcgen.
+
+Lemma agree_set_commut:
+ forall ms sp rs r1 r2 v1 v2,
+ r1 <> r2 ->
+ agree ms sp ((rs#r2 <- v2)#r1 <- v1) ->
+ agree ms sp ((rs#r1 <- v1)#r2 <- v2).
+Proof.
+ intros. apply agree_exten_1 with ((rs#r2 <- v2)#r1 <- v1). auto.
+ intros.
+ case (preg_eq r r1); intro.
+ subst r1. rewrite Pregmap.gss. rewrite Pregmap.gso. rewrite Pregmap.gss.
+ auto. auto.
+ case (preg_eq r r2); intro.
+ subst r2. rewrite Pregmap.gss. rewrite Pregmap.gso. rewrite Pregmap.gss.
+ auto. auto.
+ repeat (rewrite Pregmap.gso; auto).
+Qed.
+Hint Resolve agree_set_commut: ppcgen.
+
+Lemma agree_nextinstr_commut:
+ forall ms sp rs r v,
+ agree ms sp (rs#r <- v) ->
+ r <> PC ->
+ agree ms sp ((nextinstr rs)#r <- v).
+Proof.
+ intros. unfold nextinstr. apply agree_set_commut. auto.
+ apply agree_set_other. auto. auto.
+Qed.
+Hint Resolve agree_nextinstr_commut: ppcgen.
+
+Lemma agree_set_mireg_exten:
+ forall ms sp rs r v (rs': regset),
+ agree ms sp rs ->
+ mreg_type r = Tint ->
+ rs'#(ireg_of r) = v ->
+ (forall r', r' <> PC -> r' <> ireg_of r -> r' <> IR14 -> rs'#r' = rs#r') ->
+ agree (Regmap.set r v ms) sp rs'.
+Proof.
+ intros. apply agree_exten_2 with (rs#(ireg_of r) <- v).
+ auto with ppcgen.
+ intros. unfold Pregmap.set. case (PregEq.eq r0 (ireg_of r)); intro.
+ subst r0. auto. apply H2; auto.
+Qed.
+
+(** Useful properties of the PC and GPR0 registers. *)
+
+Lemma nextinstr_inv:
+ forall r rs, r <> PC -> (nextinstr rs)#r = rs#r.
+Proof.
+ intros. unfold nextinstr. apply Pregmap.gso. auto.
+Qed.
+Hint Resolve nextinstr_inv: ppcgen.
+
+Lemma nextinstr_set_preg:
+ forall rs m v,
+ (nextinstr (rs#(preg_of m) <- v))#PC = Val.add rs#PC Vone.
+Proof.
+ intros. unfold nextinstr. rewrite Pregmap.gss.
+ rewrite Pregmap.gso. auto. apply sym_not_eq. auto with ppcgen.
+Qed.
+Hint Resolve nextinstr_set_preg: ppcgen.
+
+(** Connection between Mach and Asm calling conventions for external
+ functions. *)
+
+Lemma extcall_arg_match:
+ forall ms sp rs m l v,
+ agree ms sp rs ->
+ Machconcr.extcall_arg ms m sp l v ->
+ Asm.extcall_arg rs m l v.
+Proof.
+ intros. inv H0.
+ rewrite (preg_val _ _ _ r H). constructor.
+ rewrite (sp_val _ _ _ H) in H1.
+ destruct ty; unfold load_stack in H1.
+ econstructor. reflexivity. assumption.
+ econstructor. reflexivity. assumption.
+Qed.
+
+Lemma extcall_args_match:
+ forall ms sp rs m, agree ms sp rs ->
+ forall ll vl,
+ Machconcr.extcall_args ms m sp ll vl ->
+ Asm.extcall_args rs m ll vl.
+Proof.
+ induction 2; constructor; auto. eapply extcall_arg_match; eauto.
+Qed.
+
+Lemma extcall_arguments_match:
+ forall ms m sp rs sg args,
+ agree ms sp rs ->
+ Machconcr.extcall_arguments ms m sp sg args ->
+ Asm.extcall_arguments rs m sg args.
+Proof.
+ unfold Machconcr.extcall_arguments, Asm.extcall_arguments; intros.
+ eapply extcall_args_match; eauto.
+Qed.
+
+(** * Execution of straight-line code *)
+
+Section STRAIGHTLINE.
+
+Variable ge: genv.
+Variable fn: code.
+
+(** Straight-line code is composed of PPC instructions that execute
+ in sequence (no branches, no function calls and returns).
+ The following inductive predicate relates the machine states
+ before and after executing a straight-line sequence of instructions.
+ Instructions are taken from the first list instead of being fetched
+ from memory. *)
+
+Inductive exec_straight: code -> regset -> mem ->
+ code -> regset -> mem -> Prop :=
+ | exec_straight_one:
+ forall i1 c rs1 m1 rs2 m2,
+ exec_instr ge fn i1 rs1 m1 = OK rs2 m2 ->
+ rs2#PC = Val.add rs1#PC Vone ->
+ exec_straight (i1 :: c) rs1 m1 c rs2 m2
+ | exec_straight_step:
+ forall i c rs1 m1 rs2 m2 c' rs3 m3,
+ exec_instr ge fn i rs1 m1 = OK rs2 m2 ->
+ rs2#PC = Val.add rs1#PC Vone ->
+ exec_straight c rs2 m2 c' rs3 m3 ->
+ exec_straight (i :: c) rs1 m1 c' rs3 m3.
+
+Lemma exec_straight_trans:
+ forall c1 rs1 m1 c2 rs2 m2 c3 rs3 m3,
+ exec_straight c1 rs1 m1 c2 rs2 m2 ->
+ exec_straight c2 rs2 m2 c3 rs3 m3 ->
+ exec_straight c1 rs1 m1 c3 rs3 m3.
+Proof.
+ induction 1; intros.
+ apply exec_straight_step with rs2 m2; auto.
+ apply exec_straight_step with rs2 m2; auto.
+Qed.
+
+Lemma exec_straight_two:
+ forall i1 i2 c rs1 m1 rs2 m2 rs3 m3,
+ exec_instr ge fn i1 rs1 m1 = OK rs2 m2 ->
+ exec_instr ge fn i2 rs2 m2 = OK rs3 m3 ->
+ rs2#PC = Val.add rs1#PC Vone ->
+ rs3#PC = Val.add rs2#PC Vone ->
+ exec_straight (i1 :: i2 :: c) rs1 m1 c rs3 m3.
+Proof.
+ intros. apply exec_straight_step with rs2 m2; auto.
+ apply exec_straight_one; auto.
+Qed.
+
+Lemma exec_straight_three:
+ forall i1 i2 i3 c rs1 m1 rs2 m2 rs3 m3 rs4 m4,
+ exec_instr ge fn i1 rs1 m1 = OK rs2 m2 ->
+ exec_instr ge fn i2 rs2 m2 = OK rs3 m3 ->
+ exec_instr ge fn i3 rs3 m3 = OK rs4 m4 ->
+ rs2#PC = Val.add rs1#PC Vone ->
+ rs3#PC = Val.add rs2#PC Vone ->
+ rs4#PC = Val.add rs3#PC Vone ->
+ exec_straight (i1 :: i2 :: i3 :: c) rs1 m1 c rs4 m4.
+Proof.
+ intros. apply exec_straight_step with rs2 m2; auto.
+ eapply exec_straight_two; eauto.
+Qed.
+
+Lemma exec_straight_four:
+ forall i1 i2 i3 i4 c rs1 m1 rs2 m2 rs3 m3 rs4 m4 rs5 m5,
+ exec_instr ge fn i1 rs1 m1 = OK rs2 m2 ->
+ exec_instr ge fn i2 rs2 m2 = OK rs3 m3 ->
+ exec_instr ge fn i3 rs3 m3 = OK rs4 m4 ->
+ exec_instr ge fn i4 rs4 m4 = OK rs5 m5 ->
+ rs2#PC = Val.add rs1#PC Vone ->
+ rs3#PC = Val.add rs2#PC Vone ->
+ rs4#PC = Val.add rs3#PC Vone ->
+ rs5#PC = Val.add rs4#PC Vone ->
+ exec_straight (i1 :: i2 :: i3 :: i4 :: c) rs1 m1 c rs5 m5.
+Proof.
+ intros. apply exec_straight_step with rs2 m2; auto.
+ eapply exec_straight_three; eauto.
+Qed.
+
+(** * Correctness of ARM constructor functions *)
+
+(** Properties of comparisons. *)
+(*
+Lemma compare_float_spec:
+ forall rs v1 v2,
+ let rs1 := nextinstr (compare_float rs v1 v2) in
+ rs1#CR0_0 = Val.cmpf Clt v1 v2
+ /\ rs1#CR0_1 = Val.cmpf Cgt v1 v2
+ /\ rs1#CR0_2 = Val.cmpf Ceq v1 v2
+ /\ forall r', r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 ->
+ r' <> CR0_2 -> r' <> CR0_3 -> rs1#r' = rs#r'.
+Proof.
+ intros. unfold rs1.
+ split. reflexivity.
+ split. reflexivity.
+ split. reflexivity.
+ intros. rewrite nextinstr_inv; auto.
+ unfold compare_float. repeat (rewrite Pregmap.gso; auto).
+Qed.
+
+Lemma compare_sint_spec:
+ forall rs v1 v2,
+ let rs1 := nextinstr (compare_sint rs v1 v2) in
+ rs1#CR0_0 = Val.cmp Clt v1 v2
+ /\ rs1#CR0_1 = Val.cmp Cgt v1 v2
+ /\ rs1#CR0_2 = Val.cmp Ceq v1 v2
+ /\ forall r', r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 ->
+ r' <> CR0_2 -> r' <> CR0_3 -> rs1#r' = rs#r'.
+Proof.
+ intros. unfold rs1.
+ split. reflexivity.
+ split. reflexivity.
+ split. reflexivity.
+ intros. rewrite nextinstr_inv; auto.
+ unfold compare_sint. repeat (rewrite Pregmap.gso; auto).
+Qed.
+
+Lemma compare_uint_spec:
+ forall rs v1 v2,
+ let rs1 := nextinstr (compare_uint rs v1 v2) in
+ rs1#CR0_0 = Val.cmpu Clt v1 v2
+ /\ rs1#CR0_1 = Val.cmpu Cgt v1 v2
+ /\ rs1#CR0_2 = Val.cmpu Ceq v1 v2
+ /\ forall r', r' <> PC -> r' <> CR0_0 -> r' <> CR0_1 ->
+ r' <> CR0_2 -> r' <> CR0_3 -> rs1#r' = rs#r'.
+Proof.
+ intros. unfold rs1.
+ split. reflexivity.
+ split. reflexivity.
+ split. reflexivity.
+ intros. rewrite nextinstr_inv; auto.
+ unfold compare_uint. repeat (rewrite Pregmap.gso; auto).
+Qed.
+*)
+
+(** Loading a constant. *)
+
+Lemma loadimm_correct:
+ forall r n k rs m,
+ exists rs',
+ exec_straight (loadimm r n k) rs m k rs' m
+ /\ rs'#r = Vint n
+ /\ forall r': preg, r' <> r -> r' <> PC -> rs'#r' = rs#r'.
+Proof.
+ intros. unfold loadimm.
+ case (is_immed_arith n).
+ (* single move *)
+ exists (nextinstr (rs#r <- (Vint n))).
+ split. apply exec_straight_one. reflexivity. reflexivity.
+ split. rewrite nextinstr_inv; auto with ppcgen.
+ apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ case (is_immed_arith (Int.not n)).
+ (* single move-complement *)
+ exists (nextinstr (rs#r <- (Vint n))).
+ split. apply exec_straight_one.
+ simpl. change (Int.xor (Int.not n) Int.mone) with (Int.not (Int.not n)).
+ rewrite Int.not_involutive. auto.
+ reflexivity.
+ split. rewrite nextinstr_inv; auto with ppcgen.
+ apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ (* mov - or - or - or *)
+ set (n1 := Int.and n (Int.repr 255)).
+ set (n2 := Int.and n (Int.repr 65280)).
+ set (n3 := Int.and n (Int.repr 16711680)).
+ set (n4 := Int.and n (Int.repr 4278190080)).
+ set (rs1 := nextinstr (rs#r <- (Vint n1))).
+ set (rs2 := nextinstr (rs1#r <- (Val.or rs1#r (Vint n2)))).
+ set (rs3 := nextinstr (rs2#r <- (Val.or rs2#r (Vint n3)))).
+ set (rs4 := nextinstr (rs3#r <- (Val.or rs3#r (Vint n4)))).
+ exists rs4.
+ split. apply exec_straight_four with rs1 m rs2 m rs3 m; auto.
+ split. unfold rs4. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ unfold rs3. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ unfold rs2. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ unfold rs1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ repeat rewrite Val.or_assoc. simpl. decEq.
+ unfold n4, n3, n2, n1. repeat rewrite <- Int.and_or_distrib.
+ change (Int.and n Int.mone = n). apply Int.and_mone.
+ intros.
+ unfold rs4. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+ unfold rs3. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+ unfold rs2. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+ unfold rs1. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+Qed.
+
+(** Add integer immediate. *)
+
+Lemma addimm_correct:
+ forall r1 r2 n k rs m,
+ exists rs',
+ exec_straight (addimm r1 r2 n k) rs m k rs' m
+ /\ rs'#r1 = Val.add rs#r2 (Vint n)
+ /\ forall r': preg, r' <> r1 -> r' <> PC -> rs'#r' = rs#r'.
+Proof.
+ intros. unfold addimm.
+ (* addi *)
+ case (is_immed_arith n).
+ exists (nextinstr (rs#r1 <- (Val.add rs#r2 (Vint n)))).
+ split. apply exec_straight_one; auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ (* subi *)
+ case (is_immed_arith (Int.neg n)).
+ exists (nextinstr (rs#r1 <- (Val.sub rs#r2 (Vint (Int.neg n))))).
+ split. apply exec_straight_one; auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ apply Val.sub_opp_add.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ (* general *)
+ set (n1 := Int.and n (Int.repr 255)).
+ set (n2 := Int.and n (Int.repr 65280)).
+ set (n3 := Int.and n (Int.repr 16711680)).
+ set (n4 := Int.and n (Int.repr 4278190080)).
+ set (rs1 := nextinstr (rs#r1 <- (Val.add rs#r2 (Vint n1)))).
+ set (rs2 := nextinstr (rs1#r1 <- (Val.add rs1#r1 (Vint n2)))).
+ set (rs3 := nextinstr (rs2#r1 <- (Val.add rs2#r1 (Vint n3)))).
+ set (rs4 := nextinstr (rs3#r1 <- (Val.add rs3#r1 (Vint n4)))).
+ exists rs4.
+ split. apply exec_straight_four with rs1 m rs2 m rs3 m; auto.
+ simpl.
+ split. unfold rs4. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ unfold rs3. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ unfold rs2. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ unfold rs1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ repeat rewrite Val.add_assoc. simpl. decEq. decEq.
+ unfold n4, n3, n2, n1. repeat rewrite Int.add_and.
+ change (Int.and n Int.mone = n). apply Int.and_mone.
+ vm_compute; auto.
+ vm_compute; auto.
+ vm_compute; auto.
+ intros.
+ unfold rs4. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+ unfold rs3. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+ unfold rs2. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+ unfold rs1. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+Qed.
+
+(* And integer immediate *)
+
+Lemma andimm_correct:
+ forall r1 r2 n k rs m,
+ r2 <> IR14 ->
+ exists rs',
+ exec_straight (andimm r1 r2 n k) rs m k rs' m
+ /\ rs'#r1 = Val.and rs#r2 (Vint n)
+ /\ forall r': preg, r' <> r1 -> r' <> IR14 -> r' <> PC -> rs'#r' = rs#r'.
+Proof.
+ intros. unfold andimm.
+ (* andi *)
+ case (is_immed_arith n).
+ exists (nextinstr (rs#r1 <- (Val.and rs#r2 (Vint n)))).
+ split. apply exec_straight_one; auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ (* bici *)
+ case (is_immed_arith (Int.not n)).
+ exists (nextinstr (rs#r1 <- (Val.and rs#r2 (Vint n)))).
+ split. apply exec_straight_one; auto. simpl.
+ change (Int.xor (Int.not n) Int.mone) with (Int.not (Int.not n)).
+ rewrite Int.not_involutive. auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ (* general *)
+ exploit loadimm_correct. intros [rs' [A [B C]]].
+ exists (nextinstr (rs'#r1 <- (Val.and rs#r2 (Vint n)))).
+ split. eapply exec_straight_trans. eauto. apply exec_straight_one.
+ simpl. rewrite B. rewrite C; auto with ppcgen. congruence.
+ auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+Qed.
+
+(** Other integer immediate *)
+
+Lemma makeimm_correct:
+ forall (instr: ireg -> ireg -> shift_op -> instruction)
+ (sem: val -> val -> val)
+ r1 (r2: ireg) n k (rs : regset) m,
+ (forall c r1 r2 so rs m,
+ exec_instr ge c (instr r1 r2 so) rs m
+ = OK (nextinstr rs#r1 <- (sem rs#r2 (eval_shift_op so rs))) m) ->
+ r2 <> IR14 ->
+ exists rs',
+ exec_straight (makeimm instr r1 r2 n k) rs m k rs' m
+ /\ rs'#r1 = sem rs#r2 (Vint n)
+ /\ forall r': preg, r' <> r1 -> r' <> PC -> r' <> IR14 -> rs'#r' = rs#r'.
+Proof.
+ intros. unfold makeimm.
+ case (is_immed_arith n).
+ (* one immed instr *)
+ exists (nextinstr (rs#r1 <- (sem rs#r2 (Vint n)))).
+ split. apply exec_straight_one.
+ change (Vint n) with (eval_shift_op (SOimm n) rs). auto.
+ auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ (* general case *)
+ exploit loadimm_correct. intros [rs' [A [B C]]].
+ exists (nextinstr (rs'#r1 <- (sem rs#r2 (Vint n)))).
+ split. eapply exec_straight_trans. eauto. apply exec_straight_one.
+ rewrite <- B. rewrite <- (C r2).
+ change (rs' IR14) with (eval_shift_op (SOreg IR14) rs'). auto.
+ congruence. auto with ppcgen. auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto with ppcgen.
+Qed.
+
+(** Indexed memory loads. *)
+
+Lemma loadind_int_correct:
+ forall (base: ireg) ofs dst (rs: regset) m v k,
+ Mem.loadv Mint32 m (Val.add rs#base (Vint ofs)) = Some v ->
+ exists rs',
+ exec_straight (loadind_int base ofs dst k) rs m k rs' m
+ /\ rs'#dst = v
+ /\ forall r, r <> PC -> r <> IR14 -> r <> dst -> rs'#r = rs#r.
+Proof.
+ intros; unfold loadind_int. destruct (is_immed_mem_word ofs).
+ exists (nextinstr (rs#dst <- v)).
+ split. apply exec_straight_one. simpl.
+ unfold exec_load. rewrite H. auto. auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ exploit addimm_correct. intros [rs' [A [B C]]].
+ exists (nextinstr (rs'#dst <- v)).
+ split. eapply exec_straight_trans. eauto. apply exec_straight_one.
+ simpl. unfold exec_load. rewrite B.
+ rewrite Val.add_assoc. simpl. rewrite Int.add_zero.
+ rewrite H. auto.
+ auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+Qed.
+
+Lemma loadind_float_correct:
+ forall (base: ireg) ofs dst (rs: regset) m v k,
+ Mem.loadv Mfloat64 m (Val.add rs#base (Vint ofs)) = Some v ->
+ exists rs',
+ exec_straight (loadind_float base ofs dst k) rs m k rs' m
+ /\ rs'#dst = v
+ /\ forall r, r <> PC -> r <> IR14 -> r <> dst -> rs'#r = rs#r.
+Proof.
+ intros; unfold loadind_float. destruct (is_immed_mem_float ofs).
+ exists (nextinstr (rs#dst <- v)).
+ split. apply exec_straight_one. simpl.
+ unfold exec_load. rewrite H. auto. auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+ exploit addimm_correct. eauto. intros [rs' [A [B C]]].
+ exists (nextinstr (rs'#dst <- v)).
+ split. eapply exec_straight_trans. eauto. apply exec_straight_one.
+ simpl. unfold exec_load. rewrite B. rewrite Val.add_assoc. simpl.
+ rewrite Int.add_zero. rewrite H. auto. auto.
+ split. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+Qed.
+
+Lemma loadind_correct:
+ forall (base: ireg) ofs ty dst k (rs: regset) m v,
+ Mem.loadv (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) = Some v ->
+ mreg_type dst = ty ->
+ exists rs',
+ exec_straight (loadind base ofs ty dst k) rs m k rs' m
+ /\ rs'#(preg_of dst) = v
+ /\ forall r, r <> PC -> r <> IR14 -> r <> preg_of dst -> rs'#r = rs#r.
+Proof.
+ intros. unfold loadind.
+ assert (preg_of dst <> PC).
+ unfold preg_of. case (mreg_type dst); discriminate.
+ unfold preg_of. rewrite H0. destruct ty.
+ apply loadind_int_correct; auto.
+ apply loadind_float_correct; auto.
+Qed.
+
+(** Indexed memory stores. *)
+
+Lemma storeind_int_correct:
+ forall (base: ireg) ofs (src: ireg) (rs: regset) m m' k,
+ Mem.storev Mint32 m (Val.add rs#base (Vint ofs)) (rs#src) = Some m' ->
+ src <> IR14 ->
+ exists rs',
+ exec_straight (storeind_int src base ofs k) rs m k rs' m'
+ /\ forall r, r <> PC -> r <> IR14 -> rs'#r = rs#r.
+Proof.
+ intros; unfold storeind_int. destruct (is_immed_mem_word ofs).
+ exists (nextinstr rs).
+ split. apply exec_straight_one. simpl.
+ unfold exec_store. rewrite H. auto. auto.
+ intros. rewrite nextinstr_inv; auto.
+ exploit addimm_correct. eauto. intros [rs' [A [B C]]].
+ exists (nextinstr rs').
+ split. eapply exec_straight_trans. eauto. apply exec_straight_one.
+ simpl. unfold exec_store. rewrite B. rewrite C.
+ rewrite Val.add_assoc. simpl. rewrite Int.add_zero.
+ rewrite H. auto.
+ congruence. auto with ppcgen. auto.
+ intros. rewrite nextinstr_inv; auto.
+Qed.
+
+Lemma storeind_float_correct:
+ forall (base: ireg) ofs (src: freg) (rs: regset) m m' k,
+ Mem.storev Mfloat64 m (Val.add rs#base (Vint ofs)) (rs#src) = Some m' ->
+ base <> IR14 ->
+ exists rs',
+ exec_straight (storeind_float src base ofs k) rs m k rs' m'
+ /\ forall r, r <> PC -> r <> IR14 -> rs'#r = rs#r.
+Proof.
+ intros; unfold storeind_float. destruct (is_immed_mem_float ofs).
+ exists (nextinstr rs).
+ split. apply exec_straight_one. simpl.
+ unfold exec_store. rewrite H. auto. auto.
+ intros. rewrite nextinstr_inv; auto.
+ exploit addimm_correct. eauto. intros [rs' [A [B C]]].
+ exists (nextinstr rs').
+ split. eapply exec_straight_trans. eauto. apply exec_straight_one.
+ simpl. unfold exec_store. rewrite B. rewrite C.
+ rewrite Val.add_assoc. simpl. rewrite Int.add_zero.
+ rewrite H. auto.
+ congruence. congruence. auto with ppcgen. auto.
+ intros. rewrite nextinstr_inv; auto.
+Qed.
+
+Lemma storeind_correct:
+ forall (base: ireg) ofs ty src k (rs: regset) m m',
+ Mem.storev (chunk_of_type ty) m (Val.add rs#base (Vint ofs)) (rs#(preg_of src)) = Some m' ->
+ mreg_type src = ty ->
+ base <> IR14 ->
+ exists rs',
+ exec_straight (storeind src base ofs ty k) rs m k rs' m'
+ /\ forall r, r <> PC -> r <> IR14 -> rs'#r = rs#r.
+Proof.
+ intros. unfold storeind. unfold preg_of in H. rewrite H0 in H. destruct ty.
+ apply storeind_int_correct. auto. auto. auto with ppcgen.
+ apply storeind_float_correct. auto. auto.
+Qed.
+
+(** Translation of shift immediates *)
+
+Lemma transl_shift_correct:
+ forall s (r: ireg) (rs: regset),
+ eval_shift_op (transl_shift s r) rs = eval_shift_total s (rs#r).
+Proof.
+ intros. destruct s; simpl;
+ unfold eval_shift_total, eval_shift, Val.shl, Val.shr, Val.shru, Val.ror;
+ rewrite (s_amount_ltu s); auto.
+Qed.
+
+Lemma transl_shift_addr_correct:
+ forall s (r: ireg) (rs: regset),
+ eval_shift_addr (transl_shift_addr s r) rs = eval_shift_total s (rs#r).
+Proof.
+ intros. destruct s; simpl;
+ unfold eval_shift_total, eval_shift, Val.shl, Val.shr, Val.shru, Val.ror;
+ rewrite (s_amount_ltu s); auto.
+Qed.
+
+(** Translation of conditions *)
+
+Ltac TypeInv :=
+ match goal with
+ | H: (List.map ?f ?x = nil) |- _ =>
+ destruct x; [clear H | simpl in H; discriminate]
+ | H: (List.map ?f ?x = ?hd :: ?tl) |- _ =>
+ destruct x; simpl in H;
+ [ discriminate |
+ injection H; clear H; let T := fresh "T" in (
+ intros H T; TypeInv) ]
+ | _ => idtac
+ end.
+
+(** Translation of conditions. *)
+
+Lemma compare_int_spec:
+ forall rs v1 v2,
+ let rs1 := nextinstr (compare_int rs v1 v2) in
+ rs1#CReq = (Val.cmp Ceq v1 v2)
+ /\ rs1#CRne = (Val.cmp Cne v1 v2)
+ /\ rs1#CRhs = (Val.cmpu Cge v1 v2)
+ /\ rs1#CRlo = (Val.cmpu Clt v1 v2)
+ /\ rs1#CRhi = (Val.cmpu Cgt v1 v2)
+ /\ rs1#CRls = (Val.cmpu Cle v1 v2)
+ /\ rs1#CRge = (Val.cmp Cge v1 v2)
+ /\ rs1#CRlt = (Val.cmp Clt v1 v2)
+ /\ rs1#CRgt = (Val.cmp Cgt v1 v2)
+ /\ rs1#CRle = (Val.cmp Cle v1 v2)
+ /\ forall r', is_data_reg r' -> rs1#r' = rs#r'.
+Proof.
+ intros. unfold rs1. intuition; try reflexivity.
+ rewrite nextinstr_inv; [unfold compare_int; repeat rewrite Pregmap.gso; auto | idtac];
+ red; intro; subst r'; elim H.
+Qed.
+
+Lemma compare_float_spec:
+ forall rs v1 v2,
+ let rs' := nextinstr (compare_float rs v1 v2) in
+ rs'#CReq = (Val.cmpf Ceq v1 v2)
+ /\ rs'#CRne = (Val.cmpf Cne v1 v2)
+ /\ rs'#CRmi = (Val.cmpf Clt v1 v2)
+ /\ rs'#CRpl = (Val.notbool (Val.cmpf Clt v1 v2))
+ /\ rs'#CRhi = (Val.notbool (Val.cmpf Cle v1 v2))
+ /\ rs'#CRls = (Val.cmpf Cle v1 v2)
+ /\ rs'#CRge = (Val.cmpf Cge v1 v2)
+ /\ rs'#CRlt = (Val.notbool (Val.cmpf Cge v1 v2))
+ /\ rs'#CRgt = (Val.cmpf Cgt v1 v2)
+ /\ rs'#CRle = (Val.notbool (Val.cmpf Cgt v1 v2))
+ /\ forall r', is_data_reg r' -> rs'#r' = rs#r'.
+Proof.
+ intros. unfold rs'. intuition; try reflexivity.
+ rewrite nextinstr_inv; [unfold compare_float; repeat rewrite Pregmap.gso; auto | idtac];
+ red; intro; subst r'; elim H.
+Qed.
+
+Lemma transl_cond_correct:
+ forall cond args k ms sp rs m b,
+ map mreg_type args = type_of_condition cond ->
+ agree ms sp rs ->
+ eval_condition cond (map ms args) m = Some b ->
+ exists rs',
+ exec_straight (transl_cond cond args k) rs m k rs' m
+ /\ rs'#(CR (crbit_for_cond cond)) = Val.of_bool b
+ /\ agree ms sp rs'.
+Proof.
+ intros.
+ rewrite <- (eval_condition_weaken _ _ _ H1). clear H1.
+ destruct cond; simpl in H; TypeInv; simpl.
+ (* Ccomp *)
+ generalize (compare_int_spec rs ms#m0 ms#m1).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs ms#m0 ms#m1)).
+ split. apply exec_straight_one. simpl.
+ repeat rewrite <- (ireg_val ms sp rs); trivial.
+ reflexivity.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs; auto.
+ (* Ccompu *)
+ generalize (compare_int_spec rs ms#m0 ms#m1).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs ms#m0 ms#m1)).
+ split. apply exec_straight_one. simpl.
+ repeat rewrite <- (ireg_val ms sp rs); trivial.
+ reflexivity.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs; auto.
+ (* Ccompshift *)
+ generalize (compare_int_spec rs ms#m0 (eval_shift_total s ms#m1)).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs ms#m0 (eval_shift_total s ms#m1))).
+ split. apply exec_straight_one. simpl.
+ rewrite transl_shift_correct.
+ repeat rewrite <- (ireg_val ms sp rs); trivial.
+ reflexivity.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs; auto.
+ (* Ccompushift *)
+ generalize (compare_int_spec rs ms#m0 (eval_shift_total s ms#m1)).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs ms#m0 (eval_shift_total s ms#m1))).
+ split. apply exec_straight_one. simpl.
+ rewrite transl_shift_correct.
+ repeat rewrite <- (ireg_val ms sp rs); trivial.
+ reflexivity.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs; auto.
+ (* Ccompimm *)
+ destruct (is_immed_arith i).
+ generalize (compare_int_spec rs ms#m0 (Vint i)).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs ms#m0 (Vint i))).
+ split. apply exec_straight_one. simpl.
+ rewrite <- (ireg_val ms sp rs); trivial. auto.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs; auto.
+ exploit (loadimm_correct IR14). intros [rs' [P [Q R]]].
+ assert (AG: agree ms sp rs'). apply agree_exten_2 with rs; auto.
+ generalize (compare_int_spec rs' ms#m0 (Vint i)).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs' ms#m0 (Vint i))).
+ split. eapply exec_straight_trans. eexact P. apply exec_straight_one. simpl.
+ rewrite Q. rewrite <- (ireg_val ms sp rs'); trivial. auto.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs'; auto.
+ (* Ccompuimm *)
+ destruct (is_immed_arith i).
+ generalize (compare_int_spec rs ms#m0 (Vint i)).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs ms#m0 (Vint i))).
+ split. apply exec_straight_one. simpl.
+ rewrite <- (ireg_val ms sp rs); trivial. auto.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs; auto.
+ exploit (loadimm_correct IR14). intros [rs' [P [Q R]]].
+ assert (AG: agree ms sp rs'). apply agree_exten_2 with rs; auto.
+ generalize (compare_int_spec rs' ms#m0 (Vint i)).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_int rs' ms#m0 (Vint i))).
+ split. eapply exec_straight_trans. eexact P. apply exec_straight_one. simpl.
+ rewrite Q. rewrite <- (ireg_val ms sp rs'); trivial. auto.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs'; auto.
+ (* Ccompf *)
+ generalize (compare_float_spec rs ms#m0 ms#m1).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_float rs ms#m0 ms#m1)).
+ split. apply exec_straight_one. simpl.
+ repeat rewrite <- (freg_val ms sp rs); trivial. auto.
+ split.
+ case c; simpl; auto.
+ apply agree_exten_1 with rs; auto.
+ (* Cnotcompf *)
+ generalize (compare_float_spec rs ms#m0 ms#m1).
+ intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]].
+ exists (nextinstr (compare_float rs ms#m0 ms#m1)).
+ split. apply exec_straight_one. simpl.
+ repeat rewrite <- (freg_val ms sp rs); trivial. auto.
+ split.
+ case c; simpl; auto.
+ rewrite Val.negate_cmpf_ne. auto.
+ rewrite Val.negate_cmpf_eq. auto.
+ apply agree_exten_1 with rs; auto.
+Qed.
+
+(** Translation of arithmetic operations. *)
+
+Ltac TranslOpSimpl :=
+ match goal with
+ | |- exists rs' : regset,
+ exec_straight ?c ?rs ?m ?k rs' ?m /\
+ agree (Regmap.set ?res ?v ?ms) ?sp rs' =>
+ (exists (nextinstr (rs#(ireg_of res) <- v));
+ split;
+ [ apply exec_straight_one;
+ [ repeat (rewrite (ireg_val ms sp rs); auto);
+ simpl; try rewrite transl_shift_correct; reflexivity
+ | reflexivity ]
+ | auto with ppcgen ])
+ ||
+ (exists (nextinstr (rs#(freg_of res) <- v));
+ split;
+ [ apply exec_straight_one;
+ [ repeat (rewrite (freg_val ms sp rs); auto); reflexivity
+ | reflexivity ]
+ | auto with ppcgen ])
+ end.
+
+Lemma transl_op_correct:
+ forall op args res k ms sp rs m v,
+ wt_instr (Mop op args res) ->
+ agree ms sp rs ->
+ eval_operation ge sp op (map ms args) m = Some v ->
+ exists rs',
+ exec_straight (transl_op op args res k) rs m k rs' m
+ /\ agree (Regmap.set res v ms) sp rs'.
+Proof.
+ intros. rewrite <- (eval_operation_weaken _ _ _ _ _ H1). (*clear H1; clear v.*)
+ inversion H.
+ (* Omove *)
+ simpl. exists (nextinstr (rs#(preg_of res) <- (ms r1))).
+ split. caseEq (mreg_type r1); intro.
+ apply exec_straight_one. simpl. rewrite (ireg_val ms sp rs); auto.
+ simpl. unfold preg_of. rewrite <- H3. rewrite H6. reflexivity.
+ auto with ppcgen.
+ apply exec_straight_one. simpl. rewrite (freg_val ms sp rs); auto.
+ simpl. unfold preg_of. rewrite <- H3. rewrite H6. reflexivity.
+ auto with ppcgen.
+ auto with ppcgen.
+ (* Other instructions *)
+ clear H2 H3 H5.
+ destruct op; simpl in H6; injection H6; clear H6; intros;
+ TypeInv; simpl; try (TranslOpSimpl).
+ (* Omove again *)
+ congruence.
+ (* Ointconst *)
+ generalize (loadimm_correct (ireg_of res) i k rs m).
+ intros [rs' [A [B C]]].
+ exists rs'. split. auto.
+ apply agree_set_mireg_exten with rs; auto.
+(*
+ (* Ofloatconst *)
+ exists (nextinstr (rs#(freg_of res) <- (Vfloat f))).
+ split. apply exec_straight_one. reflexivity. reflexivity.
+ auto with ppcgen.
+ (* Oaddrsymbol *)
+ change (find_symbol_offset ge i i0) with (symbol_offset ge i i0).
+ set (v := symbol_offset ge i i0).
+ pose (rs1 := nextinstr (rs#GPR2 <- (high_half v))).
+ exists (nextinstr (rs1#(ireg_of res) <- v)).
+ split. apply exec_straight_two with rs1 m.
+ unfold exec_instr. rewrite gpr_or_zero_zero.
+ unfold const_high. rewrite Val.add_commut.
+ rewrite high_half_zero. reflexivity.
+ simpl. rewrite gpr_or_zero_not_zero. 2: congruence.
+ unfold rs1 at 1. rewrite nextinstr_inv; auto with ppcgen.
+ rewrite Pregmap.gss.
+ fold v. rewrite Val.add_commut. unfold v. rewrite low_high_half.
+ reflexivity. reflexivity. reflexivity.
+ unfold rs1. apply agree_nextinstr. apply agree_set_mireg; auto.
+ apply agree_set_mreg. apply agree_nextinstr.
+ apply agree_set_other. auto. simpl. tauto.
+*)
+ (* Oaddrstack *)
+ generalize (addimm_correct (ireg_of res) IR13 i k rs m).
+ intros [rs' [EX [RES OTH]]].
+ exists rs'. split. auto.
+ apply agree_set_mireg_exten with rs; auto.
+ rewrite (sp_val ms sp rs). auto. auto.
+ (* Ocast8signed *)
+ set (rs1 := nextinstr (rs#(ireg_of res) <- (Val.shl (ms m0) (Vint (Int.repr 24))))).
+ set (rs2 := nextinstr (rs1#(ireg_of res) <- (Val.shr (rs1 (ireg_of res)) (Vint (Int.repr 24))))).
+ exists rs2. split.
+ apply exec_straight_two with rs1 m; auto.
+ simpl. rewrite <- (ireg_val ms sp rs); auto.
+ unfold rs2.
+ replace (Val.shr (rs1 (ireg_of res)) (Vint (Int.repr 24))) with (Val.sign_ext 8 (ms m0)).
+ apply agree_nextinstr. unfold rs1. apply agree_nextinstr_commut.
+ apply agree_set_mireg_twice; auto with ppcgen. auto with ppcgen.
+ unfold rs1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ destruct (ms m0); simpl; auto. rewrite Int.sign_ext_shr_shl. reflexivity.
+ vm_compute; auto.
+ (* Ocast8unsigned *)
+ exists (nextinstr (rs#(ireg_of res) <- (Val.and (ms m0) (Vint (Int.repr 255))))).
+ split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs)); auto. reflexivity.
+ replace (Val.zero_ext 8 (ms m0))
+ with (Val.and (ms m0) (Vint (Int.repr 255))).
+ auto with ppcgen.
+ destruct (ms m0); simpl; auto. rewrite Int.zero_ext_and. reflexivity.
+ vm_compute; auto.
+ (* Ocast16signed *)
+ set (rs1 := nextinstr (rs#(ireg_of res) <- (Val.shl (ms m0) (Vint (Int.repr 16))))).
+ set (rs2 := nextinstr (rs1#(ireg_of res) <- (Val.shr (rs1 (ireg_of res)) (Vint (Int.repr 16))))).
+ exists rs2. split.
+ apply exec_straight_two with rs1 m; auto.
+ simpl. rewrite <- (ireg_val ms sp rs); auto.
+ unfold rs2.
+ replace (Val.shr (rs1 (ireg_of res)) (Vint (Int.repr 16))) with (Val.sign_ext 16 (ms m0)).
+ apply agree_nextinstr. unfold rs1. apply agree_nextinstr_commut.
+ apply agree_set_mireg_twice; auto with ppcgen. auto with ppcgen.
+ unfold rs1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ destruct (ms m0); simpl; auto. rewrite Int.sign_ext_shr_shl. reflexivity.
+ vm_compute; auto.
+ (* Ocast16unsigned *)
+ set (rs1 := nextinstr (rs#(ireg_of res) <- (Val.shl (ms m0) (Vint (Int.repr 16))))).
+ set (rs2 := nextinstr (rs1#(ireg_of res) <- (Val.shru (rs1 (ireg_of res)) (Vint (Int.repr 16))))).
+ exists rs2. split.
+ apply exec_straight_two with rs1 m; auto.
+ simpl. rewrite <- (ireg_val ms sp rs); auto.
+ unfold rs2.
+ replace (Val.shru (rs1 (ireg_of res)) (Vint (Int.repr 16))) with (Val.zero_ext 16 (ms m0)).
+ apply agree_nextinstr. unfold rs1. apply agree_nextinstr_commut.
+ apply agree_set_mireg_twice; auto with ppcgen. auto with ppcgen.
+ unfold rs1. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ destruct (ms m0); simpl; auto. rewrite Int.zero_ext_shru_shl. reflexivity.
+ vm_compute; auto.
+ (* Oaddimm *)
+ generalize (addimm_correct (ireg_of res) (ireg_of m0) i k rs m).
+ intros [rs' [A [B C]]].
+ exists rs'. split. auto.
+ apply agree_set_mireg_exten with rs; auto.
+ rewrite (ireg_val ms sp rs); auto.
+ (* Orsbimm *)
+ exploit (makeimm_correct Prsb (fun v1 v2 => Val.sub v2 v1) (ireg_of res) (ireg_of m0));
+ auto with ppcgen.
+ intros [rs' [A [B C]]].
+ exists rs'.
+ split. eauto.
+ apply agree_set_mireg_exten with rs; auto. rewrite B.
+ rewrite <- (ireg_val ms sp rs); auto.
+ (* Omul *)
+ destruct (ireg_eq (ireg_of res) (ireg_of m0) || ireg_eq (ireg_of res) (ireg_of m1)).
+ set (rs1 := nextinstr (rs#IR14 <- (Val.mul (ms m0) (ms m1)))).
+ set (rs2 := nextinstr (rs1#(ireg_of res) <- (rs1#IR14))).
+ exists rs2; split.
+ apply exec_straight_two with rs1 m; auto.
+ simpl. repeat rewrite <- (ireg_val ms sp rs); auto.
+ unfold rs2. unfold rs1. rewrite nextinstr_inv. rewrite Pregmap.gss.
+ apply agree_nextinstr. apply agree_nextinstr_commut.
+ apply agree_set_mireg; auto. apply agree_set_mreg. apply agree_set_other. auto.
+ simpl; auto. auto with ppcgen. discriminate.
+ TranslOpSimpl.
+ (* Oandimm *)
+ generalize (andimm_correct (ireg_of res) (ireg_of m0) i k rs m
+ (ireg_of_not_IR14 m0)).
+ intros [rs' [A [B C]]].
+ exists rs'. split. auto.
+ apply agree_set_mireg_exten with rs; auto.
+ rewrite (ireg_val ms sp rs); auto.
+ (* Oorimm *)
+ exploit (makeimm_correct Porr Val.or (ireg_of res) (ireg_of m0));
+ auto with ppcgen.
+ intros [rs' [A [B C]]].
+ exists rs'.
+ split. eauto.
+ apply agree_set_mireg_exten with rs; auto. rewrite B.
+ rewrite <- (ireg_val ms sp rs); auto.
+ (* Oxorimm *)
+ exploit (makeimm_correct Peor Val.xor (ireg_of res) (ireg_of m0));
+ auto with ppcgen.
+ intros [rs' [A [B C]]].
+ exists rs'.
+ split. eauto.
+ apply agree_set_mireg_exten with rs; auto. rewrite B.
+ rewrite <- (ireg_val ms sp rs); auto.
+ (* Oshrximm *)
+ assert (exists n, ms m0 = Vint n /\ Int.ltu i (Int.repr 31) = true).
+ simpl in H1. destruct (ms m0); try discriminate.
+ exists i0; split; auto. destruct (Int.ltu i (Int.repr 31)); discriminate || auto.
+ destruct H3 as [n [ARG1 LTU]].
+ assert (LTU': Int.ltu i (Int.repr 32) = true).
+ exploit Int.ltu_inv. eexact LTU. intro.
+ unfold Int.ltu. apply zlt_true.
+ assert (Int.unsigned (Int.repr 31) < Int.unsigned (Int.repr 32)). vm_compute; auto.
+ omega.
+ assert (RSm0: rs (ireg_of m0) = Vint n).
+ rewrite <- ARG1. symmetry. eapply ireg_val; eauto.
+ set (islt := Int.lt n Int.zero).
+ set (rs1 := nextinstr (compare_int rs (Vint n) (Vint Int.zero))).
+ assert (OTH1: forall r', is_data_reg r' -> rs1#r' = rs#r').
+ generalize (compare_int_spec rs (Vint n) (Vint Int.zero)).
+ fold rs1. intros [A B]. intuition.
+ exploit (addimm_correct IR14 (ireg_of m0) (Int.sub (Int.shl Int.one i) Int.one)).
+ intros [rs2 [EXEC2 [RES2 OTH2]]].
+ set (rs3 := nextinstr (if islt then rs2 else rs2#IR14 <- (Vint n))).
+ set (rs4 := nextinstr (rs3#(ireg_of res) <- (Val.shr rs3#IR14 (Vint i)))).
+ exists rs4; split.
+ apply exec_straight_step with rs1 m.
+ simpl. rewrite RSm0. auto. auto.
+ eapply exec_straight_trans. eexact EXEC2.
+ apply exec_straight_two with rs3 m.
+ simpl. rewrite OTH2. change (rs1 CRge) with (Val.cmp Cge (Vint n) (Vint Int.zero)).
+ unfold Val.cmp. change (Int.cmp Cge n Int.zero) with (negb islt).
+ rewrite OTH2. rewrite OTH1. rewrite RSm0.
+ unfold rs3. case islt; reflexivity.
+ apply ireg_of_is_data_reg. decEq; auto with ppcgen. auto with ppcgen. congruence. congruence.
+ simpl. auto.
+ auto. unfold rs3. case islt; auto. auto.
+ (* agreement *)
+ assert (RES4: rs4#(ireg_of res) = Vint(Int.shrx n i)).
+ unfold rs4. rewrite nextinstr_inv; auto. rewrite Pregmap.gss.
+ rewrite Int.shrx_shr. fold islt. unfold rs3.
+ repeat rewrite nextinstr_inv; auto.
+ case islt. rewrite RES2. rewrite OTH1. rewrite RSm0.
+ simpl. rewrite LTU'. auto.
+ apply ireg_of_is_data_reg.
+ rewrite Pregmap.gss. simpl. rewrite LTU'. auto. congruence.
+ exact LTU. auto with ppcgen.
+ assert (OTH4: forall r, is_data_reg r -> r <> ireg_of res -> rs4#r = rs#r).
+ intros.
+ assert (r <> PC). red; intro; subst r; elim H3.
+ assert (r <> IR14). red; intro; subst r; elim H3.
+ unfold rs4. rewrite nextinstr_inv; auto. rewrite Pregmap.gso; auto.
+ unfold rs3. rewrite nextinstr_inv; auto.
+ transitivity (rs2 r).
+ case islt. auto. apply Pregmap.gso; auto.
+ rewrite OTH2; auto.
+ apply agree_exten_1 with (rs#(ireg_of res) <- (Val.shrx (ms m0) (Vint i))).
+ auto with ppcgen.
+ intros. unfold Pregmap.set. destruct (PregEq.eq r (ireg_of res)).
+ subst r. rewrite ARG1. simpl. rewrite LTU'. auto.
+ auto.
+ (* Ointoffloat *)
+ exists (nextinstr (rs#(ireg_of res) <- (Val.intoffloat (ms m0)))).
+ split. apply exec_straight_one.
+ repeat (rewrite (freg_val ms sp rs); auto).
+ reflexivity. auto with ppcgen.
+ (* Ointuoffloat *)
+ exists (nextinstr (rs#(ireg_of res) <- (Val.intuoffloat (ms m0)))).
+ split. apply exec_straight_one.
+ repeat (rewrite (freg_val ms sp rs); auto).
+ reflexivity. auto with ppcgen.
+ (* Ofloatofint *)
+ exists (nextinstr (rs#(freg_of res) <- (Val.floatofint (ms m0)))).
+ split. apply exec_straight_one.
+ repeat (rewrite (ireg_val ms sp rs); auto).
+ reflexivity. auto 10 with ppcgen.
+ (* Ofloatofintu *)
+ exists (nextinstr (rs#(freg_of res) <- (Val.floatofintu (ms m0)))).
+ split. apply exec_straight_one.
+ repeat (rewrite (ireg_val ms sp rs); auto).
+ reflexivity. auto 10 with ppcgen.
+ (* Ocmp *)
+ assert (exists b, eval_condition c ms##args m = Some b /\ v = Val.of_bool b).
+ simpl in H1. destruct (eval_condition c ms##args m).
+ destruct b; inv H1. exists true; auto. exists false; auto.
+ discriminate.
+ destruct H5 as [b [EVC EQ]].
+ exploit transl_cond_correct; eauto. intros [rs' [A [B C]]].
+ rewrite (eval_condition_weaken _ _ _ EVC).
+ set (rs1 := nextinstr (rs'#(ireg_of res) <- (Vint Int.zero))).
+ set (rs2 := nextinstr (if b then (rs1#(ireg_of res) <- Vtrue) else rs1)).
+ exists rs2; split.
+ eapply exec_straight_trans. eauto.
+ apply exec_straight_two with rs1 m; auto.
+ simpl. replace (rs1 (crbit_for_cond c)) with (Val.of_bool b).
+ unfold rs2. destruct b; auto.
+ unfold rs2. destruct b; auto.
+ apply agree_set_mireg_exten with rs'; auto.
+ unfold rs2. rewrite nextinstr_inv; auto with ppcgen.
+ destruct b. apply Pregmap.gss.
+ unfold rs1. rewrite nextinstr_inv; auto with ppcgen. apply Pregmap.gss.
+ intros. unfold rs2. rewrite nextinstr_inv; auto.
+ transitivity (rs1 r'). destruct b; auto. rewrite Pregmap.gso; auto.
+ unfold rs1. rewrite nextinstr_inv; auto. apply Pregmap.gso; auto.
+Qed.
+
+Remark val_add_add_zero:
+ forall v1 v2, Val.add v1 v2 = Val.add (Val.add v1 v2) (Vint Int.zero).
+Proof.
+ intros. destruct v1; destruct v2; simpl; auto; rewrite Int.add_zero; auto.
+Qed.
+
+Lemma transl_load_store_correct:
+ forall (mk_instr_imm: ireg -> int -> instruction)
+ (mk_instr_gen: option (ireg -> shift_addr -> instruction))
+ (is_immed: int -> bool)
+ addr args k ms sp rs m ms' m',
+ (forall (r1: ireg) (rs1: regset) n k,
+ eval_addressing_total sp addr (map ms args) = Val.add rs1#r1 (Vint n) ->
+ agree ms sp rs1 ->
+ exists rs',
+ exec_straight (mk_instr_imm r1 n :: k) rs1 m k rs' m' /\
+ agree ms' sp rs') ->
+ match mk_instr_gen with
+ | None => True
+ | Some mk =>
+ (forall (r1: ireg) (sa: shift_addr) (rs1: regset) k,
+ eval_addressing_total sp addr (map ms args) = Val.add rs1#r1 (eval_shift_addr sa rs1) ->
+ agree ms sp rs1 ->
+ exists rs',
+ exec_straight (mk r1 sa :: k) rs1 m k rs' m' /\
+ agree ms' sp rs')
+ end ->
+ agree ms sp rs ->
+ map mreg_type args = type_of_addressing addr ->
+ exists rs',
+ exec_straight (transl_load_store mk_instr_imm mk_instr_gen is_immed addr args k) rs m
+ k rs' m'
+ /\ agree ms' sp rs'.
+Proof.
+ intros. destruct addr; simpl in H2; TypeInv; simpl.
+ (* Aindexed *)
+ case (is_immed i).
+ (* Aindexed, small displacement *)
+ apply H; eauto. simpl. rewrite (ireg_val ms sp rs); auto.
+ (* Aindexed, large displacement *)
+ exploit (addimm_correct IR14 (ireg_of t)); eauto with ppcgen.
+ intros [rs' [A [B C]]].
+ exploit (H IR14 rs' Int.zero); eauto.
+ simpl. rewrite (ireg_val ms sp rs); auto. rewrite B.
+ rewrite Val.add_assoc. simpl Val.add. rewrite Int.add_zero. reflexivity.
+ apply agree_exten_2 with rs; auto.
+ intros [rs'' [D E]].
+ exists rs''; split.
+ eapply exec_straight_trans. eexact A. eexact D. auto.
+ (* Aindexed2 *)
+ destruct mk_instr_gen as [mk | ].
+ (* binary form available *)
+ apply H0; auto. simpl. repeat rewrite (ireg_val ms sp rs); auto.
+ (* binary form not available *)
+ set (rs' := nextinstr (rs#IR14 <- (Val.add (ms t) (ms t0)))).
+ exploit (H IR14 rs' Int.zero); eauto.
+ simpl. repeat rewrite (ireg_val ms sp rs); auto.
+ unfold rs'. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ repeat rewrite (ireg_val ms sp rs); auto. apply val_add_add_zero.
+ unfold rs'; auto with ppcgen.
+ intros [rs'' [A B]].
+ exists rs''; split.
+ eapply exec_straight_step with (rs2 := rs'); eauto.
+ simpl. repeat rewrite <- (ireg_val ms sp rs); auto.
+ auto.
+ (* Aindexed2shift *)
+ destruct mk_instr_gen as [mk | ].
+ (* binary form available *)
+ apply H0; auto. simpl. repeat rewrite (ireg_val ms sp rs); auto.
+ rewrite transl_shift_addr_correct. auto.
+ (* binary form not available *)
+ set (rs' := nextinstr (rs#IR14 <- (Val.add (ms t) (eval_shift_total s (ms t0))))).
+ exploit (H IR14 rs' Int.zero); eauto.
+ simpl. repeat rewrite (ireg_val ms sp rs); auto.
+ unfold rs'. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss.
+ repeat rewrite (ireg_val ms sp rs); auto. apply val_add_add_zero.
+ unfold rs'; auto with ppcgen.
+ intros [rs'' [A B]].
+ exists rs''; split.
+ eapply exec_straight_step with (rs2 := rs'); eauto.
+ simpl. rewrite transl_shift_correct.
+ repeat rewrite <- (ireg_val ms sp rs); auto.
+ auto.
+ (* Ainstack *)
+ destruct (is_immed i).
+ (* Ainstack, short displacement *)
+ apply H. simpl. rewrite (sp_val ms sp rs); auto. auto.
+ (* Ainstack, large displacement *)
+ exploit (addimm_correct IR14 IR13); eauto with ppcgen.
+ intros [rs' [A [B C]]].
+ exploit (H IR14 rs' Int.zero); eauto.
+ simpl. rewrite (sp_val ms sp rs); auto. rewrite B.
+ rewrite Val.add_assoc. simpl Val.add. rewrite Int.add_zero. reflexivity.
+ apply agree_exten_2 with rs; auto.
+ intros [rs'' [D E]].
+ exists rs''; split.
+ eapply exec_straight_trans. eexact A. eexact D. auto.
+Qed.
+
+Lemma transl_load_int_correct:
+ forall (mk_instr: ireg -> ireg -> shift_addr -> instruction)
+ (is_immed: int -> bool)
+ (rd: mreg) addr args k ms sp rs m chunk a v,
+ (forall (c: code) (r1 r2: ireg) (sa: shift_addr) (rs1: regset),
+ exec_instr ge c (mk_instr r1 r2 sa) rs1 m =
+ exec_load chunk (Val.add rs1#r2 (eval_shift_addr sa rs1)) r1 rs1 m) ->
+ agree ms sp rs ->
+ map mreg_type args = type_of_addressing addr ->
+ mreg_type rd = Tint ->
+ eval_addressing ge sp addr (map ms args) = Some a ->
+ Mem.loadv chunk m a = Some v ->
+ exists rs',
+ exec_straight (transl_load_store_int mk_instr is_immed rd addr args k) rs m
+ k rs' m
+ /\ agree (Regmap.set rd v ms) sp rs'.
+Proof.
+ intros. unfold transl_load_store_int.
+ exploit eval_addressing_weaken. eauto. intros.
+ apply transl_load_store_correct with ms; auto.
+ intros. exists (nextinstr (rs1#(ireg_of rd) <- v)); split.
+ apply exec_straight_one. rewrite H. simpl. rewrite <- H6. rewrite H5.
+ unfold exec_load. rewrite H4. auto. auto.
+ auto with ppcgen.
+ intros. exists (nextinstr (rs1#(ireg_of rd) <- v)); split.
+ apply exec_straight_one. rewrite H. simpl. rewrite <- H6. rewrite H5.
+ unfold exec_load. rewrite H4. auto. auto.
+ auto with ppcgen.
+Qed.
+
+Lemma transl_load_float_correct:
+ forall (mk_instr: freg -> ireg -> int -> instruction)
+ (is_immed: int -> bool)
+ (rd: mreg) addr args k ms sp rs m chunk a v,
+ (forall (c: code) (r1: freg) (r2: ireg) (n: int) (rs1: regset),
+ exec_instr ge c (mk_instr r1 r2 n) rs1 m =
+ exec_load chunk (Val.add rs1#r2 (Vint n)) r1 rs1 m) ->
+ agree ms sp rs ->
+ map mreg_type args = type_of_addressing addr ->
+ mreg_type rd = Tfloat ->
+ eval_addressing ge sp addr (map ms args) = Some a ->
+ Mem.loadv chunk m a = Some v ->
+ exists rs',
+ exec_straight (transl_load_store_float mk_instr is_immed rd addr args k) rs m
+ k rs' m
+ /\ agree (Regmap.set rd v ms) sp rs'.
+Proof.
+ intros. unfold transl_load_store_float.
+ exploit eval_addressing_weaken. eauto. intros.
+ apply transl_load_store_correct with ms; auto.
+ intros. exists (nextinstr (rs1#(freg_of rd) <- v)); split.
+ apply exec_straight_one. rewrite H. rewrite <- H6. rewrite H5.
+ unfold exec_load. rewrite H4. auto. auto.
+ auto with ppcgen.
+Qed.
+
+Lemma transl_store_int_correct:
+ forall (mk_instr: ireg -> ireg -> shift_addr -> instruction)
+ (is_immed: int -> bool)
+ (rd: mreg) addr args k ms sp rs m chunk a m',
+ (forall (c: code) (r1 r2: ireg) (sa: shift_addr) (rs1: regset),
+ exec_instr ge c (mk_instr r1 r2 sa) rs1 m =
+ exec_store chunk (Val.add rs1#r2 (eval_shift_addr sa rs1)) r1 rs1 m) ->
+ agree ms sp rs ->
+ map mreg_type args = type_of_addressing addr ->
+ mreg_type rd = Tint ->
+ eval_addressing ge sp addr (map ms args) = Some a ->
+ Mem.storev chunk m a (ms rd) = Some m' ->
+ exists rs',
+ exec_straight (transl_load_store_int mk_instr is_immed rd addr args k) rs m
+ k rs' m'
+ /\ agree ms sp rs'.
+Proof.
+ intros. unfold transl_load_store_int.
+ exploit eval_addressing_weaken. eauto. intros.
+ apply transl_load_store_correct with ms; auto.
+ intros. exists (nextinstr rs1); split.
+ apply exec_straight_one. rewrite H. simpl. rewrite <- H6. rewrite H5.
+ unfold exec_store. rewrite <- (ireg_val ms sp rs1); auto.
+ rewrite H4. auto. auto.
+ auto with ppcgen.
+ intros. exists (nextinstr rs1); split.
+ apply exec_straight_one. rewrite H. simpl. rewrite <- H6. rewrite H5.
+ unfold exec_store. rewrite <- (ireg_val ms sp rs1); auto.
+ rewrite H4. auto. auto.
+ auto with ppcgen.
+Qed.
+
+Lemma transl_store_float_correct:
+ forall (mk_instr: freg -> ireg -> int -> instruction)
+ (is_immed: int -> bool)
+ (rd: mreg) addr args k ms sp rs m chunk a m',
+ (forall (c: code) (r1: freg) (r2: ireg) (n: int) (rs1: regset),
+ exec_instr ge c (mk_instr r1 r2 n) rs1 m =
+ exec_store chunk (Val.add rs1#r2 (Vint n)) r1 rs1 m) ->
+ agree ms sp rs ->
+ map mreg_type args = type_of_addressing addr ->
+ mreg_type rd = Tfloat ->
+ eval_addressing ge sp addr (map ms args) = Some a ->
+ Mem.storev chunk m a (ms rd) = Some m' ->
+ exists rs',
+ exec_straight (transl_load_store_float mk_instr is_immed rd addr args k) rs m
+ k rs' m'
+ /\ agree ms sp rs'.
+Proof.
+ intros. unfold transl_load_store_float.
+ exploit eval_addressing_weaken. eauto. intros.
+ apply transl_load_store_correct with ms; auto.
+ intros. exists (nextinstr rs1); split.
+ apply exec_straight_one. rewrite H. simpl. rewrite <- H6. rewrite H5.
+ unfold exec_store. rewrite <- (freg_val ms sp rs1); auto.
+ rewrite H4. auto. auto.
+ auto with ppcgen.
+Qed.
+
+(** Translation of allocations *)
+
+Lemma transl_alloc_correct:
+ forall ms sp rs sz m m' blk k,
+ agree ms sp rs ->
+ ms Conventions.loc_alloc_argument = Vint sz ->
+ Mem.alloc m 0 (Int.signed sz) = (m', blk) ->
+ let ms' := Regmap.set Conventions.loc_alloc_result (Vptr blk Int.zero) ms in
+ exists rs',
+ exec_straight (Pallocblock :: k) rs m k rs' m'
+ /\ agree ms' sp rs'.
+Proof.
+ intros.
+ pose (rs' := nextinstr (rs#IR0 <- (Vptr blk Int.zero) #IR14 <- (Val.add rs#PC Vone))).
+ exists rs'; split.
+ apply exec_straight_one. unfold exec_instr.
+ generalize (preg_val _ _ _ Conventions.loc_alloc_argument H).
+ unfold preg_of; intro. simpl in H2. rewrite <- H2. rewrite H0.
+ rewrite H1. reflexivity.
+ reflexivity.
+ unfold ms', rs'. apply agree_nextinstr. apply agree_set_other.
+ change (IR IR0) with (preg_of Conventions.loc_alloc_result).
+ apply agree_set_mreg. auto.
+ simpl. tauto.
+Qed.
+
+End STRAIGHTLINE.
+
diff --git a/arm/Asmgenretaddr.v b/arm/Asmgenretaddr.v
new file mode 100644
index 0000000000000000000000000000000000000000..72d855a9911e0e9be851a5ef0f075df1233eeb6d
--- /dev/null
+++ b/arm/Asmgenretaddr.v
@@ -0,0 +1,201 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Predictor for return addresses in generated PPC code.
+
+ The [return_address_offset] predicate defined here is used in the
+ concrete semantics for Mach (module [Machconcr]) to determine the
+ return addresses that are stored in activation records. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Mem.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Locations.
+Require Import Mach.
+Require Import Asm.
+Require Import Asmgen.
+
+(** The ``code tail'' of an instruction list [c] is the list of instructions
+ starting at PC [pos]. *)
+
+Inductive code_tail: Z -> code -> code -> Prop :=
+ | code_tail_0: forall c,
+ code_tail 0 c c
+ | code_tail_S: forall pos i c1 c2,
+ code_tail pos c1 c2 ->
+ code_tail (pos + 1) (i :: c1) c2.
+
+Lemma code_tail_pos:
+ forall pos c1 c2, code_tail pos c1 c2 -> pos >= 0.
+Proof.
+ induction 1. omega. omega.
+Qed.
+
+(** Consider a Mach function [f] and a sequence [c] of Mach instructions
+ representing the Mach code that remains to be executed after a
+ function call returns. The predicate [return_address_offset f c ofs]
+ holds if [ofs] is the integer offset of the PPC instruction
+ following the call in the PPC code obtained by translating the
+ code of [f]. Graphically:
+<<
+ Mach function f |--------- Mcall ---------|
+ Mach code c | |--------|
+ | \ \
+ | \ \
+ | \ \
+ PPC code | |--------|
+ PPC function |--------------- Pbl ---------|
+
+ <-------- ofs ------->
+>>
+*)
+
+Inductive return_address_offset: Mach.function -> Mach.code -> int -> Prop :=
+ | return_address_offset_intro:
+ forall c f ofs,
+ code_tail ofs (transl_function f) (transl_code f c) ->
+ return_address_offset f c (Int.repr ofs).
+
+(** We now show that such an offset always exists if the Mach code [c]
+ is a suffix of [f.(fn_code)]. This holds because the translation
+ from Mach to PPC is compositional: each Mach instruction becomes
+ zero, one or several PPC instructions, but the order of instructions
+ is preserved. *)
+
+Lemma is_tail_code_tail:
+ forall c1 c2, is_tail c1 c2 -> exists ofs, code_tail ofs c2 c1.
+Proof.
+ induction 1. exists 0; constructor.
+ destruct IHis_tail as [ofs CT]. exists (ofs + 1); constructor; auto.
+Qed.
+
+Hint Resolve is_tail_refl: ppcretaddr.
+
+Ltac IsTail :=
+ auto with ppcretaddr;
+ match goal with
+ | [ |- is_tail _ (_ :: _) ] => constructor; IsTail
+ | [ |- is_tail _ (match ?x with true => _ | false => _ end) ] => destruct x; IsTail
+ | [ |- is_tail _ (match ?x with left _ => _ | right _ => _ end) ] => destruct x; IsTail
+ | [ |- is_tail _ (match ?x with nil => _ | _ :: _ => _ end) ] => destruct x; IsTail
+ | [ |- is_tail _ (match ?x with Tint => _ | Tfloat => _ end) ] => destruct x; IsTail
+ | [ |- is_tail _ (?f _ _ _ _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+ | [ |- is_tail _ (?f _ _ _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+ | [ |- is_tail _ (?f _ _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+ | [ |- is_tail _ (?f _ _ _ ?k) ] => apply is_tail_trans with k; IsTail
+ | [ |- is_tail _ (?f _ _ ?k) ] => apply is_tail_trans with k; IsTail
+ | _ => idtac
+ end.
+
+Lemma loadimm_tail:
+ forall r n k, is_tail k (loadimm r n k).
+Proof. unfold loadimm; intros; IsTail. Qed.
+Hint Resolve loadimm_tail: ppcretaddr.
+
+Lemma addimm_tail:
+ forall r1 r2 n k, is_tail k (addimm r1 r2 n k).
+Proof. unfold addimm; intros; IsTail. Qed.
+Hint Resolve addimm_tail: ppcretaddr.
+
+Lemma andimm_tail:
+ forall r1 r2 n k, is_tail k (andimm r1 r2 n k).
+Proof. unfold andimm; intros; IsTail. Qed.
+Hint Resolve andimm_tail: ppcretaddr.
+
+Lemma makeimm_tail:
+ forall f r1 r2 n k, is_tail k (makeimm f r1 r2 n k).
+Proof. unfold makeimm; intros; IsTail. Qed.
+Hint Resolve makeimm_tail: ppcretaddr.
+
+Lemma transl_cond_tail:
+ forall cond args k, is_tail k (transl_cond cond args k).
+Proof. unfold transl_cond; intros; destruct cond; IsTail. Qed.
+Hint Resolve transl_cond_tail: ppcretaddr.
+
+Lemma transl_op_tail:
+ forall op args r k, is_tail k (transl_op op args r k).
+Proof. unfold transl_op; intros; destruct op; IsTail. Qed.
+Hint Resolve transl_op_tail: ppcretaddr.
+
+Lemma transl_load_store_tail:
+ forall mk1 mk2 is_immed addr args k,
+ is_tail k (transl_load_store mk1 mk2 is_immed addr args k).
+Proof. unfold transl_load_store; intros; destruct addr; IsTail.
+ destruct mk2; IsTail. destruct mk2; IsTail. Qed.
+Hint Resolve transl_load_store_tail: ppcretaddr.
+
+Lemma transl_load_store_int_tail:
+ forall mk is_immed rd addr args k,
+ is_tail k (transl_load_store_int mk is_immed rd addr args k).
+Proof. unfold transl_load_store_int; intros; IsTail. Qed.
+Hint Resolve transl_load_store_int_tail: ppcretaddr.
+
+Lemma transl_load_store_float_tail:
+ forall mk is_immed rd addr args k,
+ is_tail k (transl_load_store_float mk is_immed rd addr args k).
+Proof. unfold transl_load_store_float; intros; IsTail. Qed.
+Hint Resolve transl_load_store_float_tail: ppcretaddr.
+
+Lemma loadind_int_tail:
+ forall base ofs dst k, is_tail k (loadind_int base ofs dst k).
+Proof. unfold loadind_int; intros; IsTail. Qed.
+Hint Resolve loadind_int_tail: ppcretaddr.
+
+Lemma loadind_tail:
+ forall base ofs ty dst k, is_tail k (loadind base ofs ty dst k).
+Proof. unfold loadind, loadind_float; intros; IsTail. Qed.
+Hint Resolve loadind_tail: ppcretaddr.
+
+Lemma storeind_int_tail:
+ forall src base ofs k, is_tail k (storeind_int src base ofs k).
+Proof. unfold storeind_int; intros; IsTail. Qed.
+Hint Resolve storeind_int_tail: ppcretaddr.
+
+Lemma storeind_tail:
+ forall src base ofs ty k, is_tail k (storeind src base ofs ty k).
+Proof. unfold storeind, storeind_float; intros; IsTail. Qed.
+Hint Resolve storeind_tail: ppcretaddr.
+
+Lemma transl_instr_tail:
+ forall f i k, is_tail k (transl_instr f i k).
+Proof.
+ unfold transl_instr; intros; destruct i; IsTail.
+ destruct m; IsTail.
+ destruct m; IsTail.
+ destruct s0; IsTail.
+ destruct s0; IsTail.
+Qed.
+Hint Resolve transl_instr_tail: ppcretaddr.
+
+Lemma transl_code_tail:
+ forall f c1 c2, is_tail c1 c2 -> is_tail (transl_code f c1) (transl_code f c2).
+Proof.
+ induction 1; simpl. constructor. eapply is_tail_trans; eauto with ppcretaddr.
+Qed.
+
+Lemma return_address_exists:
+ forall f c, is_tail c f.(fn_code) ->
+ exists ra, return_address_offset f c ra.
+Proof.
+ intros. assert (is_tail (transl_code f c) (transl_function f)).
+ unfold transl_function. IsTail. apply transl_code_tail; auto.
+ destruct (is_tail_code_tail _ _ H0) as [ofs A].
+ exists (Int.repr ofs). constructor. auto.
+Qed.
+
+
diff --git a/arm/Constprop.v b/arm/Constprop.v
new file mode 100644
index 0000000000000000000000000000000000000000..7369012c3427733ffd424c4b072315070aad8ea3
--- /dev/null
+++ b/arm/Constprop.v
@@ -0,0 +1,1254 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Constant propagation over RTL. This is the first of the two
+ optimizations performed at RTL level. It proceeds by a standard
+ dataflow analysis and the corresponding code transformation. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Globalenvs.
+Require Import Op.
+Require Import Registers.
+Require Import RTL.
+Require Import Lattice.
+Require Import Kildall.
+
+(** * Static analysis *)
+
+(** To each pseudo-register at each program point, the static analysis
+ associates a compile-time approximation taken from the following set. *)
+
+Inductive approx : Set :=
+ | Novalue: approx (** No value possible, code is unreachable. *)
+ | Unknown: approx (** All values are possible,
+ no compile-time information is available. *)
+ | I: int -> approx (** A known integer value. *)
+ | F: float -> approx (** A known floating-point value. *)
+ | S: ident -> int -> approx.
+ (** The value is the address of the given global
+ symbol plus the given integer offset. *)
+
+(** We equip this set of approximations with a semi-lattice structure.
+ The ordering is inclusion between the sets of values denoted by
+ the approximations. *)
+
+Module Approx <: SEMILATTICE_WITH_TOP.
+ Definition t := approx.
+ Definition eq (x y: t) := (x = y).
+ Definition eq_refl: forall x, eq x x := (@refl_equal t).
+ Definition eq_sym: forall x y, eq x y -> eq y x := (@sym_equal t).
+ Definition eq_trans: forall x y z, eq x y -> eq y z -> eq x z := (@trans_equal t).
+ Lemma eq_dec: forall (x y: t), {x=y} + {x<>y}.
+ Proof.
+ decide equality.
+ apply Int.eq_dec.
+ apply Float.eq_dec.
+ apply Int.eq_dec.
+ apply ident_eq.
+ Qed.
+ Definition beq (x y: t) := if eq_dec x y then true else false.
+ Lemma beq_correct: forall x y, beq x y = true -> x = y.
+ Proof.
+ unfold beq; intros. destruct (eq_dec x y). auto. congruence.
+ Qed.
+ Definition ge (x y: t) : Prop :=
+ x = Unknown \/ y = Novalue \/ x = y.
+ Lemma ge_refl: forall x y, eq x y -> ge x y.
+ Proof.
+ unfold eq, ge; tauto.
+ Qed.
+ Lemma ge_trans: forall x y z, ge x y -> ge y z -> ge x z.
+ Proof.
+ unfold ge; intuition congruence.
+ Qed.
+ Lemma ge_compat: forall x x' y y', eq x x' -> eq y y' -> ge x y -> ge x' y'.
+ Proof.
+ unfold eq, ge; intros; congruence.
+ Qed.
+ Definition bot := Novalue.
+ Definition top := Unknown.
+ Lemma ge_bot: forall x, ge x bot.
+ Proof.
+ unfold ge, bot; tauto.
+ Qed.
+ Lemma ge_top: forall x, ge top x.
+ Proof.
+ unfold ge, bot; tauto.
+ Qed.
+ Definition lub (x y: t) : t :=
+ if eq_dec x y then x else
+ match x, y with
+ | Novalue, _ => y
+ | _, Novalue => x
+ | _, _ => Unknown
+ end.
+ Lemma lub_commut: forall x y, eq (lub x y) (lub y x).
+ Proof.
+ unfold lub, eq; intros.
+ case (eq_dec x y); case (eq_dec y x); intros; try congruence.
+ destruct x; destruct y; auto.
+ Qed.
+ Lemma ge_lub_left: forall x y, ge (lub x y) x.
+ Proof.
+ unfold lub; intros.
+ case (eq_dec x y); intro.
+ apply ge_refl. apply eq_refl.
+ destruct x; destruct y; unfold ge; tauto.
+ Qed.
+End Approx.
+
+Module D := LPMap Approx.
+
+(** We now define the abstract interpretations of conditions and operators
+ over this set of approximations. For instance, the abstract interpretation
+ of the operator [Oaddf] applied to two expressions [a] and [b] is
+ [F(Float.add f g)] if [a] and [b] have static approximations [F f]
+ and [F g] respectively, and [Unknown] otherwise.
+
+ The static approximations are defined by large pattern-matchings over
+ the approximations of the results. We write these matchings in the
+ indirect style described in file [Selection] to avoid excessive
+ duplication of cases in proofs. *)
+
+(*
+Definition eval_static_condition (cond: condition) (vl: list approx) :=
+ match cond, vl with
+ | Ccomp c, I n1 :: I n2 :: nil => Some(Int.cmp c n1 n2)
+ | Ccompu c, I n1 :: I n2 :: nil => Some(Int.cmpu c n1 n2)
+ | Ccompshift c s, I n1 :: I n2 :: nil => Some(Int.cmp c n1 (eval_shift s n2))
+ | Ccompushift c s, I n1 :: I n2 :: nil => Some(Int.cmpu c n1 (eval_shift s n2))
+ | Ccompimm c n, I n1 :: nil => Some(Int.cmp c n1 n)
+ | Ccompuimm c n, I n1 :: nil => Some(Int.cmpu c n1 n)
+ | Ccompf c, F n1 :: F n2 :: nil => Some(Float.cmp c n1 n2)
+ | Cnotcompf c, F n1 :: F n2 :: nil => Some(negb(Float.cmp c n1 n2))
+ | _, _ => None
+ end.
+*)
+
+Inductive eval_static_condition_cases: forall (cond: condition) (vl: list approx), Set :=
+ | eval_static_condition_case1:
+ forall c n1 n2,
+ eval_static_condition_cases (Ccomp c) (I n1 :: I n2 :: nil)
+ | eval_static_condition_case2:
+ forall c n1 n2,
+ eval_static_condition_cases (Ccompu c) (I n1 :: I n2 :: nil)
+ | eval_static_condition_case3:
+ forall c s n1 n2,
+ eval_static_condition_cases (Ccompshift c s) (I n1 :: I n2 :: nil)
+ | eval_static_condition_case4:
+ forall c s n1 n2,
+ eval_static_condition_cases (Ccompushift c s) (I n1 :: I n2 :: nil)
+ | eval_static_condition_case5:
+ forall c n n1,
+ eval_static_condition_cases (Ccompimm c n) (I n1 :: nil)
+ | eval_static_condition_case6:
+ forall c n n1,
+ eval_static_condition_cases (Ccompuimm c n) (I n1 :: nil)
+ | eval_static_condition_case7:
+ forall c n1 n2,
+ eval_static_condition_cases (Ccompf c) (F n1 :: F n2 :: nil)
+ | eval_static_condition_case8:
+ forall c n1 n2,
+ eval_static_condition_cases (Cnotcompf c) (F n1 :: F n2 :: nil)
+ | eval_static_condition_default:
+ forall (cond: condition) (vl: list approx),
+ eval_static_condition_cases cond vl.
+
+Definition eval_static_condition_match (cond: condition) (vl: list approx) :=
+ match cond as z1, vl as z2 return eval_static_condition_cases z1 z2 with
+ | Ccomp c, I n1 :: I n2 :: nil =>
+ eval_static_condition_case1 c n1 n2
+ | Ccompu c, I n1 :: I n2 :: nil =>
+ eval_static_condition_case2 c n1 n2
+ | Ccompshift c s, I n1 :: I n2 :: nil =>
+ eval_static_condition_case3 c s n1 n2
+ | Ccompushift c s, I n1 :: I n2 :: nil =>
+ eval_static_condition_case4 c s n1 n2
+ | Ccompimm c n, I n1 :: nil =>
+ eval_static_condition_case5 c n n1
+ | Ccompuimm c n, I n1 :: nil =>
+ eval_static_condition_case6 c n n1
+ | Ccompf c, F n1 :: F n2 :: nil =>
+ eval_static_condition_case7 c n1 n2
+ | Cnotcompf c, F n1 :: F n2 :: nil =>
+ eval_static_condition_case8 c n1 n2
+ | cond, vl =>
+ eval_static_condition_default cond vl
+ end.
+
+Definition eval_static_condition (cond: condition) (vl: list approx) :=
+ match eval_static_condition_match cond vl with
+ | eval_static_condition_case1 c n1 n2 =>
+ Some(Int.cmp c n1 n2)
+ | eval_static_condition_case2 c n1 n2 =>
+ Some(Int.cmpu c n1 n2)
+ | eval_static_condition_case3 c s n1 n2 =>
+ Some(Int.cmp c n1 (eval_shift s n2))
+ | eval_static_condition_case4 c s n1 n2 =>
+ Some(Int.cmpu c n1 (eval_shift s n2))
+ | eval_static_condition_case5 c n n1 =>
+ Some(Int.cmp c n1 n)
+ | eval_static_condition_case6 c n n1 =>
+ Some(Int.cmpu c n1 n)
+ | eval_static_condition_case7 c n1 n2 =>
+ Some(Float.cmp c n1 n2)
+ | eval_static_condition_case8 c n1 n2 =>
+ Some(negb(Float.cmp c n1 n2))
+ | eval_static_condition_default cond vl =>
+ None
+ end.
+
+(*
+Definition eval_static_operation (op: operation) (vl: list approx) :=
+ match op, vl with
+ | Omove, v1::nil => v1
+ | Ointconst n, nil => I n
+ | Ofloatconst n, nil => F n
+ | Oaddrsymbol s n, nil => S s n
+ | Ocast8signed, I n1 :: nil => I(Int.sign_ext 8 n)
+ | Ocast8unsigned, I n1 :: nil => I(Int.zero_ext 8 n)
+ | Ocast16signed, I n1 :: nil => I(Int.sign_ext 16 n)
+ | Ocast16unsigned, I n1 :: nil => I(Int.zero_ext 16 n)
+ | Oadd, I n1 :: I n2 :: nil => I(Int.add n1 n2)
+ | Oaddshift s, I n1 :: I n2 :: nil => I(Int.add n1 (eval_shift s n2))
+ | Oadd, S s1 n1 :: I n2 :: nil => S s1 (Int.add n1 n2)
+ | Oaddshift s, S s1 n1 :: I n2 :: nil => S s1 (Int.add n1 (eval_shift s n2))
+ | Oaddimm n, I n1 :: nil => I (Int.add n1 n)
+ | Oaddimm n, S s1 n1 :: nil => S s1 (Int.add n1 n)
+ | Osub, I n1 :: I n2 :: nil => I(Int.sub n1 n2)
+ | Osubshift s, I n1 :: I n2 :: nil => I(Int.sub n1 (eval_shift s n2))
+ | Osub, S s1 n1 :: I n2 :: nil => S s1 (Int.sub n1 n2)
+ | Osubshift s, S s1 n1 :: I n2 :: nil => S s1 (Int.sub n1 (eval_shift s n2))
+ | Orsubshift s, I n1 :: I n2 :: nil => I(Int.sub (eval_shift s n2) n1)
+ | Orsubimm n, I n1 :: nil => I (Int.sub n n1)
+ | Omul, I n1 :: I n2 :: nil => I(Int.mul n1 n2)
+ | Odiv, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2)
+ | Odivu, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2)
+ | Oand, I n1 :: I n2 :: nil => I(Int.and n1 n2)
+ | Oandshift s, I n1 :: I n2 :: nil => I(Int.and n1 (eval_shift s n2))
+ | Oandimm n, I n1 :: nil => I(Int.and n1 n)
+ | Oor, I n1 :: I n2 :: nil => I(Int.or n1 n2)
+ | Oorshift s, I n1 :: I n2 :: nil => I(Int.or n1 (eval_shift s n2))
+ | Oorimm n, I n1 :: nil => I(Int.or n1 n)
+ | Oxor, I n1 :: I n2 :: nil => I(Int.xor n1 n2)
+ | Oxorshift s, I n1 :: I n2 :: nil => I(Int.xor n1 (eval_shift s n2))
+ | Oxorimm n, I n1 :: nil => I(Int.xor n1 n)
+ | Obic, I n1 :: I n2 :: nil => I(Int.and n1 (Int.not n2))
+ | Obicshift s, I n1 :: I n2 :: nil => I(Int.and n1 (Int.not (eval_shift s n2)))
+ | Onot, I n1 :: nil => I(Int.not n1)
+ | Onotshift s, I n1 :: nil => I(Int.not (eval_shift s n1))
+ | Oshl, I n1 :: I n2 :: nil => if Int.ltu n2 (Int.repr 32) then I(Int.shl n1 n2) else Unknown
+ | Oshr, I n1 :: I n2 :: nil => if Int.ltu n2 (Int.repr 32) then I(Int.shr n1 n2) else Unknown
+ | Oshru, I n1 :: I n2 :: nil => if Int.ltu n2 (Int.repr 32) then I(Int.shru n1 n2) else Unknown
+ | Oshift s, I n1 :: nil => I(eval_shift s n1)
+ | Onegf, F n1 :: nil => F(Float.neg n1)
+ | Oabsf, F n1 :: nil => F(Float.abs n1)
+ | Oaddf, F n1 :: F n2 :: nil => F(Float.add n1 n2)
+ | Osubf, F n1 :: F n2 :: nil => F(Float.sub n1 n2)
+ | Omulf, F n1 :: F n2 :: nil => F(Float.mul n1 n2)
+ | Odivf, F n1 :: F n2 :: nil => F(Float.div n1 n2)
+ | Osingleoffloat, F n1 :: nil => F(Float.singleoffloat n1)
+ | Ointoffloat, F n1 :: nil => I(Float.intoffloat n1)
+ | Ofloatofint, I n1 :: nil => F(Float.floatofint n1)
+ | Ofloatofintu, I n1 :: nil => F(Float.floatofintu n1)
+ | Ocmp c, vl =>
+ match eval_static_condition c vl with
+ | None => Unknown
+ | Some b => I(if b then Int.one else Int.zero)
+ end
+ | _, _ => Unknown
+ end.
+*)
+
+Inductive eval_static_operation_cases: forall (op: operation) (vl: list approx), Set :=
+ | eval_static_operation_case1:
+ forall v1,
+ eval_static_operation_cases (Omove) (v1::nil)
+ | eval_static_operation_case2:
+ forall n,
+ eval_static_operation_cases (Ointconst n) (nil)
+ | eval_static_operation_case3:
+ forall n,
+ eval_static_operation_cases (Ofloatconst n) (nil)
+ | eval_static_operation_case4:
+ forall s n,
+ eval_static_operation_cases (Oaddrsymbol s n) (nil)
+ | eval_static_operation_case5:
+ forall n1,
+ eval_static_operation_cases (Ocast8signed) (I n1 :: nil)
+ | eval_static_operation_case6:
+ forall n1,
+ eval_static_operation_cases (Ocast8unsigned) (I n1 :: nil)
+ | eval_static_operation_case7:
+ forall n1,
+ eval_static_operation_cases (Ocast16signed) (I n1 :: nil)
+ | eval_static_operation_case8:
+ forall n1,
+ eval_static_operation_cases (Ocast16unsigned) (I n1 :: nil)
+ | eval_static_operation_case9:
+ forall n1 n2,
+ eval_static_operation_cases (Oadd) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case10:
+ forall s n1 n2,
+ eval_static_operation_cases (Oaddshift s) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case11:
+ forall s1 n1 n2,
+ eval_static_operation_cases (Oadd) (S s1 n1 :: I n2 :: nil)
+ | eval_static_operation_case12:
+ forall s s1 n1 n2,
+ eval_static_operation_cases (Oaddshift s) (S s1 n1 :: I n2 :: nil)
+ | eval_static_operation_case13:
+ forall n n1,
+ eval_static_operation_cases (Oaddimm n) (I n1 :: nil)
+ | eval_static_operation_case14:
+ forall n s1 n1,
+ eval_static_operation_cases (Oaddimm n) (S s1 n1 :: nil)
+ | eval_static_operation_case15:
+ forall n1 n2,
+ eval_static_operation_cases (Osub) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case16:
+ forall s n1 n2,
+ eval_static_operation_cases (Osubshift s) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case17:
+ forall s1 n1 n2,
+ eval_static_operation_cases (Osub) (S s1 n1 :: I n2 :: nil)
+ | eval_static_operation_case18:
+ forall s s1 n1 n2,
+ eval_static_operation_cases (Osubshift s) (S s1 n1 :: I n2 :: nil)
+ | eval_static_operation_case19:
+ forall s n1 n2,
+ eval_static_operation_cases (Orsubshift s) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case20:
+ forall n n1,
+ eval_static_operation_cases (Orsubimm n) (I n1 :: nil)
+ | eval_static_operation_case21:
+ forall n1 n2,
+ eval_static_operation_cases (Omul) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case22:
+ forall n1 n2,
+ eval_static_operation_cases (Odiv) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case23:
+ forall n1 n2,
+ eval_static_operation_cases (Odivu) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case24:
+ forall n1 n2,
+ eval_static_operation_cases (Oand) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case25:
+ forall s n1 n2,
+ eval_static_operation_cases (Oandshift s) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case26:
+ forall n n1,
+ eval_static_operation_cases (Oandimm n) (I n1 :: nil)
+ | eval_static_operation_case27:
+ forall n1 n2,
+ eval_static_operation_cases (Oor) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case28:
+ forall s n1 n2,
+ eval_static_operation_cases (Oorshift s) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case29:
+ forall n n1,
+ eval_static_operation_cases (Oorimm n) (I n1 :: nil)
+ | eval_static_operation_case30:
+ forall n1 n2,
+ eval_static_operation_cases (Oxor) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case31:
+ forall s n1 n2,
+ eval_static_operation_cases (Oxorshift s) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case32:
+ forall n n1,
+ eval_static_operation_cases (Oxorimm n) (I n1 :: nil)
+ | eval_static_operation_case33:
+ forall n1 n2,
+ eval_static_operation_cases (Obic) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case34:
+ forall s n1 n2,
+ eval_static_operation_cases (Obicshift s) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case35:
+ forall n1,
+ eval_static_operation_cases (Onot) (I n1 :: nil)
+ | eval_static_operation_case36:
+ forall s n1,
+ eval_static_operation_cases (Onotshift s) (I n1 :: nil)
+ | eval_static_operation_case37:
+ forall n1 n2,
+ eval_static_operation_cases (Oshl) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case38:
+ forall n1 n2,
+ eval_static_operation_cases (Oshr) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case39:
+ forall n1 n2,
+ eval_static_operation_cases (Oshru) (I n1 :: I n2 :: nil)
+ | eval_static_operation_case40:
+ forall s n1,
+ eval_static_operation_cases (Oshift s) (I n1 :: nil)
+ | eval_static_operation_case41:
+ forall n1,
+ eval_static_operation_cases (Onegf) (F n1 :: nil)
+ | eval_static_operation_case42:
+ forall n1,
+ eval_static_operation_cases (Oabsf) (F n1 :: nil)
+ | eval_static_operation_case43:
+ forall n1 n2,
+ eval_static_operation_cases (Oaddf) (F n1 :: F n2 :: nil)
+ | eval_static_operation_case44:
+ forall n1 n2,
+ eval_static_operation_cases (Osubf) (F n1 :: F n2 :: nil)
+ | eval_static_operation_case45:
+ forall n1 n2,
+ eval_static_operation_cases (Omulf) (F n1 :: F n2 :: nil)
+ | eval_static_operation_case46:
+ forall n1 n2,
+ eval_static_operation_cases (Odivf) (F n1 :: F n2 :: nil)
+ | eval_static_operation_case47:
+ forall n1,
+ eval_static_operation_cases (Osingleoffloat) (F n1 :: nil)
+ | eval_static_operation_case48:
+ forall n1,
+ eval_static_operation_cases (Ointoffloat) (F n1 :: nil)
+ | eval_static_operation_case49:
+ forall n1,
+ eval_static_operation_cases (Ofloatofint) (I n1 :: nil)
+ | eval_static_operation_case50:
+ forall n1,
+ eval_static_operation_cases (Ofloatofintu) (I n1 :: nil)
+ | eval_static_operation_case51:
+ forall c vl,
+ eval_static_operation_cases (Ocmp c) (vl)
+ | eval_static_operation_case52:
+ forall n n1,
+ eval_static_operation_cases (Oshrximm n) (I n1 :: nil)
+ | eval_static_operation_default:
+ forall (op: operation) (vl: list approx),
+ eval_static_operation_cases op vl.
+
+Definition eval_static_operation_match (op: operation) (vl: list approx) :=
+ match op as z1, vl as z2 return eval_static_operation_cases z1 z2 with
+ | Omove, v1::nil =>
+ eval_static_operation_case1 v1
+ | Ointconst n, nil =>
+ eval_static_operation_case2 n
+ | Ofloatconst n, nil =>
+ eval_static_operation_case3 n
+ | Oaddrsymbol s n, nil =>
+ eval_static_operation_case4 s n
+ | Ocast8signed, I n1 :: nil =>
+ eval_static_operation_case5 n1
+ | Ocast8unsigned, I n1 :: nil =>
+ eval_static_operation_case6 n1
+ | Ocast16signed, I n1 :: nil =>
+ eval_static_operation_case7 n1
+ | Ocast16unsigned, I n1 :: nil =>
+ eval_static_operation_case8 n1
+ | Oadd, I n1 :: I n2 :: nil =>
+ eval_static_operation_case9 n1 n2
+ | Oaddshift s, I n1 :: I n2 :: nil =>
+ eval_static_operation_case10 s n1 n2
+ | Oadd, S s1 n1 :: I n2 :: nil =>
+ eval_static_operation_case11 s1 n1 n2
+ | Oaddshift s, S s1 n1 :: I n2 :: nil =>
+ eval_static_operation_case12 s s1 n1 n2
+ | Oaddimm n, I n1 :: nil =>
+ eval_static_operation_case13 n n1
+ | Oaddimm n, S s1 n1 :: nil =>
+ eval_static_operation_case14 n s1 n1
+ | Osub, I n1 :: I n2 :: nil =>
+ eval_static_operation_case15 n1 n2
+ | Osubshift s, I n1 :: I n2 :: nil =>
+ eval_static_operation_case16 s n1 n2
+ | Osub, S s1 n1 :: I n2 :: nil =>
+ eval_static_operation_case17 s1 n1 n2
+ | Osubshift s, S s1 n1 :: I n2 :: nil =>
+ eval_static_operation_case18 s s1 n1 n2
+ | Orsubshift s, I n1 :: I n2 :: nil =>
+ eval_static_operation_case19 s n1 n2
+ | Orsubimm n, I n1 :: nil =>
+ eval_static_operation_case20 n n1
+ | Omul, I n1 :: I n2 :: nil =>
+ eval_static_operation_case21 n1 n2
+ | Odiv, I n1 :: I n2 :: nil =>
+ eval_static_operation_case22 n1 n2
+ | Odivu, I n1 :: I n2 :: nil =>
+ eval_static_operation_case23 n1 n2
+ | Oand, I n1 :: I n2 :: nil =>
+ eval_static_operation_case24 n1 n2
+ | Oandshift s, I n1 :: I n2 :: nil =>
+ eval_static_operation_case25 s n1 n2
+ | Oandimm n, I n1 :: nil =>
+ eval_static_operation_case26 n n1
+ | Oor, I n1 :: I n2 :: nil =>
+ eval_static_operation_case27 n1 n2
+ | Oorshift s, I n1 :: I n2 :: nil =>
+ eval_static_operation_case28 s n1 n2
+ | Oorimm n, I n1 :: nil =>
+ eval_static_operation_case29 n n1
+ | Oxor, I n1 :: I n2 :: nil =>
+ eval_static_operation_case30 n1 n2
+ | Oxorshift s, I n1 :: I n2 :: nil =>
+ eval_static_operation_case31 s n1 n2
+ | Oxorimm n, I n1 :: nil =>
+ eval_static_operation_case32 n n1
+ | Obic, I n1 :: I n2 :: nil =>
+ eval_static_operation_case33 n1 n2
+ | Obicshift s, I n1 :: I n2 :: nil =>
+ eval_static_operation_case34 s n1 n2
+ | Onot, I n1 :: nil =>
+ eval_static_operation_case35 n1
+ | Onotshift s, I n1 :: nil =>
+ eval_static_operation_case36 s n1
+ | Oshl, I n1 :: I n2 :: nil =>
+ eval_static_operation_case37 n1 n2
+ | Oshr, I n1 :: I n2 :: nil =>
+ eval_static_operation_case38 n1 n2
+ | Oshru, I n1 :: I n2 :: nil =>
+ eval_static_operation_case39 n1 n2
+ | Oshift s, I n1 :: nil =>
+ eval_static_operation_case40 s n1
+ | Onegf, F n1 :: nil =>
+ eval_static_operation_case41 n1
+ | Oabsf, F n1 :: nil =>
+ eval_static_operation_case42 n1
+ | Oaddf, F n1 :: F n2 :: nil =>
+ eval_static_operation_case43 n1 n2
+ | Osubf, F n1 :: F n2 :: nil =>
+ eval_static_operation_case44 n1 n2
+ | Omulf, F n1 :: F n2 :: nil =>
+ eval_static_operation_case45 n1 n2
+ | Odivf, F n1 :: F n2 :: nil =>
+ eval_static_operation_case46 n1 n2
+ | Osingleoffloat, F n1 :: nil =>
+ eval_static_operation_case47 n1
+ | Ointoffloat, F n1 :: nil =>
+ eval_static_operation_case48 n1
+ | Ofloatofint, I n1 :: nil =>
+ eval_static_operation_case49 n1
+ | Ofloatofintu, I n1 :: nil =>
+ eval_static_operation_case50 n1
+ | Ocmp c, vl =>
+ eval_static_operation_case51 c vl
+ | Oshrximm n, I n1 :: nil =>
+ eval_static_operation_case52 n n1
+ | op, vl =>
+ eval_static_operation_default op vl
+ end.
+
+Definition eval_static_operation (op: operation) (vl: list approx) :=
+ match eval_static_operation_match op vl with
+ | eval_static_operation_case1 v1 =>
+ v1
+ | eval_static_operation_case2 n =>
+ I n
+ | eval_static_operation_case3 n =>
+ F n
+ | eval_static_operation_case4 s n =>
+ S s n
+ | eval_static_operation_case5 n =>
+ I(Int.sign_ext 8 n)
+ | eval_static_operation_case6 n =>
+ I(Int.zero_ext 8 n)
+ | eval_static_operation_case7 n =>
+ I(Int.sign_ext 16 n)
+ | eval_static_operation_case8 n =>
+ I(Int.zero_ext 16 n)
+ | eval_static_operation_case9 n1 n2 =>
+ I(Int.add n1 n2)
+ | eval_static_operation_case10 s n1 n2 =>
+ I(Int.add n1 (eval_shift s n2))
+ | eval_static_operation_case11 s1 n1 n2 =>
+ S s1 (Int.add n1 n2)
+ | eval_static_operation_case12 s s1 n1 n2 =>
+ S s1 (Int.add n1 (eval_shift s n2))
+ | eval_static_operation_case13 n n1 =>
+ I (Int.add n1 n)
+ | eval_static_operation_case14 n s1 n1 =>
+ S s1 (Int.add n1 n)
+ | eval_static_operation_case15 n1 n2 =>
+ I(Int.sub n1 n2)
+ | eval_static_operation_case16 s n1 n2 =>
+ I(Int.sub n1 (eval_shift s n2))
+ | eval_static_operation_case17 s1 n1 n2 =>
+ S s1 (Int.sub n1 n2)
+ | eval_static_operation_case18 s s1 n1 n2 =>
+ S s1 (Int.sub n1 (eval_shift s n2))
+ | eval_static_operation_case19 s n1 n2 =>
+ I(Int.sub (eval_shift s n2) n1)
+ | eval_static_operation_case20 n n1 =>
+ I (Int.sub n n1)
+ | eval_static_operation_case21 n1 n2 =>
+ I(Int.mul n1 n2)
+ | eval_static_operation_case22 n1 n2 =>
+ if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2)
+ | eval_static_operation_case23 n1 n2 =>
+ if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2)
+ | eval_static_operation_case24 n1 n2 =>
+ I(Int.and n1 n2)
+ | eval_static_operation_case25 s n1 n2 =>
+ I(Int.and n1 (eval_shift s n2))
+ | eval_static_operation_case26 n n1 =>
+ I(Int.and n1 n)
+ | eval_static_operation_case27 n1 n2 =>
+ I(Int.or n1 n2)
+ | eval_static_operation_case28 s n1 n2 =>
+ I(Int.or n1 (eval_shift s n2))
+ | eval_static_operation_case29 n n1 =>
+ I(Int.or n1 n)
+ | eval_static_operation_case30 n1 n2 =>
+ I(Int.xor n1 n2)
+ | eval_static_operation_case31 s n1 n2 =>
+ I(Int.xor n1 (eval_shift s n2))
+ | eval_static_operation_case32 n n1 =>
+ I(Int.xor n1 n)
+ | eval_static_operation_case33 n1 n2 =>
+ I(Int.and n1 (Int.not n2))
+ | eval_static_operation_case34 s n1 n2 =>
+ I(Int.and n1 (Int.not (eval_shift s n2)))
+ | eval_static_operation_case35 n1 =>
+ I(Int.not n1)
+ | eval_static_operation_case36 s n1 =>
+ I(Int.not (eval_shift s n1))
+ | eval_static_operation_case37 n1 n2 =>
+ if Int.ltu n2 (Int.repr 32) then I(Int.shl n1 n2) else Unknown
+ | eval_static_operation_case38 n1 n2 =>
+ if Int.ltu n2 (Int.repr 32) then I(Int.shr n1 n2) else Unknown
+ | eval_static_operation_case39 n1 n2 =>
+ if Int.ltu n2 (Int.repr 32) then I(Int.shru n1 n2) else Unknown
+ | eval_static_operation_case40 s n1 =>
+ I(eval_shift s n1)
+ | eval_static_operation_case41 n1 =>
+ F(Float.neg n1)
+ | eval_static_operation_case42 n1 =>
+ F(Float.abs n1)
+ | eval_static_operation_case43 n1 n2 =>
+ F(Float.add n1 n2)
+ | eval_static_operation_case44 n1 n2 =>
+ F(Float.sub n1 n2)
+ | eval_static_operation_case45 n1 n2 =>
+ F(Float.mul n1 n2)
+ | eval_static_operation_case46 n1 n2 =>
+ F(Float.div n1 n2)
+ | eval_static_operation_case47 n1 =>
+ F(Float.singleoffloat n1)
+ | eval_static_operation_case48 n1 =>
+ I(Float.intoffloat n1)
+ | eval_static_operation_case49 n1 =>
+ F(Float.floatofint n1)
+ | eval_static_operation_case50 n1 =>
+ F(Float.floatofintu n1)
+ | eval_static_operation_case51 c vl =>
+ match eval_static_condition c vl with
+ | None => Unknown
+ | Some b => I(if b then Int.one else Int.zero)
+ end
+ | eval_static_operation_case52 n n1 =>
+ if Int.ltu n (Int.repr 31) then I(Int.shrx n1 n) else Unknown
+ | eval_static_operation_default op vl =>
+ Unknown
+ end.
+
+
+(** The transfer function for the dataflow analysis is straightforward:
+ for [Iop] instructions, we set the approximation of the destination
+ register to the result of executing abstractly the operation;
+ for [Iload] and [Icall], we set the approximation of the destination
+ to [Unknown]. *)
+
+Definition approx_regs (rl: list reg) (approx: D.t) :=
+ List.map (fun r => D.get r approx) rl.
+
+Definition transfer (f: function) (pc: node) (before: D.t) :=
+ match f.(fn_code)!pc with
+ | None => before
+ | Some i =>
+ match i with
+ | Inop s =>
+ before
+ | Iop op args res s =>
+ let a := eval_static_operation op (approx_regs args before) in
+ D.set res a before
+ | Iload chunk addr args dst s =>
+ D.set dst Unknown before
+ | Istore chunk addr args src s =>
+ before
+ | Icall sig ros args res s =>
+ D.set res Unknown before
+ | Itailcall sig ros args =>
+ before
+ | Ialloc arg res s =>
+ D.set res Unknown before
+ | Icond cond args ifso ifnot =>
+ before
+ | Ireturn optarg =>
+ before
+ end
+ end.
+
+(** The static analysis itself is then an instantiation of Kildall's
+ generic solver for forward dataflow inequations. [analyze f]
+ returns a mapping from program points to mappings of pseudo-registers
+ to approximations. It can fail to reach a fixpoint in a reasonable
+ number of iterations, in which case [None] is returned. *)
+
+Module DS := Dataflow_Solver(D)(NodeSetForward).
+
+Definition analyze (f: RTL.function): PMap.t D.t :=
+ match DS.fixpoint (successors f) f.(fn_nextpc) (transfer f)
+ ((f.(fn_entrypoint), D.top) :: nil) with
+ | None => PMap.init D.top
+ | Some res => res
+ end.
+
+(** * Code transformation *)
+
+(** ** Operator strength reduction *)
+
+(** We now define auxiliary functions for strength reduction of
+ operators and addressing modes: replacing an operator with a cheaper
+ one if some of its arguments are statically known. These are again
+ large pattern-matchings expressed in indirect style. *)
+
+Section STRENGTH_REDUCTION.
+
+Variable approx: D.t.
+
+Definition intval (r: reg) : option int :=
+ match D.get r approx with I n => Some n | _ => None end.
+
+(*
+Definition cond_strength_reduction (cond: condition) (args: list reg) :=
+ match cond, args with
+ | Ccomp c, r1 :: r2 :: nil =>
+ | Ccompu c, r1 :: r2 :: nil =>
+ | Ccompshift c s, r1 :: r2 :: nil =>
+ | Ccompushift c s, r1 :: r2 :: nil =>
+ | _ =>
+ end.
+*)
+
+Inductive cond_strength_reduction_cases: forall (cond: condition) (args: list reg), Set :=
+ | cond_strength_reduction_case1:
+ forall c r1 r2,
+ cond_strength_reduction_cases (Ccomp c) (r1 :: r2 :: nil)
+ | cond_strength_reduction_case2:
+ forall c r1 r2,
+ cond_strength_reduction_cases (Ccompu c) (r1 :: r2 :: nil)
+ | cond_strength_reduction_case3:
+ forall c s r1 r2,
+ cond_strength_reduction_cases (Ccompshift c s) (r1 :: r2 :: nil)
+ | cond_strength_reduction_case4:
+ forall c s r1 r2,
+ cond_strength_reduction_cases (Ccompushift c s) (r1 :: r2 :: nil)
+ | cond_strength_reduction_default:
+ forall (cond: condition) (args: list reg),
+ cond_strength_reduction_cases cond args.
+
+Definition cond_strength_reduction_match (cond: condition) (args: list reg) :=
+ match cond as z1, args as z2 return cond_strength_reduction_cases z1 z2 with
+ | Ccomp c, r1 :: r2 :: nil =>
+ cond_strength_reduction_case1 c r1 r2
+ | Ccompu c, r1 :: r2 :: nil =>
+ cond_strength_reduction_case2 c r1 r2
+ | Ccompshift c s, r1 :: r2 :: nil =>
+ cond_strength_reduction_case3 c s r1 r2
+ | Ccompushift c s, r1 :: r2 :: nil =>
+ cond_strength_reduction_case4 c s r1 r2
+ | cond, args =>
+ cond_strength_reduction_default cond args
+ end.
+
+Definition cond_strength_reduction (cond: condition) (args: list reg) :=
+ match cond_strength_reduction_match cond args with
+ | cond_strength_reduction_case1 c r1 r2 =>
+ match intval r1, intval r2 with
+ | Some n, _ =>
+ (Ccompimm (swap_comparison c) n, r2 :: nil)
+ | _, Some n =>
+ (Ccompimm c n, r1 :: nil)
+ | _, _ =>
+ (cond, args)
+ end
+ | cond_strength_reduction_case2 c r1 r2 =>
+ match intval r1, intval r2 with
+ | Some n, _ =>
+ (Ccompuimm (swap_comparison c) n, r2 :: nil)
+ | _, Some n =>
+ (Ccompuimm c n, r1 :: nil)
+ | _, _ =>
+ (cond, args)
+ end
+ | cond_strength_reduction_case3 c s r1 r2 =>
+ match intval r2 with
+ | Some n =>
+ (Ccompimm c (eval_shift s n), r1 :: nil)
+ | None =>
+ (cond, args)
+ end
+ | cond_strength_reduction_case4 c s r1 r2 =>
+ match intval r2 with
+ | Some n =>
+ (Ccompuimm c (eval_shift s n), r1 :: nil)
+ | None =>
+ (cond, args)
+ end
+ | cond_strength_reduction_default cond args =>
+ (cond, args)
+ end.
+
+Definition make_addimm (n: int) (r: reg) :=
+ if Int.eq n Int.zero
+ then (Omove, r :: nil)
+ else (Oaddimm n, r :: nil).
+
+Definition make_shlimm (n: int) (r: reg) :=
+ if Int.eq n Int.zero then
+ (Omove, r :: nil)
+ else match is_shift_amount n with
+ | Some n' => (Oshift (Slsl n'), r :: nil)
+ | None => (Ointconst Int.zero, nil) (* never happens *)
+ end.
+
+Definition make_shrimm (n: int) (r: reg) :=
+ if Int.eq n Int.zero then
+ (Omove, r :: nil)
+ else match is_shift_amount n with
+ | Some n' => (Oshift (Sasr n'), r :: nil)
+ | None => (Ointconst Int.zero, nil) (* never happens *)
+ end.
+
+Definition make_shruimm (n: int) (r: reg) :=
+ if Int.eq n Int.zero then
+ (Omove, r :: nil)
+ else match is_shift_amount n with
+ | Some n' => (Oshift (Slsr n'), r :: nil)
+ | None => (Ointconst Int.zero, nil) (* never happens *)
+ end.
+
+Definition make_mulimm (n: int) (r: reg) (r': reg) :=
+ if Int.eq n Int.zero then
+ (Ointconst Int.zero, nil)
+ else if Int.eq n Int.one then
+ (Omove, r :: nil)
+ else
+ match Int.is_power2 n with
+ | Some l => make_shlimm l r
+ | None => (Omul, r :: r' :: nil)
+ end.
+
+Definition make_andimm (n: int) (r: reg) :=
+ if Int.eq n Int.zero
+ then (Ointconst Int.zero, nil)
+ else if Int.eq n Int.mone then (Omove, r :: nil)
+ else (Oandimm n, r :: nil).
+
+Definition make_orimm (n: int) (r: reg) :=
+ if Int.eq n Int.zero then (Omove, r :: nil)
+ else if Int.eq n Int.mone then (Ointconst Int.mone, nil)
+ else (Oorimm n, r :: nil).
+
+Definition make_xorimm (n: int) (r: reg) :=
+ if Int.eq n Int.zero then (Omove, r :: nil)
+ else if Int.eq n Int.mone then (Onot, r :: nil)
+ else (Oxorimm n, r :: nil).
+
+(*
+Definition op_strength_reduction (op: operation) (args: list reg) :=
+ match op, args with
+ | Oadd, r1 :: r2 :: nil =>
+ | Oaddshift s, r1 :: r2 :: nil =>
+ | Osub, r1 :: r2 :: nil =>
+ | Osubshift s, r1 :: r2 :: nil =>
+ | Orsubshift s, r1 :: r2 :: nil =>
+ | Omul, r1 :: r2 :: nil =>
+ | Odivu, r1 :: r2 :: nil =>
+ | Oand, r1 :: r2 :: nil =>
+ | Oandshift s, r1 :: r2 :: nil =>
+ | Oor, r1 :: r2 :: nil =>
+ | Oorshift s, r1 :: r2 :: nil =>
+ | Oxor, r1 :: r2 :: nil =>
+ | Oxorshift s, r1 :: r2 :: nil =>
+ | Obic, r1 :: r2 :: nil =>
+ | Obicshift s, r1 :: r2 :: nil =>
+ | Oshl, r1 :: r2 :: nil =>
+ | Oshr, r1 :: r2 :: nil =>
+ | Oshru, r1 :: r2 :: nil =>
+ | Ocmp c, rl =>
+ | _, _ =>
+ end.
+*)
+
+Inductive op_strength_reduction_cases: forall (op: operation) (args: list reg), Set :=
+ | op_strength_reduction_case1:
+ forall r1 r2,
+ op_strength_reduction_cases (Oadd) (r1 :: r2 :: nil)
+ | op_strength_reduction_case2:
+ forall s r1 r2,
+ op_strength_reduction_cases (Oaddshift s) (r1 :: r2 :: nil)
+ | op_strength_reduction_case3:
+ forall r1 r2,
+ op_strength_reduction_cases (Osub) (r1 :: r2 :: nil)
+ | op_strength_reduction_case4:
+ forall s r1 r2,
+ op_strength_reduction_cases (Osubshift s) (r1 :: r2 :: nil)
+ | op_strength_reduction_case5:
+ forall s r1 r2,
+ op_strength_reduction_cases (Orsubshift s) (r1 :: r2 :: nil)
+ | op_strength_reduction_case6:
+ forall r1 r2,
+ op_strength_reduction_cases (Omul) (r1 :: r2 :: nil)
+ | op_strength_reduction_case7:
+ forall r1 r2,
+ op_strength_reduction_cases (Odivu) (r1 :: r2 :: nil)
+ | op_strength_reduction_case8:
+ forall r1 r2,
+ op_strength_reduction_cases (Oand) (r1 :: r2 :: nil)
+ | op_strength_reduction_case9:
+ forall s r1 r2,
+ op_strength_reduction_cases (Oandshift s) (r1 :: r2 :: nil)
+ | op_strength_reduction_case10:
+ forall r1 r2,
+ op_strength_reduction_cases (Oor) (r1 :: r2 :: nil)
+ | op_strength_reduction_case11:
+ forall s r1 r2,
+ op_strength_reduction_cases (Oorshift s) (r1 :: r2 :: nil)
+ | op_strength_reduction_case12:
+ forall r1 r2,
+ op_strength_reduction_cases (Oxor) (r1 :: r2 :: nil)
+ | op_strength_reduction_case13:
+ forall s r1 r2,
+ op_strength_reduction_cases (Oxorshift s) (r1 :: r2 :: nil)
+ | op_strength_reduction_case14:
+ forall r1 r2,
+ op_strength_reduction_cases (Obic) (r1 :: r2 :: nil)
+ | op_strength_reduction_case15:
+ forall s r1 r2,
+ op_strength_reduction_cases (Obicshift s) (r1 :: r2 :: nil)
+ | op_strength_reduction_case16:
+ forall r1 r2,
+ op_strength_reduction_cases (Oshl) (r1 :: r2 :: nil)
+ | op_strength_reduction_case17:
+ forall r1 r2,
+ op_strength_reduction_cases (Oshr) (r1 :: r2 :: nil)
+ | op_strength_reduction_case18:
+ forall r1 r2,
+ op_strength_reduction_cases (Oshru) (r1 :: r2 :: nil)
+ | op_strength_reduction_case19:
+ forall c rl,
+ op_strength_reduction_cases (Ocmp c) rl
+ | op_strength_reduction_default:
+ forall (op: operation) (args: list reg),
+ op_strength_reduction_cases op args.
+
+Definition op_strength_reduction_match (op: operation) (args: list reg) :=
+ match op as z1, args as z2 return op_strength_reduction_cases z1 z2 with
+ | Oadd, r1 :: r2 :: nil =>
+ op_strength_reduction_case1 r1 r2
+ | Oaddshift s, r1 :: r2 :: nil =>
+ op_strength_reduction_case2 s r1 r2
+ | Osub, r1 :: r2 :: nil =>
+ op_strength_reduction_case3 r1 r2
+ | Osubshift s, r1 :: r2 :: nil =>
+ op_strength_reduction_case4 s r1 r2
+ | Orsubshift s, r1 :: r2 :: nil =>
+ op_strength_reduction_case5 s r1 r2
+ | Omul, r1 :: r2 :: nil =>
+ op_strength_reduction_case6 r1 r2
+ | Odivu, r1 :: r2 :: nil =>
+ op_strength_reduction_case7 r1 r2
+ | Oand, r1 :: r2 :: nil =>
+ op_strength_reduction_case8 r1 r2
+ | Oandshift s, r1 :: r2 :: nil =>
+ op_strength_reduction_case9 s r1 r2
+ | Oor, r1 :: r2 :: nil =>
+ op_strength_reduction_case10 r1 r2
+ | Oorshift s, r1 :: r2 :: nil =>
+ op_strength_reduction_case11 s r1 r2
+ | Oxor, r1 :: r2 :: nil =>
+ op_strength_reduction_case12 r1 r2
+ | Oxorshift s, r1 :: r2 :: nil =>
+ op_strength_reduction_case13 s r1 r2
+ | Obic, r1 :: r2 :: nil =>
+ op_strength_reduction_case14 r1 r2
+ | Obicshift s, r1 :: r2 :: nil =>
+ op_strength_reduction_case15 s r1 r2
+ | Oshl, r1 :: r2 :: nil =>
+ op_strength_reduction_case16 r1 r2
+ | Oshr, r1 :: r2 :: nil =>
+ op_strength_reduction_case17 r1 r2
+ | Oshru, r1 :: r2 :: nil =>
+ op_strength_reduction_case18 r1 r2
+ | Ocmp c, rl =>
+ op_strength_reduction_case19 c rl
+ | op, args =>
+ op_strength_reduction_default op args
+ end.
+
+Definition op_strength_reduction (op: operation) (args: list reg) :=
+ match op_strength_reduction_match op args with
+ | op_strength_reduction_case1 r1 r2 => (* Oadd *)
+ match intval r1, intval r2 with
+ | Some n, _ => make_addimm n r2
+ | _, Some n => make_addimm n r1
+ | _, _ => (op, args)
+ end
+ | op_strength_reduction_case2 s r1 r2 => (* Oaddshift *)
+ match intval r2 with
+ | Some n => make_addimm (eval_shift s n) r1
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case3 r1 r2 => (* Osub *)
+ match intval r1, intval r2 with
+ | Some n, _ => (Orsubimm n, r2 :: nil)
+ | _, Some n => make_addimm (Int.neg n) r1
+ | _, _ => (op, args)
+ end
+ | op_strength_reduction_case4 s r1 r2 => (* Osubshift *)
+ match intval r2 with
+ | Some n => make_addimm (Int.neg (eval_shift s n)) r1
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case5 s r1 r2 => (* Orsubshift *)
+ match intval r2 with
+ | Some n => (Orsubimm (eval_shift s n), r1 :: nil)
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case6 r1 r2 => (* Omul *)
+ match intval r1, intval r2 with
+ | Some n, _ => make_mulimm n r2 r1
+ | _, Some n => make_mulimm n r1 r2
+ | _, _ => (op, args)
+ end
+ | op_strength_reduction_case7 r1 r2 => (* Odivu *)
+ match intval r2 with
+ | Some n =>
+ match Int.is_power2 n with
+ | Some l => make_shruimm l r1
+ | None => (op, args)
+ end
+ | None =>
+ (op, args)
+ end
+ | op_strength_reduction_case8 r1 r2 => (* Oand *)
+ match intval r1, intval r2 with
+ | Some n, _ => make_andimm n r2
+ | _, Some n => make_andimm n r1
+ | _, _ => (op, args)
+ end
+ | op_strength_reduction_case9 s r1 r2 => (* Oandshift *)
+ match intval r2 with
+ | Some n => make_andimm (eval_shift s n) r1
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case10 r1 r2 => (* Oor *)
+ match intval r1, intval r2 with
+ | Some n, _ => make_orimm n r2
+ | _, Some n => make_orimm n r1
+ | _, _ => (op, args)
+ end
+ | op_strength_reduction_case11 s r1 r2 => (* Oorshift *)
+ match intval r2 with
+ | Some n => make_orimm (eval_shift s n) r1
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case12 r1 r2 => (* Oxor *)
+ match intval r1, intval r2 with
+ | Some n, _ => make_xorimm n r2
+ | _, Some n => make_xorimm n r1
+ | _, _ => (op, args)
+ end
+ | op_strength_reduction_case13 s r1 r2 => (* Oxorshift *)
+ match intval r2 with
+ | Some n => make_xorimm (eval_shift s n) r1
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case14 r1 r2 => (* Obic *)
+ match intval r2 with
+ | Some n => make_andimm (Int.not n) r1
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case15 s r1 r2 => (* Obicshift *)
+ match intval r2 with
+ | Some n => make_andimm (Int.not (eval_shift s n)) r1
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case16 r1 r2 => (* Oshl *)
+ match intval r2 with
+ | Some n =>
+ if Int.ltu n (Int.repr 32)
+ then make_shlimm n r1
+ else (op, args)
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case17 r1 r2 => (* Oshr *)
+ match intval r2 with
+ | Some n =>
+ if Int.ltu n (Int.repr 32)
+ then make_shrimm n r1
+ else (op, args)
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case18 r1 r2 => (* Oshru *)
+ match intval r2 with
+ | Some n =>
+ if Int.ltu n (Int.repr 32)
+ then make_shruimm n r1
+ else (op, args)
+ | _ => (op, args)
+ end
+ | op_strength_reduction_case19 c rl => (* Ocmp *)
+ let (c', args') := cond_strength_reduction c args in
+ (Ocmp c', args')
+ | op_strength_reduction_default op args => (* default *)
+ (op, args)
+ end.
+
+(*
+Definition addr_strength_reduction (addr: addressing) (args: list reg) :=
+ match addr, args with
+ | Aindexed2, r1 :: r2 :: nil =>
+ | Aindexed2shift s, r1 :: r2 :: nil =>
+ | _, _ =>
+ end.
+*)
+
+Inductive addr_strength_reduction_cases: forall (addr: addressing) (args: list reg), Set :=
+ | addr_strength_reduction_case1:
+ forall r1 r2,
+ addr_strength_reduction_cases (Aindexed2) (r1 :: r2 :: nil)
+ | addr_strength_reduction_case2:
+ forall s r1 r2,
+ addr_strength_reduction_cases (Aindexed2shift s) (r1 :: r2 :: nil)
+ | addr_strength_reduction_default:
+ forall (addr: addressing) (args: list reg),
+ addr_strength_reduction_cases addr args.
+
+Definition addr_strength_reduction_match (addr: addressing) (args: list reg) :=
+ match addr as z1, args as z2 return addr_strength_reduction_cases z1 z2 with
+ | Aindexed2, r1 :: r2 :: nil =>
+ addr_strength_reduction_case1 r1 r2
+ | Aindexed2shift s, r1 :: r2 :: nil =>
+ addr_strength_reduction_case2 s r1 r2
+ | addr, args =>
+ addr_strength_reduction_default addr args
+ end.
+
+Definition addr_strength_reduction (addr: addressing) (args: list reg) :=
+ match addr_strength_reduction_match addr args with
+ | addr_strength_reduction_case1 r1 r2 => (* Aindexed2 *)
+ match intval r1, intval r2 with
+ | Some n1, _ => (Aindexed n1, r2 :: nil)
+ | _, Some n2 => (Aindexed n2, r1 :: nil)
+ | _, _ => (addr, args)
+ end
+ | addr_strength_reduction_case2 s r1 r2 => (* Aindexed2shift *)
+ match intval r2 with
+ | Some n2 => (Aindexed (eval_shift s n2), r1 :: nil)
+ | _ => (addr, args)
+ end
+ | addr_strength_reduction_default addr args =>
+ (addr, args)
+ end.
+
+End STRENGTH_REDUCTION.
+
+(** ** Code transformation *)
+
+(** The code transformation proceeds instruction by instruction.
+ Operators whose arguments are all statically known are turned
+ into ``load integer constant'', ``load float constant'' or
+ ``load symbol address'' operations. Operators for which some
+ but not all arguments are known are subject to strength reduction,
+ and similarly for the addressing modes of load and store instructions.
+ Other instructions are unchanged. *)
+
+Definition transf_ros (approx: D.t) (ros: reg + ident) : reg + ident :=
+ match ros with
+ | inl r =>
+ match D.get r approx with
+ | S symb ofs => if Int.eq ofs Int.zero then inr _ symb else ros
+ | _ => ros
+ end
+ | inr s => ros
+ end.
+
+Definition transf_instr (approx: D.t) (instr: instruction) :=
+ match instr with
+ | Iop op args res s =>
+ match eval_static_operation op (approx_regs args approx) with
+ | I n =>
+ Iop (Ointconst n) nil res s
+ | F n =>
+ Iop (Ofloatconst n) nil res s
+ | S symb ofs =>
+ Iop (Oaddrsymbol symb ofs) nil res s
+ | _ =>
+ let (op', args') := op_strength_reduction approx op args in
+ Iop op' args' res s
+ end
+ | Iload chunk addr args dst s =>
+ let (addr', args') := addr_strength_reduction approx addr args in
+ Iload chunk addr' args' dst s
+ | Istore chunk addr args src s =>
+ let (addr', args') := addr_strength_reduction approx addr args in
+ Istore chunk addr' args' src s
+ | Icall sig ros args res s =>
+ Icall sig (transf_ros approx ros) args res s
+ | Itailcall sig ros args =>
+ Itailcall sig (transf_ros approx ros) args
+ | Ialloc arg res s =>
+ Ialloc arg res s
+ | Icond cond args s1 s2 =>
+ match eval_static_condition cond (approx_regs args approx) with
+ | Some b =>
+ if b then Inop s1 else Inop s2
+ | None =>
+ let (cond', args') := cond_strength_reduction approx cond args in
+ Icond cond' args' s1 s2
+ end
+ | _ =>
+ instr
+ end.
+
+Definition transf_code (approxs: PMap.t D.t) (instrs: code) : code :=
+ PTree.map (fun pc instr => transf_instr approxs!!pc instr) instrs.
+
+Lemma transf_code_wf:
+ forall f approxs,
+ (forall pc, Plt pc f.(fn_nextpc) \/ f.(fn_code)!pc = None) ->
+ (forall pc, Plt pc f.(fn_nextpc)
+ \/ (transf_code approxs f.(fn_code))!pc = None).
+Proof.
+ intros.
+ elim (H pc); intro.
+ left; auto.
+ right. unfold transf_code. rewrite PTree.gmap.
+ unfold option_map; rewrite H0. reflexivity.
+Qed.
+
+Definition transf_function (f: function) : function :=
+ let approxs := analyze f in
+ mkfunction
+ f.(fn_sig)
+ f.(fn_params)
+ f.(fn_stacksize)
+ (transf_code approxs f.(fn_code))
+ f.(fn_entrypoint)
+ f.(fn_nextpc)
+ (transf_code_wf f approxs f.(fn_code_wf)).
+
+Definition transf_fundef (fd: fundef) : fundef :=
+ AST.transf_fundef transf_function fd.
+
+Definition transf_program (p: program) : program :=
+ transform_program transf_fundef p.
diff --git a/arm/Constpropproof.v b/arm/Constpropproof.v
new file mode 100644
index 0000000000000000000000000000000000000000..e85cadfe46bd349c21fe67a39664536df89fe943
--- /dev/null
+++ b/arm/Constpropproof.v
@@ -0,0 +1,970 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Correctness proof for constant propagation. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Events.
+Require Import Mem.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Op.
+Require Import Registers.
+Require Import RTL.
+Require Import Lattice.
+Require Import Kildall.
+Require Import Constprop.
+
+(** * Correctness of the static analysis *)
+
+Section ANALYSIS.
+
+Variable ge: genv.
+
+(** We first show that the dataflow analysis is correct with respect
+ to the dynamic semantics: the approximations (sets of values)
+ of a register at a program point predicted by the static analysis
+ are a superset of the values actually encountered during concrete
+ executions. We formalize this correspondence between run-time values and
+ compile-time approximations by the following predicate. *)
+
+Definition val_match_approx (a: approx) (v: val) : Prop :=
+ match a with
+ | Unknown => True
+ | I p => v = Vint p
+ | F p => v = Vfloat p
+ | S symb ofs => exists b, Genv.find_symbol ge symb = Some b /\ v = Vptr b ofs
+ | _ => False
+ end.
+
+Definition regs_match_approx (a: D.t) (rs: regset) : Prop :=
+ forall r, val_match_approx (D.get r a) rs#r.
+
+Lemma regs_match_approx_top:
+ forall rs, regs_match_approx D.top rs.
+Proof.
+ intros. red; intros. simpl. rewrite PTree.gempty.
+ unfold Approx.top, val_match_approx. auto.
+Qed.
+
+Lemma val_match_approx_increasing:
+ forall a1 a2 v,
+ Approx.ge a1 a2 -> val_match_approx a2 v -> val_match_approx a1 v.
+Proof.
+ intros until v.
+ intros [A|[B|C]].
+ subst a1. simpl. auto.
+ subst a2. simpl. tauto.
+ subst a2. auto.
+Qed.
+
+Lemma regs_match_approx_increasing:
+ forall a1 a2 rs,
+ D.ge a1 a2 -> regs_match_approx a2 rs -> regs_match_approx a1 rs.
+Proof.
+ unfold D.ge, regs_match_approx. intros.
+ apply val_match_approx_increasing with (D.get r a2); auto.
+Qed.
+
+Lemma regs_match_approx_update:
+ forall ra rs a v r,
+ val_match_approx a v ->
+ regs_match_approx ra rs ->
+ regs_match_approx (D.set r a ra) (rs#r <- v).
+Proof.
+ intros; red; intros. rewrite Regmap.gsspec.
+ case (peq r0 r); intro.
+ subst r0. rewrite D.gss. auto.
+ rewrite D.gso; auto.
+Qed.
+
+Inductive val_list_match_approx: list approx -> list val -> Prop :=
+ | vlma_nil:
+ val_list_match_approx nil nil
+ | vlma_cons:
+ forall a al v vl,
+ val_match_approx a v ->
+ val_list_match_approx al vl ->
+ val_list_match_approx (a :: al) (v :: vl).
+
+Lemma approx_regs_val_list:
+ forall ra rs rl,
+ regs_match_approx ra rs ->
+ val_list_match_approx (approx_regs rl ra) rs##rl.
+Proof.
+ induction rl; simpl; intros.
+ constructor.
+ constructor. apply H. auto.
+Qed.
+
+Ltac SimplVMA :=
+ match goal with
+ | H: (val_match_approx (I _) ?v) |- _ =>
+ simpl in H; (try subst v); SimplVMA
+ | H: (val_match_approx (F _) ?v) |- _ =>
+ simpl in H; (try subst v); SimplVMA
+ | H: (val_match_approx (S _ _) ?v) |- _ =>
+ simpl in H;
+ (try (elim H;
+ let b := fresh "b" in let A := fresh in let B := fresh in
+ (intros b [A B]; subst v; clear H)));
+ SimplVMA
+ | _ =>
+ idtac
+ end.
+
+Ltac InvVLMA :=
+ match goal with
+ | H: (val_list_match_approx nil ?vl) |- _ =>
+ inversion H
+ | H: (val_list_match_approx (?a :: ?al) ?vl) |- _ =>
+ inversion H; SimplVMA; InvVLMA
+ | _ =>
+ idtac
+ end.
+
+(** We then show that [eval_static_operation] is a correct abstract
+ interpretations of [eval_operation]: if the concrete arguments match
+ the given approximations, the concrete results match the
+ approximations returned by [eval_static_operation]. *)
+
+Lemma eval_static_condition_correct:
+ forall cond al vl m b,
+ val_list_match_approx al vl ->
+ eval_static_condition cond al = Some b ->
+ eval_condition cond vl m = Some b.
+Proof.
+ intros until b.
+ unfold eval_static_condition.
+ case (eval_static_condition_match cond al); intros;
+ InvVLMA; simpl; congruence.
+Qed.
+
+Lemma eval_static_operation_correct:
+ forall op sp al vl m v,
+ val_list_match_approx al vl ->
+ eval_operation ge sp op vl m = Some v ->
+ val_match_approx (eval_static_operation op al) v.
+Proof.
+ intros until v.
+ unfold eval_static_operation.
+ case (eval_static_operation_match op al); intros;
+ InvVLMA; simpl in *; FuncInv; try congruence.
+
+ destruct (Genv.find_symbol ge s). exists b. intuition congruence.
+ congruence.
+
+ rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
+ rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
+ rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
+ rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
+
+ exists b. split. auto. congruence.
+ exists b. split. auto. congruence.
+ exists b. split. auto. congruence.
+ exists b. split. auto. congruence.
+ exists b. split. auto. congruence.
+
+ replace n2 with i0. destruct (Int.eq i0 Int.zero).
+ discriminate. injection H0; intro; subst v. simpl. congruence. congruence.
+
+ replace n2 with i0. destruct (Int.eq i0 Int.zero).
+ discriminate. injection H0; intro; subst v. simpl. congruence. congruence.
+
+ replace n2 with i0. destruct (Int.ltu i0 (Int.repr 32)).
+ injection H0; intro; subst v. simpl. congruence. discriminate. congruence.
+
+ replace n2 with i0. destruct (Int.ltu i0 (Int.repr 32)).
+ injection H0; intro; subst v. simpl. congruence. discriminate. congruence.
+
+ replace n2 with i0. destruct (Int.ltu i0 (Int.repr 32)).
+ injection H0; intro; subst v. simpl. congruence. discriminate. congruence.
+
+ rewrite <- H3. replace v0 with (Vfloat n1). reflexivity. congruence.
+
+ caseEq (eval_static_condition c vl0).
+ intros. generalize (eval_static_condition_correct _ _ _ m _ H H1).
+ intro. rewrite H2 in H0.
+ destruct b; injection H0; intro; subst v; simpl; auto.
+ intros; simpl; auto.
+
+ replace n1 with i. destruct (Int.ltu n (Int.repr 31)).
+ injection H0; intro; subst v. simpl. auto. congruence. congruence.
+
+ auto.
+Qed.
+
+(** The correctness of the static analysis follows from the results
+ above and the fact that the result of the static analysis is
+ a solution of the forward dataflow inequations. *)
+
+Lemma analyze_correct_1:
+ forall f pc rs pc',
+ In pc' (successors f pc) ->
+ regs_match_approx (transfer f pc (analyze f)!!pc) rs ->
+ regs_match_approx (analyze f)!!pc' rs.
+Proof.
+ intros until pc'. unfold analyze.
+ caseEq (DS.fixpoint (successors f) (fn_nextpc f) (transfer f)
+ ((fn_entrypoint f, D.top) :: nil)).
+ intros approxs; intros.
+ apply regs_match_approx_increasing with (transfer f pc approxs!!pc).
+ eapply DS.fixpoint_solution; eauto.
+ elim (fn_code_wf f pc); intro. auto.
+ unfold successors in H0; rewrite H2 in H0; simpl; contradiction.
+ auto.
+ intros. rewrite PMap.gi. apply regs_match_approx_top.
+Qed.
+
+Lemma analyze_correct_3:
+ forall f rs,
+ regs_match_approx (analyze f)!!(f.(fn_entrypoint)) rs.
+Proof.
+ intros. unfold analyze.
+ caseEq (DS.fixpoint (successors f) (fn_nextpc f) (transfer f)
+ ((fn_entrypoint f, D.top) :: nil)).
+ intros approxs; intros.
+ apply regs_match_approx_increasing with D.top.
+ eapply DS.fixpoint_entry; eauto. auto with coqlib.
+ apply regs_match_approx_top.
+ intros. rewrite PMap.gi. apply regs_match_approx_top.
+Qed.
+
+(** * Correctness of strength reduction *)
+
+(** We now show that strength reduction over operators and addressing
+ modes preserve semantics: the strength-reduced operations and
+ addressings evaluate to the same values as the original ones if the
+ actual arguments match the static approximations used for strength
+ reduction. *)
+
+Section STRENGTH_REDUCTION.
+
+Variable approx: D.t.
+Variable sp: val.
+Variable rs: regset.
+Hypothesis MATCH: regs_match_approx approx rs.
+
+Lemma intval_correct:
+ forall r n,
+ intval approx r = Some n -> rs#r = Vint n.
+Proof.
+ intros until n.
+ unfold intval. caseEq (D.get r approx); intros; try discriminate.
+ generalize (MATCH r). unfold val_match_approx. rewrite H.
+ congruence.
+Qed.
+
+Lemma cond_strength_reduction_correct:
+ forall cond args m,
+ let (cond', args') := cond_strength_reduction approx cond args in
+ eval_condition cond' rs##args' m = eval_condition cond rs##args m.
+Proof.
+ intros. unfold cond_strength_reduction.
+ case (cond_strength_reduction_match cond args); intros.
+
+ caseEq (intval approx r1); intros.
+ simpl. rewrite (intval_correct _ _ H).
+ destruct (rs#r2); auto. rewrite Int.swap_cmp. auto.
+ destruct c; reflexivity.
+ caseEq (intval approx r2); intros.
+ simpl. rewrite (intval_correct _ _ H0). auto.
+ auto.
+
+ caseEq (intval approx r1); intros.
+ simpl. rewrite (intval_correct _ _ H).
+ destruct (rs#r2); auto. rewrite Int.swap_cmpu. auto.
+ caseEq (intval approx r2); intros.
+ simpl. rewrite (intval_correct _ _ H0). auto.
+ auto.
+
+ caseEq (intval approx r2); intros.
+ simpl. rewrite (intval_correct _ _ H). auto.
+ auto.
+
+ caseEq (intval approx r2); intros.
+ simpl. rewrite (intval_correct _ _ H). auto.
+ auto.
+
+ auto.
+Qed.
+
+Lemma make_addimm_correct:
+ forall n r m v,
+ let (op, args) := make_addimm n r in
+ eval_operation ge sp Oadd (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_addimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.add_zero in H. congruence.
+ rewrite Int.add_zero in H. congruence.
+ exact H0.
+Qed.
+
+Lemma make_shlimm_correct:
+ forall n r m v,
+ let (op, args) := make_shlimm n r in
+ eval_operation ge sp Oshl (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_shlimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.shl_zero in H. congruence.
+ unfold is_shift_amount. destruct (is_shift_amount_aux n); intros.
+ simpl in *. FuncInv. rewrite e in H0. auto.
+ simpl in *. FuncInv. rewrite e in H0. discriminate.
+Qed.
+
+Lemma make_shrimm_correct:
+ forall n r m v,
+ let (op, args) := make_shrimm n r in
+ eval_operation ge sp Oshr (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_shrimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.shr_zero in H. congruence.
+ unfold is_shift_amount. destruct (is_shift_amount_aux n); intros.
+ simpl in *. FuncInv. rewrite e in H0. auto.
+ simpl in *. FuncInv. rewrite e in H0. discriminate.
+Qed.
+
+Lemma make_shruimm_correct:
+ forall n r m v,
+ let (op, args) := make_shruimm n r in
+ eval_operation ge sp Oshru (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_shruimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.shru_zero in H. congruence.
+ unfold is_shift_amount. destruct (is_shift_amount_aux n); intros.
+ simpl in *. FuncInv. rewrite e in H0. auto.
+ simpl in *. FuncInv. rewrite e in H0. discriminate.
+Qed.
+
+Lemma make_mulimm_correct:
+ forall n r r' m v,
+ rs#r' = Vint n ->
+ let (op, args) := make_mulimm n r r' in
+ eval_operation ge sp Omul (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_mulimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in H1. FuncInv. rewrite Int.mul_zero in H0. simpl. congruence.
+ generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intros.
+ subst n. simpl in H2. simpl. FuncInv. rewrite Int.mul_one in H1. congruence.
+ caseEq (Int.is_power2 n); intros.
+ replace (eval_operation ge sp Omul (rs # r :: Vint n :: nil) m)
+ with (eval_operation ge sp Oshl (rs # r :: Vint i :: nil) m).
+ apply make_shlimm_correct.
+ simpl. generalize (Int.is_power2_range _ _ H2).
+ change (Z_of_nat wordsize) with 32. intro. rewrite H3.
+ destruct rs#r; auto. rewrite (Int.mul_pow2 i0 _ _ H2). auto.
+ simpl List.map. rewrite H. auto.
+Qed.
+
+Lemma make_andimm_correct:
+ forall n r m v,
+ let (op, args) := make_andimm n r in
+ eval_operation ge sp Oand (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_andimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.and_zero in H. congruence.
+ generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.and_mone in H0. congruence.
+ exact H1.
+Qed.
+
+Lemma make_orimm_correct:
+ forall n r m v,
+ let (op, args) := make_orimm n r in
+ eval_operation ge sp Oor (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_orimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.or_zero in H. congruence.
+ generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.or_mone in H0. congruence.
+ exact H1.
+Qed.
+
+Lemma make_xorimm_correct:
+ forall n r m v,
+ let (op, args) := make_xorimm n r in
+ eval_operation ge sp Oxor (rs#r :: Vint n :: nil) m = Some v ->
+ eval_operation ge sp op rs##args m = Some v.
+Proof.
+ intros; unfold make_xorimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros.
+ subst n. simpl in *. FuncInv. rewrite Int.xor_zero in H. congruence.
+ generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros.
+ subst n. simpl in *. FuncInv. decEq. auto.
+ exact H1.
+Qed.
+
+Lemma op_strength_reduction_correct:
+ forall op args m v,
+ let (op', args') := op_strength_reduction approx op args in
+ eval_operation ge sp op rs##args m = Some v ->
+ eval_operation ge sp op' rs##args' m = Some v.
+Proof.
+ intros; unfold op_strength_reduction;
+ case (op_strength_reduction_match op args); intros; simpl List.map.
+ (* Oadd *)
+ caseEq (intval approx r1); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp Oadd (Vint i :: rs # r2 :: nil) m)
+ with (eval_operation ge sp Oadd (rs # r2 :: Vint i :: nil) m).
+ apply make_addimm_correct.
+ simpl. destruct rs#r2; auto. rewrite Int.add_commut; auto.
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H0). apply make_addimm_correct.
+ assumption.
+ (* Oaddshift *)
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp (Oaddshift s) (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oadd (rs # r1 :: Vint (eval_shift s i) :: nil) m).
+ apply make_addimm_correct.
+ simpl. destruct rs#r1; auto.
+ assumption.
+ (* Osub *)
+ caseEq (intval approx r1); intros.
+ rewrite (intval_correct _ _ H) in H0.
+ simpl in *. destruct rs#r2; auto.
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H0).
+ replace (eval_operation ge sp Osub (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oadd (rs # r1 :: Vint (Int.neg i) :: nil) m).
+ apply make_addimm_correct.
+ simpl. destruct rs#r1; auto; rewrite Int.sub_add_opp; auto.
+ assumption.
+ (* Osubshift *)
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp (Osubshift s) (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oadd (rs # r1 :: Vint (Int.neg (eval_shift s i)) :: nil) m).
+ apply make_addimm_correct.
+ simpl. destruct rs#r1; auto; rewrite Int.sub_add_opp; auto.
+ assumption.
+ (* Orsubshift *)
+ caseEq (intval approx r2). intros n H.
+ rewrite (intval_correct _ _ H).
+ simpl. destruct rs#r1; auto.
+ auto.
+ (* Omul *)
+ caseEq (intval approx r1); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp Omul (Vint i :: rs # r2 :: nil) m)
+ with (eval_operation ge sp Omul (rs # r2 :: Vint i :: nil) m).
+ apply make_mulimm_correct. apply intval_correct; auto.
+ simpl. destruct rs#r2; auto. rewrite Int.mul_commut; auto.
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H0). apply make_mulimm_correct.
+ apply intval_correct; auto.
+ assumption.
+ (* Odivu *)
+ caseEq (intval approx r2); intros.
+ caseEq (Int.is_power2 i); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp Odivu (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oshru (rs # r1 :: Vint i0 :: nil) m).
+ apply make_shruimm_correct.
+ simpl. destruct rs#r1; auto.
+ change 32 with (Z_of_nat wordsize).
+ rewrite (Int.is_power2_range _ _ H0).
+ generalize (Int.eq_spec i Int.zero); case (Int.eq i Int.zero); intros.
+ subst i. discriminate.
+ rewrite (Int.divu_pow2 i1 _ _ H0). auto.
+ assumption.
+ assumption.
+ (* Oand *)
+ caseEq (intval approx r1); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp Oand (Vint i :: rs # r2 :: nil) m)
+ with (eval_operation ge sp Oand (rs # r2 :: Vint i :: nil) m).
+ apply make_andimm_correct.
+ simpl. destruct rs#r2; auto. rewrite Int.and_commut; auto.
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H0). apply make_andimm_correct.
+ assumption.
+ (* Oandshift *)
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp (Oandshift s) (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oand (rs # r1 :: Vint (eval_shift s i) :: nil) m).
+ apply make_andimm_correct. reflexivity.
+ assumption.
+ (* Oor *)
+ caseEq (intval approx r1); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp Oor (Vint i :: rs # r2 :: nil) m)
+ with (eval_operation ge sp Oor (rs # r2 :: Vint i :: nil) m).
+ apply make_orimm_correct.
+ simpl. destruct rs#r2; auto. rewrite Int.or_commut; auto.
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H0). apply make_orimm_correct.
+ assumption.
+ (* Oorshift *)
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp (Oorshift s) (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oor (rs # r1 :: Vint (eval_shift s i) :: nil) m).
+ apply make_orimm_correct. reflexivity.
+ assumption.
+ (* Oxor *)
+ caseEq (intval approx r1); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp Oxor (Vint i :: rs # r2 :: nil) m)
+ with (eval_operation ge sp Oxor (rs # r2 :: Vint i :: nil) m).
+ apply make_xorimm_correct.
+ simpl. destruct rs#r2; auto. rewrite Int.xor_commut; auto.
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H0). apply make_xorimm_correct.
+ assumption.
+ (* Oxorshift *)
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp (Oxorshift s) (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oxor (rs # r1 :: Vint (eval_shift s i) :: nil) m).
+ apply make_xorimm_correct. reflexivity.
+ assumption.
+ (* Obic *)
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp Obic (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oand (rs # r1 :: Vint (Int.not i) :: nil) m).
+ apply make_andimm_correct. reflexivity.
+ assumption.
+ (* Obicshift *)
+ caseEq (intval approx r2); intros.
+ rewrite (intval_correct _ _ H).
+ replace (eval_operation ge sp (Obicshift s) (rs # r1 :: Vint i :: nil) m)
+ with (eval_operation ge sp Oand (rs # r1 :: Vint (Int.not (eval_shift s i)) :: nil) m).
+ apply make_andimm_correct. reflexivity.
+ assumption.
+ (* Oshl *)
+ caseEq (intval approx r2); intros.
+ caseEq (Int.ltu i (Int.repr 32)); intros.
+ rewrite (intval_correct _ _ H). apply make_shlimm_correct.
+ assumption.
+ assumption.
+ (* Oshr *)
+ caseEq (intval approx r2); intros.
+ caseEq (Int.ltu i (Int.repr 32)); intros.
+ rewrite (intval_correct _ _ H). apply make_shrimm_correct.
+ assumption.
+ assumption.
+ (* Oshru *)
+ caseEq (intval approx r2); intros.
+ caseEq (Int.ltu i (Int.repr 32)); intros.
+ rewrite (intval_correct _ _ H). apply make_shruimm_correct.
+ assumption.
+ assumption.
+ (* Ocmp *)
+ generalize (cond_strength_reduction_correct c rl).
+ destruct (cond_strength_reduction approx c rl).
+ simpl. intro. rewrite H. auto.
+ (* default *)
+ assumption.
+Qed.
+
+Ltac KnownApprox :=
+ match goal with
+ | MATCH: (regs_match_approx ?approx ?rs),
+ H: (D.get ?r ?approx = ?a) |- _ =>
+ generalize (MATCH r); rewrite H; intro; clear H; KnownApprox
+ | _ => idtac
+ end.
+
+Lemma addr_strength_reduction_correct:
+ forall addr args,
+ let (addr', args') := addr_strength_reduction approx addr args in
+ eval_addressing ge sp addr' rs##args' = eval_addressing ge sp addr rs##args.
+Proof.
+ intros.
+
+ unfold addr_strength_reduction;
+ case (addr_strength_reduction_match addr args); intros.
+
+ (* Aindexed2 *)
+ caseEq (intval approx r1); intros.
+ simpl; rewrite (intval_correct _ _ H).
+ destruct rs#r2; auto. rewrite Int.add_commut; auto.
+ caseEq (intval approx r2); intros.
+ simpl; rewrite (intval_correct _ _ H0). auto.
+ auto.
+
+ (* Aindexed2shift *)
+ caseEq (intval approx r2); intros.
+ simpl; rewrite (intval_correct _ _ H). auto.
+ auto.
+
+ (* default *)
+ reflexivity.
+Qed.
+
+End STRENGTH_REDUCTION.
+
+End ANALYSIS.
+
+(** * Correctness of the code transformation *)
+
+(** We now show that the transformed code after constant propagation
+ has the same semantics as the original code. *)
+
+Section PRESERVATION.
+
+Variable prog: program.
+Let tprog := transf_program prog.
+Let ge := Genv.globalenv prog.
+Let tge := Genv.globalenv tprog.
+
+Lemma symbols_preserved:
+ forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof.
+ intros; unfold ge, tge, tprog, transf_program.
+ apply Genv.find_symbol_transf.
+Qed.
+
+Lemma functions_translated:
+ forall (v: val) (f: fundef),
+ Genv.find_funct ge v = Some f ->
+ Genv.find_funct tge v = Some (transf_fundef f).
+Proof.
+ intros.
+ exact (Genv.find_funct_transf transf_fundef H).
+Qed.
+
+Lemma function_ptr_translated:
+ forall (b: block) (f: fundef),
+ Genv.find_funct_ptr ge b = Some f ->
+ Genv.find_funct_ptr tge b = Some (transf_fundef f).
+Proof.
+ intros.
+ exact (Genv.find_funct_ptr_transf transf_fundef H).
+Qed.
+
+Lemma sig_function_translated:
+ forall f,
+ funsig (transf_fundef f) = funsig f.
+Proof.
+ intros. destruct f; reflexivity.
+Qed.
+
+Lemma transf_ros_correct:
+ forall ros rs f approx,
+ regs_match_approx ge approx rs ->
+ find_function ge ros rs = Some f ->
+ find_function tge (transf_ros approx ros) rs = Some (transf_fundef f).
+Proof.
+ intros until approx; intro MATCH.
+ destruct ros; simpl.
+ intro.
+ exploit functions_translated; eauto. intro FIND.
+ caseEq (D.get r approx); intros; auto.
+ generalize (Int.eq_spec i0 Int.zero); case (Int.eq i0 Int.zero); intros; auto.
+ generalize (MATCH r). rewrite H0. intros [b [A B]].
+ rewrite <- symbols_preserved in A.
+ rewrite B in FIND. rewrite H1 in FIND.
+ rewrite Genv.find_funct_find_funct_ptr in FIND.
+ simpl. rewrite A. auto.
+ rewrite symbols_preserved. destruct (Genv.find_symbol ge i).
+ intro. apply function_ptr_translated. auto.
+ congruence.
+Qed.
+
+(** The proof of semantic preservation is a simulation argument
+ based on diagrams of the following form:
+<<
+ st1 --------------- st2
+ | |
+ t| |t
+ | |
+ v v
+ st1'--------------- st2'
+>>
+ The left vertical arrow represents a transition in the
+ original RTL code. The top horizontal bar is the [match_states]
+ invariant between the initial state [st1] in the original RTL code
+ and an initial state [st2] in the transformed code.
+ This invariant expresses that all code fragments appearing in [st2]
+ are obtained by [transf_code] transformation of the corresponding
+ fragments in [st1]. Moreover, the values of registers in [st1]
+ must match their compile-time approximations at the current program
+ point.
+ These two parts of the diagram are the hypotheses. In conclusions,
+ we want to prove the other two parts: the right vertical arrow,
+ which is a transition in the transformed RTL code, and the bottom
+ horizontal bar, which means that the [match_state] predicate holds
+ between the final states [st1'] and [st2']. *)
+
+Inductive match_stackframes: stackframe -> stackframe -> Prop :=
+ match_stackframe_intro:
+ forall res c sp pc rs f,
+ c = f.(RTL.fn_code) ->
+ (forall v, regs_match_approx ge (analyze f)!!pc (rs#res <- v)) ->
+ match_stackframes
+ (Stackframe res c sp pc rs)
+ (Stackframe res (transf_code (analyze f) c) sp pc rs).
+
+Inductive match_states: state -> state -> Prop :=
+ | match_states_intro:
+ forall s c sp pc rs m f s'
+ (CF: c = f.(RTL.fn_code))
+ (MATCH: regs_match_approx ge (analyze f)!!pc rs)
+ (STACKS: list_forall2 match_stackframes s s'),
+ match_states (State s c sp pc rs m)
+ (State s' (transf_code (analyze f) c) sp pc rs m)
+ | match_states_call:
+ forall s f args m s',
+ list_forall2 match_stackframes s s' ->
+ match_states (Callstate s f args m)
+ (Callstate s' (transf_fundef f) args m)
+ | match_states_return:
+ forall s s' v m,
+ list_forall2 match_stackframes s s' ->
+ match_states (Returnstate s v m)
+ (Returnstate s' v m).
+
+Ltac TransfInstr :=
+ match goal with
+ | H1: (PTree.get ?pc ?c = Some ?instr), f: function |- _ =>
+ cut ((transf_code (analyze f) c)!pc = Some(transf_instr (analyze f)!!pc instr));
+ [ simpl
+ | unfold transf_code; rewrite PTree.gmap;
+ unfold option_map; rewrite H1; reflexivity ]
+ end.
+
+(** The proof of simulation proceeds by case analysis on the transition
+ taken in the source code. *)
+
+Lemma transf_step_correct:
+ forall s1 t s2,
+ step ge s1 t s2 ->
+ forall s1' (MS: match_states s1 s1'),
+ exists s2', step tge s1' t s2' /\ match_states s2 s2'.
+Proof.
+ induction 1; intros; inv MS.
+
+ (* Inop *)
+ exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' rs m); split.
+ TransfInstr; intro. eapply exec_Inop; eauto.
+ econstructor; eauto.
+ eapply analyze_correct_1 with (pc := pc); eauto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H. auto.
+
+ (* Iop *)
+ exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' (rs#res <- v) m); split.
+ TransfInstr. caseEq (op_strength_reduction (analyze f)!!pc op args);
+ intros op' args' OSR.
+ assert (eval_operation tge sp op' rs##args' m = Some v).
+ rewrite (eval_operation_preserved symbols_preserved).
+ generalize (op_strength_reduction_correct ge (analyze f)!!pc sp rs
+ MATCH op args m v).
+ rewrite OSR; simpl. auto.
+ generalize (eval_static_operation_correct ge op sp
+ (approx_regs args (analyze f)!!pc) rs##args m v
+ (approx_regs_val_list _ _ _ args MATCH) H0).
+ case (eval_static_operation op (approx_regs args (analyze f)!!pc)); intros;
+ simpl in H2;
+ eapply exec_Iop; eauto; simpl.
+ congruence.
+ congruence.
+ elim H2; intros b [A B]. rewrite symbols_preserved.
+ rewrite A; rewrite B; auto.
+ econstructor; eauto.
+ eapply analyze_correct_1 with (pc := pc); eauto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H.
+ apply regs_match_approx_update; auto.
+ eapply eval_static_operation_correct; eauto.
+ apply approx_regs_val_list; auto.
+
+ (* Iload *)
+ caseEq (addr_strength_reduction (analyze f)!!pc addr args);
+ intros addr' args' ASR.
+ assert (eval_addressing tge sp addr' rs##args' = Some a).
+ rewrite (eval_addressing_preserved symbols_preserved).
+ generalize (addr_strength_reduction_correct ge (analyze f)!!pc sp rs
+ MATCH addr args).
+ rewrite ASR; simpl. congruence.
+ TransfInstr. rewrite ASR. intro.
+ exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' (rs#dst <- v) m); split.
+ eapply exec_Iload; eauto.
+ econstructor; eauto.
+ apply analyze_correct_1 with pc; auto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H.
+ apply regs_match_approx_update; auto. simpl; auto.
+
+ (* Istore *)
+ caseEq (addr_strength_reduction (analyze f)!!pc addr args);
+ intros addr' args' ASR.
+ assert (eval_addressing tge sp addr' rs##args' = Some a).
+ rewrite (eval_addressing_preserved symbols_preserved).
+ generalize (addr_strength_reduction_correct ge (analyze f)!!pc sp rs
+ MATCH addr args).
+ rewrite ASR; simpl. congruence.
+ TransfInstr. rewrite ASR. intro.
+ exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' rs m'); split.
+ eapply exec_Istore; eauto.
+ econstructor; eauto.
+ apply analyze_correct_1 with pc; auto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H. auto.
+
+ (* Icall *)
+ exploit transf_ros_correct; eauto. intro FIND'.
+ TransfInstr; intro.
+ econstructor; split.
+ eapply exec_Icall; eauto. apply sig_function_translated; auto.
+ constructor; auto. constructor; auto.
+ econstructor; eauto.
+ intros. apply analyze_correct_1 with pc; auto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H.
+ apply regs_match_approx_update; auto. simpl. auto.
+
+ (* Itailcall *)
+ exploit transf_ros_correct; eauto. intros FIND'.
+ TransfInstr; intro.
+ econstructor; split.
+ eapply exec_Itailcall; eauto. apply sig_function_translated; auto.
+ constructor; auto.
+
+ (* Ialloc *)
+ TransfInstr; intro.
+ exists (State s' (transf_code (analyze f) (fn_code f)) sp pc' (rs#res <- (Vptr b Int.zero)) m'); split.
+ eapply exec_Ialloc; eauto.
+ econstructor; eauto.
+ apply analyze_correct_1 with pc; auto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H.
+ apply regs_match_approx_update; auto. simpl; auto.
+
+ (* Icond, true *)
+ exists (State s' (transf_code (analyze f) (fn_code f)) sp ifso rs m); split.
+ caseEq (cond_strength_reduction (analyze f)!!pc cond args);
+ intros cond' args' CSR.
+ assert (eval_condition cond' rs##args' m = Some true).
+ generalize (cond_strength_reduction_correct
+ ge (analyze f)!!pc rs MATCH cond args m).
+ rewrite CSR. intro. congruence.
+ TransfInstr. rewrite CSR.
+ caseEq (eval_static_condition cond (approx_regs args (analyze f)!!pc)).
+ intros b ESC.
+ generalize (eval_static_condition_correct ge cond _ _ m _
+ (approx_regs_val_list _ _ _ args MATCH) ESC); intro.
+ replace b with true. intro; eapply exec_Inop; eauto. congruence.
+ intros. eapply exec_Icond_true; eauto.
+ econstructor; eauto.
+ apply analyze_correct_1 with pc; auto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H; auto.
+
+ (* Icond, false *)
+ exists (State s' (transf_code (analyze f) (fn_code f)) sp ifnot rs m); split.
+ caseEq (cond_strength_reduction (analyze f)!!pc cond args);
+ intros cond' args' CSR.
+ assert (eval_condition cond' rs##args' m = Some false).
+ generalize (cond_strength_reduction_correct
+ ge (analyze f)!!pc rs MATCH cond args m).
+ rewrite CSR. intro. congruence.
+ TransfInstr. rewrite CSR.
+ caseEq (eval_static_condition cond (approx_regs args (analyze f)!!pc)).
+ intros b ESC.
+ generalize (eval_static_condition_correct ge cond _ _ m _
+ (approx_regs_val_list _ _ _ args MATCH) ESC); intro.
+ replace b with false. intro; eapply exec_Inop; eauto. congruence.
+ intros. eapply exec_Icond_false; eauto.
+ econstructor; eauto.
+ apply analyze_correct_1 with pc; auto.
+ unfold successors; rewrite H; auto with coqlib.
+ unfold transfer; rewrite H; auto.
+
+ (* Ireturn *)
+ exists (Returnstate s' (regmap_optget or Vundef rs) (free m stk)); split.
+ eapply exec_Ireturn; eauto. TransfInstr; auto.
+ constructor; auto.
+
+ (* internal function *)
+ simpl. unfold transf_function.
+ econstructor; split.
+ eapply exec_function_internal; simpl; eauto.
+ simpl. econstructor; eauto.
+ apply analyze_correct_3; auto.
+
+ (* external function *)
+ simpl. econstructor; split.
+ eapply exec_function_external; eauto.
+ constructor; auto.
+
+ (* return *)
+ inv H3. inv H1.
+ econstructor; split.
+ eapply exec_return; eauto.
+ econstructor; eauto.
+Qed.
+
+Lemma transf_initial_states:
+ forall st1, initial_state prog st1 ->
+ exists st2, initial_state tprog st2 /\ match_states st1 st2.
+Proof.
+ intros. inversion H.
+ exploit function_ptr_translated; eauto. intro FIND.
+ exists (Callstate nil (transf_fundef f) nil (Genv.init_mem tprog)); split.
+ econstructor; eauto.
+ replace (prog_main tprog) with (prog_main prog).
+ rewrite symbols_preserved. eauto.
+ reflexivity.
+ rewrite <- H2. apply sig_function_translated.
+ replace (Genv.init_mem tprog) with (Genv.init_mem prog).
+ constructor. constructor. auto.
+ symmetry. unfold tprog, transf_program. apply Genv.init_mem_transf.
+Qed.
+
+Lemma transf_final_states:
+ forall st1 st2 r,
+ match_states st1 st2 -> final_state st1 r -> final_state st2 r.
+Proof.
+ intros. inv H0. inv H. inv H4. constructor.
+Qed.
+
+(** The preservation of the observable behavior of the program then
+ follows, using the generic preservation theorem
+ [Smallstep.simulation_step_preservation]. *)
+
+Theorem transf_program_correct:
+ forall (beh: program_behavior),
+ exec_program prog beh -> exec_program tprog beh.
+Proof.
+ unfold exec_program; intros.
+ eapply simulation_step_preservation; eauto.
+ eexact transf_initial_states.
+ eexact transf_final_states.
+ exact transf_step_correct.
+Qed.
+
+End PRESERVATION.
diff --git a/arm/Machregs.v b/arm/Machregs.v
new file mode 100644
index 0000000000000000000000000000000000000000..3466c0b0852181771a7fbf9e148b80d7ac41d04f
--- /dev/null
+++ b/arm/Machregs.v
@@ -0,0 +1,80 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+
+(** ** Machine registers *)
+
+(** The following type defines the machine registers that can be referenced
+ as locations. These include:
+- Integer registers that can be allocated to RTL pseudo-registers ([Rxx]).
+- Floating-point registers that can be allocated to RTL pseudo-registers
+ ([Fxx]).
+- Two integer registers, not allocatable, reserved as temporaries for
+ spilling and reloading ([ITx]).
+- Two float registers, not allocatable, reserved as temporaries for
+ spilling and reloading ([FTx]).
+
+ The type [mreg] does not include special-purpose machine registers
+ such as the stack pointer and the condition codes. *)
+
+Inductive mreg: Set :=
+ (** Allocatable integer regs *)
+ | R0: mreg | R1: mreg | R2: mreg | R3: mreg
+ | R4: mreg | R5: mreg | R6: mreg | R7: mreg
+ | R8: mreg | R9: mreg | R11: mreg
+ (** Allocatable float regs *)
+ | F0: mreg | F1: mreg | F4: mreg | F5: mreg
+ | F6: mreg | F7: mreg
+ (** Integer temporaries *)
+ | IT1: mreg (* R10 *) | IT2: mreg (* R12 *)
+ (** Float temporaries *)
+ | FT1: mreg (* F2 *) | FT2: mreg (* F3 *).
+
+Lemma mreg_eq: forall (r1 r2: mreg), {r1 = r2} + {r1 <> r2}.
+Proof. decide equality. Qed.
+
+Definition mreg_type (r: mreg): typ :=
+ match r with
+ | R0 => Tint | R1 => Tint | R2 => Tint | R3 => Tint
+ | R4 => Tint | R5 => Tint | R6 => Tint | R7 => Tint
+ | R8 => Tint | R9 => Tint | R11 => Tint
+ | F0 => Tfloat | F1 => Tfloat | F4 => Tfloat | F5 => Tfloat
+ | F6 => Tfloat | F7 => Tfloat
+ | IT1 => Tint | IT2 => Tint
+ | FT1 => Tfloat | FT2 => Tfloat
+ end.
+
+Open Scope positive_scope.
+
+Module IndexedMreg <: INDEXED_TYPE.
+ Definition t := mreg.
+ Definition eq := mreg_eq.
+ Definition index (r: mreg): positive :=
+ match r with
+ | R0 => 1 | R1 => 2 | R2 => 3 | R3 => 4
+ | R4 => 5 | R5 => 6 | R6 => 7 | R7 => 8
+ | R8 => 9 | R9 => 10 | R11 => 11
+ | F0 => 12 | F1 => 13 | F4 => 14 | F5 => 15
+ | F6 => 16 | F7 => 17
+ | IT1 => 18 | IT2 => 19
+ | FT1 => 20 | FT2 => 21
+ end.
+ Lemma index_inj:
+ forall r1 r2, index r1 = index r2 -> r1 = r2.
+ Proof.
+ destruct r1; destruct r2; simpl; intro; discriminate || reflexivity.
+ Qed.
+End IndexedMreg.
+
diff --git a/arm/Op.v b/arm/Op.v
new file mode 100644
index 0000000000000000000000000000000000000000..6a6df7edaec11fdec152bd65692fc2980d555d6e
--- /dev/null
+++ b/arm/Op.v
@@ -0,0 +1,1007 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Operators and addressing modes. The abstract syntax and dynamic
+ semantics for the CminorSel, RTL, LTL and Mach languages depend on the
+ following types, defined in this library:
+- [condition]: boolean conditions for conditional branches;
+- [operation]: arithmetic and logical operations;
+- [addressing]: addressing modes for load and store operations.
+
+ These types are processor-specific and correspond roughly to what the
+ processor can compute in one instruction. In other terms, these
+ types reflect the state of the program after instruction selection.
+ For a processor-independent set of operations, see the abstract
+ syntax and dynamic semantics of the Cminor language.
+*)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Mem.
+Require Import Globalenvs.
+
+Set Implicit Arguments.
+
+Record shift_amount : Set :=
+ mk_shift_amount {
+ s_amount: int;
+ s_amount_ltu: Int.ltu s_amount (Int.repr 32) = true
+ }.
+
+Inductive shift : Set :=
+ | Slsl: shift_amount -> shift
+ | Slsr: shift_amount -> shift
+ | Sasr: shift_amount -> shift
+ | Sror: shift_amount -> shift.
+
+(** Conditions (boolean-valued operators). *)
+
+Inductive condition : Set :=
+ | Ccomp: comparison -> condition (**r signed integer comparison *)
+ | Ccompu: comparison -> condition (**r unsigned integer comparison *)
+ | Ccompshift: comparison -> shift -> condition (**r signed integer comparison *)
+ | Ccompushift: comparison -> shift -> condition (**r unsigned integer comparison *)
+ | Ccompimm: comparison -> int -> condition (**r signed integer comparison with a constant *)
+ | Ccompuimm: comparison -> int -> condition (**r unsigned integer comparison with a constant *)
+ | Ccompf: comparison -> condition (**r floating-point comparison *)
+ | Cnotcompf: comparison -> condition. (**r negation of a floating-point comparison *)
+
+(** Arithmetic and logical operations. In the descriptions, [rd] is the
+ result of the operation and [r1], [r2], etc, are the arguments. *)
+
+Inductive operation : Set :=
+ | Omove: operation (**r [rd = r1] *)
+ | Ointconst: int -> operation (**r [rd] is set to the given integer constant *)
+ | Ofloatconst: float -> operation (**r [rd] is set to the given float constant *)
+ | Oaddrsymbol: ident -> int -> operation (**r [rd] is set to the the address of the symbol plus the offset *)
+ | Oaddrstack: int -> operation (**r [rd] is set to the stack pointer plus the given offset *)
+(*c Integer arithmetic: *)
+ | Ocast8signed: operation (**r [rd] is 8-bit sign extension of [r1] *)
+ | Ocast8unsigned: operation (**r [rd] is 8-bit zero extension of [r1] *)
+ | Ocast16signed: operation (**r [rd] is 16-bit sign extension of [r1] *)
+ | Ocast16unsigned: operation (**r [rd] is 16-bit zero extension of [r1] *)
+ | Oadd: operation (**r [rd = r1 + r2] *)
+ | Oaddshift: shift -> operation (**r [rd = r1 + shifted r2] *)
+ | Oaddimm: int -> operation (**r [rd = r1 + n] *)
+ | Osub: operation (**r [rd = r1 - r2] *)
+ | Osubshift: shift -> operation (**r [rd = r1 - shifted r2] *)
+ | Orsubshift: shift -> operation (**r [rd = shifted r2 - r1] *)
+ | Orsubimm: int -> operation (**r [rd = r1 - n] *)
+ | Omul: operation (**r [rd = r1 * r2] *)
+ | Odiv: operation (**r [rd = r1 / r2] (signed) *)
+ | Odivu: operation (**r [rd = r1 / r2] (unsigned) *)
+ | Oand: operation (**r [rd = r1 & r2] *)
+ | Oandshift: shift -> operation (**r [rd = r1 & shifted r2] *)
+ | Oandimm: int -> operation (**r [rd = r1 & n] *)
+ | Oor: operation (**r [rd = r1 | r2] *)
+ | Oorshift: shift -> operation (**r [rd = r1 | shifted r2] *)
+ | Oorimm: int -> operation (**r [rd = r1 | n] *)
+ | Oxor: operation (**r [rd = r1 ^ r2] *)
+ | Oxorshift: shift -> operation (**r [rd = r1 ^ shifted r2] *)
+ | Oxorimm: int -> operation (**r [rd = r1 ^ n] *)
+ | Obic: operation (**r [rd = r1 & ~r2] *)
+ | Obicshift: shift -> operation (**r [rd = r1 & ~(shifted r2)] *)
+ | Onot: operation (**r [rd = ~r1] *)
+ | Onotshift: shift -> operation (**r [rd = ~(shifted r1)] *)
+ | Oshl: operation (**r [rd = r1 << r2] *)
+ | Oshr: operation (**r [rd = r1 >> r2] (signed) *)
+ | Oshru: operation (**r [rd = r1 >> r2] (unsigned) *)
+ | Oshift: shift -> operation (**r [rd = shifted r1] *)
+ | Oshrximm: int -> operation (**r [rd = r1 / 2^n] (signed) *)
+(*c Floating-point arithmetic: *)
+ | Onegf: operation (**r [rd = - r1] *)
+ | Oabsf: operation (**r [rd = abs(r1)] *)
+ | Oaddf: operation (**r [rd = r1 + r2] *)
+ | Osubf: operation (**r [rd = r1 - r2] *)
+ | Omulf: operation (**r [rd = r1 * r2] *)
+ | Odivf: operation (**r [rd = r1 / r2] *)
+ | Osingleoffloat: operation (**r [rd] is [r1] truncated to single-precision float *)
+(*c Conversions between int and float: *)
+ | Ointoffloat: operation (**r [rd = int_of_float(r1)] *)
+ | Ointuoffloat: operation (**r [rd = unsigned_int_of_float(r1)] *)
+ | Ofloatofint: operation (**r [rd = float_of_signed_int(r1)] *)
+ | Ofloatofintu: operation (**r [rd = float_of_unsigned_int(r1)] *)
+(*c Boolean tests: *)
+ | Ocmp: condition -> operation. (**r [rd = 1] if condition holds, [rd = 0] otherwise. *)
+
+(** Addressing modes. [r1], [r2], etc, are the arguments to the
+ addressing. *)
+
+Inductive addressing: Set :=
+ | Aindexed: int -> addressing (**r Address is [r1 + offset] *)
+ | Aindexed2: addressing (**r Address is [r1 + r2] *)
+ | Aindexed2shift: shift -> addressing (**r Address is [r1 + shifted r2] *)
+ | Ainstack: int -> addressing. (**r Address is [stack_pointer + offset] *)
+
+(** Comparison functions (used in module [CSE]). *)
+
+Definition eq_shift (x y: shift): {x=y} + {x<>y}.
+Proof.
+ generalize Int.eq_dec; intro.
+ assert (forall (x y: shift_amount), {x=y}+{x<>y}).
+ destruct x as [x Px]. destruct y as [y Py]. destruct (H x y).
+ subst x. rewrite (proof_irrelevance _ Px Py). left; auto.
+ right. red; intro. elim n. inversion H0. auto.
+ decide equality.
+Qed.
+
+Definition eq_operation (x y: operation): {x=y} + {x<>y}.
+Proof.
+ generalize Int.eq_dec; intro.
+ generalize Float.eq_dec; intro.
+ assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
+ generalize eq_shift; intro.
+ assert (forall (x y: comparison), {x=y}+{x<>y}). decide equality.
+ assert (forall (x y: condition), {x=y}+{x<>y}). decide equality.
+ decide equality.
+Qed.
+
+Definition eq_addressing (x y: addressing) : {x=y} + {x<>y}.
+Proof.
+ generalize Int.eq_dec; intro.
+ generalize eq_shift; intro.
+ decide equality.
+Qed.
+
+(** Evaluation of conditions, operators and addressing modes applied
+ to lists of values. Return [None] when the computation is undefined:
+ wrong number of arguments, arguments of the wrong types, undefined
+ operations such as division by zero. [eval_condition] returns a boolean,
+ [eval_operation] and [eval_addressing] return a value. *)
+
+Definition eval_compare_mismatch (c: comparison) : option bool :=
+ match c with Ceq => Some false | Cne => Some true | _ => None end.
+
+Definition eval_compare_null (c: comparison) (n: int) : option bool :=
+ if Int.eq n Int.zero
+ then match c with Ceq => Some false | Cne => Some true | _ => None end
+ else None.
+
+Definition eval_shift (s: shift) (n: int) : int :=
+ match s with
+ | Slsl x => Int.shl n (s_amount x)
+ | Slsr x => Int.shru n (s_amount x)
+ | Sasr x => Int.shr n (s_amount x)
+ | Sror x => Int.ror n (s_amount x)
+ end.
+
+Definition eval_condition (cond: condition) (vl: list val) (m: mem):
+ option bool :=
+ match cond, vl with
+ | Ccomp c, Vint n1 :: Vint n2 :: nil =>
+ Some (Int.cmp c n1 n2)
+ | Ccomp c, Vptr b1 n1 :: Vptr b2 n2 :: nil =>
+ if valid_pointer m b1 (Int.signed n1)
+ && valid_pointer m b2 (Int.signed n2) then
+ if eq_block b1 b2
+ then Some (Int.cmp c n1 n2)
+ else eval_compare_mismatch c
+ else None
+ | Ccomp c, Vptr b1 n1 :: Vint n2 :: nil =>
+ eval_compare_null c n2
+ | Ccomp c, Vint n1 :: Vptr b2 n2 :: nil =>
+ eval_compare_null c n1
+ | Ccompu c, Vint n1 :: Vint n2 :: nil =>
+ Some (Int.cmpu c n1 n2)
+ | Ccompshift c s, Vint n1 :: Vint n2 :: nil =>
+ Some (Int.cmp c n1 (eval_shift s n2))
+ | Ccompshift c s, Vptr b1 n1 :: Vint n2 :: nil =>
+ eval_compare_null c (eval_shift s n2)
+ | Ccompushift c s, Vint n1 :: Vint n2 :: nil =>
+ Some (Int.cmpu c n1 (eval_shift s n2))
+ | Ccompimm c n, Vint n1 :: nil =>
+ Some (Int.cmp c n1 n)
+ | Ccompimm c n, Vptr b1 n1 :: nil =>
+ eval_compare_null c n
+ | Ccompuimm c n, Vint n1 :: nil =>
+ Some (Int.cmpu c n1 n)
+ | Ccompf c, Vfloat f1 :: Vfloat f2 :: nil =>
+ Some (Float.cmp c f1 f2)
+ | Cnotcompf c, Vfloat f1 :: Vfloat f2 :: nil =>
+ Some (negb (Float.cmp c f1 f2))
+ | _, _ =>
+ None
+ end.
+
+Definition offset_sp (sp: val) (delta: int) : option val :=
+ match sp with
+ | Vptr b n => Some (Vptr b (Int.add n delta))
+ | _ => None
+ end.
+
+Definition eval_operation
+ (F: Set) (genv: Genv.t F) (sp: val)
+ (op: operation) (vl: list val) (m: mem): option val :=
+ match op, vl with
+ | Omove, v1::nil => Some v1
+ | Ointconst n, nil => Some (Vint n)
+ | Ofloatconst n, nil => Some (Vfloat n)
+ | Oaddrsymbol s ofs, nil =>
+ match Genv.find_symbol genv s with
+ | None => None
+ | Some b => Some (Vptr b ofs)
+ end
+ | Oaddrstack ofs, nil => offset_sp sp ofs
+ | Ocast8signed, v1 :: nil => Some (Val.sign_ext 8 v1)
+ | Ocast8unsigned, v1 :: nil => Some (Val.zero_ext 8 v1)
+ | Ocast16signed, v1 :: nil => Some (Val.sign_ext 16 v1)
+ | Ocast16unsigned, v1 :: nil => Some (Val.zero_ext 16 v1)
+ | Oadd, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.add n1 n2))
+ | Oadd, Vint n1 :: Vptr b2 n2 :: nil => Some (Vptr b2 (Int.add n2 n1))
+ | Oadd, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.add n1 n2))
+ | Oaddshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.add n1 (eval_shift s n2)))
+ | Oaddshift s, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.add n1 (eval_shift s n2)))
+ | Oaddimm n, Vint n1 :: nil => Some (Vint (Int.add n1 n))
+ | Oaddimm n, Vptr b1 n1 :: nil => Some (Vptr b1 (Int.add n1 n))
+ | Osub, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.sub n1 n2))
+ | Osub, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.sub n1 n2))
+ | Osub, Vptr b1 n1 :: Vptr b2 n2 :: nil =>
+ if eq_block b1 b2 then Some (Vint (Int.sub n1 n2)) else None
+ | Osubshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.sub n1 (eval_shift s n2)))
+ | Osubshift s, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.sub n1 (eval_shift s n2)))
+ | Orsubshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.sub (eval_shift s n2) n1))
+ | Orsubimm n, Vint n1 :: nil => Some (Vint (Int.sub n n1))
+ | Omul, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.mul n1 n2))
+ | Odiv, Vint n1 :: Vint n2 :: nil =>
+ if Int.eq n2 Int.zero then None else Some (Vint (Int.divs n1 n2))
+ | Odivu, Vint n1 :: Vint n2 :: nil =>
+ if Int.eq n2 Int.zero then None else Some (Vint (Int.divu n1 n2))
+ | Oand, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 n2))
+ | Oandshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 (eval_shift s n2)))
+ | Oandimm n, Vint n1 :: nil => Some (Vint (Int.and n1 n))
+ | Oor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.or n1 n2))
+ | Oorshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.or n1 (eval_shift s n2)))
+ | Oorimm n, Vint n1 :: nil => Some (Vint (Int.or n1 n))
+ | Oxor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.xor n1 n2))
+ | Oxorshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.xor n1 (eval_shift s n2)))
+ | Oxorimm n, Vint n1 :: nil => Some (Vint (Int.xor n1 n))
+ | Obic, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 (Int.not n2)))
+ | Obicshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 (Int.not (eval_shift s n2))))
+ | Onot, Vint n1 :: nil => Some (Vint (Int.not n1))
+ | Onotshift s, Vint n1 :: nil => Some (Vint (Int.not (eval_shift s n1)))
+ | Oshl, Vint n1 :: Vint n2 :: nil =>
+ if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shl n1 n2)) else None
+ | Oshr, Vint n1 :: Vint n2 :: nil =>
+ if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shr n1 n2)) else None
+ | Oshru, Vint n1 :: Vint n2 :: nil =>
+ if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shru n1 n2)) else None
+ | Oshift s, Vint n :: nil => Some (Vint (eval_shift s n))
+ | Oshrximm n, Vint n1 :: nil =>
+ if Int.ltu n (Int.repr 31) then Some (Vint (Int.shrx n1 n)) else None
+ | Onegf, Vfloat f1 :: nil => Some (Vfloat (Float.neg f1))
+ | Oabsf, Vfloat f1 :: nil => Some (Vfloat (Float.abs f1))
+ | Oaddf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.add f1 f2))
+ | Osubf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.sub f1 f2))
+ | Omulf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.mul f1 f2))
+ | Odivf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.div f1 f2))
+ | Osingleoffloat, v1 :: nil =>
+ Some (Val.singleoffloat v1)
+ | Ointoffloat, Vfloat f1 :: nil =>
+ Some (Vint (Float.intoffloat f1))
+ | Ointuoffloat, Vfloat f1 :: nil =>
+ Some (Vint (Float.intuoffloat f1))
+ | Ofloatofint, Vint n1 :: nil =>
+ Some (Vfloat (Float.floatofint n1))
+ | Ofloatofintu, Vint n1 :: nil =>
+ Some (Vfloat (Float.floatofintu n1))
+ | Ocmp c, _ =>
+ match eval_condition c vl m with
+ | None => None
+ | Some false => Some Vfalse
+ | Some true => Some Vtrue
+ end
+ | _, _ => None
+ end.
+
+Definition eval_addressing
+ (F: Set) (genv: Genv.t F) (sp: val)
+ (addr: addressing) (vl: list val) : option val :=
+ match addr, vl with
+ | Aindexed n, Vptr b1 n1 :: nil =>
+ Some (Vptr b1 (Int.add n1 n))
+ | Aindexed2, Vptr b1 n1 :: Vint n2 :: nil =>
+ Some (Vptr b1 (Int.add n1 n2))
+ | Aindexed2, Vint n1 :: Vptr b2 n2 :: nil =>
+ Some (Vptr b2 (Int.add n1 n2))
+ | Aindexed2shift s, Vptr b1 n1 :: Vint n2 :: nil =>
+ Some (Vptr b1 (Int.add n1 (eval_shift s n2)))
+ | Ainstack ofs, nil =>
+ offset_sp sp ofs
+ | _, _ => None
+ end.
+
+Definition negate_condition (cond: condition): condition :=
+ match cond with
+ | Ccomp c => Ccomp(negate_comparison c)
+ | Ccompu c => Ccompu(negate_comparison c)
+ | Ccompshift c s => Ccompshift (negate_comparison c) s
+ | Ccompushift c s => Ccompushift (negate_comparison c) s
+ | Ccompimm c n => Ccompimm (negate_comparison c) n
+ | Ccompuimm c n => Ccompuimm (negate_comparison c) n
+ | Ccompf c => Cnotcompf c
+ | Cnotcompf c => Ccompf c
+ end.
+
+Ltac FuncInv :=
+ match goal with
+ | H: (match ?x with nil => _ | _ :: _ => _ end = Some _) |- _ =>
+ destruct x; simpl in H; try discriminate; FuncInv
+ | H: (match ?v with Vundef => _ | Vint _ => _ | Vfloat _ => _ | Vptr _ _ => _ end = Some _) |- _ =>
+ destruct v; simpl in H; try discriminate; FuncInv
+ | H: (Some _ = Some _) |- _ =>
+ injection H; intros; clear H; FuncInv
+ | _ =>
+ idtac
+ end.
+
+Remark eval_negate_compare_null:
+ forall c n b,
+ eval_compare_null c n = Some b ->
+ eval_compare_null (negate_comparison c) n = Some (negb b).
+Proof.
+ intros until b. unfold eval_compare_null.
+ case (Int.eq n Int.zero).
+ destruct c; intro EQ; simplify_eq EQ; intros; subst b; reflexivity.
+ intro; discriminate.
+Qed.
+
+Lemma eval_negate_condition:
+ forall (cond: condition) (vl: list val) (b: bool) (m: mem),
+ eval_condition cond vl m = Some b ->
+ eval_condition (negate_condition cond) vl m = Some (negb b).
+Proof.
+ intros.
+ destruct cond; simpl in H; FuncInv; try subst b; simpl.
+ rewrite Int.negate_cmp. auto.
+ apply eval_negate_compare_null; auto.
+ apply eval_negate_compare_null; auto.
+ destruct (valid_pointer m b0 (Int.signed i) &&
+ valid_pointer m b1 (Int.signed i0)).
+ destruct (eq_block b0 b1). rewrite Int.negate_cmp. congruence.
+ destruct c; simpl in H; inv H; auto.
+ discriminate.
+ rewrite Int.negate_cmpu. auto.
+ rewrite Int.negate_cmp. auto.
+ apply eval_negate_compare_null; auto.
+ rewrite Int.negate_cmpu. auto.
+ rewrite Int.negate_cmp. auto.
+ apply eval_negate_compare_null; auto.
+ rewrite Int.negate_cmpu. auto.
+ auto.
+ rewrite negb_elim. auto.
+Qed.
+
+(** [eval_operation] and [eval_addressing] depend on a global environment
+ for resolving references to global symbols. We show that they give
+ the same results if a global environment is replaced by another that
+ assigns the same addresses to the same symbols. *)
+
+Section GENV_TRANSF.
+
+Variable F1 F2: Set.
+Variable ge1: Genv.t F1.
+Variable ge2: Genv.t F2.
+Hypothesis agree_on_symbols:
+ forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s.
+
+Lemma eval_operation_preserved:
+ forall sp op vl m,
+ eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m.
+Proof.
+ intros.
+ unfold eval_operation; destruct op; try rewrite agree_on_symbols;
+ reflexivity.
+Qed.
+
+Lemma eval_addressing_preserved:
+ forall sp addr vl,
+ eval_addressing ge2 sp addr vl = eval_addressing ge1 sp addr vl.
+Proof.
+ intros.
+ assert (UNUSED: forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s).
+ exact agree_on_symbols.
+ unfold eval_addressing; destruct addr; try rewrite agree_on_symbols;
+ reflexivity.
+Qed.
+
+End GENV_TRANSF.
+
+(** [eval_condition] and [eval_operation] depend on a memory store
+ (to check pointer validity in pointer comparisons).
+ We show that their results are preserved by a change of
+ memory if this change preserves pointer validity.
+ In particular, this holds in case of a memory allocation
+ or a memory store. *)
+
+Lemma eval_condition_change_mem:
+ forall m m' c args b,
+ (forall b ofs, valid_pointer m b ofs = true -> valid_pointer m' b ofs = true) ->
+ eval_condition c args m = Some b -> eval_condition c args m' = Some b.
+Proof.
+ intros until b. intro INV. destruct c; simpl; auto.
+ destruct args; auto. destruct v; auto. destruct args; auto.
+ destruct v; auto. destruct args; auto.
+ caseEq (valid_pointer m b0 (Int.signed i)); intro.
+ caseEq (valid_pointer m b1 (Int.signed i0)); intro.
+ simpl. rewrite (INV _ _ H). rewrite (INV _ _ H0). auto.
+ simpl; congruence. simpl; congruence.
+Qed.
+
+Lemma eval_operation_change_mem:
+ forall (F: Set) m m' (ge: Genv.t F) sp op args v,
+ (forall b ofs, valid_pointer m b ofs = true -> valid_pointer m' b ofs = true) ->
+ eval_operation ge sp op args m = Some v -> eval_operation ge sp op args m' = Some v.
+Proof.
+ intros until v; intro INV. destruct op; simpl; auto.
+ caseEq (eval_condition c args m); intros.
+ rewrite (eval_condition_change_mem _ _ _ _ INV H). auto.
+ discriminate.
+Qed.
+
+Lemma eval_condition_alloc:
+ forall m lo hi m' b c args v,
+ Mem.alloc m lo hi = (m', b) ->
+ eval_condition c args m = Some v -> eval_condition c args m' = Some v.
+Proof.
+ intros. apply eval_condition_change_mem with m; auto.
+ intros. eapply valid_pointer_alloc; eauto.
+Qed.
+
+Lemma eval_operation_alloc:
+ forall (F: Set) m lo hi m' b (ge: Genv.t F) sp op args v,
+ Mem.alloc m lo hi = (m', b) ->
+ eval_operation ge sp op args m = Some v -> eval_operation ge sp op args m' = Some v.
+Proof.
+ intros. apply eval_operation_change_mem with m; auto.
+ intros. eapply valid_pointer_alloc; eauto.
+Qed.
+
+Lemma eval_condition_store:
+ forall chunk m b ofs v' m' c args v,
+ Mem.store chunk m b ofs v' = Some m' ->
+ eval_condition c args m = Some v -> eval_condition c args m' = Some v.
+Proof.
+ intros. apply eval_condition_change_mem with m; auto.
+ intros. eapply valid_pointer_store; eauto.
+Qed.
+
+Lemma eval_operation_store:
+ forall (F: Set) chunk m b ofs v' m' (ge: Genv.t F) sp op args v,
+ Mem.store chunk m b ofs v' = Some m' ->
+ eval_operation ge sp op args m = Some v -> eval_operation ge sp op args m' = Some v.
+Proof.
+ intros. apply eval_operation_change_mem with m; auto.
+ intros. eapply valid_pointer_store; eauto.
+Qed.
+
+(** Recognition of move operations. *)
+
+Definition is_move_operation
+ (A: Set) (op: operation) (args: list A) : option A :=
+ match op, args with
+ | Omove, arg :: nil => Some arg
+ | _, _ => None
+ end.
+
+Lemma is_move_operation_correct:
+ forall (A: Set) (op: operation) (args: list A) (a: A),
+ is_move_operation op args = Some a ->
+ op = Omove /\ args = a :: nil.
+Proof.
+ intros until a. unfold is_move_operation; destruct op;
+ try (intros; discriminate).
+ destruct args. intros; discriminate.
+ destruct args. intros. intuition congruence.
+ intros; discriminate.
+Qed.
+
+(** Static typing of conditions, operators and addressing modes. *)
+
+Definition type_of_condition (c: condition) : list typ :=
+ match c with
+ | Ccomp _ => Tint :: Tint :: nil
+ | Ccompu _ => Tint :: Tint :: nil
+ | Ccompshift _ _ => Tint :: Tint :: nil
+ | Ccompushift _ _ => Tint :: Tint :: nil
+ | Ccompimm _ _ => Tint :: nil
+ | Ccompuimm _ _ => Tint :: nil
+ | Ccompf _ => Tfloat :: Tfloat :: nil
+ | Cnotcompf _ => Tfloat :: Tfloat :: nil
+ end.
+
+Definition type_of_operation (op: operation) : list typ * typ :=
+ match op with
+ | Omove => (nil, Tint) (* treated specially *)
+ | Ointconst _ => (nil, Tint)
+ | Ofloatconst _ => (nil, Tfloat)
+ | Oaddrsymbol _ _ => (nil, Tint)
+ | Oaddrstack _ => (nil, Tint)
+ | Ocast8signed => (Tint :: nil, Tint)
+ | Ocast8unsigned => (Tint :: nil, Tint)
+ | Ocast16signed => (Tint :: nil, Tint)
+ | Ocast16unsigned => (Tint :: nil, Tint)
+ | Oadd => (Tint :: Tint :: nil, Tint)
+ | Oaddshift _ => (Tint :: Tint :: nil, Tint)
+ | Oaddimm _ => (Tint :: nil, Tint)
+ | Osub => (Tint :: Tint :: nil, Tint)
+ | Osubshift _ => (Tint :: Tint :: nil, Tint)
+ | Orsubshift _ => (Tint :: Tint :: nil, Tint)
+ | Orsubimm _ => (Tint :: nil, Tint)
+ | Omul => (Tint :: Tint :: nil, Tint)
+ | Odiv => (Tint :: Tint :: nil, Tint)
+ | Odivu => (Tint :: Tint :: nil, Tint)
+ | Oand => (Tint :: Tint :: nil, Tint)
+ | Oandshift _ => (Tint :: Tint :: nil, Tint)
+ | Oandimm _ => (Tint :: nil, Tint)
+ | Oor => (Tint :: Tint :: nil, Tint)
+ | Oorshift _ => (Tint :: Tint :: nil, Tint)
+ | Oorimm _ => (Tint :: nil, Tint)
+ | Oxor => (Tint :: Tint :: nil, Tint)
+ | Oxorshift _ => (Tint :: Tint :: nil, Tint)
+ | Oxorimm _ => (Tint :: nil, Tint)
+ | Obic => (Tint :: Tint :: nil, Tint)
+ | Obicshift _ => (Tint :: Tint :: nil, Tint)
+ | Onot => (Tint :: nil, Tint)
+ | Onotshift _ => (Tint :: nil, Tint)
+ | Oshl => (Tint :: Tint :: nil, Tint)
+ | Oshr => (Tint :: Tint :: nil, Tint)
+ | Oshru => (Tint :: Tint :: nil, Tint)
+ | Oshift _ => (Tint :: nil, Tint)
+ | Oshrximm _ => (Tint :: nil, Tint)
+ | Onegf => (Tfloat :: nil, Tfloat)
+ | Oabsf => (Tfloat :: nil, Tfloat)
+ | Oaddf => (Tfloat :: Tfloat :: nil, Tfloat)
+ | Osubf => (Tfloat :: Tfloat :: nil, Tfloat)
+ | Omulf => (Tfloat :: Tfloat :: nil, Tfloat)
+ | Odivf => (Tfloat :: Tfloat :: nil, Tfloat)
+ | Osingleoffloat => (Tfloat :: nil, Tfloat)
+ | Ointoffloat => (Tfloat :: nil, Tint)
+ | Ointuoffloat => (Tfloat :: nil, Tint)
+ | Ofloatofint => (Tint :: nil, Tfloat)
+ | Ofloatofintu => (Tint :: nil, Tfloat)
+ | Ocmp c => (type_of_condition c, Tint)
+ end.
+
+Definition type_of_addressing (addr: addressing) : list typ :=
+ match addr with
+ | Aindexed _ => Tint :: nil
+ | Aindexed2 => Tint :: Tint :: nil
+ | Aindexed2shift _ => Tint :: Tint :: nil
+ | Ainstack _ => nil
+ end.
+
+Definition type_of_chunk (c: memory_chunk) : typ :=
+ match c with
+ | Mint8signed => Tint
+ | Mint8unsigned => Tint
+ | Mint16signed => Tint
+ | Mint16unsigned => Tint
+ | Mint32 => Tint
+ | Mfloat32 => Tfloat
+ | Mfloat64 => Tfloat
+ end.
+
+(** Weak type soundness results for [eval_operation]:
+ the result values, when defined, are always of the type predicted
+ by [type_of_operation]. *)
+
+Section SOUNDNESS.
+
+Variable A: Set.
+Variable genv: Genv.t A.
+
+Lemma type_of_operation_sound:
+ forall op vl sp v m,
+ op <> Omove ->
+ eval_operation genv sp op vl m = Some v ->
+ Val.has_type v (snd (type_of_operation op)).
+Proof.
+ intros.
+ destruct op; simpl in H0; FuncInv; try subst v; try exact I.
+ congruence.
+ destruct (Genv.find_symbol genv i); simplify_eq H0; intro; subst v; exact I.
+ simpl. unfold offset_sp in H0. destruct sp; try discriminate.
+ inversion H0. exact I.
+ destruct v0; exact I.
+ destruct v0; exact I.
+ destruct v0; exact I.
+ destruct v0; exact I.
+ destruct (eq_block b b0). injection H0; intro; subst v; exact I.
+ discriminate.
+ destruct (Int.eq i0 Int.zero). discriminate.
+ injection H0; intro; subst v; exact I.
+ destruct (Int.eq i0 Int.zero). discriminate.
+ injection H0; intro; subst v; exact I.
+ destruct (Int.ltu i0 (Int.repr 32)).
+ injection H0; intro; subst v; exact I. discriminate.
+ destruct (Int.ltu i0 (Int.repr 32)).
+ injection H0; intro; subst v; exact I. discriminate.
+ destruct (Int.ltu i0 (Int.repr 32)).
+ injection H0; intro; subst v; exact I. discriminate.
+ destruct (Int.ltu i (Int.repr 31)).
+ injection H0; intro; subst v; exact I. discriminate.
+ destruct v0; exact I.
+ destruct (eval_condition c vl).
+ destruct b; injection H0; intro; subst v; exact I.
+ discriminate.
+Qed.
+
+Lemma type_of_chunk_correct:
+ forall chunk m addr v,
+ Mem.loadv chunk m addr = Some v ->
+ Val.has_type v (type_of_chunk chunk).
+Proof.
+ intro chunk.
+ assert (forall v, Val.has_type (Val.load_result chunk v) (type_of_chunk chunk)).
+ destruct v; destruct chunk; exact I.
+ intros until v. unfold Mem.loadv.
+ destruct addr; intros; try discriminate.
+ generalize (Mem.load_inv _ _ _ _ _ H0).
+ intros [X Y]. subst v. apply H.
+Qed.
+
+End SOUNDNESS.
+
+(** Alternate definition of [eval_condition], [eval_op], [eval_addressing]
+ as total functions that return [Vundef] when not applicable
+ (instead of [None]). Used in the proof of [PPCgen]. *)
+
+Section EVAL_OP_TOTAL.
+
+Variable F: Set.
+Variable genv: Genv.t F.
+
+Definition find_symbol_offset (id: ident) (ofs: int) : val :=
+ match Genv.find_symbol genv id with
+ | Some b => Vptr b ofs
+ | None => Vundef
+ end.
+
+Definition eval_shift_total (s: shift) (v: val) : val :=
+ match v with
+ | Vint n => Vint(eval_shift s n)
+ | _ => Vundef
+ end.
+
+Definition eval_condition_total (cond: condition) (vl: list val) : val :=
+ match cond, vl with
+ | Ccomp c, v1::v2::nil => Val.cmp c v1 v2
+ | Ccompu c, v1::v2::nil => Val.cmpu c v1 v2
+ | Ccompshift c s, v1::v2::nil => Val.cmp c v1 (eval_shift_total s v2)
+ | Ccompushift c s, v1::v2::nil => Val.cmpu c v1 (eval_shift_total s v2)
+ | Ccompimm c n, v1::nil => Val.cmp c v1 (Vint n)
+ | Ccompuimm c n, v1::nil => Val.cmpu c v1 (Vint n)
+ | Ccompf c, v1::v2::nil => Val.cmpf c v1 v2
+ | Cnotcompf c, v1::v2::nil => Val.notbool(Val.cmpf c v1 v2)
+ | _, _ => Vundef
+ end.
+
+Definition eval_operation_total (sp: val) (op: operation) (vl: list val) : val :=
+ match op, vl with
+ | Omove, v1::nil => v1
+ | Ointconst n, nil => Vint n
+ | Ofloatconst n, nil => Vfloat n
+ | Oaddrsymbol s ofs, nil => find_symbol_offset s ofs
+ | Oaddrstack ofs, nil => Val.add sp (Vint ofs)
+ | Ocast8signed, v1::nil => Val.sign_ext 8 v1
+ | Ocast8unsigned, v1::nil => Val.zero_ext 8 v1
+ | Ocast16signed, v1::nil => Val.sign_ext 16 v1
+ | Ocast16unsigned, v1::nil => Val.zero_ext 16 v1
+ | Oadd, v1::v2::nil => Val.add v1 v2
+ | Oaddshift s, v1::v2::nil => Val.add v1 (eval_shift_total s v2)
+ | Oaddimm n, v1::nil => Val.add v1 (Vint n)
+ | Osub, v1::v2::nil => Val.sub v1 v2
+ | Osubshift s, v1::v2::nil => Val.sub v1 (eval_shift_total s v2)
+ | Orsubshift s, v1::v2::nil => Val.sub (eval_shift_total s v2) v1
+ | Orsubimm n, v1::nil => Val.sub (Vint n) v1
+ | Omul, v1::v2::nil => Val.mul v1 v2
+ | Odiv, v1::v2::nil => Val.divs v1 v2
+ | Odivu, v1::v2::nil => Val.divu v1 v2
+ | Oand, v1::v2::nil => Val.and v1 v2
+ | Oandshift s, v1::v2::nil => Val.and v1 (eval_shift_total s v2)
+ | Oandimm n, v1::nil => Val.and v1 (Vint n)
+ | Oor, v1::v2::nil => Val.or v1 v2
+ | Oorshift s, v1::v2::nil => Val.or v1 (eval_shift_total s v2)
+ | Oorimm n, v1::nil => Val.or v1 (Vint n)
+ | Oxor, v1::v2::nil => Val.xor v1 v2
+ | Oxorshift s, v1::v2::nil => Val.xor v1 (eval_shift_total s v2)
+ | Oxorimm n, v1::nil => Val.xor v1 (Vint n)
+ | Obic, v1::v2::nil => Val.and v1 (Val.notint v2)
+ | Obicshift s, v1::v2::nil => Val.and v1 (Val.notint (eval_shift_total s v2))
+ | Onot, v1::nil => Val.notint v1
+ | Onotshift s, v1::nil => Val.notint (eval_shift_total s v1)
+ | Oshl, v1::v2::nil => Val.shl v1 v2
+ | Oshr, v1::v2::nil => Val.shr v1 v2
+ | Oshru, v1::v2::nil => Val.shru v1 v2
+ | Oshrximm n, v1::nil => Val.shrx v1 (Vint n)
+ | Oshift s, v1::nil => eval_shift_total s v1
+ | Onegf, v1::nil => Val.negf v1
+ | Oabsf, v1::nil => Val.absf v1
+ | Oaddf, v1::v2::nil => Val.addf v1 v2
+ | Osubf, v1::v2::nil => Val.subf v1 v2
+ | Omulf, v1::v2::nil => Val.mulf v1 v2
+ | Odivf, v1::v2::nil => Val.divf v1 v2
+ | Osingleoffloat, v1::nil => Val.singleoffloat v1
+ | Ointoffloat, v1::nil => Val.intoffloat v1
+ | Ointuoffloat, v1::nil => Val.intuoffloat v1
+ | Ofloatofint, v1::nil => Val.floatofint v1
+ | Ofloatofintu, v1::nil => Val.floatofintu v1
+ | Ocmp c, _ => eval_condition_total c vl
+ | _, _ => Vundef
+ end.
+
+Definition eval_addressing_total
+ (sp: val) (addr: addressing) (vl: list val) : val :=
+ match addr, vl with
+ | Aindexed n, v1::nil => Val.add v1 (Vint n)
+ | Aindexed2, v1::v2::nil => Val.add v1 v2
+ | Aindexed2shift s, v1::v2::nil => Val.add v1 (eval_shift_total s v2)
+ | Ainstack ofs, nil => Val.add sp (Vint ofs)
+ | _, _ => Vundef
+ end.
+
+Lemma eval_compare_mismatch_weaken:
+ forall c b,
+ eval_compare_mismatch c = Some b ->
+ Val.cmp_mismatch c = Val.of_bool b.
+Proof.
+ unfold eval_compare_mismatch. intros. destruct c; inv H; auto.
+Qed.
+
+Lemma eval_compare_null_weaken:
+ forall c i b,
+ eval_compare_null c i = Some b ->
+ (if Int.eq i Int.zero then Val.cmp_mismatch c else Vundef) = Val.of_bool b.
+Proof.
+ unfold eval_compare_null. intros.
+ destruct (Int.eq i Int.zero); try discriminate.
+ apply eval_compare_mismatch_weaken; auto.
+Qed.
+
+Lemma eval_condition_weaken:
+ forall c vl m b,
+ eval_condition c vl m = Some b ->
+ eval_condition_total c vl = Val.of_bool b.
+Proof.
+ intros.
+ unfold eval_condition in H; destruct c; FuncInv;
+ try subst b; try reflexivity; simpl;
+ try (apply eval_compare_null_weaken; auto).
+ destruct (valid_pointer m b0 (Int.signed i) &&
+ valid_pointer m b1 (Int.signed i0)).
+ unfold eq_block in H. destruct (zeq b0 b1); try congruence.
+ apply eval_compare_mismatch_weaken; auto.
+ discriminate.
+ symmetry. apply Val.notbool_negb_1.
+Qed.
+
+Lemma eval_operation_weaken:
+ forall sp op vl m v,
+ eval_operation genv sp op vl m = Some v ->
+ eval_operation_total sp op vl = v.
+Proof.
+ intros.
+ unfold eval_operation in H; destruct op; FuncInv;
+ try subst v; try reflexivity; simpl.
+ unfold find_symbol_offset.
+ destruct (Genv.find_symbol genv i); try discriminate.
+ congruence.
+ unfold offset_sp in H.
+ destruct sp; try discriminate. simpl. congruence.
+ unfold eq_block in H. destruct (zeq b b0); congruence.
+ destruct (Int.eq i0 Int.zero); congruence.
+ destruct (Int.eq i0 Int.zero); congruence.
+ destruct (Int.ltu i0 (Int.repr 32)); congruence.
+ destruct (Int.ltu i0 (Int.repr 32)); congruence.
+ destruct (Int.ltu i0 (Int.repr 32)); congruence.
+ unfold Int.ltu in H. destruct (zlt (Int.unsigned i) (Int.unsigned (Int.repr 31))).
+ unfold Int.ltu. rewrite zlt_true. congruence.
+ assert (Int.unsigned (Int.repr 31) < Int.unsigned (Int.repr 32)). vm_compute; auto.
+ omega. discriminate.
+ caseEq (eval_condition c vl m); intros; rewrite H0 in H.
+ replace v with (Val.of_bool b).
+ eapply eval_condition_weaken; eauto.
+ destruct b; simpl; congruence.
+ discriminate.
+Qed.
+
+Lemma eval_addressing_weaken:
+ forall sp addr vl v,
+ eval_addressing genv sp addr vl = Some v ->
+ eval_addressing_total sp addr vl = v.
+Proof.
+ intros.
+ unfold eval_addressing in H; destruct addr; FuncInv;
+ try subst v; simpl; try reflexivity.
+ decEq. apply Int.add_commut.
+ unfold offset_sp in H. destruct sp; simpl; congruence.
+Qed.
+
+Lemma eval_condition_total_is_bool:
+ forall cond vl, Val.is_bool (eval_condition_total cond vl).
+Proof.
+ intros; destruct cond;
+ destruct vl; try apply Val.undef_is_bool;
+ destruct vl; try apply Val.undef_is_bool;
+ try (destruct vl; try apply Val.undef_is_bool); simpl.
+ apply Val.cmp_is_bool.
+ apply Val.cmpu_is_bool.
+ apply Val.cmp_is_bool.
+ apply Val.cmpu_is_bool.
+ apply Val.cmp_is_bool.
+ apply Val.cmpu_is_bool.
+ apply Val.cmpf_is_bool.
+ apply Val.notbool_is_bool.
+Qed.
+
+End EVAL_OP_TOTAL.
+
+(** Compatibility of the evaluation functions with the
+ ``is less defined'' relation over values and memory states. *)
+
+Section EVAL_LESSDEF.
+
+Variable F: Set.
+Variable genv: Genv.t F.
+Variables m1 m2: mem.
+Hypothesis MEM: Mem.lessdef m1 m2.
+
+Ltac InvLessdef :=
+ match goal with
+ | [ H: Val.lessdef (Vint _) _ |- _ ] =>
+ inv H; InvLessdef
+ | [ H: Val.lessdef (Vfloat _) _ |- _ ] =>
+ inv H; InvLessdef
+ | [ H: Val.lessdef (Vptr _ _) _ |- _ ] =>
+ inv H; InvLessdef
+ | [ H: Val.lessdef_list nil _ |- _ ] =>
+ inv H; InvLessdef
+ | [ H: Val.lessdef_list (_ :: _) _ |- _ ] =>
+ inv H; InvLessdef
+ | _ => idtac
+ end.
+
+Lemma eval_condition_lessdef:
+ forall cond vl1 vl2 b,
+ Val.lessdef_list vl1 vl2 ->
+ eval_condition cond vl1 m1 = Some b ->
+ eval_condition cond vl2 m2 = Some b.
+Proof.
+ intros. destruct cond; simpl in *; FuncInv; InvLessdef; auto.
+ generalize H0.
+ caseEq (valid_pointer m1 b0 (Int.signed i)); intro; simpl; try congruence.
+ caseEq (valid_pointer m1 b1 (Int.signed i0)); intro; simpl; try congruence.
+ rewrite (Mem.valid_pointer_lessdef _ _ _ _ MEM H1).
+ rewrite (Mem.valid_pointer_lessdef _ _ _ _ MEM H). simpl. auto.
+Qed.
+
+Ltac TrivialExists :=
+ match goal with
+ | [ |- exists v2, Some ?v1 = Some v2 /\ Val.lessdef ?v1 v2 ] =>
+ exists v1; split; [auto | constructor]
+ | _ => idtac
+ end.
+
+Lemma eval_operation_lessdef:
+ forall sp op vl1 vl2 v1,
+ Val.lessdef_list vl1 vl2 ->
+ eval_operation genv sp op vl1 m1 = Some v1 ->
+ exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2.
+Proof.
+ intros. destruct op; simpl in *; FuncInv; InvLessdef; TrivialExists.
+ exists v2; auto.
+ destruct (Genv.find_symbol genv i); inv H0. TrivialExists.
+ exists v1; auto.
+ exists (Val.sign_ext 8 v2); split. auto. apply Val.sign_ext_lessdef; auto.
+ exists (Val.zero_ext 8 v2); split. auto. apply Val.zero_ext_lessdef; auto.
+ exists (Val.sign_ext 16 v2); split. auto. apply Val.sign_ext_lessdef; auto.
+ exists (Val.zero_ext 16 v2); split. auto. apply Val.zero_ext_lessdef; auto.
+ destruct (eq_block b b0); inv H0. TrivialExists.
+ destruct (Int.eq i0 Int.zero); inv H0; TrivialExists.
+ destruct (Int.eq i0 Int.zero); inv H0; TrivialExists.
+ destruct (Int.ltu i0 (Int.repr 32)); inv H0; TrivialExists.
+ destruct (Int.ltu i0 (Int.repr 32)); inv H0; TrivialExists.
+ destruct (Int.ltu i (Int.repr 32)); inv H0; TrivialExists.
+ destruct (Int.ltu i0 (Int.repr 32)); inv H1; TrivialExists.
+ destruct (Int.ltu i0 (Int.repr 32)); inv H1; TrivialExists.
+ destruct (Int.ltu i (Int.repr 31)); inv H0; TrivialExists.
+ exists (Val.singleoffloat v2); split. auto. apply Val.singleoffloat_lessdef; auto.
+ caseEq (eval_condition c vl1 m1); intros. rewrite H1 in H0.
+ rewrite (eval_condition_lessdef c H H1).
+ destruct b; inv H0; TrivialExists.
+ rewrite H1 in H0. discriminate.
+Qed.
+
+Lemma eval_addressing_lessdef:
+ forall sp addr vl1 vl2 v1,
+ Val.lessdef_list vl1 vl2 ->
+ eval_addressing genv sp addr vl1 = Some v1 ->
+ exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2.
+Proof.
+ intros. destruct addr; simpl in *; FuncInv; InvLessdef; TrivialExists.
+ exists v1; auto.
+Qed.
+
+End EVAL_LESSDEF.
+
+(** Recognition of integers that are valid shift amounts. *)
+
+Definition is_shift_amount_aux (n: int) :
+ { Int.ltu n (Int.repr 32) = true } +
+ { Int.ltu n (Int.repr 32) = false }.
+Proof.
+ intro. case (Int.ltu n (Int.repr 32)). left; auto. right; auto.
+Defined.
+
+Definition is_shift_amount (n: int) : option shift_amount :=
+ match is_shift_amount_aux n with
+ | left H => Some(mk_shift_amount n H)
+ | right _ => None
+ end.
+
+Lemma is_shift_amount_Some:
+ forall n s, is_shift_amount n = Some s -> s_amount s = n.
+Proof.
+ intros until s. unfold is_shift_amount.
+ destruct (is_shift_amount_aux n).
+ simpl. intros. inv H. reflexivity.
+ congruence.
+Qed.
+
+Lemma is_shift_amount_None:
+ forall n, is_shift_amount n = None -> Int.ltu n (Int.repr 32) = true -> False.
+Proof.
+ intro n. unfold is_shift_amount.
+ destruct (is_shift_amount_aux n).
+ congruence.
+ congruence.
+Qed.
+
+(** Transformation of addressing modes with two operands or more
+ into an equivalent arithmetic operation. This is used in the [Reload]
+ pass when a store instruction cannot be reloaded directly because
+ it runs out of temporary registers. *)
+
+(** For the ARM, there are only two binary addressing mode: [Aindexed2]
+ and [Aindexed2shift]. The corresponding operations are [Oadd]
+ and [Oaddshift]. *)
+
+Definition op_for_binary_addressing (addr: addressing) : operation :=
+ match addr with
+ | Aindexed2 => Oadd
+ | Aindexed2shift s => Oaddshift s
+ | _ => Ointconst Int.zero (* never happens *)
+ end.
+
+Lemma eval_op_for_binary_addressing:
+ forall (F: Set) (ge: Genv.t F) sp addr args m v,
+ (length args >= 2)%nat ->
+ eval_addressing ge sp addr args = Some v ->
+ eval_operation ge sp (op_for_binary_addressing addr) args m = Some v.
+Proof.
+ intros.
+ unfold eval_addressing in H0; destruct addr; FuncInv; simpl in H; try omegaContradiction; simpl.
+ rewrite Int.add_commut. congruence.
+ congruence.
+ congruence.
+Qed.
+
+Lemma type_op_for_binary_addressing:
+ forall addr,
+ (length (type_of_addressing addr) >= 2)%nat ->
+ type_of_operation (op_for_binary_addressing addr) = (type_of_addressing addr, Tint).
+Proof.
+ intros. destruct addr; simpl in H; reflexivity || omegaContradiction.
+Qed.
diff --git a/arm/Selection.v b/arm/Selection.v
new file mode 100644
index 0000000000000000000000000000000000000000..d5eb6b8b01b17d444caf07bbb67da4c30bc226d6
--- /dev/null
+++ b/arm/Selection.v
@@ -0,0 +1,1394 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Instruction selection *)
+
+(** The instruction selection pass recognizes opportunities for using
+ combined arithmetic and logical operations and addressing modes
+ offered by the target processor. For instance, the expression [x + 1]
+ can take advantage of the "immediate add" instruction of the processor,
+ and on the PowerPC, the expression [(x >> 6) & 0xFF] can be turned
+ into a "rotate and mask" instruction.
+
+ Instruction selection proceeds by bottom-up rewriting over expressions.
+ The source language is Cminor and the target language is CminorSel. *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Mem.
+Require Import Globalenvs.
+Require Cminor.
+Require Import Op.
+Require Import CminorSel.
+
+Infix ":::" := Econs (at level 60, right associativity) : selection_scope.
+
+Open Local Scope selection_scope.
+
+(** * Lifting of let-bound variables *)
+
+(** Some of the instruction functions generate [Elet] constructs to
+ share the evaluation of a subexpression. Owing to the use of de
+ Bruijn indices for let-bound variables, we need to shift de Bruijn
+ indices when an expression [b] is put in a [Elet a b] context. *)
+
+Fixpoint lift_expr (p: nat) (a: expr) {struct a}: expr :=
+ match a with
+ | Evar id => Evar id
+ | Eop op bl => Eop op (lift_exprlist p bl)
+ | Eload chunk addr bl => Eload chunk addr (lift_exprlist p bl)
+ | Econdition b c d =>
+ Econdition (lift_condexpr p b) (lift_expr p c) (lift_expr p d)
+ | Elet b c => Elet (lift_expr p b) (lift_expr (S p) c)
+ | Eletvar n =>
+ if le_gt_dec p n then Eletvar (S n) else Eletvar n
+ end
+
+with lift_condexpr (p: nat) (a: condexpr) {struct a}: condexpr :=
+ match a with
+ | CEtrue => CEtrue
+ | CEfalse => CEfalse
+ | CEcond cond bl => CEcond cond (lift_exprlist p bl)
+ | CEcondition b c d =>
+ CEcondition (lift_condexpr p b) (lift_condexpr p c) (lift_condexpr p d)
+ end
+
+with lift_exprlist (p: nat) (a: exprlist) {struct a}: exprlist :=
+ match a with
+ | Enil => Enil
+ | Econs b cl => Econs (lift_expr p b) (lift_exprlist p cl)
+ end.
+
+Definition lift (a: expr): expr := lift_expr O a.
+
+(** * Smart constructors for operators *)
+
+(** This section defines functions for building CminorSel expressions
+ and statements, especially expressions consisting of operator
+ applications. These functions examine their arguments to choose
+ cheaper forms of operators whenever possible.
+
+ For instance, [add e1 e2] will return a CminorSel expression semantically
+ equivalent to [Eop Oadd (e1 ::: e2 ::: Enil)], but will use a
+ [Oaddimm] operator if one of the arguments is an integer constant,
+ or suppress the addition altogether if one of the arguments is the
+ null integer. In passing, we perform operator reassociation
+ ([(e + c1) * c2] becomes [(e * c2) + (c1 * c2)]) and a small amount
+ of constant propagation.
+*)
+
+(** ** Integer logical negation *)
+
+(** The natural way to write smart constructors is by pattern-matching
+ on their arguments, recognizing cases where cheaper operators
+ or combined operators are applicable. For instance, integer logical
+ negation has three special cases (not-and, not-or and not-xor),
+ along with a default case that uses not-or over its arguments and itself.
+ This is written naively as follows:
+<<
+Definition notint (e: expr) :=
+ match e with
+ | Eop (Oshift s) (t1:::Enil) => Eop (Onotshift s) (t1:::Enil)
+ | Eop Onot (t1:::Enil) => t1
+ | Eop (Onotshift s) (t1:::Enil) => Eop (Oshift s) (t1:::Enil)
+ | _ => Eop Onot (e:::Enil)
+ end.
+>>
+ However, Coq expands complex pattern-matchings like the above into
+ elementary matchings over all constructors of an inductive type,
+ resulting in much duplication of the final catch-all case.
+ Such duplications generate huge executable code and duplicate
+ cases in the correctness proofs.
+
+ To limit this duplication, we use the following trick due to
+ Yves Bertot. We first define a dependent inductive type that
+ characterizes the expressions that match each of the 4 cases of interest.
+*)
+
+Inductive notint_cases: forall (e: expr), Set :=
+ | notint_case1:
+ forall s t1,
+ notint_cases (Eop (Oshift s) (t1:::Enil))
+ | notint_case2:
+ forall t1,
+ notint_cases (Eop Onot (t1:::Enil))
+ | notint_case3:
+ forall s t1,
+ notint_cases (Eop (Onotshift s) (t1:::Enil))
+ | notint_default:
+ forall (e: expr),
+ notint_cases e.
+
+(** We then define a classification function that takes an expression
+ and return the case in which it falls. Note that the catch-all case
+ [notint_default] does not state that it is mutually exclusive with
+ the first three, more specific cases. The classification function
+ nonetheless chooses the specific cases in preference to the catch-all
+ case. *)
+
+Definition notint_match (e: expr) :=
+ match e as z1 return notint_cases z1 with
+ | Eop (Oshift s) (t1:::Enil) =>
+ notint_case1 s t1
+ | Eop Onot (t1:::Enil) =>
+ notint_case2 t1
+ | Eop (Onotshift s) (t1:::Enil) =>
+ notint_case3 s t1
+ | e =>
+ notint_default e
+ end.
+
+(** Finally, the [notint] function we need is defined by a 4-case match
+ over the result of the classification function. Thus, no duplication
+ of the right-hand sides of this match occur, and the proof has only
+ 4 cases to consider (it proceeds by case over [notint_match e]).
+ Since the default case is not obviously exclusive with the three
+ specific cases, it is important that its right-hand side is
+ semantically correct for all possible values of [e], which is the
+ case here and for all other smart constructors. *)
+
+Definition notint (e: expr) :=
+ match notint_match e with
+ | notint_case1 s t1 =>
+ Eop (Onotshift s) (t1:::Enil)
+ | notint_case2 t1 =>
+ t1
+ | notint_case3 s t1 =>
+ Eop (Oshift s) (t1:::Enil)
+ | notint_default e =>
+ Eop Onot (e:::Enil)
+ end.
+
+(** This programming pattern will be applied systematically for the
+ other smart constructors in this file. *)
+
+(** ** Boolean negation *)
+
+Definition notbool_base (e: expr) :=
+ Eop (Ocmp (Ccompimm Ceq Int.zero)) (e ::: Enil).
+
+Fixpoint notbool (e: expr) {struct e} : expr :=
+ match e with
+ | Eop (Ointconst n) Enil =>
+ Eop (Ointconst (if Int.eq n Int.zero then Int.one else Int.zero)) Enil
+ | Eop (Ocmp cond) args =>
+ Eop (Ocmp (negate_condition cond)) args
+ | Econdition e1 e2 e3 =>
+ Econdition e1 (notbool e2) (notbool e3)
+ | _ =>
+ notbool_base e
+ end.
+
+(** ** Integer addition and pointer addition *)
+
+(** Addition of an integer constant. *)
+
+(*
+Definition addimm (n: int) (e: expr) :=
+ if Int.eq n Int.zero then e else
+ match e with
+ | Eop (Ointconst m) Enil => Eop (Ointconst(Int.add n m)) Enil
+ | Eop (Oaddrsymbol s m) Enil => Eop (Oaddrsymbol s (Int.add n m)) Enil
+ | Eop (Oaddrstack m) Enil => Eop (Oaddrstack (Int.add n m)) Enil
+ | Eop (Oaddimm m) (t ::: Enil) => Eop (Oaddimm(Int.add n m)) (t ::: Enil)
+ | _ => Eop (Oaddimm n) (e ::: Enil)
+ end.
+*)
+
+Inductive addimm_cases: forall (e: expr), Set :=
+ | addimm_case1:
+ forall m,
+ addimm_cases (Eop (Ointconst m) Enil)
+ | addimm_case2:
+ forall s m,
+ addimm_cases (Eop (Oaddrsymbol s m) Enil)
+ | addimm_case3:
+ forall m,
+ addimm_cases (Eop (Oaddrstack m) Enil)
+ | addimm_case4:
+ forall m t,
+ addimm_cases (Eop (Oaddimm m) (t ::: Enil))
+ | addimm_default:
+ forall (e: expr),
+ addimm_cases e.
+
+Definition addimm_match (e: expr) :=
+ match e as z1 return addimm_cases z1 with
+ | Eop (Ointconst m) Enil =>
+ addimm_case1 m
+ | Eop (Oaddrsymbol s m) Enil =>
+ addimm_case2 s m
+ | Eop (Oaddrstack m) Enil =>
+ addimm_case3 m
+ | Eop (Oaddimm m) (t ::: Enil) =>
+ addimm_case4 m t
+ | e =>
+ addimm_default e
+ end.
+
+Definition addimm (n: int) (e: expr) :=
+ if Int.eq n Int.zero then e else
+ match addimm_match e with
+ | addimm_case1 m =>
+ Eop (Ointconst(Int.add n m)) Enil
+ | addimm_case2 s m =>
+ Eop (Oaddrsymbol s (Int.add n m)) Enil
+ | addimm_case3 m =>
+ Eop (Oaddrstack (Int.add n m)) Enil
+ | addimm_case4 m t =>
+ Eop (Oaddimm(Int.add n m)) (t ::: Enil)
+ | addimm_default e =>
+ Eop (Oaddimm n) (e ::: Enil)
+ end.
+
+(** Addition of two integer or pointer expressions. *)
+
+(*
+Definition add (e1: expr) (e2: expr) :=
+ match e1, e2 with
+ | Eop (Ointconst n1) Enil, t2 => addimm n1 t2
+ | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => addimm (Int.add n1 n2) (Eop Oadd (t1:::t2:::Enil))
+ | Eop(Oaddimm n1) (t1:::Enil)), t2 => addimm n1 (Eop Oadd (t1:::t2:::Enil))
+ | t1, Eop (Ointconst n2) Enil => addimm n2 t1
+ | t1, Eop (Oaddimm n2) (t2:::Enil) => addimm n2 (Eop Oadd (t1:::t2:::Enil))
+ | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oaddshift s) (t2:::t1:::Enil)
+ | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oaddshift s) (t1:::t2:::Enil)
+ | _, _ => Eop Oadd (e1:::e2:::Enil)
+ end.
+*)
+
+Inductive add_cases: forall (e1: expr) (e2: expr), Set :=
+ | add_case1:
+ forall n1 t2,
+ add_cases (Eop (Ointconst n1) Enil) (t2)
+ | add_case2:
+ forall n1 t1 n2 t2,
+ add_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil))
+ | add_case3:
+ forall n1 t1 t2,
+ add_cases (Eop (Oaddimm n1) (t1:::Enil)) (t2)
+ | add_case4:
+ forall t1 n2,
+ add_cases (t1) (Eop (Ointconst n2) Enil)
+ | add_case5:
+ forall t1 n2 t2,
+ add_cases (t1) (Eop (Oaddimm n2) (t2:::Enil))
+ | add_case6:
+ forall s t1 t2,
+ add_cases (Eop (Oshift s) (t1:::Enil)) (t2)
+ | add_case7:
+ forall t1 s t2,
+ add_cases (t1) (Eop (Oshift s) (t2:::Enil))
+ | add_default:
+ forall (e1: expr) (e2: expr),
+ add_cases e1 e2.
+
+Definition add_match (e1: expr) (e2: expr) :=
+ match e1 as z1, e2 as z2 return add_cases z1 z2 with
+ | Eop (Ointconst n1) Enil, t2 =>
+ add_case1 n1 t2
+ | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) =>
+ add_case2 n1 t1 n2 t2
+ | Eop(Oaddimm n1) (t1:::Enil), t2 =>
+ add_case3 n1 t1 t2
+ | t1, Eop (Ointconst n2) Enil =>
+ add_case4 t1 n2
+ | t1, Eop (Oaddimm n2) (t2:::Enil) =>
+ add_case5 t1 n2 t2
+ | Eop (Oshift s) (t1:::Enil), t2 =>
+ add_case6 s t1 t2
+ | t1, Eop (Oshift s) (t2:::Enil) =>
+ add_case7 t1 s t2
+ | e1, e2 =>
+ add_default e1 e2
+ end.
+
+Definition add (e1: expr) (e2: expr) :=
+ match add_match e1 e2 with
+ | add_case1 n1 t2 =>
+ addimm n1 t2
+ | add_case2 n1 t1 n2 t2 =>
+ addimm (Int.add n1 n2) (Eop Oadd (t1:::t2:::Enil))
+ | add_case3 n1 t1 t2 =>
+ addimm n1 (Eop Oadd (t1:::t2:::Enil))
+ | add_case4 t1 n2 =>
+ addimm n2 t1
+ | add_case5 t1 n2 t2 =>
+ addimm n2 (Eop Oadd (t1:::t2:::Enil))
+ | add_case6 s t1 t2 =>
+ Eop (Oaddshift s) (t2:::t1:::Enil)
+ | add_case7 t1 s t2 =>
+ Eop (Oaddshift s) (t1:::t2:::Enil)
+ | add_default e1 e2 =>
+ Eop Oadd (e1:::e2:::Enil)
+ end.
+
+(** ** Integer and pointer subtraction *)
+
+(*
+Definition sub (e1: expr) (e2: expr) :=
+ match e1, e2 with
+ | t1, Eop (Ointconst n2) Enil => addimm (Int.neg n2) t1
+ | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => addimm (intsub n1 n2) (Eop Osub (t1:::t2:::Enil))
+ | Eop (Oaddimm n1) (t1:::Enil), t2 => addimm n1 (Eop Osub (t1:::t2:::Rnil))
+ | t1, Eop (Oaddimm n2) (t2:::Enil) => addimm (Int.neg n2) (Eop Osub (t1::::t2:::Enil))
+ | Eop (Ointconst n1) Enil, t2 => Eop (Orsubimm n1) (t2:::Enil)
+ | Eop (Oshift s) (t1:::Enil), t2 => Eop (Orsubshift s) (t2:::t1:::Enil)
+ | t1, Eop (Oshift s) (t2:::Enil) => Eop (Osubshift s) (t1:::t2:::Enil)
+ | _, _ => Eop Osub (e1:::e2:::Enil)
+ end.
+*)
+
+Inductive sub_cases: forall (e1: expr) (e2: expr), Set :=
+ | sub_case1:
+ forall t1 n2,
+ sub_cases (t1) (Eop (Ointconst n2) Enil)
+ | sub_case2:
+ forall n1 t1 n2 t2,
+ sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil))
+ | sub_case3:
+ forall n1 t1 t2,
+ sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (t2)
+ | sub_case4:
+ forall t1 n2 t2,
+ sub_cases (t1) (Eop (Oaddimm n2) (t2:::Enil))
+ | sub_case5:
+ forall n1 t2,
+ sub_cases (Eop (Ointconst n1) Enil) (t2)
+ | sub_case6:
+ forall s t1 t2,
+ sub_cases (Eop (Oshift s) (t1:::Enil)) (t2)
+ | sub_case7:
+ forall t1 s t2,
+ sub_cases (t1) (Eop (Oshift s) (t2:::Enil))
+ | sub_default:
+ forall (e1: expr) (e2: expr),
+ sub_cases e1 e2.
+
+Definition sub_match (e1: expr) (e2: expr) :=
+ match e1 as z1, e2 as z2 return sub_cases z1 z2 with
+ | t1, Eop (Ointconst n2) Enil =>
+ sub_case1 t1 n2
+ | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) =>
+ sub_case2 n1 t1 n2 t2
+ | Eop (Oaddimm n1) (t1:::Enil), t2 =>
+ sub_case3 n1 t1 t2
+ | t1, Eop (Oaddimm n2) (t2:::Enil) =>
+ sub_case4 t1 n2 t2
+ | Eop (Ointconst n1) Enil, t2 =>
+ sub_case5 n1 t2
+ | Eop (Oshift s) (t1:::Enil), t2 =>
+ sub_case6 s t1 t2
+ | t1, Eop (Oshift s) (t2:::Enil) =>
+ sub_case7 t1 s t2
+ | e1, e2 =>
+ sub_default e1 e2
+ end.
+
+Definition sub (e1: expr) (e2: expr) :=
+ match sub_match e1 e2 with
+ | sub_case1 t1 n2 =>
+ addimm (Int.neg n2) t1
+ | sub_case2 n1 t1 n2 t2 =>
+ addimm (Int.sub n1 n2) (Eop Osub (t1:::t2:::Enil))
+ | sub_case3 n1 t1 t2 =>
+ addimm n1 (Eop Osub (t1:::t2:::Enil))
+ | sub_case4 t1 n2 t2 =>
+ addimm (Int.neg n2) (Eop Osub (t1:::t2:::Enil))
+ | sub_case5 n1 t2 =>
+ Eop (Orsubimm n1) (t2:::Enil)
+ | sub_case6 s t1 t2 =>
+ Eop (Orsubshift s) (t2:::t1:::Enil)
+ | sub_case7 t1 s t2 =>
+ Eop (Osubshift s) (t1:::t2:::Enil)
+ | sub_default e1 e2 =>
+ Eop Osub (e1:::e2:::Enil)
+ end.
+
+(** ** Immediate shifts *)
+
+(*
+Definition shlimm (e1: expr) :=
+ if Int.eq n Int.zero then e1 else
+ match e1 with
+ | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shl n1 n))
+ | Eop (Oshift (Olsl n1)) (t1:::Enil) => if Int.ltu (Int.add n n1) (Int.repr 32) then Eop (Oshift (Olsl (Int.add n n1))) (t1:::Enil) else Eop (Oshift (Olsl n)) (e1:::Enil)
+ | _ => Eop (Oshift (Olsl n)) (e1:::Enil)
+ end.
+*)
+
+Inductive shlimm_cases: forall (e1: expr), Set :=
+ | shlimm_case1:
+ forall n1,
+ shlimm_cases (Eop (Ointconst n1) Enil)
+ | shlimm_case2:
+ forall n1 t1,
+ shlimm_cases (Eop (Oshift (Slsl n1)) (t1:::Enil))
+ | shlimm_default:
+ forall (e1: expr),
+ shlimm_cases e1.
+
+Definition shlimm_match (e1: expr) :=
+ match e1 as z1 return shlimm_cases z1 with
+ | Eop (Ointconst n1) Enil =>
+ shlimm_case1 n1
+ | Eop (Oshift (Slsl n1)) (t1:::Enil) =>
+ shlimm_case2 n1 t1
+ | e1 =>
+ shlimm_default e1
+ end.
+
+Definition shlimm (e1: expr) (n: int) :=
+ if Int.eq n Int.zero then e1 else
+ match is_shift_amount n with
+ | None => Eop Oshl (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+ | Some n' =>
+ match shlimm_match e1 with
+ | shlimm_case1 n1 =>
+ Eop (Ointconst(Int.shl n1 n)) Enil
+ | shlimm_case2 n1 t1 =>
+ match is_shift_amount (Int.add n (s_amount n1)) with
+ | None =>
+ Eop (Oshift (Slsl n')) (e1:::Enil)
+ | Some n'' =>
+ Eop (Oshift (Slsl n'')) (t1:::Enil)
+ end
+ | shlimm_default e1 =>
+ Eop (Oshift (Slsl n')) (e1:::Enil)
+ end
+ end.
+
+(*
+Definition shruimm (e1: expr) :=
+ if Int.eq n Int.zero then e1 else
+ match e1 with
+ | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shru n1 n))
+ | Eop (Oshift (Olsr n1)) (t1:::Enil) => if Int.ltu (Int.add n n1) (Int.repr 32) then Eop (Oshift (Olsr (Int.add n n1))) (t1:::Enil) else Eop (Oshift (Olsr n)) (e1:::Enil)
+ | _ => Eop (Oshift (Olsr n)) (e1:::Enil)
+ end.
+*)
+
+Inductive shruimm_cases: forall (e1: expr), Set :=
+ | shruimm_case1:
+ forall n1,
+ shruimm_cases (Eop (Ointconst n1) Enil)
+ | shruimm_case2:
+ forall n1 t1,
+ shruimm_cases (Eop (Oshift (Slsr n1)) (t1:::Enil))
+ | shruimm_default:
+ forall (e1: expr),
+ shruimm_cases e1.
+
+Definition shruimm_match (e1: expr) :=
+ match e1 as z1 return shruimm_cases z1 with
+ | Eop (Ointconst n1) Enil =>
+ shruimm_case1 n1
+ | Eop (Oshift (Slsr n1)) (t1:::Enil) =>
+ shruimm_case2 n1 t1
+ | e1 =>
+ shruimm_default e1
+ end.
+
+Definition shruimm (e1: expr) (n: int) :=
+ if Int.eq n Int.zero then e1 else
+ match is_shift_amount n with
+ | None => Eop Oshru (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+ | Some n' =>
+ match shruimm_match e1 with
+ | shruimm_case1 n1 =>
+ Eop (Ointconst(Int.shru n1 n)) Enil
+ | shruimm_case2 n1 t1 =>
+ match is_shift_amount (Int.add n (s_amount n1)) with
+ | None =>
+ Eop (Oshift (Slsr n')) (e1:::Enil)
+ | Some n'' =>
+ Eop (Oshift (Slsr n'')) (t1:::Enil)
+ end
+ | shruimm_default e1 =>
+ Eop (Oshift (Slsr n')) (e1:::Enil)
+ end
+ end.
+
+(*
+Definition shrimm (e1: expr) :=
+ match e1 with
+ | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shr n1 n))
+ | Eop (Oshift (Oasr n1)) (t1:::Enil) => if Int.ltu (Int.add n n1) (Int.repr 32) then Eop (Oshift (Oasr (Int.add n n1))) (t1:::Enil) else Eop (Oshift (Oasr n)) (e1:::Enil)
+ | _ => Eop (Oshift (Oasr n)) (e1:::Enil)
+ end.
+*)
+
+Inductive shrimm_cases: forall (e1: expr), Set :=
+ | shrimm_case1:
+ forall n1,
+ shrimm_cases (Eop (Ointconst n1) Enil)
+ | shrimm_case2:
+ forall n1 t1,
+ shrimm_cases (Eop (Oshift (Sasr n1)) (t1:::Enil))
+ | shrimm_default:
+ forall (e1: expr),
+ shrimm_cases e1.
+
+Definition shrimm_match (e1: expr) :=
+ match e1 as z1 return shrimm_cases z1 with
+ | Eop (Ointconst n1) Enil =>
+ shrimm_case1 n1
+ | Eop (Oshift (Sasr n1)) (t1:::Enil) =>
+ shrimm_case2 n1 t1
+ | e1 =>
+ shrimm_default e1
+ end.
+
+Definition shrimm (e1: expr) (n: int) :=
+ if Int.eq n Int.zero then e1 else
+ match is_shift_amount n with
+ | None => Eop Oshr (e1 ::: Eop (Ointconst n) Enil ::: Enil)
+ | Some n' =>
+ match shrimm_match e1 with
+ | shrimm_case1 n1 =>
+ Eop (Ointconst(Int.shr n1 n)) Enil
+ | shrimm_case2 n1 t1 =>
+ match is_shift_amount (Int.add n (s_amount n1)) with
+ | None =>
+ Eop (Oshift (Sasr n')) (e1:::Enil)
+ | Some n'' =>
+ Eop (Oshift (Sasr n'')) (t1:::Enil)
+ end
+ | shrimm_default e1 =>
+ Eop (Oshift (Sasr n')) (e1:::Enil)
+ end
+ end.
+
+(** ** Integer multiply *)
+
+Definition mulimm_base (n1: int) (e2: expr) :=
+ match Int.one_bits n1 with
+ | i :: nil =>
+ shlimm e2 i
+ | i :: j :: nil =>
+ Elet e2
+ (add (shlimm (Eletvar 0) i) (shlimm (Eletvar 0) j))
+ | _ =>
+ Eop Omul (Eop (Ointconst n1) Enil ::: e2 ::: Enil)
+ end.
+
+(*
+Definition mulimm (n1: int) (e2: expr) :=
+ if Int.eq n1 Int.zero then
+ Eop (Ointconst Int.zero) Enil
+ else if Int.eq n1 Int.one then
+ e2
+ else match e2 with
+ | Eop (Ointconst n2) Enil => Eop (Ointconst(intmul n1 n2)) Enil
+ | Eop (Oaddimm n2) (t2:::Enil) => addimm (intmul n1 n2) (mulimm_base n1 t2)
+ | _ => mulimm_base n1 e2
+ end.
+*)
+
+Inductive mulimm_cases: forall (e2: expr), Set :=
+ | mulimm_case1:
+ forall (n2: int),
+ mulimm_cases (Eop (Ointconst n2) Enil)
+ | mulimm_case2:
+ forall (n2: int) (t2: expr),
+ mulimm_cases (Eop (Oaddimm n2) (t2:::Enil))
+ | mulimm_default:
+ forall (e2: expr),
+ mulimm_cases e2.
+
+Definition mulimm_match (e2: expr) :=
+ match e2 as z1 return mulimm_cases z1 with
+ | Eop (Ointconst n2) Enil =>
+ mulimm_case1 n2
+ | Eop (Oaddimm n2) (t2:::Enil) =>
+ mulimm_case2 n2 t2
+ | e2 =>
+ mulimm_default e2
+ end.
+
+Definition mulimm (n1: int) (e2: expr) :=
+ if Int.eq n1 Int.zero then
+ Eop (Ointconst Int.zero) Enil
+ else if Int.eq n1 Int.one then
+ e2
+ else match mulimm_match e2 with
+ | mulimm_case1 n2 =>
+ Eop (Ointconst(Int.mul n1 n2)) Enil
+ | mulimm_case2 n2 t2 =>
+ addimm (Int.mul n1 n2) (mulimm_base n1 t2)
+ | mulimm_default e2 =>
+ mulimm_base n1 e2
+ end.
+
+(*
+Definition mul (e1: expr) (e2: expr) :=
+ match e1, e2 with
+ | Eop (Ointconst n1) Enil, t2 => mulimm n1 t2
+ | t1, Eop (Ointconst n2) Enil => mulimm n2 t1
+ | _, _ => Eop Omul (e1:::e2:::Enil)
+ end.
+*)
+
+Inductive mul_cases: forall (e1: expr) (e2: expr), Set :=
+ | mul_case1:
+ forall (n1: int) (t2: expr),
+ mul_cases (Eop (Ointconst n1) Enil) (t2)
+ | mul_case2:
+ forall (t1: expr) (n2: int),
+ mul_cases (t1) (Eop (Ointconst n2) Enil)
+ | mul_default:
+ forall (e1: expr) (e2: expr),
+ mul_cases e1 e2.
+
+Definition mul_match_aux (e1: expr) (e2: expr) :=
+ match e2 as z2 return mul_cases e1 z2 with
+ | Eop (Ointconst n2) Enil =>
+ mul_case2 e1 n2
+ | e2 =>
+ mul_default e1 e2
+ end.
+
+Definition mul_match (e1: expr) (e2: expr) :=
+ match e1 as z1 return mul_cases z1 e2 with
+ | Eop (Ointconst n1) Enil =>
+ mul_case1 n1 e2
+ | e1 =>
+ mul_match_aux e1 e2
+ end.
+
+Definition mul (e1: expr) (e2: expr) :=
+ match mul_match e1 e2 with
+ | mul_case1 n1 t2 =>
+ mulimm n1 t2
+ | mul_case2 t1 n2 =>
+ mulimm n2 t1
+ | mul_default e1 e2 =>
+ Eop Omul (e1:::e2:::Enil)
+ end.
+
+(** ** Integer division and modulus *)
+
+Definition mod_aux (divop: operation) (e1 e2: expr) :=
+ Elet e1
+ (Elet (lift e2)
+ (Eop Osub (Eletvar 1 :::
+ Eop Omul (Eop divop (Eletvar 1 ::: Eletvar 0 ::: Enil) :::
+ Eletvar 0 :::
+ Enil) :::
+ Enil))).
+
+Inductive divu_cases: forall (e2: expr), Set :=
+ | divu_case1:
+ forall (n2: int),
+ divu_cases (Eop (Ointconst n2) Enil)
+ | divu_default:
+ forall (e2: expr),
+ divu_cases e2.
+
+Definition divu_match (e2: expr) :=
+ match e2 as z1 return divu_cases z1 with
+ | Eop (Ointconst n2) Enil =>
+ divu_case1 n2
+ | e2 =>
+ divu_default e2
+ end.
+
+Definition divu (e1: expr) (e2: expr) :=
+ match divu_match e2 with
+ | divu_case1 n2 =>
+ match Int.is_power2 n2 with
+ | Some l2 => shruimm e1 l2
+ | None => Eop Odivu (e1:::e2:::Enil)
+ end
+ | divu_default e2 =>
+ Eop Odivu (e1:::e2:::Enil)
+ end.
+
+Definition modu (e1: expr) (e2: expr) :=
+ match divu_match e2 with
+ | divu_case1 n2 =>
+ match Int.is_power2 n2 with
+ | Some l2 => Eop (Oandimm (Int.sub n2 Int.one)) (e1:::Enil)
+ | None => mod_aux Odivu e1 e2
+ end
+ | divu_default e2 =>
+ mod_aux Odivu e1 e2
+ end.
+
+Definition divs (e1: expr) (e2: expr) :=
+ match divu_match e2 with
+ | divu_case1 n2 =>
+ match Int.is_power2 n2 with
+ | Some l2 => if Int.ltu l2 (Int.repr 31)
+ then Eop (Oshrximm l2) (e1:::Enil)
+ else Eop Odiv (e1:::e2:::Enil)
+ | None => Eop Odiv (e1:::e2:::Enil)
+ end
+ | divu_default e2 =>
+ Eop Odiv (e1:::e2:::Enil)
+ end.
+
+Definition mods := mod_aux Odiv. (* could be improved *)
+
+
+(** ** Bitwise and, or, xor *)
+
+(*
+Definition and (e1: expr) (e2: expr) :=
+ match e1, e2 with
+ | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oandshift s) (t2:::t1:::Enil)
+ | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oandshift s) (t1:::t2:::Enil)
+ | Eop (Onotshift s) (t1:::Enil), t2 => Eop (Obicshift s) (t2:::t1:::Enil)
+ | t1, Eop (Onotshift s) (t2:::Enil) => Eop (Obicshift s) (t1:::t2:::Enil)
+ | Eop Onot (t1:::Enil), t2 => Eop Obic (t2:::t1:::Enil)
+ | t1, Eop Onot (t2:::Enil) => Eop Obic (t1:::t2:::Enil)
+ | _, _ => Eop Oand (e1:::e2:::Enil)
+ end.
+*)
+
+Inductive and_cases: forall (e1: expr) (e2: expr), Set :=
+ | and_case1:
+ forall s t1 t2,
+ and_cases (Eop (Oshift s) (t1:::Enil)) (t2)
+ | and_case2:
+ forall t1 s t2,
+ and_cases (t1) (Eop (Oshift s) (t2:::Enil))
+ | and_case3:
+ forall s t1 t2,
+ and_cases (Eop (Onotshift s) (t1:::Enil)) (t2)
+ | and_case4:
+ forall t1 s t2,
+ and_cases (t1) (Eop (Onotshift s) (t2:::Enil))
+ | and_case5:
+ forall t1 t2,
+ and_cases (Eop Onot (t1:::Enil)) (t2)
+ | and_case6:
+ forall t1 t2,
+ and_cases (t1) (Eop Onot (t2:::Enil))
+ | and_default:
+ forall (e1: expr) (e2: expr),
+ and_cases e1 e2.
+
+Definition and_match (e1: expr) (e2: expr) :=
+ match e1 as z1, e2 as z2 return and_cases z1 z2 with
+ | Eop (Oshift s) (t1:::Enil), t2 =>
+ and_case1 s t1 t2
+ | t1, Eop (Oshift s) (t2:::Enil) =>
+ and_case2 t1 s t2
+ | Eop (Onotshift s) (t1:::Enil), t2 =>
+ and_case3 s t1 t2
+ | t1, Eop (Onotshift s) (t2:::Enil) =>
+ and_case4 t1 s t2
+ | Eop Onot (t1:::Enil), t2 =>
+ and_case5 t1 t2
+ | t1, Eop Onot (t2:::Enil) =>
+ and_case6 t1 t2
+ | e1, e2 =>
+ and_default e1 e2
+ end.
+
+Definition and (e1: expr) (e2: expr) :=
+ match and_match e1 e2 with
+ | and_case1 s t1 t2 =>
+ Eop (Oandshift s) (t2:::t1:::Enil)
+ | and_case2 t1 s t2 =>
+ Eop (Oandshift s) (t1:::t2:::Enil)
+ | and_case3 s t1 t2 =>
+ Eop (Obicshift s) (t2:::t1:::Enil)
+ | and_case4 t1 s t2 =>
+ Eop (Obicshift s) (t1:::t2:::Enil)
+ | and_case5 t1 t2 =>
+ Eop Obic (t2:::t1:::Enil)
+ | and_case6 t1 t2 =>
+ Eop Obic (t1:::t2:::Enil)
+ | and_default e1 e2 =>
+ Eop Oand (e1:::e2:::Enil)
+ end.
+
+Definition same_expr_pure (e1 e2: expr) :=
+ match e1, e2 with
+ | Evar v1, Evar v2 => if ident_eq v1 v2 then true else false
+ | _, _ => false
+ end.
+
+(*
+Definition or (e1: expr) (e2: expr) :=
+ match e1, e2 with
+ | Eop (Oshift (Olsl n1) (t1:::Enil), Eop (Oshift (Olsr n2) (t2:::Enil)) => ...
+ | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oorshift s) (t2:::t1:::Enil)
+ | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oorshift s) (t1:::t2:::Enil)
+ | _, _ => Eop Oor (e1:::e2:::Enil)
+ end.
+*)
+
+(* TODO: symmetric of first case *)
+
+Inductive or_cases: forall (e1: expr) (e2: expr), Set :=
+ | or_case1:
+ forall n1 t1 n2 t2,
+ or_cases (Eop (Oshift (Slsl n1)) (t1:::Enil)) (Eop (Oshift (Slsr n2)) (t2:::Enil))
+ | or_case2:
+ forall s t1 t2,
+ or_cases (Eop (Oshift s) (t1:::Enil)) (t2)
+ | or_case3:
+ forall t1 s t2,
+ or_cases (t1) (Eop (Oshift s) (t2:::Enil))
+ | or_default:
+ forall (e1: expr) (e2: expr),
+ or_cases e1 e2.
+
+Definition or_match (e1: expr) (e2: expr) :=
+ match e1 as z1, e2 as z2 return or_cases z1 z2 with
+ | Eop (Oshift (Slsl n1)) (t1:::Enil), Eop (Oshift (Slsr n2)) (t2:::Enil) =>
+ or_case1 n1 t1 n2 t2
+ | Eop (Oshift s) (t1:::Enil), t2 =>
+ or_case2 s t1 t2
+ | t1, Eop (Oshift s) (t2:::Enil) =>
+ or_case3 t1 s t2
+ | e1, e2 =>
+ or_default e1 e2
+ end.
+
+Definition or (e1: expr) (e2: expr) :=
+ match or_match e1 e2 with
+ | or_case1 n1 t1 n2 t2 =>
+ if Int.eq (Int.add (s_amount n1) (s_amount n2)) (Int.repr 32)
+ && same_expr_pure t1 t2
+ then Eop (Oshift (Sror n2)) (t1:::Enil)
+ else Eop (Oorshift (Slsr n2)) (e1:::t2:::Enil)
+ | or_case2 s t1 t2 =>
+ Eop (Oorshift s) (t2:::t1:::Enil)
+ | or_case3 t1 s t2 =>
+ Eop (Oorshift s) (t1:::t2:::Enil)
+ | or_default e1 e2 =>
+ Eop Oor (e1:::e2:::Enil)
+ end.
+
+(*
+Definition xor (e1: expr) (e2: expr) :=
+ match e1, e2 with
+ | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oxorshift s) (t2:::t1:::Enil)
+ | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oxorshift s) (t1:::t2:::Enil)
+ | _, _ => Eop Oxor (e1:::e2:::Enil)
+ end.
+*)
+
+Inductive xor_cases: forall (e1: expr) (e2: expr), Set :=
+ | xor_case1:
+ forall s t1 t2,
+ xor_cases (Eop (Oshift s) (t1:::Enil)) (t2)
+ | xor_case2:
+ forall t1 s t2,
+ xor_cases (t1) (Eop (Oshift s) (t2:::Enil))
+ | xor_default:
+ forall (e1: expr) (e2: expr),
+ xor_cases e1 e2.
+
+Definition xor_match (e1: expr) (e2: expr) :=
+ match e1 as z1, e2 as z2 return xor_cases z1 z2 with
+ | Eop (Oshift s) (t1:::Enil), t2 =>
+ xor_case1 s t1 t2
+ | t1, Eop (Oshift s) (t2:::Enil) =>
+ xor_case2 t1 s t2
+ | e1, e2 =>
+ xor_default e1 e2
+ end.
+
+Definition xor (e1: expr) (e2: expr) :=
+ match xor_match e1 e2 with
+ | xor_case1 s t1 t2 =>
+ Eop (Oxorshift s) (t2:::t1:::Enil)
+ | xor_case2 t1 s t2 =>
+ Eop (Oxorshift s) (t1:::t2:::Enil)
+ | xor_default e1 e2 =>
+ Eop Oxor (e1:::e2:::Enil)
+ end.
+
+(** ** General shifts *)
+
+Inductive shift_cases: forall (e1: expr), Set :=
+ | shift_case1:
+ forall (n2: int),
+ shift_cases (Eop (Ointconst n2) Enil)
+ | shift_default:
+ forall (e1: expr),
+ shift_cases e1.
+
+Definition shift_match (e1: expr) :=
+ match e1 as z1 return shift_cases z1 with
+ | Eop (Ointconst n2) Enil =>
+ shift_case1 n2
+ | e1 =>
+ shift_default e1
+ end.
+
+Definition shl (e1: expr) (e2: expr) :=
+ match shift_match e2 with
+ | shift_case1 n2 =>
+ shlimm e1 n2
+ | shift_default e2 =>
+ Eop Oshl (e1:::e2:::Enil)
+ end.
+
+Definition shru (e1: expr) (e2: expr) :=
+ match shift_match e2 with
+ | shift_case1 n2 =>
+ shruimm e1 n2
+ | shift_default e2 =>
+ Eop Oshru (e1:::e2:::Enil)
+ end.
+
+Definition shr (e1: expr) (e2: expr) :=
+ match shift_match e2 with
+ | shift_case1 n2 =>
+ shrimm e1 n2
+ | shift_default e2 =>
+ Eop Oshr (e1:::e2:::Enil)
+ end.
+
+(** ** Truncations and sign extensions *)
+
+Inductive cast8signed_cases: forall (e1: expr), Set :=
+ | cast8signed_case1:
+ forall (e2: expr),
+ cast8signed_cases (Eop Ocast8signed (e2 ::: Enil))
+ | cast8signed_default:
+ forall (e1: expr),
+ cast8signed_cases e1.
+
+Definition cast8signed_match (e1: expr) :=
+ match e1 as z1 return cast8signed_cases z1 with
+ | Eop Ocast8signed (e2 ::: Enil) =>
+ cast8signed_case1 e2
+ | e1 =>
+ cast8signed_default e1
+ end.
+
+Definition cast8signed (e: expr) :=
+ match cast8signed_match e with
+ | cast8signed_case1 e1 => e
+ | cast8signed_default e1 => Eop Ocast8signed (e1 ::: Enil)
+ end.
+
+Inductive cast8unsigned_cases: forall (e1: expr), Set :=
+ | cast8unsigned_case1:
+ forall (e2: expr),
+ cast8unsigned_cases (Eop Ocast8unsigned (e2 ::: Enil))
+ | cast8unsigned_default:
+ forall (e1: expr),
+ cast8unsigned_cases e1.
+
+Definition cast8unsigned_match (e1: expr) :=
+ match e1 as z1 return cast8unsigned_cases z1 with
+ | Eop Ocast8unsigned (e2 ::: Enil) =>
+ cast8unsigned_case1 e2
+ | e1 =>
+ cast8unsigned_default e1
+ end.
+
+Definition cast8unsigned (e: expr) :=
+ match cast8unsigned_match e with
+ | cast8unsigned_case1 e1 => e
+ | cast8unsigned_default e1 => Eop Ocast8unsigned (e1 ::: Enil)
+ end.
+
+Inductive cast16signed_cases: forall (e1: expr), Set :=
+ | cast16signed_case1:
+ forall (e2: expr),
+ cast16signed_cases (Eop Ocast16signed (e2 ::: Enil))
+ | cast16signed_default:
+ forall (e1: expr),
+ cast16signed_cases e1.
+
+Definition cast16signed_match (e1: expr) :=
+ match e1 as z1 return cast16signed_cases z1 with
+ | Eop Ocast16signed (e2 ::: Enil) =>
+ cast16signed_case1 e2
+ | e1 =>
+ cast16signed_default e1
+ end.
+
+Definition cast16signed (e: expr) :=
+ match cast16signed_match e with
+ | cast16signed_case1 e1 => e
+ | cast16signed_default e1 => Eop Ocast16signed (e1 ::: Enil)
+ end.
+
+Inductive cast16unsigned_cases: forall (e1: expr), Set :=
+ | cast16unsigned_case1:
+ forall (e2: expr),
+ cast16unsigned_cases (Eop Ocast16unsigned (e2 ::: Enil))
+ | cast16unsigned_default:
+ forall (e1: expr),
+ cast16unsigned_cases e1.
+
+Definition cast16unsigned_match (e1: expr) :=
+ match e1 as z1 return cast16unsigned_cases z1 with
+ | Eop Ocast16unsigned (e2 ::: Enil) =>
+ cast16unsigned_case1 e2
+ | e1 =>
+ cast16unsigned_default e1
+ end.
+
+Definition cast16unsigned (e: expr) :=
+ match cast16unsigned_match e with
+ | cast16unsigned_case1 e1 => e
+ | cast16unsigned_default e1 => Eop Ocast16unsigned (e1 ::: Enil)
+ end.
+
+Inductive singleoffloat_cases: forall (e1: expr), Set :=
+ | singleoffloat_case1:
+ forall (e2: expr),
+ singleoffloat_cases (Eop Osingleoffloat (e2 ::: Enil))
+ | singleoffloat_default:
+ forall (e1: expr),
+ singleoffloat_cases e1.
+
+Definition singleoffloat_match (e1: expr) :=
+ match e1 as z1 return singleoffloat_cases z1 with
+ | Eop Osingleoffloat (e2 ::: Enil) =>
+ singleoffloat_case1 e2
+ | e1 =>
+ singleoffloat_default e1
+ end.
+
+Definition singleoffloat (e: expr) :=
+ match singleoffloat_match e with
+ | singleoffloat_case1 e1 => e
+ | singleoffloat_default e1 => Eop Osingleoffloat (e1 ::: Enil)
+ end.
+
+(** ** Comparisons *)
+
+(*
+Definition comp (e1: expr) (e2: expr) :=
+ match e1, e2 with
+ | Eop (Ointconst n1) Enil, t2 => Eop (Ocmp (Ccompimm (swap_comparison c) n1)) (t2:::Enil)
+ | t1, Eop (Ointconst n2) Enil => Eop (Ocmp (Ccompimm c n1)) (t1:::Enil)
+ | Eop (Oshift s) (t1:::Enil), t2 => Eop (Ocmp (Ccompshift (swap_comparison c) s)) (t2:::t1:::Enil)
+ | t1, Eop (Oshift s) (t2:::Enil) => Eop (Ocmp (Ccompshift c s)) (t1:::t2:::Enil)
+ | _, _ => Eop (Ocmp (Ccomp c)) (e1:::e2:::Enil)
+ end.
+*)
+
+Inductive comp_cases: forall (e1: expr) (e2: expr), Set :=
+ | comp_case1:
+ forall n1 t2,
+ comp_cases (Eop (Ointconst n1) Enil) (t2)
+ | comp_case2:
+ forall t1 n2,
+ comp_cases (t1) (Eop (Ointconst n2) Enil)
+ | comp_case3:
+ forall s t1 t2,
+ comp_cases (Eop (Oshift s) (t1:::Enil)) (t2)
+ | comp_case4:
+ forall t1 s t2,
+ comp_cases (t1) (Eop (Oshift s) (t2:::Enil))
+ | comp_default:
+ forall (e1: expr) (e2: expr),
+ comp_cases e1 e2.
+
+Definition comp_match (e1: expr) (e2: expr) :=
+ match e1 as z1, e2 as z2 return comp_cases z1 z2 with
+ | Eop (Ointconst n1) Enil, t2 =>
+ comp_case1 n1 t2
+ | t1, Eop (Ointconst n2) Enil =>
+ comp_case2 t1 n2
+ | Eop (Oshift s) (t1:::Enil), t2 =>
+ comp_case3 s t1 t2
+ | t1, Eop (Oshift s) (t2:::Enil) =>
+ comp_case4 t1 s t2
+ | e1, e2 =>
+ comp_default e1 e2
+ end.
+
+Definition comp (c: comparison) (e1: expr) (e2: expr) :=
+ match comp_match e1 e2 with
+ | comp_case1 n1 t2 =>
+ Eop (Ocmp (Ccompimm (swap_comparison c) n1)) (t2:::Enil)
+ | comp_case2 t1 n2 =>
+ Eop (Ocmp (Ccompimm c n2)) (t1:::Enil)
+ | comp_case3 s t1 t2 =>
+ Eop (Ocmp (Ccompshift (swap_comparison c) s)) (t2:::t1:::Enil)
+ | comp_case4 t1 s t2 =>
+ Eop (Ocmp (Ccompshift c s)) (t1:::t2:::Enil)
+ | comp_default e1 e2 =>
+ Eop (Ocmp (Ccomp c)) (e1:::e2:::Enil)
+ end.
+
+Definition compu (c: comparison) (e1: expr) (e2: expr) :=
+ match comp_match e1 e2 with
+ | comp_case1 n1 t2 =>
+ Eop (Ocmp (Ccompuimm (swap_comparison c) n1)) (t2:::Enil)
+ | comp_case2 t1 n2 =>
+ Eop (Ocmp (Ccompuimm c n2)) (t1:::Enil)
+ | comp_case3 s t1 t2 =>
+ Eop (Ocmp (Ccompushift (swap_comparison c) s)) (t2:::t1:::Enil)
+ | comp_case4 t1 s t2 =>
+ Eop (Ocmp (Ccompushift c s)) (t1:::t2:::Enil)
+ | comp_default e1 e2 =>
+ Eop (Ocmp (Ccompu c)) (e1:::e2:::Enil)
+ end.
+
+Definition compf (c: comparison) (e1: expr) (e2: expr) :=
+ Eop (Ocmp (Ccompf c)) (e1 ::: e2 ::: Enil).
+
+(** ** Conditional expressions *)
+
+Fixpoint negate_condexpr (e: condexpr): condexpr :=
+ match e with
+ | CEtrue => CEfalse
+ | CEfalse => CEtrue
+ | CEcond c el => CEcond (negate_condition c) el
+ | CEcondition e1 e2 e3 =>
+ CEcondition e1 (negate_condexpr e2) (negate_condexpr e3)
+ end.
+
+
+Definition is_compare_neq_zero (c: condition) : bool :=
+ match c with
+ | Ccompimm Cne n => Int.eq n Int.zero
+ | Ccompuimm Cne n => Int.eq n Int.zero
+ | _ => false
+ end.
+
+Definition is_compare_eq_zero (c: condition) : bool :=
+ match c with
+ | Ccompimm Ceq n => Int.eq n Int.zero
+ | Ccompuimm Ceq n => Int.eq n Int.zero
+ | _ => false
+ end.
+
+Fixpoint condexpr_of_expr (e: expr) : condexpr :=
+ match e with
+ | Eop (Ointconst n) Enil =>
+ if Int.eq n Int.zero then CEfalse else CEtrue
+ | Eop (Ocmp c) (e1 ::: Enil) =>
+ if is_compare_neq_zero c then
+ condexpr_of_expr e1
+ else if is_compare_eq_zero c then
+ negate_condexpr (condexpr_of_expr e1)
+ else
+ CEcond c (e1 ::: Enil)
+ | Eop (Ocmp c) el =>
+ CEcond c el
+ | Econdition ce e1 e2 =>
+ CEcondition ce (condexpr_of_expr e1) (condexpr_of_expr e2)
+ | _ =>
+ CEcond (Ccompimm Cne Int.zero) (e:::Enil)
+ end.
+
+(** ** Recognition of addressing modes for load and store operations *)
+
+(*
+Definition addressing (e: expr) :=
+ match e with
+ | Eop (Oaddrstack n) Enil => (Ainstack n, Enil)
+ | Eop (Oaddimm n) (e1:::Enil) => (Aindexed n, e1:::Enil)
+ | Eop (Oaddshift s) (e1:::e2:::Enil) => (Aindexed2shift s, e1:::e2:::Enil)
+ | Eop Oadd (e1:::e2:::Enil) => (Aindexed2, e1:::e2:::Enil)
+ | _ => (Aindexed Int.zero, e:::Enil)
+ end.
+*)
+
+Inductive addressing_cases: forall (e: expr), Set :=
+ | addressing_case2:
+ forall n,
+ addressing_cases (Eop (Oaddrstack n) Enil)
+ | addressing_case3:
+ forall n e1,
+ addressing_cases (Eop (Oaddimm n) (e1:::Enil))
+ | addressing_case4:
+ forall s e1 e2,
+ addressing_cases (Eop (Oaddshift s) (e1:::e2:::Enil))
+ | addressing_case5:
+ forall e1 e2,
+ addressing_cases (Eop Oadd (e1:::e2:::Enil))
+ | addressing_default:
+ forall (e: expr),
+ addressing_cases e.
+
+Definition addressing_match (e: expr) :=
+ match e as z1 return addressing_cases z1 with
+ | Eop (Oaddrstack n) Enil =>
+ addressing_case2 n
+ | Eop (Oaddimm n) (e1:::Enil) =>
+ addressing_case3 n e1
+ | Eop (Oaddshift s) (e1:::e2:::Enil) =>
+ addressing_case4 s e1 e2
+ | Eop Oadd (e1:::e2:::Enil) =>
+ addressing_case5 e1 e2
+ | e =>
+ addressing_default e
+ end.
+
+(** We do not recognize the [Aindexed2] and [Aindexed2shift] modes
+ for floating-point accesses, since these are not supported
+ by the hardware and emulated inefficiently in [ARMgen]. *)
+
+Definition is_float_addressing (chunk: memory_chunk): bool :=
+ match chunk with
+ | Mfloat32 => true
+ | Mfloat64 => true
+ | _ => false
+ end.
+
+Definition addressing (chunk: memory_chunk) (e: expr) :=
+ match addressing_match e with
+ | addressing_case2 n =>
+ (Ainstack n, Enil)
+ | addressing_case3 n e1 =>
+ (Aindexed n, e1:::Enil)
+ | addressing_case4 s e1 e2 =>
+ if is_float_addressing chunk
+ then (Aindexed Int.zero, Eop (Oaddshift s) (e1:::e2:::Enil) ::: Enil)
+ else (Aindexed2shift s, e1:::e2:::Enil)
+ | addressing_case5 e1 e2 =>
+ if is_float_addressing chunk
+ then (Aindexed Int.zero, Eop Oadd (e1:::e2:::Enil) ::: Enil)
+ else (Aindexed2, e1:::e2:::Enil)
+ | addressing_default e =>
+ (Aindexed Int.zero, e:::Enil)
+ end.
+
+Definition load (chunk: memory_chunk) (e1: expr) :=
+ match addressing chunk e1 with
+ | (mode, args) => Eload chunk mode args
+ end.
+
+Definition store (chunk: memory_chunk) (e1 e2: expr) :=
+ match addressing chunk e1 with
+ | (mode, args) => Sstore chunk mode args e2
+ end.
+
+(** * Translation from Cminor to CminorSel *)
+
+(** Instruction selection for operator applications *)
+
+Definition sel_constant (cst: Cminor.constant) : expr :=
+ match cst with
+ | Cminor.Ointconst n => Eop (Ointconst n) Enil
+ | Cminor.Ofloatconst f => Eop (Ofloatconst f) Enil
+ | Cminor.Oaddrsymbol id ofs => Eop (Oaddrsymbol id ofs) Enil
+ | Cminor.Oaddrstack ofs => Eop (Oaddrstack ofs) Enil
+ end.
+
+Definition sel_unop (op: Cminor.unary_operation) (arg: expr) : expr :=
+ match op with
+ | Cminor.Ocast8unsigned => cast8unsigned arg
+ | Cminor.Ocast8signed => cast8signed arg
+ | Cminor.Ocast16unsigned => cast16unsigned arg
+ | Cminor.Ocast16signed => cast16signed arg
+ | Cminor.Onegint => Eop (Orsubimm Int.zero) (arg ::: Enil)
+ | Cminor.Onotbool => notbool arg
+ | Cminor.Onotint => notint arg
+ | Cminor.Onegf => Eop Onegf (arg ::: Enil)
+ | Cminor.Oabsf => Eop Oabsf (arg ::: Enil)
+ | Cminor.Osingleoffloat => singleoffloat arg
+ | Cminor.Ointoffloat => Eop Ointoffloat (arg ::: Enil)
+ | Cminor.Ointuoffloat => Eop Ointuoffloat (arg ::: Enil)
+ | Cminor.Ofloatofint => Eop Ofloatofint (arg ::: Enil)
+ | Cminor.Ofloatofintu => Eop Ofloatofintu (arg ::: Enil)
+ end.
+
+Definition sel_binop (op: Cminor.binary_operation) (arg1 arg2: expr) : expr :=
+ match op with
+ | Cminor.Oadd => add arg1 arg2
+ | Cminor.Osub => sub arg1 arg2
+ | Cminor.Omul => mul arg1 arg2
+ | Cminor.Odiv => divs arg1 arg2
+ | Cminor.Odivu => divu arg1 arg2
+ | Cminor.Omod => mods arg1 arg2
+ | Cminor.Omodu => modu arg1 arg2
+ | Cminor.Oand => and arg1 arg2
+ | Cminor.Oor => or arg1 arg2
+ | Cminor.Oxor => xor arg1 arg2
+ | Cminor.Oshl => shl arg1 arg2
+ | Cminor.Oshr => shr arg1 arg2
+ | Cminor.Oshru => shru arg1 arg2
+ | Cminor.Oaddf => Eop Oaddf (arg1 ::: arg2 ::: Enil)
+ | Cminor.Osubf => Eop Osubf (arg1 ::: arg2 ::: Enil)
+ | Cminor.Omulf => Eop Omulf (arg1 ::: arg2 ::: Enil)
+ | Cminor.Odivf => Eop Odivf (arg1 ::: arg2 ::: Enil)
+ | Cminor.Ocmp c => comp c arg1 arg2
+ | Cminor.Ocmpu c => compu c arg1 arg2
+ | Cminor.Ocmpf c => compf c arg1 arg2
+ end.
+
+(** Conversion from Cminor expression to Cminorsel expressions *)
+
+Fixpoint sel_expr (a: Cminor.expr) : expr :=
+ match a with
+ | Cminor.Evar id => Evar id
+ | Cminor.Econst cst => sel_constant cst
+ | Cminor.Eunop op arg => sel_unop op (sel_expr arg)
+ | Cminor.Ebinop op arg1 arg2 => sel_binop op (sel_expr arg1) (sel_expr arg2)
+ | Cminor.Eload chunk addr => load chunk (sel_expr addr)
+ | Cminor.Econdition cond ifso ifnot =>
+ Econdition (condexpr_of_expr (sel_expr cond))
+ (sel_expr ifso) (sel_expr ifnot)
+ end.
+
+Fixpoint sel_exprlist (al: list Cminor.expr) : exprlist :=
+ match al with
+ | nil => Enil
+ | a :: bl => Econs (sel_expr a) (sel_exprlist bl)
+ end.
+
+(** Conversion from Cminor statements to Cminorsel statements. *)
+
+Fixpoint sel_stmt (s: Cminor.stmt) : stmt :=
+ match s with
+ | Cminor.Sskip => Sskip
+ | Cminor.Sassign id e => Sassign id (sel_expr e)
+ | Cminor.Sstore chunk addr rhs => store chunk (sel_expr addr) (sel_expr rhs)
+ | Cminor.Scall optid sg fn args =>
+ Scall optid sg (sel_expr fn) (sel_exprlist args)
+ | Cminor.Stailcall sg fn args =>
+ Stailcall sg (sel_expr fn) (sel_exprlist args)
+ | Cminor.Salloc id b => Salloc id (sel_expr b)
+ | Cminor.Sseq s1 s2 => Sseq (sel_stmt s1) (sel_stmt s2)
+ | Cminor.Sifthenelse e ifso ifnot =>
+ Sifthenelse (condexpr_of_expr (sel_expr e))
+ (sel_stmt ifso) (sel_stmt ifnot)
+ | Cminor.Sloop body => Sloop (sel_stmt body)
+ | Cminor.Sblock body => Sblock (sel_stmt body)
+ | Cminor.Sexit n => Sexit n
+ | Cminor.Sswitch e cases dfl => Sswitch (sel_expr e) cases dfl
+ | Cminor.Sreturn None => Sreturn None
+ | Cminor.Sreturn (Some e) => Sreturn (Some (sel_expr e))
+ | Cminor.Slabel lbl body => Slabel lbl (sel_stmt body)
+ | Cminor.Sgoto lbl => Sgoto lbl
+ end.
+
+(** Conversion of functions and programs. *)
+
+Definition sel_function (f: Cminor.function) : function :=
+ mkfunction
+ f.(Cminor.fn_sig)
+ f.(Cminor.fn_params)
+ f.(Cminor.fn_vars)
+ f.(Cminor.fn_stackspace)
+ (sel_stmt f.(Cminor.fn_body)).
+
+Definition sel_fundef (f: Cminor.fundef) : fundef :=
+ transf_fundef sel_function f.
+
+Definition sel_program (p: Cminor.program) : program :=
+ transform_program sel_fundef p.
+
+
+
diff --git a/arm/Selectionproof.v b/arm/Selectionproof.v
new file mode 100644
index 0000000000000000000000000000000000000000..e487d15a62b30ce9517ff920d357cd5f5e6ef083
--- /dev/null
+++ b/arm/Selectionproof.v
@@ -0,0 +1,1475 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Correctness of instruction selection *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import Mem.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Smallstep.
+Require Import Cminor.
+Require Import Op.
+Require Import CminorSel.
+Require Import Selection.
+
+Open Local Scope selection_scope.
+
+Section CMCONSTR.
+
+Variable ge: genv.
+Variable sp: val.
+Variable e: env.
+Variable m: mem.
+
+(** * Lifting of let-bound variables *)
+
+Inductive insert_lenv: letenv -> nat -> val -> letenv -> Prop :=
+ | insert_lenv_0:
+ forall le v,
+ insert_lenv le O v (v :: le)
+ | insert_lenv_S:
+ forall le p w le' v,
+ insert_lenv le p w le' ->
+ insert_lenv (v :: le) (S p) w (v :: le').
+
+Lemma insert_lenv_lookup1:
+ forall le p w le',
+ insert_lenv le p w le' ->
+ forall n v,
+ nth_error le n = Some v -> (p > n)%nat ->
+ nth_error le' n = Some v.
+Proof.
+ induction 1; intros.
+ omegaContradiction.
+ destruct n; simpl; simpl in H0. auto.
+ apply IHinsert_lenv. auto. omega.
+Qed.
+
+Lemma insert_lenv_lookup2:
+ forall le p w le',
+ insert_lenv le p w le' ->
+ forall n v,
+ nth_error le n = Some v -> (p <= n)%nat ->
+ nth_error le' (S n) = Some v.
+Proof.
+ induction 1; intros.
+ simpl. assumption.
+ simpl. destruct n. omegaContradiction.
+ apply IHinsert_lenv. exact H0. omega.
+Qed.
+
+Hint Resolve eval_Evar eval_Eop eval_Eload eval_Econdition
+ eval_Elet eval_Eletvar
+ eval_CEtrue eval_CEfalse eval_CEcond
+ eval_CEcondition eval_Enil eval_Econs: evalexpr.
+
+Lemma eval_lift_expr:
+ forall w le a v,
+ eval_expr ge sp e m le a v ->
+ forall p le', insert_lenv le p w le' ->
+ eval_expr ge sp e m le' (lift_expr p a) v.
+Proof.
+ intro w.
+ apply (eval_expr_ind3 ge sp e m
+ (fun le a v =>
+ forall p le', insert_lenv le p w le' ->
+ eval_expr ge sp e m le' (lift_expr p a) v)
+ (fun le a v =>
+ forall p le', insert_lenv le p w le' ->
+ eval_condexpr ge sp e m le' (lift_condexpr p a) v)
+ (fun le al vl =>
+ forall p le', insert_lenv le p w le' ->
+ eval_exprlist ge sp e m le' (lift_exprlist p al) vl));
+ simpl; intros; eauto with evalexpr.
+
+ destruct v1; eapply eval_Econdition;
+ eauto with evalexpr; simpl; eauto with evalexpr.
+
+ eapply eval_Elet. eauto. apply H2. apply insert_lenv_S; auto.
+
+ case (le_gt_dec p n); intro.
+ apply eval_Eletvar. eapply insert_lenv_lookup2; eauto.
+ apply eval_Eletvar. eapply insert_lenv_lookup1; eauto.
+
+ destruct vb1; eapply eval_CEcondition;
+ eauto with evalexpr; simpl; eauto with evalexpr.
+Qed.
+
+Lemma eval_lift:
+ forall le a v w,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m (w::le) (lift a) v.
+Proof.
+ intros. unfold lift. eapply eval_lift_expr.
+ eexact H. apply insert_lenv_0.
+Qed.
+
+Hint Resolve eval_lift: evalexpr.
+
+(** * Useful lemmas and tactics *)
+
+(** The following are trivial lemmas and custom tactics that help
+ perform backward (inversion) and forward reasoning over the evaluation
+ of operator applications. *)
+
+Ltac EvalOp := eapply eval_Eop; eauto with evalexpr.
+
+Ltac TrivialOp cstr := unfold cstr; intros; EvalOp.
+
+Ltac InvEval1 :=
+ match goal with
+ | [ H: (eval_expr _ _ _ _ _ (Eop _ Enil) _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_expr _ _ _ _ _ (Eop _ (_ ::: Enil)) _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_expr _ _ _ _ _ (Eop _ (_ ::: _ ::: Enil)) _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_exprlist _ _ _ _ _ Enil _) |- _ ] =>
+ inv H; InvEval1
+ | [ H: (eval_exprlist _ _ _ _ _ (_ ::: _) _) |- _ ] =>
+ inv H; InvEval1
+ | _ =>
+ idtac
+ end.
+
+Ltac InvEval2 :=
+ match goal with
+ | [ H: (eval_operation _ _ _ nil _ = Some _) |- _ ] =>
+ simpl in H; inv H
+ | [ H: (eval_operation _ _ _ (_ :: nil) _ = Some _) |- _ ] =>
+ simpl in H; FuncInv
+ | [ H: (eval_operation _ _ _ (_ :: _ :: nil) _ = Some _) |- _ ] =>
+ simpl in H; FuncInv
+ | [ H: (eval_operation _ _ _ (_ :: _ :: _ :: nil) _ = Some _) |- _ ] =>
+ simpl in H; FuncInv
+ | _ =>
+ idtac
+ end.
+
+Ltac InvEval := InvEval1; InvEval2; InvEval2.
+
+(** * Correctness of the smart constructors *)
+
+(** We now show that the code generated by "smart constructor" functions
+ such as [Selection.notint] behaves as expected. Continuing the
+ [notint] example, we show that if the expression [e]
+ evaluates to some integer value [Vint n], then [Selection.notint e]
+ evaluates to a value [Vint (Int.not n)] which is indeed the integer
+ negation of the value of [e].
+
+ All proofs follow a common pattern:
+- Reasoning by case over the result of the classification functions
+ (such as [add_match] for integer addition), gathering additional
+ information on the shape of the argument expressions in the non-default
+ cases.
+- Inversion of the evaluations of the arguments, exploiting the additional
+ information thus gathered.
+- Equational reasoning over the arithmetic operations performed,
+ using the lemmas from the [Int] and [Float] modules.
+- Construction of an evaluation derivation for the expression returned
+ by the smart constructor.
+*)
+
+Theorem eval_notint:
+ forall le a x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (notint a) (Vint (Int.not x)).
+Proof.
+ unfold notint; intros until x; case (notint_match a); intros; InvEval.
+ EvalOp. simpl. congruence.
+ subst x. rewrite Int.not_involutive. auto.
+ EvalOp. simpl. subst x. rewrite Int.not_involutive. auto.
+ EvalOp.
+Qed.
+
+Lemma eval_notbool_base:
+ forall le a v b,
+ eval_expr ge sp e m le a v ->
+ Val.bool_of_val v b ->
+ eval_expr ge sp e m le (notbool_base a) (Val.of_bool (negb b)).
+Proof.
+ TrivialOp notbool_base. simpl.
+ inv H0.
+ rewrite Int.eq_false; auto.
+ rewrite Int.eq_true; auto.
+ reflexivity.
+Qed.
+
+Hint Resolve Val.bool_of_true_val Val.bool_of_false_val
+ Val.bool_of_true_val_inv Val.bool_of_false_val_inv: valboolof.
+
+Theorem eval_notbool:
+ forall le a v b,
+ eval_expr ge sp e m le a v ->
+ Val.bool_of_val v b ->
+ eval_expr ge sp e m le (notbool a) (Val.of_bool (negb b)).
+Proof.
+ induction a; simpl; intros; try (eapply eval_notbool_base; eauto).
+ destruct o; try (eapply eval_notbool_base; eauto).
+
+ destruct e0. InvEval.
+ inv H0. rewrite Int.eq_false; auto.
+ simpl; eauto with evalexpr.
+ rewrite Int.eq_true; simpl; eauto with evalexpr.
+ eapply eval_notbool_base; eauto.
+
+ inv H. eapply eval_Eop; eauto.
+ simpl. assert (eval_condition c vl m = Some b).
+ generalize H6. simpl.
+ case (eval_condition c vl m); intros.
+ destruct b0; inv H1; inversion H0; auto; congruence.
+ congruence.
+ rewrite (Op.eval_negate_condition _ _ _ H).
+ destruct b; reflexivity.
+
+ inv H. eapply eval_Econdition; eauto.
+ destruct v1; eauto.
+Qed.
+
+Theorem eval_addimm:
+ forall le n a x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (addimm n a) (Vint (Int.add x n)).
+Proof.
+ unfold addimm; intros until x.
+ generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro.
+ subst n. rewrite Int.add_zero. auto.
+ case (addimm_match a); intros; InvEval; EvalOp; simpl.
+ rewrite Int.add_commut. auto.
+ destruct (Genv.find_symbol ge s); discriminate.
+ destruct sp; simpl in H1; discriminate.
+ subst x. rewrite Int.add_assoc. decEq; decEq; decEq. apply Int.add_commut.
+Qed.
+
+Theorem eval_addimm_ptr:
+ forall le n a b ofs,
+ eval_expr ge sp e m le a (Vptr b ofs) ->
+ eval_expr ge sp e m le (addimm n a) (Vptr b (Int.add ofs n)).
+Proof.
+ unfold addimm; intros until ofs.
+ generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro.
+ subst n. rewrite Int.add_zero. auto.
+ case (addimm_match a); intros; InvEval; EvalOp; simpl.
+ destruct (Genv.find_symbol ge s).
+ rewrite Int.add_commut. congruence.
+ discriminate.
+ destruct sp; simpl in H1; try discriminate.
+ inv H1. simpl. decEq. decEq.
+ rewrite Int.add_assoc. decEq. apply Int.add_commut.
+ subst. rewrite (Int.add_commut n m0). rewrite Int.add_assoc. auto.
+Qed.
+
+Theorem eval_add:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (add a b) (Vint (Int.add x y)).
+Proof.
+ intros until y.
+ unfold add; case (add_match a b); intros; InvEval.
+ rewrite Int.add_commut. apply eval_addimm. auto.
+ replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
+ apply eval_addimm. EvalOp.
+ subst x; subst y.
+ repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
+ replace (Int.add x y) with (Int.add (Int.add i y) n1).
+ apply eval_addimm. EvalOp.
+ subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
+ apply eval_addimm. auto.
+ replace (Int.add x y) with (Int.add (Int.add x i) n2).
+ apply eval_addimm. EvalOp.
+ subst y. rewrite Int.add_assoc. auto.
+ EvalOp. simpl. subst x. rewrite Int.add_commut. auto.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Theorem eval_add_ptr:
+ forall le a b p x y,
+ eval_expr ge sp e m le a (Vptr p x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (add a b) (Vptr p (Int.add x y)).
+Proof.
+ intros until y. unfold add; case (add_match a b); intros; InvEval.
+ replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
+ apply eval_addimm_ptr. subst b0. EvalOp.
+ subst x; subst y.
+ repeat rewrite Int.add_assoc. decEq. apply Int.add_permut.
+ replace (Int.add x y) with (Int.add (Int.add i y) n1).
+ apply eval_addimm_ptr. subst b0. EvalOp.
+ subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
+ apply eval_addimm_ptr. auto.
+ replace (Int.add x y) with (Int.add (Int.add x i) n2).
+ apply eval_addimm_ptr. EvalOp.
+ subst y. rewrite Int.add_assoc. auto.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Theorem eval_add_ptr_2:
+ forall le a b x p y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vptr p y) ->
+ eval_expr ge sp e m le (add a b) (Vptr p (Int.add y x)).
+Proof.
+ intros until y. unfold add; case (add_match a b); intros; InvEval.
+ apply eval_addimm_ptr. auto.
+ replace (Int.add y x) with (Int.add (Int.add i i0) (Int.add n1 n2)).
+ apply eval_addimm_ptr. subst b0. EvalOp.
+ subst x; subst y.
+ repeat rewrite Int.add_assoc. decEq.
+ rewrite (Int.add_commut n1 n2). apply Int.add_permut.
+ replace (Int.add y x) with (Int.add (Int.add y i) n1).
+ apply eval_addimm_ptr. EvalOp.
+ subst x. repeat rewrite Int.add_assoc. auto.
+ replace (Int.add y x) with (Int.add (Int.add i x) n2).
+ apply eval_addimm_ptr. EvalOp. subst b0; reflexivity.
+ subst y. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Theorem eval_sub:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)).
+Proof.
+ intros until y.
+ unfold sub; case (sub_match a b); intros; InvEval.
+ rewrite Int.sub_add_opp.
+ apply eval_addimm. assumption.
+ replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
+ apply eval_addimm. EvalOp.
+ subst x; subst y.
+ repeat rewrite Int.sub_add_opp.
+ repeat rewrite Int.add_assoc. decEq.
+ rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
+ replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
+ apply eval_addimm. EvalOp.
+ subst x. rewrite Int.sub_add_l. auto.
+ replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
+ apply eval_addimm. EvalOp.
+ subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r.
+ EvalOp.
+ EvalOp. simpl. congruence.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Theorem eval_sub_ptr_int:
+ forall le a b p x y,
+ eval_expr ge sp e m le a (Vptr p x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (sub a b) (Vptr p (Int.sub x y)).
+Proof.
+ intros until y.
+ unfold sub; case (sub_match a b); intros; InvEval.
+ rewrite Int.sub_add_opp.
+ apply eval_addimm_ptr. assumption.
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
+ apply eval_addimm_ptr. EvalOp.
+ subst x; subst y.
+ repeat rewrite Int.sub_add_opp.
+ repeat rewrite Int.add_assoc. decEq.
+ rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
+ apply eval_addimm_ptr. EvalOp.
+ subst x. rewrite Int.sub_add_l. auto.
+ replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
+ apply eval_addimm_ptr. EvalOp.
+ subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Theorem eval_sub_ptr_ptr:
+ forall le a b p x y,
+ eval_expr ge sp e m le a (Vptr p x) ->
+ eval_expr ge sp e m le b (Vptr p y) ->
+ eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)).
+Proof.
+ intros until y.
+ unfold sub; case (sub_match a b); intros; InvEval.
+ replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)).
+ apply eval_addimm. EvalOp.
+ simpl; unfold eq_block. subst b0; subst b1; rewrite zeq_true. auto.
+ subst x; subst y.
+ repeat rewrite Int.sub_add_opp.
+ repeat rewrite Int.add_assoc. decEq.
+ rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr.
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1).
+ apply eval_addimm. EvalOp.
+ simpl. unfold eq_block. rewrite zeq_true. auto.
+ subst x. rewrite Int.sub_add_l. auto.
+ subst b0. replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)).
+ apply eval_addimm. EvalOp.
+ simpl. unfold eq_block. rewrite zeq_true. auto.
+ subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r.
+ EvalOp. simpl. unfold eq_block. rewrite zeq_true. auto.
+Qed.
+
+Theorem eval_shlimm:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
+ Int.ltu n (Int.repr 32) = true ->
+ eval_expr ge sp e m le (shlimm a n) (Vint (Int.shl x n)).
+Proof.
+ intros until x. unfold shlimm, is_shift_amount.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
+ intros. subst n. rewrite Int.shl_zero. auto.
+ destruct (is_shift_amount_aux n). simpl.
+ case (shlimm_match a); intros; InvEval.
+ EvalOp.
+ destruct (is_shift_amount_aux (Int.add n (s_amount n1))).
+ EvalOp. simpl. subst x.
+ decEq. decEq. symmetry. rewrite Int.add_commut. apply Int.shl_shl.
+ apply s_amount_ltu. auto.
+ rewrite Int.add_commut. auto.
+ EvalOp. econstructor. EvalOp. simpl. reflexivity. constructor.
+ simpl. congruence.
+ EvalOp.
+ congruence.
+Qed.
+
+Theorem eval_shruimm:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
+ Int.ltu n (Int.repr 32) = true ->
+ eval_expr ge sp e m le (shruimm a n) (Vint (Int.shru x n)).
+Proof.
+ intros until x. unfold shruimm, is_shift_amount.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
+ intros. subst n. rewrite Int.shru_zero. auto.
+ destruct (is_shift_amount_aux n). simpl.
+ case (shruimm_match a); intros; InvEval.
+ EvalOp.
+ destruct (is_shift_amount_aux (Int.add n (s_amount n1))).
+ EvalOp. simpl. subst x.
+ decEq. decEq. symmetry. rewrite Int.add_commut. apply Int.shru_shru.
+ apply s_amount_ltu. auto.
+ rewrite Int.add_commut. auto.
+ EvalOp. econstructor. EvalOp. simpl. reflexivity. constructor.
+ simpl. congruence.
+ EvalOp.
+ congruence.
+Qed.
+
+Theorem eval_shrimm:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
+ Int.ltu n (Int.repr 32) = true ->
+ eval_expr ge sp e m le (shrimm a n) (Vint (Int.shr x n)).
+Proof.
+ intros until x. unfold shrimm, is_shift_amount.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
+ intros. subst n. rewrite Int.shr_zero. auto.
+ destruct (is_shift_amount_aux n). simpl.
+ case (shrimm_match a); intros; InvEval.
+ EvalOp.
+ destruct (is_shift_amount_aux (Int.add n (s_amount n1))).
+ EvalOp. simpl. subst x.
+ decEq. decEq. symmetry. rewrite Int.add_commut. apply Int.shr_shr.
+ apply s_amount_ltu. auto.
+ rewrite Int.add_commut. auto.
+ EvalOp. econstructor. EvalOp. simpl. reflexivity. constructor.
+ simpl. congruence.
+ EvalOp.
+ congruence.
+Qed.
+
+Lemma eval_mulimm_base:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (mulimm_base n a) (Vint (Int.mul x n)).
+Proof.
+ intros; unfold mulimm_base.
+ generalize (Int.one_bits_decomp n).
+ generalize (Int.one_bits_range n).
+ change (Z_of_nat wordsize) with 32.
+ destruct (Int.one_bits n).
+ intros. EvalOp. constructor. EvalOp. simpl; reflexivity.
+ constructor. eauto. constructor. simpl. rewrite Int.mul_commut. auto.
+ destruct l.
+ intros. rewrite H1. simpl.
+ rewrite Int.add_zero. rewrite <- Int.shl_mul.
+ apply eval_shlimm. auto. auto with coqlib.
+ destruct l.
+ intros. apply eval_Elet with (Vint x). auto.
+ rewrite H1. simpl. rewrite Int.add_zero.
+ rewrite Int.mul_add_distr_r.
+ rewrite <- Int.shl_mul.
+ rewrite <- Int.shl_mul.
+ apply eval_add.
+ apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity.
+ auto with coqlib.
+ apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity.
+ auto with coqlib.
+ intros. EvalOp. constructor. EvalOp. simpl; reflexivity.
+ constructor. eauto. constructor. simpl. rewrite Int.mul_commut. auto.
+Qed.
+
+Theorem eval_mulimm:
+ forall le a n x,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le (mulimm n a) (Vint (Int.mul x n)).
+Proof.
+ intros until x; unfold mulimm.
+ generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
+ subst n. rewrite Int.mul_zero.
+ intro. EvalOp.
+ generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intro.
+ subst n. rewrite Int.mul_one. auto.
+ case (mulimm_match a); intros; InvEval.
+ EvalOp. rewrite Int.mul_commut. reflexivity.
+ replace (Int.mul x n) with (Int.add (Int.mul i n) (Int.mul n n2)).
+ apply eval_addimm. apply eval_mulimm_base. auto.
+ subst x. rewrite Int.mul_add_distr_l. decEq. apply Int.mul_commut.
+ apply eval_mulimm_base. assumption.
+Qed.
+
+Theorem eval_mul:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (mul a b) (Vint (Int.mul x y)).
+Proof.
+ intros until y.
+ unfold mul; case (mul_match a b); intros; InvEval.
+ rewrite Int.mul_commut. apply eval_mulimm. auto.
+ apply eval_mulimm. auto.
+ EvalOp.
+Qed.
+
+Theorem eval_divs_base:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ y <> Int.zero ->
+ eval_expr ge sp e m le (Eop Odiv (a ::: b ::: Enil)) (Vint (Int.divs x y)).
+Proof.
+ intros. EvalOp; simpl.
+ predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
+Qed.
+
+Theorem eval_divs:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ y <> Int.zero ->
+ eval_expr ge sp e m le (divs a b) (Vint (Int.divs x y)).
+Proof.
+ intros until y.
+ unfold divs; case (divu_match b); intros; InvEval.
+ caseEq (Int.is_power2 y); intros.
+ caseEq (Int.ltu i (Int.repr 31)); intros.
+ EvalOp. simpl. unfold Int.ltu. rewrite zlt_true.
+ rewrite (Int.divs_pow2 x y i H0). auto.
+ exploit Int.ltu_inv; eauto.
+ change (Int.unsigned (Int.repr 31)) with 31.
+ change (Int.unsigned (Int.repr 32)) with 32.
+ omega.
+ apply eval_divs_base. auto. EvalOp. auto.
+ apply eval_divs_base. auto. EvalOp. auto.
+ apply eval_divs_base; auto.
+Qed.
+
+Lemma eval_mod_aux:
+ forall divop semdivop,
+ (forall sp x y m,
+ y <> Int.zero ->
+ eval_operation ge sp divop (Vint x :: Vint y :: nil) m =
+ Some (Vint (semdivop x y))) ->
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ y <> Int.zero ->
+ eval_expr ge sp e m le (mod_aux divop a b)
+ (Vint (Int.sub x (Int.mul (semdivop x y) y))).
+Proof.
+ intros; unfold mod_aux.
+ eapply eval_Elet. eexact H0. eapply eval_Elet.
+ apply eval_lift. eexact H1.
+ eapply eval_Eop. eapply eval_Econs.
+ eapply eval_Eletvar. simpl; reflexivity.
+ eapply eval_Econs. eapply eval_Eop.
+ eapply eval_Econs. eapply eval_Eop.
+ eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
+ eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
+ apply eval_Enil.
+ apply H. assumption.
+ eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
+ apply eval_Enil.
+ simpl; reflexivity. apply eval_Enil.
+ reflexivity.
+Qed.
+
+Theorem eval_mods:
+ forall le a b x y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ y <> Int.zero ->
+ eval_expr ge sp e m le (mods a b) (Vint (Int.mods x y)).
+Proof.
+ intros; unfold mods.
+ rewrite Int.mods_divs.
+ eapply eval_mod_aux; eauto.
+ intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
+ contradiction. auto.
+Qed.
+
+Lemma eval_divu_base:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ y <> Int.zero ->
+ eval_expr ge sp e m le (Eop Odivu (a ::: b ::: Enil)) (Vint (Int.divu x y)).
+Proof.
+ intros. EvalOp. simpl.
+ predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
+Qed.
+
+Theorem eval_divu:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ y <> Int.zero ->
+ eval_expr ge sp e m le (divu a b) (Vint (Int.divu x y)).
+Proof.
+ intros until y.
+ unfold divu; case (divu_match b); intros; InvEval.
+ caseEq (Int.is_power2 y).
+ intros. rewrite (Int.divu_pow2 x y i H0).
+ apply eval_shruimm. auto.
+ apply Int.is_power2_range with y. auto.
+ intros. apply eval_divu_base. auto. EvalOp. auto.
+ eapply eval_divu_base; eauto.
+Qed.
+
+Theorem eval_modu:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ y <> Int.zero ->
+ eval_expr ge sp e m le (modu a b) (Vint (Int.modu x y)).
+Proof.
+ intros until y; unfold modu; case (divu_match b); intros; InvEval.
+ caseEq (Int.is_power2 y).
+ intros. rewrite (Int.modu_and x y i H0).
+ EvalOp.
+ intro. rewrite Int.modu_divu. eapply eval_mod_aux.
+ intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
+ contradiction. auto.
+ auto. EvalOp. auto. auto.
+ rewrite Int.modu_divu. eapply eval_mod_aux.
+ intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
+ contradiction. auto. auto. auto. auto. auto.
+Qed.
+
+Theorem eval_and:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (and a b) (Vint (Int.and x y)).
+Proof.
+ intros until y; unfold and; case (and_match a b); intros; InvEval.
+ rewrite Int.and_commut. EvalOp. simpl. congruence.
+ EvalOp. simpl. congruence.
+ rewrite Int.and_commut. EvalOp. simpl. congruence.
+ EvalOp. simpl. congruence.
+ rewrite Int.and_commut. EvalOp. simpl. congruence.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Remark eval_same_expr:
+ forall a1 a2 le v1 v2,
+ same_expr_pure a1 a2 = true ->
+ eval_expr ge sp e m le a1 v1 ->
+ eval_expr ge sp e m le a2 v2 ->
+ a1 = a2 /\ v1 = v2.
+Proof.
+ intros until v2.
+ destruct a1; simpl; try (intros; discriminate).
+ destruct a2; simpl; try (intros; discriminate).
+ case (ident_eq i i0); intros.
+ subst i0. inversion H0. inversion H1. split. auto. congruence.
+ discriminate.
+Qed.
+
+Lemma eval_or:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (or a b) (Vint (Int.or x y)).
+Proof.
+ intros until y; unfold or; case (or_match a b); intros; InvEval.
+ caseEq (Int.eq (Int.add (s_amount n1) (s_amount n2)) (Int.repr 32)
+ && same_expr_pure t1 t2); intro.
+ destruct (andb_prop _ _ H1).
+ generalize (Int.eq_spec (Int.add (s_amount n1) (s_amount n2)) (Int.repr 32)).
+ rewrite H4. intro.
+ exploit eval_same_expr; eauto. intros [EQ1 EQ2]. inv EQ1. inv EQ2.
+ simpl. EvalOp. simpl. decEq. decEq. apply Int.or_ror.
+ destruct n1; auto. destruct n2; auto. auto.
+ EvalOp. econstructor. EvalOp. simpl. reflexivity.
+ econstructor; eauto with evalexpr.
+ simpl. congruence.
+ EvalOp. simpl. rewrite Int.or_commut. congruence.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Theorem eval_xor:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (xor a b) (Vint (Int.xor x y)).
+Proof.
+ intros until y; unfold xor; case (xor_match a b); intros; InvEval.
+ rewrite Int.xor_commut. EvalOp. simpl. congruence.
+ EvalOp. simpl. congruence.
+ EvalOp.
+Qed.
+
+Theorem eval_shl:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ Int.ltu y (Int.repr 32) = true ->
+ eval_expr ge sp e m le (shl a b) (Vint (Int.shl x y)).
+Proof.
+ intros until y; unfold shl; case (shift_match b); intros.
+ InvEval. apply eval_shlimm; auto.
+ EvalOp. simpl. rewrite H1. auto.
+Qed.
+
+Theorem eval_shru:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ Int.ltu y (Int.repr 32) = true ->
+ eval_expr ge sp e m le (shru a b) (Vint (Int.shru x y)).
+Proof.
+ intros until y; unfold shru; case (shift_match b); intros.
+ InvEval. apply eval_shruimm; auto.
+ EvalOp. simpl. rewrite H1. auto.
+Qed.
+
+Theorem eval_shr:
+ forall le a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ Int.ltu y (Int.repr 32) = true ->
+ eval_expr ge sp e m le (shr a b) (Vint (Int.shr x y)).
+Proof.
+ intros until y; unfold shr; case (shift_match b); intros.
+ InvEval. apply eval_shrimm; auto.
+ EvalOp. simpl. rewrite H1. auto.
+Qed.
+
+Theorem eval_cast8signed:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast8signed a) (Val.sign_ext 8 v).
+Proof.
+ intros until v; unfold cast8signed; case (cast8signed_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto.
+ rewrite Int.sign_ext_idem. reflexivity. vm_compute; auto.
+ EvalOp.
+Qed.
+
+Theorem eval_cast8unsigned:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast8unsigned a) (Val.zero_ext 8 v).
+Proof.
+ intros until v; unfold cast8unsigned; case (cast8unsigned_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto.
+ rewrite Int.zero_ext_idem. reflexivity. vm_compute; auto.
+ EvalOp.
+Qed.
+
+Theorem eval_cast16signed:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast16signed a) (Val.sign_ext 16 v).
+Proof.
+ intros until v; unfold cast16signed; case (cast16signed_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto.
+ rewrite Int.sign_ext_idem. reflexivity. vm_compute; auto.
+ EvalOp.
+Qed.
+
+Theorem eval_cast16unsigned:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (cast16unsigned a) (Val.zero_ext 16 v).
+Proof.
+ intros until v; unfold cast16unsigned; case (cast16unsigned_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto.
+ rewrite Int.zero_ext_idem. reflexivity. vm_compute; auto.
+ EvalOp.
+Qed.
+
+Theorem eval_singleoffloat:
+ forall le a v,
+ eval_expr ge sp e m le a v ->
+ eval_expr ge sp e m le (singleoffloat a) (Val.singleoffloat v).
+Proof.
+ intros until v; unfold singleoffloat; case (singleoffloat_match a); intros; InvEval.
+ EvalOp. simpl. subst v. destruct v1; simpl; auto. rewrite Float.singleoffloat_idem. reflexivity.
+ EvalOp.
+Qed.
+
+Theorem eval_comp_int:
+ forall le c a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (comp c a b) (Val.of_bool(Int.cmp c x y)).
+Proof.
+ intros until y.
+ unfold comp; case (comp_match a b); intros; InvEval.
+ EvalOp. simpl. rewrite Int.swap_cmp. destruct (Int.cmp c x y); reflexivity.
+ EvalOp. simpl. destruct (Int.cmp c x y); reflexivity.
+ EvalOp. simpl. rewrite Int.swap_cmp. rewrite H. destruct (Int.cmp c x y); reflexivity.
+ EvalOp. simpl. rewrite H0. destruct (Int.cmp c x y); reflexivity.
+ EvalOp. simpl. destruct (Int.cmp c x y); reflexivity.
+Qed.
+
+Remark eval_compare_null_trans:
+ forall c x v,
+ (if Int.eq x Int.zero then Cminor.eval_compare_mismatch c else None) = Some v ->
+ match eval_compare_null c x with
+ | Some true => Some Vtrue
+ | Some false => Some Vfalse
+ | None => None (A:=val)
+ end = Some v.
+Proof.
+ unfold Cminor.eval_compare_mismatch, eval_compare_null; intros.
+ destruct (Int.eq x Int.zero); try discriminate.
+ destruct c; try discriminate; auto.
+Qed.
+
+Theorem eval_comp_ptr_int:
+ forall le c a x1 x2 b y v,
+ eval_expr ge sp e m le a (Vptr x1 x2) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ (if Int.eq y Int.zero then Cminor.eval_compare_mismatch c else None) = Some v ->
+ eval_expr ge sp e m le (comp c a b) v.
+Proof.
+ intros until v.
+ unfold comp; case (comp_match a b); intros; InvEval.
+ EvalOp. simpl. apply eval_compare_null_trans; auto.
+ EvalOp. simpl. rewrite H0. apply eval_compare_null_trans; auto.
+ EvalOp. simpl. apply eval_compare_null_trans; auto.
+Qed.
+
+Remark eval_swap_compare_null_trans:
+ forall c x v,
+ (if Int.eq x Int.zero then Cminor.eval_compare_mismatch c else None) = Some v ->
+ match eval_compare_null (swap_comparison c) x with
+ | Some true => Some Vtrue
+ | Some false => Some Vfalse
+ | None => None (A:=val)
+ end = Some v.
+Proof.
+ unfold Cminor.eval_compare_mismatch, eval_compare_null; intros.
+ destruct (Int.eq x Int.zero); try discriminate.
+ destruct c; simpl; try discriminate; auto.
+Qed.
+
+Theorem eval_comp_int_ptr:
+ forall le c a x b y1 y2 v,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vptr y1 y2) ->
+ (if Int.eq x Int.zero then Cminor.eval_compare_mismatch c else None) = Some v ->
+ eval_expr ge sp e m le (comp c a b) v.
+Proof.
+ intros until v.
+ unfold comp; case (comp_match a b); intros; InvEval.
+ EvalOp. simpl. apply eval_swap_compare_null_trans; auto.
+ EvalOp. simpl. rewrite H. apply eval_swap_compare_null_trans; auto.
+ EvalOp. simpl. apply eval_compare_null_trans; auto.
+Qed.
+
+Theorem eval_comp_ptr_ptr:
+ forall le c a x1 x2 b y1 y2,
+ eval_expr ge sp e m le a (Vptr x1 x2) ->
+ eval_expr ge sp e m le b (Vptr y1 y2) ->
+ valid_pointer m x1 (Int.signed x2) &&
+ valid_pointer m y1 (Int.signed y2) = true ->
+ x1 = y1 ->
+ eval_expr ge sp e m le (comp c a b) (Val.of_bool(Int.cmp c x2 y2)).
+Proof.
+ intros until y2.
+ unfold comp; case (comp_match a b); intros; InvEval.
+ EvalOp. simpl. rewrite H1. simpl.
+ subst y1. rewrite dec_eq_true.
+ destruct (Int.cmp c x2 y2); reflexivity.
+Qed.
+
+Theorem eval_comp_ptr_ptr_2:
+ forall le c a x1 x2 b y1 y2 v,
+ eval_expr ge sp e m le a (Vptr x1 x2) ->
+ eval_expr ge sp e m le b (Vptr y1 y2) ->
+ valid_pointer m x1 (Int.signed x2) &&
+ valid_pointer m y1 (Int.signed y2) = true ->
+ x1 <> y1 ->
+ Cminor.eval_compare_mismatch c = Some v ->
+ eval_expr ge sp e m le (comp c a b) v.
+Proof.
+ intros until y2.
+ unfold comp; case (comp_match a b); intros; InvEval.
+ EvalOp. simpl. rewrite H1. rewrite dec_eq_false; auto.
+ destruct c; simpl in H3; inv H3; auto.
+Qed.
+
+
+Theorem eval_compu:
+ forall le c a x b y,
+ eval_expr ge sp e m le a (Vint x) ->
+ eval_expr ge sp e m le b (Vint y) ->
+ eval_expr ge sp e m le (compu c a b) (Val.of_bool(Int.cmpu c x y)).
+Proof.
+ intros until y.
+ unfold compu; case (comp_match a b); intros; InvEval.
+ EvalOp. simpl. rewrite Int.swap_cmpu. destruct (Int.cmpu c x y); reflexivity.
+ EvalOp. simpl. destruct (Int.cmpu c x y); reflexivity.
+ EvalOp. simpl. rewrite H. rewrite Int.swap_cmpu. destruct (Int.cmpu c x y); reflexivity.
+ EvalOp. simpl. rewrite H0. destruct (Int.cmpu c x y); reflexivity.
+ EvalOp. simpl. destruct (Int.cmpu c x y); reflexivity.
+Qed.
+
+Theorem eval_compf:
+ forall le c a x b y,
+ eval_expr ge sp e m le a (Vfloat x) ->
+ eval_expr ge sp e m le b (Vfloat y) ->
+ eval_expr ge sp e m le (compf c a b) (Val.of_bool(Float.cmp c x y)).
+Proof.
+ intros. unfold compf. EvalOp. simpl.
+ destruct (Float.cmp c x y); reflexivity.
+Qed.
+
+Lemma negate_condexpr_correct:
+ forall le a b,
+ eval_condexpr ge sp e m le a b ->
+ eval_condexpr ge sp e m le (negate_condexpr a) (negb b).
+Proof.
+ induction 1; simpl.
+ constructor.
+ constructor.
+ econstructor. eauto. apply eval_negate_condition. auto.
+ econstructor. eauto. destruct vb1; auto.
+Qed.
+
+Scheme expr_ind2 := Induction for expr Sort Prop
+ with exprlist_ind2 := Induction for exprlist Sort Prop.
+
+Fixpoint forall_exprlist (P: expr -> Prop) (el: exprlist) {struct el}: Prop :=
+ match el with
+ | Enil => True
+ | Econs e el' => P e /\ forall_exprlist P el'
+ end.
+
+Lemma expr_induction_principle:
+ forall (P: expr -> Prop),
+ (forall i : ident, P (Evar i)) ->
+ (forall (o : operation) (e : exprlist),
+ forall_exprlist P e -> P (Eop o e)) ->
+ (forall (m : memory_chunk) (a : Op.addressing) (e : exprlist),
+ forall_exprlist P e -> P (Eload m a e)) ->
+ (forall (c : condexpr) (e : expr),
+ P e -> forall e0 : expr, P e0 -> P (Econdition c e e0)) ->
+ (forall e : expr, P e -> forall e0 : expr, P e0 -> P (Elet e e0)) ->
+ (forall n : nat, P (Eletvar n)) ->
+ forall e : expr, P e.
+Proof.
+ intros. apply expr_ind2 with (P := P) (P0 := forall_exprlist P); auto.
+ simpl. auto.
+ intros. simpl. auto.
+Qed.
+
+Lemma eval_base_condition_of_expr:
+ forall le a v b,
+ eval_expr ge sp e m le a v ->
+ Val.bool_of_val v b ->
+ eval_condexpr ge sp e m le
+ (CEcond (Ccompimm Cne Int.zero) (a ::: Enil))
+ b.
+Proof.
+ intros.
+ eapply eval_CEcond. eauto with evalexpr.
+ inversion H0; simpl. rewrite Int.eq_false; auto. auto. auto.
+Qed.
+
+Lemma is_compare_neq_zero_correct:
+ forall c v b,
+ is_compare_neq_zero c = true ->
+ eval_condition c (v :: nil) m = Some b ->
+ Val.bool_of_val v b.
+Proof.
+ intros.
+ destruct c; simpl in H; try discriminate;
+ destruct c; simpl in H; try discriminate;
+ generalize (Int.eq_spec i Int.zero); rewrite H; intro; subst i.
+
+ simpl in H0. destruct v; inv H0.
+ generalize (Int.eq_spec i Int.zero). destruct (Int.eq i Int.zero); intros; simpl.
+ subst i; constructor. constructor; auto. constructor.
+
+ simpl in H0. destruct v; inv H0.
+ generalize (Int.eq_spec i Int.zero). destruct (Int.eq i Int.zero); intros; simpl.
+ subst i; constructor. constructor; auto.
+Qed.
+
+Lemma is_compare_eq_zero_correct:
+ forall c v b,
+ is_compare_eq_zero c = true ->
+ eval_condition c (v :: nil) m = Some b ->
+ Val.bool_of_val v (negb b).
+Proof.
+ intros. apply is_compare_neq_zero_correct with (negate_condition c).
+ destruct c; simpl in H; simpl; try discriminate;
+ destruct c; simpl; try discriminate; auto.
+ apply eval_negate_condition; auto.
+Qed.
+
+Lemma eval_condition_of_expr:
+ forall a le v b,
+ eval_expr ge sp e m le a v ->
+ Val.bool_of_val v b ->
+ eval_condexpr ge sp e m le (condexpr_of_expr a) b.
+Proof.
+ intro a0; pattern a0.
+ apply expr_induction_principle; simpl; intros;
+ try (eapply eval_base_condition_of_expr; eauto; fail).
+
+ destruct o; try (eapply eval_base_condition_of_expr; eauto; fail).
+
+ destruct e0. InvEval.
+ inversion H1.
+ rewrite Int.eq_false; auto. constructor.
+ subst i; rewrite Int.eq_true. constructor.
+ eapply eval_base_condition_of_expr; eauto.
+
+ inv H0. simpl in H7.
+ assert (eval_condition c vl m = Some b).
+ destruct (eval_condition c vl m); try discriminate.
+ destruct b0; inv H7; inversion H1; congruence.
+ assert (eval_condexpr ge sp e m le (CEcond c e0) b).
+ eapply eval_CEcond; eauto.
+ destruct e0; auto. destruct e1; auto.
+ simpl in H. destruct H.
+ inv H5. inv H11.
+
+ case_eq (is_compare_neq_zero c); intros.
+ eapply H; eauto.
+ apply is_compare_neq_zero_correct with c; auto.
+
+ case_eq (is_compare_eq_zero c); intros.
+ replace b with (negb (negb b)). apply negate_condexpr_correct.
+ eapply H; eauto.
+ apply is_compare_eq_zero_correct with c; auto.
+ apply negb_involutive.
+
+ auto.
+
+ inv H1. destruct v1; eauto with evalexpr.
+Qed.
+
+Lemma eval_addressing:
+ forall le chunk a v b ofs,
+ eval_expr ge sp e m le a v ->
+ v = Vptr b ofs ->
+ match addressing chunk a with (mode, args) =>
+ exists vl,
+ eval_exprlist ge sp e m le args vl /\
+ eval_addressing ge sp mode vl = Some v
+ end.
+Proof.
+ intros until v. unfold addressing; case (addressing_match a); intros; InvEval.
+ exists (@nil val). split. eauto with evalexpr. simpl. auto.
+ exists (Vptr b0 i :: nil). split. eauto with evalexpr.
+ simpl. congruence.
+ destruct (is_float_addressing chunk).
+ exists (Vptr b0 ofs :: nil).
+ split. constructor. econstructor. eauto with evalexpr. simpl. congruence. constructor.
+ simpl. rewrite Int.add_zero. congruence.
+ exists (Vptr b0 i :: Vint i0 :: nil).
+ split. eauto with evalexpr. simpl. congruence.
+ destruct (is_float_addressing chunk).
+ exists (Vptr b0 ofs :: nil).
+ split. constructor. econstructor. eauto with evalexpr. simpl. congruence. constructor.
+ simpl. rewrite Int.add_zero. congruence.
+ exists (Vint i :: Vptr b0 i0 :: nil).
+ split. eauto with evalexpr. simpl.
+ rewrite Int.add_commut. congruence.
+ destruct (is_float_addressing chunk).
+ exists (Vptr b0 ofs :: nil).
+ split. constructor. econstructor. eauto with evalexpr. simpl. congruence. constructor.
+ simpl. rewrite Int.add_zero. congruence.
+ exists (Vptr b0 i :: Vint i0 :: nil).
+ split. eauto with evalexpr. simpl. congruence.
+ exists (v :: nil). split. eauto with evalexpr.
+ subst v. simpl. rewrite Int.add_zero. auto.
+Qed.
+
+Lemma eval_load:
+ forall le a v chunk v',
+ eval_expr ge sp e m le a v ->
+ Mem.loadv chunk m v = Some v' ->
+ eval_expr ge sp e m le (load chunk a) v'.
+Proof.
+ intros. generalize H0; destruct v; simpl; intro; try discriminate.
+ unfold load.
+ generalize (eval_addressing _ chunk _ _ _ _ H (refl_equal _)).
+ destruct (addressing chunk a). intros [vl [EV EQ]].
+ eapply eval_Eload; eauto.
+Qed.
+
+Lemma eval_store:
+ forall chunk a1 a2 v1 v2 f k m',
+ eval_expr ge sp e m nil a1 v1 ->
+ eval_expr ge sp e m nil a2 v2 ->
+ Mem.storev chunk m v1 v2 = Some m' ->
+ step ge (State f (store chunk a1 a2) k sp e m)
+ E0 (State f Sskip k sp e m').
+Proof.
+ intros. generalize H1; destruct v1; simpl; intro; try discriminate.
+ unfold store.
+ generalize (eval_addressing _ chunk _ _ _ _ H (refl_equal _)).
+ destruct (addressing chunk a1). intros [vl [EV EQ]].
+ eapply step_store; eauto.
+Qed.
+
+(** * Correctness of instruction selection for operators *)
+
+(** We now prove a semantic preservation result for the [sel_unop]
+ and [sel_binop] selection functions. The proof exploits
+ the results of the previous section. *)
+
+Lemma eval_sel_unop:
+ forall le op a1 v1 v,
+ eval_expr ge sp e m le a1 v1 ->
+ eval_unop op v1 = Some v ->
+ eval_expr ge sp e m le (sel_unop op a1) v.
+Proof.
+ destruct op; simpl; intros; FuncInv; try subst v.
+ apply eval_cast8unsigned; auto.
+ apply eval_cast8signed; auto.
+ apply eval_cast16unsigned; auto.
+ apply eval_cast16signed; auto.
+ EvalOp.
+ generalize (Int.eq_spec i Int.zero). destruct (Int.eq i Int.zero); intro.
+ change true with (negb false). eapply eval_notbool; eauto. subst i; constructor.
+ change false with (negb true). eapply eval_notbool; eauto. constructor; auto.
+ change Vfalse with (Val.of_bool (negb true)).
+ eapply eval_notbool; eauto. constructor.
+ apply eval_notint; auto.
+ EvalOp.
+ EvalOp.
+ apply eval_singleoffloat; auto.
+ EvalOp.
+ EvalOp.
+ EvalOp.
+ EvalOp.
+Qed.
+
+Lemma eval_sel_binop:
+ forall le op a1 a2 v1 v2 v,
+ eval_expr ge sp e m le a1 v1 ->
+ eval_expr ge sp e m le a2 v2 ->
+ eval_binop op v1 v2 m = Some v ->
+ eval_expr ge sp e m le (sel_binop op a1 a2) v.
+Proof.
+ destruct op; simpl; intros; FuncInv; try subst v.
+ apply eval_add; auto.
+ apply eval_add_ptr_2; auto.
+ apply eval_add_ptr; auto.
+ apply eval_sub; auto.
+ apply eval_sub_ptr_int; auto.
+ destruct (eq_block b b0); inv H1.
+ eapply eval_sub_ptr_ptr; eauto.
+ apply eval_mul; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_divs; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_divu; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_mods; eauto.
+ generalize (Int.eq_spec i0 Int.zero). destruct (Int.eq i0 Int.zero); inv H1.
+ apply eval_modu; eauto.
+ apply eval_and; auto.
+ apply eval_or; auto.
+ apply eval_xor; auto.
+ caseEq (Int.ltu i0 (Int.repr 32)); intro; rewrite H2 in H1; inv H1.
+ apply eval_shl; auto.
+ caseEq (Int.ltu i0 (Int.repr 32)); intro; rewrite H2 in H1; inv H1.
+ apply eval_shr; auto.
+ caseEq (Int.ltu i0 (Int.repr 32)); intro; rewrite H2 in H1; inv H1.
+ apply eval_shru; auto.
+ EvalOp.
+ EvalOp.
+ EvalOp.
+ EvalOp.
+ apply eval_comp_int; auto.
+ eapply eval_comp_int_ptr; eauto.
+ eapply eval_comp_ptr_int; eauto.
+ generalize H1; clear H1.
+ case_eq (valid_pointer m b (Int.signed i) && valid_pointer m b0 (Int.signed i0)); intros.
+ destruct (eq_block b b0); inv H2.
+ eapply eval_comp_ptr_ptr; eauto.
+ eapply eval_comp_ptr_ptr_2; eauto.
+ discriminate.
+ eapply eval_compu; eauto.
+ eapply eval_compf; eauto.
+Qed.
+
+End CMCONSTR.
+
+(** * Semantic preservation for instruction selection. *)
+
+Section PRESERVATION.
+
+Variable prog: Cminor.program.
+Let tprog := sel_program prog.
+Let ge := Genv.globalenv prog.
+Let tge := Genv.globalenv tprog.
+
+(** Relationship between the global environments for the original
+ CminorSel program and the generated RTL program. *)
+
+Lemma symbols_preserved:
+ forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof.
+ intros; unfold ge, tge, tprog, sel_program.
+ apply Genv.find_symbol_transf.
+Qed.
+
+Lemma functions_translated:
+ forall (v: val) (f: Cminor.fundef),
+ Genv.find_funct ge v = Some f ->
+ Genv.find_funct tge v = Some (sel_fundef f).
+Proof.
+ intros.
+ exact (Genv.find_funct_transf sel_fundef H).
+Qed.
+
+Lemma function_ptr_translated:
+ forall (b: block) (f: Cminor.fundef),
+ Genv.find_funct_ptr ge b = Some f ->
+ Genv.find_funct_ptr tge b = Some (sel_fundef f).
+Proof.
+ intros.
+ exact (Genv.find_funct_ptr_transf sel_fundef H).
+Qed.
+
+Lemma sig_function_translated:
+ forall f,
+ funsig (sel_fundef f) = Cminor.funsig f.
+Proof.
+ intros. destruct f; reflexivity.
+Qed.
+
+(** Semantic preservation for expressions. *)
+
+Lemma sel_expr_correct:
+ forall sp e m a v,
+ Cminor.eval_expr ge sp e m a v ->
+ forall le,
+ eval_expr tge sp e m le (sel_expr a) v.
+Proof.
+ induction 1; intros; simpl.
+ (* Evar *)
+ constructor; auto.
+ (* Econst *)
+ destruct cst; simpl; simpl in H; (econstructor; [constructor|simpl;auto]).
+ rewrite symbols_preserved. auto.
+ (* Eunop *)
+ eapply eval_sel_unop; eauto.
+ (* Ebinop *)
+ eapply eval_sel_binop; eauto.
+ (* Eload *)
+ eapply eval_load; eauto.
+ (* Econdition *)
+ econstructor; eauto. eapply eval_condition_of_expr; eauto.
+ destruct b1; auto.
+Qed.
+
+Hint Resolve sel_expr_correct: evalexpr.
+
+Lemma sel_exprlist_correct:
+ forall sp e m a v,
+ Cminor.eval_exprlist ge sp e m a v ->
+ forall le,
+ eval_exprlist tge sp e m le (sel_exprlist a) v.
+Proof.
+ induction 1; intros; simpl; constructor; auto with evalexpr.
+Qed.
+
+Hint Resolve sel_exprlist_correct: evalexpr.
+
+(** Semantic preservation for terminating function calls and statements. *)
+
+Fixpoint sel_cont (k: Cminor.cont) : CminorSel.cont :=
+ match k with
+ | Cminor.Kstop => Kstop
+ | Cminor.Kseq s1 k1 => Kseq (sel_stmt s1) (sel_cont k1)
+ | Cminor.Kblock k1 => Kblock (sel_cont k1)
+ | Cminor.Kcall id f sp e k1 =>
+ Kcall id (sel_function f) sp e (sel_cont k1)
+ end.
+
+Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
+ | match_state: forall f s k s' k' sp e m,
+ s' = sel_stmt s ->
+ k' = sel_cont k ->
+ match_states
+ (Cminor.State f s k sp e m)
+ (State (sel_function f) s' k' sp e m)
+ | match_callstate: forall f args k k' m,
+ k' = sel_cont k ->
+ match_states
+ (Cminor.Callstate f args k m)
+ (Callstate (sel_fundef f) args k' m)
+ | match_returnstate: forall v k k' m,
+ k' = sel_cont k ->
+ match_states
+ (Cminor.Returnstate v k m)
+ (Returnstate v k' m).
+
+Remark call_cont_commut:
+ forall k, call_cont (sel_cont k) = sel_cont (Cminor.call_cont k).
+Proof.
+ induction k; simpl; auto.
+Qed.
+
+Remark find_label_commut:
+ forall lbl s k,
+ find_label lbl (sel_stmt s) (sel_cont k) =
+ option_map (fun sk => (sel_stmt (fst sk), sel_cont (snd sk)))
+ (Cminor.find_label lbl s k).
+Proof.
+ induction s; intros; simpl; auto.
+ unfold store. destruct (addressing m (sel_expr e)); auto.
+ change (Kseq (sel_stmt s2) (sel_cont k))
+ with (sel_cont (Cminor.Kseq s2 k)).
+ rewrite IHs1. rewrite IHs2.
+ destruct (Cminor.find_label lbl s1 (Cminor.Kseq s2 k)); auto.
+ rewrite IHs1. rewrite IHs2.
+ destruct (Cminor.find_label lbl s1 k); auto.
+ change (Kseq (Sloop (sel_stmt s)) (sel_cont k))
+ with (sel_cont (Cminor.Kseq (Cminor.Sloop s) k)).
+ auto.
+ change (Kblock (sel_cont k))
+ with (sel_cont (Cminor.Kblock k)).
+ auto.
+ destruct o; auto.
+ destruct (ident_eq lbl l); auto.
+Qed.
+
+Lemma sel_step_correct:
+ forall S1 t S2, Cminor.step ge S1 t S2 ->
+ forall T1, match_states S1 T1 ->
+ exists T2, step tge T1 t T2 /\ match_states S2 T2.
+Proof.
+ induction 1; intros T1 ME; inv ME; simpl;
+ try (econstructor; split; [econstructor; eauto with evalexpr | econstructor; eauto]; fail).
+
+ (* skip call *)
+ econstructor; split.
+ econstructor. destruct k; simpl in H; simpl; auto.
+ rewrite <- H0; reflexivity.
+ constructor; auto.
+ (* assign *)
+ exists (State (sel_function f) Sskip (sel_cont k) sp (PTree.set id v e) m); split.
+ constructor. auto with evalexpr.
+ constructor; auto.
+ (* store *)
+ econstructor; split.
+ eapply eval_store; eauto with evalexpr.
+ constructor; auto.
+ (* Scall *)
+ econstructor; split.
+ econstructor; eauto with evalexpr.
+ apply functions_translated; eauto.
+ apply sig_function_translated.
+ constructor; auto.
+ (* Stailcall *)
+ econstructor; split.
+ econstructor; eauto with evalexpr.
+ apply functions_translated; eauto.
+ apply sig_function_translated.
+ constructor; auto. apply call_cont_commut.
+ (* Salloc *)
+ exists (State (sel_function f) Sskip (sel_cont k) sp (PTree.set id (Vptr b Int.zero) e) m'); split.
+ econstructor; eauto with evalexpr.
+ constructor; auto.
+ (* Sifthenelse *)
+ exists (State (sel_function f) (if b then sel_stmt s1 else sel_stmt s2) (sel_cont k) sp e m); split.
+ constructor. eapply eval_condition_of_expr; eauto with evalexpr.
+ constructor; auto. destruct b; auto.
+ (* Sreturn None *)
+ econstructor; split.
+ econstructor. rewrite <- H; reflexivity.
+ constructor; auto. apply call_cont_commut.
+ (* Sreturn Some *)
+ econstructor; split.
+ econstructor. simpl. auto. eauto with evalexpr.
+ constructor; auto. apply call_cont_commut.
+ (* Sgoto *)
+ econstructor; split.
+ econstructor. simpl. rewrite call_cont_commut. rewrite find_label_commut.
+ rewrite H. simpl. reflexivity.
+ constructor; auto.
+Qed.
+
+Lemma sel_initial_states:
+ forall S, Cminor.initial_state prog S ->
+ exists R, initial_state tprog R /\ match_states S R.
+Proof.
+ induction 1.
+ econstructor; split.
+ econstructor.
+ simpl. fold tge. rewrite symbols_preserved. eexact H.
+ apply function_ptr_translated. eauto.
+ rewrite <- H1. apply sig_function_translated; auto.
+ unfold tprog, sel_program. rewrite Genv.init_mem_transf.
+ constructor; auto.
+Qed.
+
+Lemma sel_final_states:
+ forall S R r,
+ match_states S R -> Cminor.final_state S r -> final_state R r.
+Proof.
+ intros. inv H0. inv H. simpl. constructor.
+Qed.
+
+Theorem transf_program_correct:
+ forall (beh: program_behavior),
+ Cminor.exec_program prog beh -> CminorSel.exec_program tprog beh.
+Proof.
+ unfold CminorSel.exec_program, Cminor.exec_program; intros.
+ eapply simulation_step_preservation; eauto.
+ eexact sel_initial_states.
+ eexact sel_final_states.
+ exact sel_step_correct.
+Qed.
+
+End PRESERVATION.
diff --git a/arm/linux/Conventions.v b/arm/linux/Conventions.v
new file mode 100644
index 0000000000000000000000000000000000000000..03425213d1319169a71dde4114e543d922f35009
--- /dev/null
+++ b/arm/linux/Conventions.v
@@ -0,0 +1,858 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Function calling conventions and other conventions regarding the use of
+ machine registers and stack slots. *)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Locations.
+
+(** * Classification of machine registers *)
+
+(** Machine registers (type [mreg] in module [Locations]) are divided in
+ the following groups:
+- Temporaries used for spilling, reloading, and parallel move operations.
+- Allocatable registers, that can be assigned to RTL pseudo-registers.
+ These are further divided into:
+-- Callee-save registers, whose value is preserved across a function call.
+-- Caller-save registers that can be modified during a function call.
+
+ We follow the PowerPC application binary interface (ABI) in our choice
+ of callee- and caller-save registers.
+*)
+
+Definition int_caller_save_regs :=
+ R0 :: R1 :: R2 :: R3 :: nil.
+
+Definition float_caller_save_regs :=
+ F0 :: F1 :: nil.
+
+Definition int_callee_save_regs :=
+ R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R11 :: nil.
+
+Definition float_callee_save_regs :=
+ F4 :: F5 :: F6 :: F7 :: nil.
+
+Definition destroyed_at_call_regs :=
+ int_caller_save_regs ++ float_caller_save_regs.
+
+Definition destroyed_at_call :=
+ List.map R destroyed_at_call_regs.
+
+Definition int_temporaries := IT1 :: IT2 :: nil.
+
+Definition float_temporaries := FT1 :: FT2 :: nil.
+
+Definition temporaries :=
+ R IT1 :: R IT2 :: R FT1 :: R FT2 :: nil.
+
+(** The [index_int_callee_save] and [index_float_callee_save] associate
+ a unique positive integer to callee-save registers. This integer is
+ used in [Stacking] to determine where to save these registers in
+ the activation record if they are used by the current function. *)
+
+Definition index_int_callee_save (r: mreg) :=
+ match r with
+ | R4 => 0 | R5 => 1 | R6 => 2 | R7 => 3
+ | R8 => 4 | R9 => 5 | R11 => 6
+ | _ => -1
+ end.
+
+Definition index_float_callee_save (r: mreg) :=
+ match r with
+ | F4 => 0 | F5 => 1 | F6 => 2 | F7 => 3
+ | _ => -1
+ end.
+
+Ltac ElimOrEq :=
+ match goal with
+ | |- (?x = ?y) \/ _ -> _ =>
+ let H := fresh in
+ (intro H; elim H; clear H;
+ [intro H; rewrite <- H; clear H | ElimOrEq])
+ | |- False -> _ =>
+ let H := fresh in (intro H; contradiction)
+ end.
+
+Ltac OrEq :=
+ match goal with
+ | |- (?x = ?x) \/ _ => left; reflexivity
+ | |- (?x = ?y) \/ _ => right; OrEq
+ | |- False => fail
+ end.
+
+Ltac NotOrEq :=
+ match goal with
+ | |- (?x = ?y) \/ _ -> False =>
+ let H := fresh in (
+ intro H; elim H; clear H; [intro; discriminate | NotOrEq])
+ | |- False -> False =>
+ contradiction
+ end.
+
+Lemma index_int_callee_save_pos:
+ forall r, In r int_callee_save_regs -> index_int_callee_save r >= 0.
+Proof.
+ intro r. simpl; ElimOrEq; unfold index_int_callee_save; omega.
+Qed.
+
+Lemma index_float_callee_save_pos:
+ forall r, In r float_callee_save_regs -> index_float_callee_save r >= 0.
+Proof.
+ intro r. simpl; ElimOrEq; unfold index_float_callee_save; omega.
+Qed.
+
+Lemma index_int_callee_save_pos2:
+ forall r, index_int_callee_save r >= 0 -> In r int_callee_save_regs.
+Proof.
+ destruct r; simpl; intro; omegaContradiction || OrEq.
+Qed.
+
+Lemma index_float_callee_save_pos2:
+ forall r, index_float_callee_save r >= 0 -> In r float_callee_save_regs.
+Proof.
+ destruct r; simpl; intro; omegaContradiction || OrEq.
+Qed.
+
+Lemma index_int_callee_save_inj:
+ forall r1 r2,
+ In r1 int_callee_save_regs ->
+ In r2 int_callee_save_regs ->
+ r1 <> r2 ->
+ index_int_callee_save r1 <> index_int_callee_save r2.
+Proof.
+ intros r1 r2.
+ simpl; ElimOrEq; ElimOrEq; unfold index_int_callee_save;
+ intros; congruence.
+Qed.
+
+Lemma index_float_callee_save_inj:
+ forall r1 r2,
+ In r1 float_callee_save_regs ->
+ In r2 float_callee_save_regs ->
+ r1 <> r2 ->
+ index_float_callee_save r1 <> index_float_callee_save r2.
+Proof.
+ intros r1 r2.
+ simpl; ElimOrEq; ElimOrEq; unfold index_float_callee_save;
+ intros; congruence.
+Qed.
+
+(** The following lemmas show that
+ (temporaries, destroyed at call, integer callee-save, float callee-save)
+ is a partition of the set of machine registers. *)
+
+Lemma int_float_callee_save_disjoint:
+ list_disjoint int_callee_save_regs float_callee_save_regs.
+Proof.
+ red; intros r1 r2. simpl; ElimOrEq; ElimOrEq; discriminate.
+Qed.
+
+Lemma register_classification:
+ forall r,
+ (In (R r) temporaries \/ In (R r) destroyed_at_call) \/
+ (In r int_callee_save_regs \/ In r float_callee_save_regs).
+Proof.
+ destruct r;
+ try (left; left; simpl; OrEq);
+ try (left; right; simpl; OrEq);
+ try (right; left; simpl; OrEq);
+ try (right; right; simpl; OrEq).
+Qed.
+
+Lemma int_callee_save_not_destroyed:
+ forall r,
+ In (R r) temporaries \/ In (R r) destroyed_at_call ->
+ ~(In r int_callee_save_regs).
+Proof.
+ intros; red; intros. elim H.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+Qed.
+
+Lemma float_callee_save_not_destroyed:
+ forall r,
+ In (R r) temporaries \/ In (R r) destroyed_at_call ->
+ ~(In r float_callee_save_regs).
+Proof.
+ intros; red; intros. elim H.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+Qed.
+
+Lemma int_callee_save_type:
+ forall r, In r int_callee_save_regs -> mreg_type r = Tint.
+Proof.
+ intro. simpl; ElimOrEq; reflexivity.
+Qed.
+
+Lemma float_callee_save_type:
+ forall r, In r float_callee_save_regs -> mreg_type r = Tfloat.
+Proof.
+ intro. simpl; ElimOrEq; reflexivity.
+Qed.
+
+Ltac NoRepet :=
+ match goal with
+ | |- list_norepet nil =>
+ apply list_norepet_nil
+ | |- list_norepet (?a :: ?b) =>
+ apply list_norepet_cons; [simpl; intuition discriminate | NoRepet]
+ end.
+
+Lemma int_callee_save_norepet:
+ list_norepet int_callee_save_regs.
+Proof.
+ unfold int_callee_save_regs; NoRepet.
+Qed.
+
+Lemma float_callee_save_norepet:
+ list_norepet float_callee_save_regs.
+Proof.
+ unfold float_callee_save_regs; NoRepet.
+Qed.
+
+(** * Acceptable locations for register allocation *)
+
+(** The following predicate describes the locations that can be assigned
+ to an RTL pseudo-register during register allocation: a non-temporary
+ machine register or a [Local] stack slot are acceptable. *)
+
+Definition loc_acceptable (l: loc) : Prop :=
+ match l with
+ | R r => ~(In l temporaries)
+ | S (Local ofs ty) => ofs >= 0
+ | S (Incoming _ _) => False
+ | S (Outgoing _ _) => False
+ end.
+
+Definition locs_acceptable (ll: list loc) : Prop :=
+ forall l, In l ll -> loc_acceptable l.
+
+Lemma temporaries_not_acceptable:
+ forall l, loc_acceptable l -> Loc.notin l temporaries.
+Proof.
+ unfold loc_acceptable; destruct l.
+ simpl. intuition congruence.
+ destruct s; try contradiction.
+ intro. simpl. tauto.
+Qed.
+Hint Resolve temporaries_not_acceptable: locs.
+
+Lemma locs_acceptable_disj_temporaries:
+ forall ll, locs_acceptable ll -> Loc.disjoint ll temporaries.
+Proof.
+ intros. apply Loc.notin_disjoint. intros.
+ apply temporaries_not_acceptable. auto.
+Qed.
+
+Lemma loc_acceptable_noteq_diff:
+ forall l1 l2,
+ loc_acceptable l1 -> l1 <> l2 -> Loc.diff l1 l2.
+Proof.
+ unfold loc_acceptable, Loc.diff; destruct l1; destruct l2;
+ try (destruct s); try (destruct s0); intros; auto; try congruence.
+ case (zeq z z0); intro.
+ compare t t0; intro.
+ subst z0; subst t0; tauto.
+ tauto. tauto.
+ contradiction. contradiction.
+Qed.
+
+Lemma loc_acceptable_notin_notin:
+ forall r ll,
+ loc_acceptable r ->
+ ~(In r ll) -> Loc.notin r ll.
+Proof.
+ induction ll; simpl; intros.
+ auto.
+ split. apply loc_acceptable_noteq_diff. assumption.
+ apply sym_not_equal. tauto.
+ apply IHll. assumption. tauto.
+Qed.
+
+(** * Function calling conventions *)
+
+(** The functions in this section determine the locations (machine registers
+ and stack slots) used to communicate arguments and results between the
+ caller and the callee during function calls. These locations are functions
+ of the signature of the function and of the call instruction.
+ Agreement between the caller and the callee on the locations to use
+ is guaranteed by our dynamic semantics for Cminor and RTL, which demand
+ that the signature of the call instruction is identical to that of the
+ called function.
+
+ Calling conventions are largely arbitrary: they must respect the properties
+ proved in this section (such as no overlapping between the locations
+ of function arguments), but this leaves much liberty in choosing actual
+ locations. To ensure binary interoperability of code generated by our
+ compiler with libraries compiled by another PowerPC compiler, we
+ implement the standard conventions defined in the PowerPC application
+ binary interface. *)
+
+(** ** Location of function result *)
+
+(** The result value of a function is passed back to the caller in
+ registers [R0] or [F0], depending on the type of the returned value.
+ We treat a function without result as a function with one integer result. *)
+
+Definition loc_result (s: signature) : mreg :=
+ match s.(sig_res) with
+ | None => R0
+ | Some Tint => R0
+ | Some Tfloat => F0
+ end.
+
+(** The result location has the type stated in the signature. *)
+
+Lemma loc_result_type:
+ forall sig,
+ mreg_type (loc_result sig) =
+ match sig.(sig_res) with None => Tint | Some ty => ty end.
+Proof.
+ intros; unfold loc_result.
+ destruct (sig_res sig).
+ destruct t; reflexivity.
+ reflexivity.
+Qed.
+
+(** The result location is acceptable. *)
+
+Lemma loc_result_acceptable:
+ forall sig, loc_acceptable (R (loc_result sig)).
+Proof.
+ intros. unfold loc_acceptable. red.
+ unfold loc_result. destruct (sig_res sig).
+ destruct t; simpl; NotOrEq.
+ simpl; NotOrEq.
+Qed.
+
+(** The result location is a caller-save register. *)
+
+Lemma loc_result_caller_save:
+ forall (s: signature), In (R (loc_result s)) destroyed_at_call.
+Proof.
+ intros; unfold loc_result.
+ destruct (sig_res s).
+ destruct t; simpl; OrEq.
+ simpl; OrEq.
+Qed.
+
+(** The result location is not a callee-save register. *)
+
+Lemma loc_result_not_callee_save:
+ forall (s: signature),
+ ~(In (loc_result s) int_callee_save_regs \/ In (loc_result s) float_callee_save_regs).
+Proof.
+ intros. generalize (loc_result_caller_save s).
+ generalize (int_callee_save_not_destroyed (loc_result s)).
+ generalize (float_callee_save_not_destroyed (loc_result s)).
+ tauto.
+Qed.
+
+(** ** Location of function arguments *)
+
+(** We use the following calling conventions, adapted from the ARM ABI:
+- The first 4 integer arguments are passed in registers [R0] to [R3].
+- The first 2 float arguments are passed in registers [F0] and [F1].
+- Each float argument passed in a float register ``consumes'' two
+ integer arguments.
+- Extra arguments are passed on the stack, in [Outgoing] slots, consecutively
+ assigned (1 word for an integer argument, 2 words for a float),
+ starting at word offset 0.
+
+These conventions are somewhat baroque, but they are mandated by the ABI.
+*)
+
+Fixpoint loc_arguments_rec
+ (tyl: list typ) (iregl: list mreg) (fregl: list mreg)
+ (ofs: Z) {struct tyl} : list loc :=
+ match tyl with
+ | nil => nil
+ | Tint :: tys =>
+ match iregl with
+ | nil =>
+ S (Outgoing ofs Tint) :: loc_arguments_rec tys nil fregl (ofs + 1)
+ | ireg :: iregs =>
+ R ireg :: loc_arguments_rec tys iregs fregl ofs
+ end
+ | Tfloat :: tys =>
+ match fregl with
+ | nil =>
+ S (Outgoing ofs Tfloat) ::
+ loc_arguments_rec tys iregl nil (ofs + 2)
+ | freg :: fregs =>
+ match iregl with
+ | nil =>
+ S (Outgoing ofs Tfloat) ::
+ loc_arguments_rec tys nil fregl (ofs + 2)
+ | ireg :: nil =>
+ R freg ::
+ loc_arguments_rec tys nil fregs (ofs + 1)
+ | ireg1 :: ireg2 :: iregs =>
+ R freg ::
+ loc_arguments_rec tys iregs fregs ofs
+ end
+ end
+ end.
+
+Definition int_param_regs :=
+ R0 :: R1 :: R2 :: R3 :: nil.
+Definition float_param_regs :=
+ F0 :: F1 :: nil.
+
+(** [loc_arguments s] returns the list of locations where to store arguments
+ when calling a function with signature [s]. *)
+
+Definition loc_arguments (s: signature) : list loc :=
+ loc_arguments_rec s.(sig_args) int_param_regs float_param_regs 0.
+
+(** [size_arguments s] returns the number of [Outgoing] slots used
+ to call a function with signature [s]. *)
+
+Fixpoint size_arguments_rec
+ (tyl: list typ) (iregl: list mreg) (fregl: list mreg)
+ (ofs: Z) {struct tyl} : Z :=
+ match tyl with
+ | nil => ofs
+ | Tint :: tys =>
+ match iregl with
+ | nil => size_arguments_rec tys nil fregl (ofs + 1)
+ | ireg :: iregs => size_arguments_rec tys iregs fregl ofs
+ end
+ | Tfloat :: tys =>
+ match fregl with
+ | nil =>
+ size_arguments_rec tys iregl nil (ofs + 2)
+ | freg :: fregs =>
+ match iregl with
+ | nil =>
+ size_arguments_rec tys nil fregl (ofs + 2)
+ | ireg :: nil =>
+ size_arguments_rec tys nil fregs (ofs + 1)
+ | ireg1 :: ireg2 :: iregs =>
+ size_arguments_rec tys iregs fregs ofs
+ end
+ end
+ end.
+
+Definition size_arguments (s: signature) : Z :=
+ size_arguments_rec s.(sig_args) int_param_regs float_param_regs 0.
+
+(** A tail-call is possible for a signature if the corresponding
+ arguments are all passed in registers. *)
+
+Definition tailcall_possible (s: signature) : Prop :=
+ forall l, In l (loc_arguments s) ->
+ match l with R _ => True | S _ => False end.
+
+(** Argument locations are either non-temporary registers or [Outgoing]
+ stack slots at nonnegative offsets. *)
+
+Definition loc_argument_acceptable (l: loc) : Prop :=
+ match l with
+ | R r => ~(In l temporaries)
+ | S (Outgoing ofs ty) => ofs >= 0
+ | _ => False
+ end.
+
+Remark loc_arguments_rec_charact:
+ forall tyl iregl fregl ofs l,
+ In l (loc_arguments_rec tyl iregl fregl ofs) ->
+ match l with
+ | R r => In r iregl \/ In r fregl
+ | S (Outgoing ofs' ty) => ofs' >= ofs
+ | S _ => False
+ end.
+Proof.
+ induction tyl; simpl loc_arguments_rec; intros.
+ elim H.
+ destruct a.
+ destruct iregl; elim H; intro.
+ subst l. omega.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto. destruct s; auto. omega.
+ subst l. auto with coqlib.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto. simpl; intuition.
+ destruct fregl.
+ elim H; intro.
+ subst l. omega.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto. destruct s; auto. omega.
+ destruct iregl.
+ elim H; intro.
+ subst l. omega.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto. destruct s; auto. omega.
+ destruct iregl.
+ elim H; intro.
+ subst l. auto with coqlib.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto.
+ intros [A|B]. elim A. auto with coqlib.
+ destruct s; auto. omega.
+ elim H; intro.
+ subst l. auto with coqlib.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto.
+ intros [A|B]; auto with coqlib.
+Qed.
+
+Lemma loc_arguments_acceptable:
+ forall (s: signature) (r: loc),
+ In r (loc_arguments s) -> loc_argument_acceptable r.
+Proof.
+ unfold loc_arguments; intros.
+ generalize (loc_arguments_rec_charact _ _ _ _ _ H).
+ destruct r.
+ intro H0; elim H0. simpl. unfold not. ElimOrEq; NotOrEq.
+ simpl. unfold not. ElimOrEq; NotOrEq.
+ destruct s0; try contradiction.
+ simpl. omega.
+Qed.
+Hint Resolve loc_arguments_acceptable: locs.
+
+(** Arguments are parwise disjoint (in the sense of [Loc.norepet]). *)
+
+Remark loc_arguments_rec_notin_reg:
+ forall tyl iregl fregl ofs r,
+ ~(In r iregl) -> ~(In r fregl) ->
+ Loc.notin (R r) (loc_arguments_rec tyl iregl fregl ofs).
+Proof.
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl. auto.
+ simpl in H. split. apply sym_not_equal. tauto.
+ apply IHtyl. tauto. tauto.
+ destruct fregl; simpl. auto. simpl in H0.
+ destruct iregl; simpl. auto.
+ destruct iregl; simpl.
+ split. apply sym_not_equal. tauto. apply IHtyl. hnf. tauto. tauto.
+ split. apply sym_not_equal. tauto. apply IHtyl.
+ red; intro. apply H. auto with coqlib. tauto.
+Qed.
+
+Remark loc_arguments_rec_notin_local:
+ forall tyl iregl fregl ofs ofs0 ty0,
+ Loc.notin (S (Local ofs0 ty0)) (loc_arguments_rec tyl iregl fregl ofs).
+Proof.
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl; auto.
+ destruct fregl; simpl; auto.
+ destruct iregl; simpl; auto.
+ destruct iregl; simpl; auto.
+Qed.
+
+Remark loc_arguments_rec_notin_outgoing:
+ forall tyl iregl fregl ofs ofs0 ty0,
+ ofs0 + typesize ty0 <= ofs ->
+ Loc.notin (S (Outgoing ofs0 ty0)) (loc_arguments_rec tyl iregl fregl ofs).
+Proof.
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl.
+ split. omega. eapply IHtyl. omega.
+ auto.
+ destruct fregl; simpl.
+ split. omega. eapply IHtyl. omega.
+ destruct iregl; simpl.
+ split. omega. eapply IHtyl. omega.
+ destruct iregl; simpl.
+ split; auto. eapply IHtyl. omega.
+ split; auto.
+Qed.
+
+Lemma loc_arguments_norepet:
+ forall (s: signature), Loc.norepet (loc_arguments s).
+Proof.
+ assert (forall tyl iregl fregl ofs,
+ list_norepet iregl ->
+ list_norepet fregl ->
+ list_disjoint iregl fregl ->
+ Loc.norepet (loc_arguments_rec tyl iregl fregl ofs)).
+ induction tyl; simpl; intros.
+ constructor.
+ destruct a.
+ destruct iregl; constructor.
+ apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
+ apply loc_arguments_rec_notin_reg. inversion H. auto.
+ apply list_disjoint_notin with (m :: iregl); auto with coqlib.
+ apply IHtyl. inv H; auto. auto.
+ eapply list_disjoint_cons_left; eauto.
+
+ destruct fregl. constructor.
+ apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
+ destruct iregl. constructor.
+ apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
+ destruct iregl; constructor.
+ apply loc_arguments_rec_notin_reg.
+ red; intro. apply (H1 m m). auto with coqlib. auto with coqlib. auto.
+ inv H0; auto.
+ apply IHtyl. constructor. inv H0; auto.
+ red; intros. elim H2.
+ apply loc_arguments_rec_notin_reg.
+ red; intros. elim (H1 m m); auto with coqlib.
+ inv H0; auto.
+ apply IHtyl. inv H. inv H5. auto. inv H0; auto.
+ red; intros. apply H1; auto with coqlib.
+
+ intro. unfold loc_arguments. apply H.
+ unfold int_param_regs. NoRepet.
+ unfold float_param_regs. NoRepet.
+ red; intros x y; simpl. ElimOrEq; ElimOrEq; discriminate.
+Qed.
+
+(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
+
+Remark size_arguments_rec_above:
+ forall tyl iregl fregl ofs0,
+ ofs0 <= size_arguments_rec tyl iregl fregl ofs0.
+Proof.
+ induction tyl; simpl; intros.
+ omega.
+ destruct a.
+ destruct iregl. apply Zle_trans with (ofs0 + 1); auto; omega. auto.
+ destruct fregl. apply Zle_trans with (ofs0 + 2); auto; omega.
+ destruct iregl. apply Zle_trans with (ofs0 + 2); auto; omega.
+ destruct iregl. apply Zle_trans with (ofs0 + 1); auto; omega.
+ auto.
+Qed.
+
+Lemma size_arguments_above:
+ forall s, size_arguments s >= 0.
+Proof.
+ intros; unfold size_arguments. apply Zle_ge.
+ apply size_arguments_rec_above.
+Qed.
+
+Lemma loc_arguments_bounded:
+ forall (s: signature) (ofs: Z) (ty: typ),
+ In (S (Outgoing ofs ty)) (loc_arguments s) ->
+ ofs + typesize ty <= size_arguments s.
+Proof.
+ intros.
+ assert (forall tyl iregl fregl ofs0,
+ In (S (Outgoing ofs ty)) (loc_arguments_rec tyl iregl fregl ofs0) ->
+ ofs + typesize ty <= size_arguments_rec tyl iregl fregl ofs0).
+ induction tyl; simpl; intros.
+ elim H0.
+ destruct a. destruct iregl; elim H0; intro.
+ inv H1. simpl. apply size_arguments_rec_above. auto.
+ discriminate. auto.
+ destruct fregl. elim H0; intro.
+ inv H1. simpl. apply size_arguments_rec_above. auto.
+ destruct iregl. elim H0; intro.
+ inv H1. simpl. apply size_arguments_rec_above. auto.
+ destruct iregl.
+ elim H0; intro. inv H1. auto.
+ elim H0; intro. inv H1. auto.
+
+ unfold size_arguments. eapply H0. unfold loc_arguments in H. eauto.
+Qed.
+
+(** Temporary registers do not overlap with argument locations. *)
+
+Lemma loc_arguments_not_temporaries:
+ forall sig, Loc.disjoint (loc_arguments sig) temporaries.
+Proof.
+ intros; red; intros x1 x2 H.
+ generalize (loc_arguments_rec_charact _ _ _ _ _ H).
+ destruct x1.
+ intro H0; elim H0; simpl; (ElimOrEq; ElimOrEq; congruence).
+ destruct s; try contradiction. intro.
+ simpl; ElimOrEq; auto.
+Qed.
+Hint Resolve loc_arguments_not_temporaries: locs.
+
+(** Argument registers are caller-save. *)
+
+Lemma arguments_caller_save:
+ forall sig r,
+ In (R r) (loc_arguments sig) -> In (R r) destroyed_at_call.
+Proof.
+ unfold loc_arguments; intros.
+ elim (loc_arguments_rec_charact _ _ _ _ _ H); simpl.
+ ElimOrEq; intuition.
+ ElimOrEq; intuition.
+Qed.
+
+(** Callee-save registers do not overlap with argument locations. *)
+
+Lemma arguments_not_preserved:
+ forall sig l,
+ Loc.notin l destroyed_at_call -> loc_acceptable l ->
+ Loc.notin l (loc_arguments sig).
+Proof.
+ intros. unfold loc_arguments. destruct l.
+ apply loc_arguments_rec_notin_reg.
+ generalize (Loc.notin_not_in _ _ H). intro; red; intro.
+ apply H1. generalize H2. simpl. ElimOrEq; OrEq.
+ generalize (Loc.notin_not_in _ _ H). intro; red; intro.
+ apply H1. generalize H2. simpl. ElimOrEq; OrEq.
+ destruct s; simpl in H0; try contradiction.
+ apply loc_arguments_rec_notin_local.
+Qed.
+Hint Resolve arguments_not_preserved: locs.
+
+(** Argument locations agree in number with the function signature. *)
+
+Lemma loc_arguments_length:
+ forall sig,
+ List.length (loc_arguments sig) = List.length sig.(sig_args).
+Proof.
+ assert (forall tyl iregl fregl ofs,
+ List.length (loc_arguments_rec tyl iregl fregl ofs) = List.length tyl).
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl; decEq; auto.
+ destruct fregl; simpl; decEq; auto.
+ destruct iregl; simpl. decEq; auto.
+ destruct iregl; simpl; decEq; auto.
+
+ intros. unfold loc_arguments. auto.
+Qed.
+
+(** Argument locations agree in types with the function signature. *)
+
+Lemma loc_arguments_type:
+ forall sig, List.map Loc.type (loc_arguments sig) = sig.(sig_args).
+Proof.
+ assert (forall tyl iregl fregl ofs,
+ (forall r, In r iregl -> mreg_type r = Tint) ->
+ (forall r, In r fregl -> mreg_type r = Tfloat) ->
+ List.map Loc.type (loc_arguments_rec tyl iregl fregl ofs) = tyl).
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl; f_equal; eauto with coqlib.
+ destruct fregl; simpl.
+ f_equal; eauto with coqlib.
+ destruct iregl; simpl.
+ f_equal; eauto with coqlib.
+ destruct iregl; simpl; f_equal; eauto with coqlib.
+ apply IHtyl. simpl; tauto. auto with coqlib.
+ apply IHtyl. auto with coqlib. auto with coqlib.
+
+ intros. unfold loc_arguments. apply H.
+ intro; simpl. ElimOrEq; reflexivity.
+ intro; simpl. ElimOrEq; reflexivity.
+Qed.
+
+(** There is no partial overlap between an argument location and an
+ acceptable location: they are either identical or disjoint. *)
+
+Lemma no_overlap_arguments:
+ forall args sg,
+ locs_acceptable args ->
+ Loc.no_overlap args (loc_arguments sg).
+Proof.
+ unfold Loc.no_overlap; intros.
+ generalize (H r H0).
+ generalize (loc_arguments_acceptable _ _ H1).
+ destruct s; destruct r; simpl.
+ intros. case (mreg_eq m0 m); intro. left; congruence. tauto.
+ intros. right; destruct s; auto.
+ intros. right. auto.
+ destruct s; try tauto. destruct s0; tauto.
+Qed.
+
+(** Decide whether a tailcall is possible. *)
+
+Definition tailcall_is_possible (sg: signature) : bool :=
+ let fix tcisp (l: list loc) :=
+ match l with
+ | nil => true
+ | R _ :: l' => tcisp l'
+ | S _ :: l' => false
+ end
+ in tcisp (loc_arguments sg).
+
+Lemma tailcall_is_possible_correct:
+ forall s, tailcall_is_possible s = true -> tailcall_possible s.
+Proof.
+ intro s. unfold tailcall_is_possible, tailcall_possible.
+ generalize (loc_arguments s). induction l; simpl; intros.
+ elim H0.
+ destruct a.
+ destruct H0. subst l0. auto. apply IHl. auto. auto. discriminate.
+Qed.
+
+(** ** Location of function parameters *)
+
+(** A function finds the values of its parameter in the same locations
+ where its caller stored them, except that the stack-allocated arguments,
+ viewed as [Outgoing] slots by the caller, are accessed via [Incoming]
+ slots (at the same offsets and types) in the callee. *)
+
+Definition parameter_of_argument (l: loc) : loc :=
+ match l with
+ | S (Outgoing n ty) => S (Incoming n ty)
+ | _ => l
+ end.
+
+Definition loc_parameters (s: signature) :=
+ List.map parameter_of_argument (loc_arguments s).
+
+Lemma loc_parameters_type:
+ forall sig, List.map Loc.type (loc_parameters sig) = sig.(sig_args).
+Proof.
+ intros. unfold loc_parameters.
+ rewrite list_map_compose.
+ rewrite <- loc_arguments_type.
+ apply list_map_exten.
+ intros. destruct x; simpl. auto.
+ destruct s; reflexivity.
+Qed.
+
+Lemma loc_parameters_length:
+ forall sg, List.length (loc_parameters sg) = List.length sg.(sig_args).
+Proof.
+ intros. unfold loc_parameters. rewrite list_length_map.
+ apply loc_arguments_length.
+Qed.
+
+Lemma loc_parameters_not_temporaries:
+ forall sig, Loc.disjoint (loc_parameters sig) temporaries.
+Proof.
+ intro; red; intros.
+ unfold loc_parameters in H.
+ elim (list_in_map_inv _ _ _ H). intros y [EQ IN].
+ generalize (loc_arguments_not_temporaries sig y x2 IN H0).
+ subst x1. destruct x2.
+ destruct y; simpl. auto. destruct s; auto.
+ byContradiction. generalize H0. simpl. NotOrEq.
+Qed.
+
+Lemma no_overlap_parameters:
+ forall params sg,
+ locs_acceptable params ->
+ Loc.no_overlap (loc_parameters sg) params.
+Proof.
+ unfold Loc.no_overlap; intros.
+ unfold loc_parameters in H0.
+ elim (list_in_map_inv _ _ _ H0). intros t [EQ IN].
+ rewrite EQ.
+ generalize (loc_arguments_acceptable _ _ IN).
+ generalize (H s H1).
+ destruct s; destruct t; simpl.
+ intros. case (mreg_eq m0 m); intro. left; congruence. tauto.
+ intros. right; destruct s; simpl; auto.
+ intros; right; auto.
+ destruct s; try tauto. destruct s0; try tauto.
+ intros; simpl. tauto.
+Qed.
+
+(** ** Location of argument and result for dynamic memory allocation *)
+
+Definition loc_alloc_argument := R0.
+Definition loc_alloc_result := R0.
diff --git a/arm/linux/Stacklayout.v b/arm/linux/Stacklayout.v
new file mode 100644
index 0000000000000000000000000000000000000000..dd3c6a1da6ffa98e51a4d0ebf4d5232d7487f80c
--- /dev/null
+++ b/arm/linux/Stacklayout.v
@@ -0,0 +1,79 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Machine- and ABI-dependent layout information for activation records. *)
+
+Require Import Coqlib.
+Require Import Bounds.
+
+(** The general shape of activation records is as follows,
+ from bottom (lowest offsets) to top:
+- Space for outgoing arguments to function calls.
+- Local stack slots of integer type.
+- Saved values of integer callee-save registers used by the function.
+- One word of padding, if necessary to align the following data
+ on a 8-byte boundary.
+- Local stack slots of float type.
+- Saved values of float callee-save registers used by the function.
+- Saved return address into caller.
+- Pointer to activation record of the caller.
+- Space for the stack-allocated data declared in Cminor.
+
+To facilitate some of the proofs, the Cminor stack-allocated data
+starts at offset 0; the preceding areas in the activation record
+therefore have negative offsets. This part (with negative offsets)
+is called the ``frame'', by opposition with the ``Cminor stack data''
+which is the part with positive offsets.
+
+The [frame_env] compilation environment records the positions of
+the boundaries between areas in the frame part.
+*)
+
+Definition fe_ofs_arg := 0.
+
+Record frame_env : Set := mk_frame_env {
+ fe_size: Z;
+ fe_ofs_link: Z;
+ fe_ofs_retaddr: Z;
+ fe_ofs_int_local: Z;
+ fe_ofs_int_callee_save: Z;
+ fe_num_int_callee_save: Z;
+ fe_ofs_float_local: Z;
+ fe_ofs_float_callee_save: Z;
+ fe_num_float_callee_save: Z
+}.
+
+(** Computation of the frame environment from the bounds of the current
+ function. *)
+
+Definition make_env (b: bounds) :=
+ let oil := 4 * b.(bound_outgoing) in (* integer locals *)
+ let oics := oil + 4 * b.(bound_int_local) in (* integer callee-saves *)
+ let oendi := oics + 4 * b.(bound_int_callee_save) in
+ let ofl := align oendi 8 in (* float locals *)
+ let ofcs := ofl + 8 * b.(bound_float_local) in (* float callee-saves *)
+ let ora := ofcs + 8 * b.(bound_float_callee_save) in (* retaddr *)
+ let olink := ora + 4 in (* back link *)
+ let sz := olink + 4 in (* total frame size *)
+ mk_frame_env sz olink ora
+ oil oics b.(bound_int_callee_save)
+ ofl ofcs b.(bound_float_callee_save).
+
+
+Remark align_float_part:
+ forall b,
+ 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b <=
+ align (4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b) 8.
+Proof.
+ intros. apply align_le. omega.
+Qed.
+
diff --git a/caml/CMlexer.mli b/backend/CMlexer.mli
similarity index 100%
rename from caml/CMlexer.mli
rename to backend/CMlexer.mli
diff --git a/caml/CMlexer.mll b/backend/CMlexer.mll
similarity index 100%
rename from caml/CMlexer.mll
rename to backend/CMlexer.mll
diff --git a/caml/CMparser.mly b/backend/CMparser.mly
similarity index 100%
rename from caml/CMparser.mly
rename to backend/CMparser.mly
diff --git a/caml/CMtypecheck.ml b/backend/CMtypecheck.ml
similarity index 100%
rename from caml/CMtypecheck.ml
rename to backend/CMtypecheck.ml
diff --git a/caml/CMtypecheck.mli b/backend/CMtypecheck.mli
similarity index 100%
rename from caml/CMtypecheck.mli
rename to backend/CMtypecheck.mli
diff --git a/backend/CSE.v b/backend/CSE.v
index b7e19c1bcaffd01bdb416284768d61e15f996da2..49b8489906386e2fc30a868b4ca7bfd8e243e7db 100644
--- a/backend/CSE.v
+++ b/backend/CSE.v
@@ -72,12 +72,9 @@ Definition eq_rhs (x y: rhs) : {x=y}+{x<>y}.
Proof.
generalize Int.eq_dec; intro.
generalize Float.eq_dec; intro.
- assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
- assert (forall (x y: comparison), {x=y}+{x<>y}). decide equality.
- assert (forall (x y: condition), {x=y}+{x<>y}). decide equality.
- assert (forall (x y: operation), {x=y}+{x<>y}). decide equality.
+ generalize eq_operation; intro.
+ generalize eq_addressing; intro.
assert (forall (x y: memory_chunk), {x=y}+{x<>y}). decide equality.
- assert (forall (x y: addressing), {x=y}+{x<>y}). decide equality.
generalize eq_valnum; intro.
generalize eq_list_valnum; intro.
decide equality.
diff --git a/caml/Coloringaux.ml b/backend/Coloringaux.ml
similarity index 99%
rename from caml/Coloringaux.ml
rename to backend/Coloringaux.ml
index f11738df012f9675e71d2c7eaee535e6618a125f..19efe434b009024f8ca84ca00916a81ed4f9bd99 100644
--- a/caml/Coloringaux.ml
+++ b/backend/Coloringaux.ml
@@ -17,6 +17,7 @@ open BinInt
open AST
open Maps
open Registers
+open Machregs
open Locations
open RTL
open RTLtyping
diff --git a/caml/Coloringaux.mli b/backend/Coloringaux.mli
similarity index 100%
rename from caml/Coloringaux.mli
rename to backend/Coloringaux.mli
diff --git a/backend/Linear.v b/backend/Linear.v
index 900b6a5020b65c412736a13a82b38e943c84194d..629dcc53cc58b1026ca1861e135976f72ccf12f7 100644
--- a/backend/Linear.v
+++ b/backend/Linear.v
@@ -337,7 +337,7 @@ Inductive initial_state (p: program): state -> Prop :=
Inductive final_state: state -> int -> Prop :=
| final_state_intro: forall rs m r,
- rs (R R3) = Vint r ->
+ rs (R (Conventions.loc_result (mksignature nil (Some Tint)))) = Vint r ->
final_state (Returnstate nil rs m) r.
Definition exec_program (p: program) (beh: program_behavior) : Prop :=
diff --git a/caml/Linearizeaux.ml b/backend/Linearizeaux.ml
similarity index 100%
rename from caml/Linearizeaux.ml
rename to backend/Linearizeaux.ml
diff --git a/backend/Linearizeproof.v b/backend/Linearizeproof.v
index 3451cdb5ac5880fb675b172acb0945d2237e409d..8378332e7a5ca337774b707455845c69ab7ded18 100644
--- a/backend/Linearizeproof.v
+++ b/backend/Linearizeproof.v
@@ -546,8 +546,9 @@ Proof.
exploit find_label_lin_succ; eauto. inv WTI; auto. intros [c'' AT'].
econstructor; split.
eapply plus_left'.
- eapply exec_Lload; eauto.
+ apply exec_Lload with a.
rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved.
+ eauto.
eapply add_branch_correct; eauto.
eapply is_tail_add_branch. eapply is_tail_cons_left.
eapply is_tail_find_label. eauto.
@@ -562,8 +563,9 @@ Proof.
exploit find_label_lin_succ; eauto. inv WTI; auto. intros [c'' AT'].
econstructor; split.
eapply plus_left'.
- eapply exec_Lstore; eauto.
+ apply exec_Lstore with a.
rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved.
+ eauto.
eapply add_branch_correct; eauto.
eapply is_tail_add_branch. eapply is_tail_cons_left.
eapply is_tail_find_label. eauto.
diff --git a/backend/Locations.v b/backend/Locations.v
index b03657c070a91932f59047a9eb6e755c67ad9178..ca2f527258f7bf30646b3040764cfcc8598241d9 100644
--- a/backend/Locations.v
+++ b/backend/Locations.v
@@ -17,102 +17,17 @@ Require Import Coqlib.
Require Import Maps.
Require Import AST.
Require Import Values.
+Require Export Machregs.
(** * Representation of locations *)
(** A location is either a processor register or (an abstract designation of)
a slot in the activation record of the current function. *)
-(** ** Machine registers *)
-
-(** The following type defines the machine registers that can be referenced
- as locations. These include:
-- Integer registers that can be allocated to RTL pseudo-registers ([Rxx]).
-- Floating-point registers that can be allocated to RTL pseudo-registers
- ([Fxx]).
-- Two integer registers, not allocatable, reserved as temporaries for
- spilling and reloading ([IT1, IT2]).
-- Two float registers, not allocatable, reserved as temporaries for
- spilling and reloading ([FT1, FT2]).
-
- The type [mreg] does not include special-purpose machine registers
- such as the stack pointer and the condition codes. *)
-
-Inductive mreg: Set :=
- (** Allocatable integer regs *)
- | R3: mreg | R4: mreg | R5: mreg | R6: mreg
- | R7: mreg | R8: mreg | R9: mreg | R10: mreg
- | R13: mreg | R14: mreg | R15: mreg | R16: mreg
- | R17: mreg | R18: mreg | R19: mreg | R20: mreg
- | R21: mreg | R22: mreg | R23: mreg | R24: mreg
- | R25: mreg | R26: mreg | R27: mreg | R28: mreg
- | R29: mreg | R30: mreg | R31: mreg
- (** Allocatable float regs *)
- | F1: mreg | F2: mreg | F3: mreg | F4: mreg
- | F5: mreg | F6: mreg | F7: mreg | F8: mreg
- | F9: mreg | F10: mreg | F14: mreg | F15: mreg
- | F16: mreg | F17: mreg | F18: mreg | F19: mreg
- | F20: mreg | F21: mreg | F22: mreg | F23: mreg
- | F24: mreg | F25: mreg | F26: mreg | F27: mreg
- | F28: mreg | F29: mreg | F30: mreg | F31: mreg
- (** Integer temporaries *)
- | IT1: mreg (* R11 *) | IT2: mreg (* R0 *)
- (** Float temporaries *)
- | FT1: mreg (* F11 *) | FT2: mreg (* F12 *) | FT3: mreg (* F0 *).
-
-Lemma mreg_eq: forall (r1 r2: mreg), {r1 = r2} + {r1 <> r2}.
-Proof. decide equality. Qed.
-
-Definition mreg_type (r: mreg): typ :=
- match r with
- | R3 => Tint | R4 => Tint | R5 => Tint | R6 => Tint
- | R7 => Tint | R8 => Tint | R9 => Tint | R10 => Tint
- | R13 => Tint | R14 => Tint | R15 => Tint | R16 => Tint
- | R17 => Tint | R18 => Tint | R19 => Tint | R20 => Tint
- | R21 => Tint | R22 => Tint | R23 => Tint | R24 => Tint
- | R25 => Tint | R26 => Tint | R27 => Tint | R28 => Tint
- | R29 => Tint | R30 => Tint | R31 => Tint
- | F1 => Tfloat | F2 => Tfloat | F3 => Tfloat | F4 => Tfloat
- | F5 => Tfloat | F6 => Tfloat | F7 => Tfloat | F8 => Tfloat
- | F9 => Tfloat | F10 => Tfloat | F14 => Tfloat | F15 => Tfloat
- | F16 => Tfloat | F17 => Tfloat | F18 => Tfloat | F19 => Tfloat
- | F20 => Tfloat | F21 => Tfloat | F22 => Tfloat | F23 => Tfloat
- | F24 => Tfloat | F25 => Tfloat | F26 => Tfloat | F27 => Tfloat
- | F28 => Tfloat | F29 => Tfloat | F30 => Tfloat | F31 => Tfloat
- | IT1 => Tint | IT2 => Tint
- | FT1 => Tfloat | FT2 => Tfloat | FT3 => Tfloat
- end.
+(** ** Processor registers *)
-Open Scope positive_scope.
-
-Module IndexedMreg <: INDEXED_TYPE.
- Definition t := mreg.
- Definition eq := mreg_eq.
- Definition index (r: mreg): positive :=
- match r with
- | R3 => 1 | R4 => 2 | R5 => 3 | R6 => 4
- | R7 => 5 | R8 => 6 | R9 => 7 | R10 => 8
- | R13 => 9 | R14 => 10 | R15 => 11 | R16 => 12
- | R17 => 13 | R18 => 14 | R19 => 15 | R20 => 16
- | R21 => 17 | R22 => 18 | R23 => 19 | R24 => 20
- | R25 => 21 | R26 => 22 | R27 => 23 | R28 => 24
- | R29 => 25 | R30 => 26 | R31 => 27
- | F1 => 28 | F2 => 29 | F3 => 30 | F4 => 31
- | F5 => 32 | F6 => 33 | F7 => 34 | F8 => 35
- | F9 => 36 | F10 => 37 | F14 => 38 | F15 => 39
- | F16 => 40 | F17 => 41 | F18 => 42 | F19 => 43
- | F20 => 44 | F21 => 45 | F22 => 46 | F23 => 47
- | F24 => 48 | F25 => 49 | F26 => 50 | F27 => 51
- | F28 => 52 | F29 => 53 | F30 => 54 | F31 => 55
- | IT1 => 56 | IT2 => 57
- | FT1 => 58 | FT2 => 59 | FT3 => 60
- end.
- Lemma index_inj:
- forall r1 r2, index r1 = index r2 -> r1 = r2.
- Proof.
- destruct r1; destruct r2; simpl; intro; discriminate || reflexivity.
- Qed.
-End IndexedMreg.
+(** Processor registers usable for register allocation are defined
+ in module [Machregs]. *)
(** ** Slots in activation records *)
diff --git a/backend/Machabstr.v b/backend/Machabstr.v
index 9ef75ec8acc88e170e97a06fb318a32fe6ecbd3d..e145c8964243485e56e0e6ce771f856c0033d35b 100644
--- a/backend/Machabstr.v
+++ b/backend/Machabstr.v
@@ -26,7 +26,7 @@ Require Import Op.
Require Import Locations.
Require Conventions.
Require Import Mach.
-Require Stacking.
+Require Stacklayout.
(** This file defines the "abstract" semantics for the Mach
intermediate language, as opposed to the more concrete
@@ -134,7 +134,7 @@ Inductive extcall_arg: regset -> frame -> loc -> val -> Prop :=
| extcall_arg_reg: forall rs fr r,
extcall_arg rs fr (R r) (rs r)
| extcall_arg_stack: forall rs fr ofs ty v,
- get_slot fr ty (Int.signed (Int.repr (Stacking.fe_ofs_arg + 4 * ofs))) v ->
+ get_slot fr ty (Int.signed (Int.repr (Stacklayout.fe_ofs_arg + 4 * ofs))) v ->
extcall_arg rs fr (S (Outgoing ofs ty)) v.
Inductive extcall_args: regset -> frame -> list loc -> list val -> Prop :=
@@ -323,7 +323,7 @@ Inductive initial_state (p: program): state -> Prop :=
Inductive final_state: state -> int -> Prop :=
| final_state_intro: forall rs m r,
- rs R3 = Vint r ->
+ rs (Conventions.loc_result (mksignature nil (Some Tint))) = Vint r ->
final_state (Returnstate nil rs m) r.
Definition exec_program (p: program) (beh: program_behavior) : Prop :=
diff --git a/backend/Machabstr2concr.v b/backend/Machabstr2concr.v
index 2dd3134fb566755fc7ef89975ffc8824a93d039b..7eae610b862f90183c72c7dc178decb0935c4229 100644
--- a/backend/Machabstr2concr.v
+++ b/backend/Machabstr2concr.v
@@ -27,7 +27,7 @@ Require Import Mach.
Require Import Machtyping.
Require Import Machabstr.
Require Import Machconcr.
-Require Import PPCgenretaddr.
+Require Import Asmgenretaddr.
(** Two semantics were defined for the Mach intermediate language:
- The concrete semantics (file [Mach]), where the whole activation
@@ -43,7 +43,7 @@ Require Import PPCgenretaddr.
abstract semantics, it also executes with the same behaviour in
the concrete semantics. This result bridges the correctness proof
in file [Stackingproof] (which uses the abstract Mach semantics
- as output) and that in file [PPCgenproof] (which uses the concrete
+ as output) and that in file [Asmgenproof] (which uses the concrete
Mach semantics as input).
*)
diff --git a/backend/Machconcr.v b/backend/Machconcr.v
index 5ca3cad7ed562c512d3b195f6fdde66c5ffedf2c..41216d2554b78005780b32b34c8534cac26ec4a0 100644
--- a/backend/Machconcr.v
+++ b/backend/Machconcr.v
@@ -25,8 +25,8 @@ Require Import Op.
Require Import Locations.
Require Conventions.
Require Import Mach.
-Require Stacking.
-Require PPCgenretaddr.
+Require Stacklayout.
+Require Asmgenretaddr.
(** In the concrete semantics for Mach, the three stack-related Mach
instructions are interpreted as memory accesses relative to the
@@ -45,14 +45,14 @@ In addition to this linking of activation records, the concrete
semantics also make provisions for storing a back link at offset
[f.(fn_link_ofs)] from the stack pointer, and a return address at
offset [f.(fn_retaddr_ofs)]. The latter stack location will be used
-by the PPC code generated by [PPCgen] to save the return address into
+by the Asm code generated by [Asmgen] to save the return address into
the caller at the beginning of a function, then restore it and jump to
it at the end of a function. The Mach concrete semantics does not
attach any particular meaning to the pointer stored in this reserved
location, but makes sure that it is preserved during execution of a
function. The [return_address_offset] predicate from module
-[PPCgenretaddr] is used to guess the value of the return address that
-the PPC code generated later will store in the reserved location.
+[Asmgenretaddr] is used to guess the value of the return address that
+the Asm code generated later will store in the reserved location.
*)
Definition chunk_of_type (ty: typ) :=
@@ -70,7 +70,7 @@ Inductive extcall_arg: regset -> mem -> val -> loc -> val -> Prop :=
| extcall_arg_reg: forall rs m sp r,
extcall_arg rs m sp (R r) (rs r)
| extcall_arg_stack: forall rs m sp ofs ty v,
- load_stack m sp ty (Int.repr (Stacking.fe_ofs_arg + 4 * ofs)) = Some v ->
+ load_stack m sp ty (Int.repr (Stacklayout.fe_ofs_arg + 4 * ofs)) = Some v ->
extcall_arg rs m sp (S (Outgoing ofs ty)) v.
Inductive extcall_args: regset -> mem -> val -> list loc -> list val -> Prop :=
@@ -90,7 +90,7 @@ Inductive stackframe: Set :=
| Stackframe:
forall (f: block) (**r pointer to calling function *)
(sp: val) (**r stack pointer in calling function *)
- (retaddr: val) (**r PPC return address in calling function *)
+ (retaddr: val) (**r Asm return address in calling function *)
(c: code), (**r program point in calling function *)
stackframe.
@@ -174,7 +174,7 @@ Inductive step: state -> trace -> state -> Prop :=
forall s fb sp sig ros c rs m f f' ra,
find_function_ptr ge ros rs = Some f' ->
Genv.find_funct_ptr ge fb = Some (Internal f) ->
- PPCgenretaddr.return_address_offset f c ra ->
+ Asmgenretaddr.return_address_offset f c ra ->
step (State s fb sp (Mcall sig ros :: c) rs m)
E0 (Callstate (Stackframe fb sp (Vptr fb ra) c :: s)
f' rs m)
@@ -252,7 +252,7 @@ Inductive initial_state (p: program): state -> Prop :=
Inductive final_state: state -> int -> Prop :=
| final_state_intro: forall rs m r,
- rs R3 = Vint r ->
+ rs (Conventions.loc_result (mksignature nil (Some Tint))) = Vint r ->
final_state (Returnstate nil rs m) r.
Definition exec_program (p: program) (beh: program_behavior) : Prop :=
diff --git a/caml/RTLgenaux.ml b/backend/RTLgenaux.ml
similarity index 100%
rename from caml/RTLgenaux.ml
rename to backend/RTLgenaux.ml
diff --git a/caml/RTLtypingaux.ml b/backend/RTLtypingaux.ml
similarity index 100%
rename from caml/RTLtypingaux.ml
rename to backend/RTLtypingaux.ml
diff --git a/backend/Reloadproof.v b/backend/Reloadproof.v
index 3a96d3a2e406d55e56df4936e7c56b434d2ca467..5a3acd314ff29d811e0957e35f532dbb01bdd337 100644
--- a/backend/Reloadproof.v
+++ b/backend/Reloadproof.v
@@ -1017,7 +1017,7 @@ Proof.
intros [ls2 [A [B C]]].
assert (exists ta, eval_addressing tge sp addr (reglist ls2 (regs_for args)) = Some ta
/\ Val.lessdef a ta).
- apply eval_addressing_lessdef with (map rs args); auto.
+ apply eval_addressing_lessdef with (map rs args).
rewrite B. eapply agree_locs; eauto.
rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
destruct H1 as [ta [P Q]].
@@ -1047,7 +1047,7 @@ Proof.
simpl in B.
assert (exists ta, eval_addressing tge sp addr (reglist ls2 rargs) = Some ta
/\ Val.lessdef a ta).
- apply eval_addressing_lessdef with (map rs args); auto.
+ apply eval_addressing_lessdef with (map rs args).
rewrite D. eapply agree_locs; eauto.
rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
destruct H1 as [ta [P Q]].
@@ -1072,7 +1072,7 @@ Proof.
apply locs_acceptable_disj_temporaries; auto.
assert (exists ta, eval_addressing tge sp addr (reglist ls2 (regs_for args)) = Some ta
/\ Val.lessdef a ta).
- apply eval_addressing_lessdef with (map rs args); auto.
+ apply eval_addressing_lessdef with (map rs args).
rewrite B. eapply agree_locs; eauto.
rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved.
destruct H1 as [ta [P Q]].
diff --git a/backend/Stacking.v b/backend/Stacking.v
index 3f08daa33b6fe098c22123df43837d2babf0d0e0..1cf010b435b4167d6fc5a84e57ef251c950e16c3 100644
--- a/backend/Stacking.v
+++ b/backend/Stacking.v
@@ -24,61 +24,12 @@ Require Import Linear.
Require Import Bounds.
Require Import Mach.
Require Import Conventions.
+Require Import Stacklayout.
(** * Layout of activation records *)
-(** The general shape of activation records is as follows,
- from bottom (lowest offsets) to top:
-- 24 reserved bytes. The first 4 bytes hold the back pointer to the
- activation record of the caller. We use the 4 bytes at offset 12
- to store the return address. (These are reserved by the PowerPC
- application binary interface.) The remaining bytes are unused.
-- Space for outgoing arguments to function calls.
-- Local stack slots of integer type.
-- Saved values of integer callee-save registers used by the function.
-- One word of padding, if necessary to align the following data
- on a 8-byte boundary.
-- Local stack slots of float type.
-- Saved values of float callee-save registers used by the function.
-- Space for the stack-allocated data declared in Cminor.
-
-To facilitate some of the proofs, the Cminor stack-allocated data
-starts at offset 0; the preceding areas in the activation record
-therefore have negative offsets. This part (with negative offsets)
-is called the ``frame'', by opposition with the ``Cminor stack data''
-which is the part with positive offsets.
-
-The [frame_env] compilation environment records the positions of
-the boundaries between areas in the frame part.
-*)
-
-Definition fe_ofs_arg := 24.
-
-Record frame_env : Set := mk_frame_env {
- fe_size: Z;
- fe_ofs_link: Z;
- fe_ofs_retaddr: Z;
- fe_ofs_int_local: Z;
- fe_ofs_int_callee_save: Z;
- fe_num_int_callee_save: Z;
- fe_ofs_float_local: Z;
- fe_ofs_float_callee_save: Z;
- fe_num_float_callee_save: Z
-}.
-
-(** Computation of the frame environment from the bounds of the current
- function. *)
-
-Definition make_env (b: bounds) :=
- let oil := 24 + 4 * b.(bound_outgoing) in (* integer locals *)
- let oics := oil + 4 * b.(bound_int_local) in (* integer callee-saves *)
- let oendi := oics + 4 * b.(bound_int_callee_save) in
- let ofl := align oendi 8 in (* float locals *)
- let ofcs := ofl + 8 * b.(bound_float_local) in (* float callee-saves *)
- let sz := ofcs + 8 * b.(bound_float_callee_save) in (* total frame size *)
- mk_frame_env sz 0 12
- oil oics b.(bound_int_callee_save)
- ofl ofcs b.(bound_float_callee_save).
+(** The machine- and ABI-dependent aspects of the layout are defined
+ in module [Stacklayout]. *)
(** Computation the frame offset for the given component of the frame.
The component is expressed by the following [frame_index] sum type. *)
diff --git a/backend/Stackingproof.v b/backend/Stackingproof.v
index a9187eed0cc78ef71c118b1056e6f19d9a4842ad..e17f67a65f7e29c0ef46bbe002924a2f8a00c7fe 100644
--- a/backend/Stackingproof.v
+++ b/backend/Stackingproof.v
@@ -38,6 +38,7 @@ Require Import Mach.
Require Import Machabstr.
Require Import Bounds.
Require Import Conventions.
+Require Import Stacklayout.
Require Import Stacking.
(** * Properties of frames and frame accesses *)
@@ -50,92 +51,6 @@ Proof.
destruct ty; auto.
Qed.
-(*
-Lemma get_slot_ok:
- forall fr ty ofs,
- 24 <= ofs -> fr.(fr_low) + ofs + 4 * typesize ty <= 0 ->
- exists v, get_slot fr ty ofs v.
-Proof.
- intros. rewrite <- typesize_typesize in H0.
- exists (fr.(fr_contents) ty (fr.(fr_low) + ofs)). constructor; auto.
-Qed.
-
-Lemma set_slot_ok:
- forall fr ty ofs v,
- 24 <= ofs -> fr.(fr_low) + ofs + 4 * typesize ty <= 0 ->
- exists fr', set_slot fr ty ofs v fr'.
-Proof.
- intros. rewrite <- typesize_typesize in H0.
- econstructor. constructor; eauto.
-Qed.
-
-Lemma slot_gss:
- forall fr1 ty ofs v fr2,
- set_slot fr1 ty ofs v fr2 ->
- get_slot fr2 ty ofs v.
-Proof.
- intros. inv H. constructor; auto.
- simpl. destruct (typ_eq ty ty); try congruence.
- rewrite zeq_true. auto.
-Qed.
-
-Remark frame_update_gso:
- forall fr ty ofs v ty' ofs',
- ofs' + 4 * typesize ty' <= ofs \/ ofs + 4 * typesize ty <= ofs' ->
- fr_contents (update ty ofs v fr) ty' ofs' = fr_contents fr ty' ofs'.
-Proof.
- intros.
- generalize (typesize_pos ty); intro.
- generalize (typesize_pos ty'); intro.
- simpl. rewrite zeq_false. 2: omega.
- repeat rewrite <- typesize_typesize in H.
- destruct (zle (ofs' + AST.typesize ty') ofs). auto.
- destruct (zle (ofs + AST.typesize ty) ofs'). auto.
- omegaContradiction.
-Qed.
-
-Remark frame_update_overlap:
- forall fr ty ofs v ty' ofs',
- ofs <> ofs' ->
- ofs' + 4 * typesize ty' > ofs -> ofs + 4 * typesize ty > ofs' ->
- fr_contents (update ty ofs v fr) ty' ofs' = Vundef.
-Proof.
- intros. simpl. rewrite zeq_false; auto.
- rewrite <- typesize_typesize in H0.
- rewrite <- typesize_typesize in H1.
- repeat rewrite zle_false; auto.
-Qed.
-
-Remark frame_update_mismatch:
- forall fr ty ofs v ty',
- ty <> ty' ->
- fr_contents (update ty ofs v fr) ty' ofs = Vundef.
-Proof.
- intros. simpl. rewrite zeq_true.
- destruct (typ_eq ty ty'); congruence.
-Qed.
-
-Lemma slot_gso:
- forall fr1 ty ofs v fr2 ty' ofs' v',
- set_slot fr1 ty ofs v fr2 ->
- get_slot fr1 ty' ofs' v' ->
- ofs' + 4 * typesize ty' <= ofs \/ ofs + 4 * typesize ty <= ofs' ->
- get_slot fr2 ty' ofs' v'.
-Proof.
- intros. inv H. inv H0.
- constructor; auto.
- symmetry. simpl fr_low. apply frame_update_gso. omega.
-Qed.
-
-Lemma slot_gi:
- forall f ofs ty,
- 24 <= ofs -> fr_low (init_frame f) + ofs + 4 * typesize ty <= 0 ->
- get_slot (init_frame f) ty ofs Vundef.
-Proof.
- intros. rewrite <- typesize_typesize in H0. constructor; auto.
-Qed.
-*)
-
Section PRESERVATION.
Variable prog: Linear.program.
@@ -219,20 +134,13 @@ Definition index_diff (idx1 idx2: frame_index) : Prop :=
| _, _ => True
end.
-Remark align_float_part:
- 24 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b <=
- align (24 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b) 8.
-Proof.
- apply align_le. omega.
-Qed.
-
Ltac AddPosProps :=
generalize (bound_int_local_pos b); intro;
generalize (bound_float_local_pos b); intro;
generalize (bound_int_callee_save_pos b); intro;
generalize (bound_float_callee_save_pos b); intro;
generalize (bound_outgoing_pos b); intro;
- generalize align_float_part; intro.
+ generalize (align_float_part b); intro.
Lemma size_pos: fe.(fe_size) >= 0.
Proof.
@@ -1383,10 +1291,9 @@ Lemma shift_eval_addressing:
(transl_addr (make_env (function_bounds f)) addr) args =
Some v.
Proof.
- intros. destruct addr; auto.
- simpl. rewrite symbols_preserved. auto.
- simpl. rewrite symbols_preserved. auto.
- unfold transl_addr, eval_addressing in *.
+ intros.
+ unfold transl_addr, eval_addressing in *;
+ destruct addr; try (rewrite symbols_preserved); auto.
destruct args; try discriminate.
apply shift_offset_sp; auto.
Qed.
diff --git a/backend/Stackingtyping.v b/backend/Stackingtyping.v
index f3fe24f2b814e748f843b5c71c5f4790dff9397f..f1fe2cf0930c6bd3f1dcdd1fa4696e1b5e9a5e37 100644
--- a/backend/Stackingtyping.v
+++ b/backend/Stackingtyping.v
@@ -25,6 +25,7 @@ Require Import Lineartyping.
Require Import Mach.
Require Import Machtyping.
Require Import Bounds.
+Require Import Stacklayout.
Require Import Stacking.
Require Import Stackingproof.
diff --git a/caml/Cil2Csyntax.ml b/cfrontend/Cil2Csyntax.ml
similarity index 100%
rename from caml/Cil2Csyntax.ml
rename to cfrontend/Cil2Csyntax.ml
diff --git a/caml/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml
similarity index 100%
rename from caml/PrintCsyntax.ml
rename to cfrontend/PrintCsyntax.ml
diff --git a/configure b/configure
index bd1b7bbf6e829aa3922cef63da5451c5bcb98a29..0d71d2785026d91bf1cb3826e2695a289f4faa0f 100755
--- a/configure
+++ b/configure
@@ -16,6 +16,22 @@ cildistrib=cil-1.3.5.tar.gz
prefix=/usr/local
bindir='$(PREFIX)/bin'
libdir='$(PREFIX)/lib/compcert'
+target=''
+
+usage='Usage: ./configure [options] <target>
+
+Supported targets:
+ macosx (PowerPC, MacOS X)
+ ppc-linux (PowerPC, Linux)
+ ppc-linux-cross (PowerPC, Linux, cross-compilation)
+ arm-linux (ARM, Linux)
+ arm-linux-cross (ARM, Linux, cross-compilation)
+
+Options:
+ -prefix <dir> Install in <dir>/bin and <dir>/lib/compcert
+ -bindir <dir> Install binaries in <dir>
+ -libdir <dir> Install libraries in <dir>
+'
# Parse command-line arguments
@@ -28,11 +44,64 @@ while : ; do
bindir=$2; shift;;
-libdir|--libdir)
libdir=$2; shift;;
- *) echo "Unknown option \"$1\"." 1>&2; exit 2;;
+ *)
+ if test -n "$target"; then echo "$usage" 1>&2; exit 2; fi
+ target="$1";;
esac
shift
done
+if test -z "$target"; then echo "$usage" 1>&2; exit 2; fi
+
+# Per-target configuration
+
+case "$target" in
+ macosx)
+ arch="powerpc"
+ variant="macosx"
+ cc="gcc -arch ppc"
+ cprepro="gcc -arch ppc -U__GNUC__ -E"
+ casm="gcc -arch ppc -c"
+ clinker="gcc -arch ppc"
+ libmath="";;
+ ppc-linux)
+ arch="powerpc"
+ variant="eabi"
+ cc="gcc"
+ cprepro="gcc -U__GNUC__ -E"
+ casm="gcc -c"
+ clinker="gcc"
+ libmath="-lm";;
+ ppc-linux-cross)
+ arch="powerpc"
+ variant="eabi"
+ cc="ppc-linux-gcc"
+ cprepro="ppc-linux-gcc -U__GNUC__ -E"
+ casm="ppc-linux-gcc -c"
+ clinker="ppc-linux-gcc"
+ libmath="-lm";;
+ arm-linux)
+ arch="arm"
+ variant="linux"
+ cc="gcc"
+ cprepro="gcc -U__GNUC__ -E"
+ casm="gcc -c"
+ clinker="gcc"
+ libmath="-lm";;
+ arm-linux-cross)
+ arch="arm"
+ variant="linux"
+ cc="arm-linux-gcc"
+ cprepro="arm-linux-gcc -U__GNUC__ -E"
+ casm="arm-linux-gcc -c"
+ clinker="arm-linux-gcc"
+ libmath="-lm";;
+ *)
+ echo "Unsupported configuration '$target'" 1>&2
+ echo "$usage" 1>&2
+ exit 2;;
+esac
+
# Generate Makefile.config
rm -f Makefile.config
@@ -40,11 +109,13 @@ cat > Makefile.config <<EOF
PREFIX=$prefix
BINDIR=$bindir
LIBDIR=$libdir
-CC=gcc -arch ppc
-CPREPRO=gcc -arch ppc -U__GNUC__ -E
-CASM=gcc -arch ppc -c
-CLINKER=gcc -arch ppc
-LIBMATH=
+ARCH=$arch
+VARIANT=$variant
+CC=$cc
+CPREPRO=$cprepro
+CASM=$casm
+CLINKER=$clinker
+LIBMATH=$libmath
EOF
# Extract and configure Cil
@@ -57,3 +128,17 @@ for i in cil.patch/*; do patch -p1 < $i; done
# Extract 'ARCHOS' info from Cil configuration
grep '^ARCHOS=' cil/config.log >> Makefile.config
+
+# Summarize configuration
+
+cat <<EOF
+
+CompCert configuration:
+ Target architecture........... $arch ($variant)
+ C compiler.................... $cc
+ C preprocessor................ $cprepro
+ Assembler..................... $casm
+ Linker........................ $clinker
+ Math library.................. $libmath
+
+EOF
\ No newline at end of file
diff --git a/coq b/coq
index b110c54fcf7a846fb3cfa8c114e467ce2c86b15b..19edb9a9db9aabb6730d96d9af88b675a4c53b24 100755
--- a/coq
+++ b/coq
@@ -1,4 +1,7 @@
#!/bin/sh
# Start coqide with the right -I options
-coqide -I lib -I common -I backend -I cfrontend $1 && make ${1}o
+ARCH=`sed -n -e 's/^ARCH=//p' Makefile.config`
+VARIANT=`sed -n -e 's/^VARIANT=//p' Makefile.config`
+
+coqide -I lib -I common -I $ARCH/$VARIANT -I $ARCH -I backend -I cfrontend $1 && make ${1}o
diff --git a/caml/Clflags.ml b/driver/Clflags.ml
similarity index 100%
rename from caml/Clflags.ml
rename to driver/Clflags.ml
diff --git a/common/Main.v b/driver/Compiler.v
similarity index 91%
rename from common/Main.v
rename to driver/Compiler.v
index f50640ae46eef2cad09f59be96b59f30966401f3..219fcae3420bfa46459431ae84b61817c68dacab 100644
--- a/common/Main.v
+++ b/driver/Compiler.v
@@ -30,7 +30,7 @@ Require LTL.
Require LTLin.
Require Linear.
Require Mach.
-Require PPC.
+Require Asm.
(** Translation passes. *)
Require Cshmgen.
Require Cminorgen.
@@ -43,7 +43,7 @@ Require Tunneling.
Require Linearize.
Require Reload.
Require Stacking.
-Require PPCgen.
+Require Asmgen.
(** Type systems. *)
Require Ctyping.
Require RTLtyping.
@@ -69,7 +69,7 @@ Require Reloadtyping.
Require Stackingproof.
Require Stackingtyping.
Require Machabstr2concr.
-Require PPCgenproof.
+Require Asmgenproof.
Open Local Scope string_scope.
@@ -92,21 +92,21 @@ Notation "a @@ b" :=
(** We define three translation functions for whole programs: one
starting with a C program, one with a Cminor program, one with an
- RTL program. The three translations produce PPC programs ready for
+ RTL program. The three translations produce Asm programs ready for
pretty-printing and assembling.
There are two ways to compose the compiler passes. The first
translates every function from the Cminor program from Cminor to
- RTL, then to LTL, etc, all the way to PPC, and iterates this
+ RTL, then to LTL, etc, all the way to Asm, and iterates this
transformation for every function. The second translates the whole
Cminor program to a RTL program, then to an LTL program, etc.
- Between Cminor and PPC, we follow the first approach because it has
- lower memory requirements. The translation from Clight to PPC
+ Between Cminor and Asm, we follow the first approach because it has
+ lower memory requirements. The translation from Clight to Asm
follows the second approach.
- The translation of an RTL function to a PPC function is as follows. *)
+ The translation of an RTL function to an Asm function is as follows. *)
-Definition transf_rtl_fundef (f: RTL.fundef) : res PPC.fundef :=
+Definition transf_rtl_fundef (f: RTL.fundef) : res Asm.fundef :=
OK f
@@ Constprop.transf_fundef
@@ CSE.transf_fundef
@@ -115,11 +115,11 @@ Definition transf_rtl_fundef (f: RTL.fundef) : res PPC.fundef :=
@@@ Linearize.transf_fundef
@@ Reload.transf_fundef
@@@ Stacking.transf_fundef
- @@@ PPCgen.transf_fundef.
+ @@@ Asmgen.transf_fundef.
-(* Here is the translation of a Cminor function to a PPC function. *)
+(* Here is the translation of a Cminor function to an Asm function. *)
-Definition transf_cminor_fundef (f: Cminor.fundef) : res PPC.fundef :=
+Definition transf_cminor_fundef (f: Cminor.fundef) : res Asm.fundef :=
OK f
@@ Selection.sel_fundef
@@@ RTLgen.transl_fundef
@@ -127,13 +127,13 @@ Definition transf_cminor_fundef (f: Cminor.fundef) : res PPC.fundef :=
(** The corresponding translations for whole program follow. *)
-Definition transf_rtl_program (p: RTL.program) : res PPC.program :=
+Definition transf_rtl_program (p: RTL.program) : res Asm.program :=
transform_partial_program transf_rtl_fundef p.
-Definition transf_cminor_program (p: Cminor.program) : res PPC.program :=
+Definition transf_cminor_program (p: Cminor.program) : res Asm.program :=
transform_partial_program transf_cminor_fundef p.
-Definition transf_c_program (p: Csyntax.program) : res PPC.program :=
+Definition transf_c_program (p: Csyntax.program) : res Asm.program :=
match Ctyping.typecheck_program p with
| false =>
Error (msg "Ctyping: type error")
@@ -226,7 +226,7 @@ Theorem transf_rtl_program_correct:
forall p tp beh,
transf_rtl_program p = OK tp ->
RTL.exec_program p beh ->
- PPC.exec_program tp beh.
+ Asm.exec_program tp beh.
Proof.
intros. unfold transf_rtl_program, transf_rtl_fundef in H.
destruct (transform_partial_program_compose _ _ _ _ _ _ _ _ H) as [p7 [H7 P7]].
@@ -258,7 +258,7 @@ Proof.
assert (WT7: Machtyping.wt_program p7).
apply Stackingtyping.program_typing_preserved with p6. auto. auto.
- apply PPCgenproof.transf_program_correct with p7; auto.
+ apply Asmgenproof.transf_program_correct with p7; auto.
apply Machabstr2concr.exec_program_equiv; auto.
apply Stackingproof.transf_program_correct with p6; auto.
subst p6; apply Reloadproof.transf_program_correct; auto.
@@ -273,7 +273,7 @@ Theorem transf_cminor_program_correct:
forall p tp beh,
transf_cminor_program p = OK tp ->
Cminor.exec_program p beh ->
- PPC.exec_program tp beh.
+ Asm.exec_program tp beh.
Proof.
intros. unfold transf_cminor_program, transf_cminor_fundef in H.
destruct (transform_partial_program_compose _ _ _ _ _ _ _ _ H) as [p3 [H3 P3]].
@@ -291,7 +291,7 @@ Theorem transf_c_program_correct:
forall p tp beh,
transf_c_program p = OK tp ->
Csem.exec_program p beh ->
- PPC.exec_program tp beh.
+ Asm.exec_program tp beh.
Proof.
intros until beh; unfold transf_c_program; simpl.
caseEq (Ctyping.typecheck_program p); try congruence; intro.
diff --git a/common/Complements.v b/driver/Complements.v
similarity index 96%
rename from common/Complements.v
rename to driver/Complements.v
index 6df488fc75d72761f68fc18ffdb246109e2f26e0..fc2fa5333d700828c5d2a571b8807ce471c14c41 100644
--- a/common/Complements.v
+++ b/driver/Complements.v
@@ -22,13 +22,13 @@ Require Import Globalenvs.
Require Import Smallstep.
Require Import Csyntax.
Require Import Csem.
-Require Import PPC.
-Require Import Main.
+Require Import Asm.
+Require Import Compiler.
Require Import Errors.
-(** * Determinism of PPC semantics *)
+(** * Determinism of Asm semantics *)
-(** In this section, we show that the semantics for the PPC language
+(** In this section, we show that the semantics for the Asm language
are deterministic, in a sense to be made precise later.
There are two sources of apparent non-determinism:
- The semantics leaves unspecified the results of calls to external
@@ -181,7 +181,7 @@ Proof.
rewrite <- (eventval_match_deterministic _ _ _ _ _ H4 H5). auto.
Qed.
-(** ** Determinism of PPC transitions. *)
+(** ** Determinism of Asm transitions. *)
Remark extcall_arguments_deterministic:
forall rs m sg args args',
@@ -189,16 +189,13 @@ Remark extcall_arguments_deterministic:
extcall_arguments rs m sg args' -> args = args'.
Proof.
assert (
- forall rs m tyl iregl fregl ofs args,
- extcall_args rs m tyl iregl fregl ofs args ->
- forall args', extcall_args rs m tyl iregl fregl ofs args' -> args = args').
+ forall rs m ll args,
+ extcall_args rs m ll args ->
+ forall args', extcall_args rs m ll args' -> args = args').
induction 1; intros.
inv H. auto.
- inv H1. decEq; eauto.
- inv H1. decEq. congruence. eauto.
- inv H1. decEq; eauto.
- inv H1. decEq. congruence. eauto.
-
+ inv H1. decEq; eauto.
+ inv H; inv H4; congruence.
unfold extcall_arguments; intros; eauto.
Qed.
@@ -573,11 +570,11 @@ Qed.
(** * Additional semantic preservation property *)
(** Combining the semantic preservation theorem from module [Main]
- with the determinism of PPC executions, we easily obtain
+ with the determinism of Asm executions, we easily obtain
additional, stronger semantic preservation properties.
The first property states that, when compiling a Clight
program that has well-defined semantics, all possible executions
- of the resulting PPC code correspond to an execution of
+ of the resulting Asm code correspond to an execution of
the source Clight program, in the sense of the [matching_behaviors]
predicate. *)
@@ -591,7 +588,7 @@ Theorem transf_c_program_correct_strong:
exists b0, Csem.exec_program p b0 /\ matching_behaviors b0 b').
Proof.
intros.
- assert (PPC.exec_program tp b).
+ assert (Asm.exec_program tp b).
eapply transf_c_program_correct; eauto.
exploit exec_program_program'; eauto.
intros [b' [A B]].
@@ -606,7 +603,7 @@ Section SPECS_PRESERVED.
(** The second additional results shows that if one execution
of the source Clight program satisfies a given specification
(a predicate on the observable behavior of the program),
- then all executions of the produced PPC program satisfy
+ then all executions of the produced Asm program satisfy
this specification as well. *)
Variable spec: program_behavior -> Prop.
@@ -633,7 +630,7 @@ Theorem transf_c_program_preserves_spec:
/\(forall b', exec_program' tp w b' -> spec b').
Proof.
intros.
- assert (PPC.exec_program tp b).
+ assert (Asm.exec_program tp b).
eapply transf_c_program_correct; eauto.
exploit exec_program_program'; eauto.
intros [b' [A B]].
diff --git a/caml/Driver.ml b/driver/Driver.ml
similarity index 98%
rename from caml/Driver.ml
rename to driver/Driver.ml
index 8fffcaa0f7975bccf8f5c90b669296b8be0fe13a..8361829f7a58fefd7c54f4d7986d40f0a26db6ab 100644
--- a/caml/Driver.ml
+++ b/driver/Driver.ml
@@ -134,16 +134,16 @@ let compile_c_file sourcename ifile ofile =
PrintCsyntax.print_program (Format.formatter_of_out_channel oc) csyntax;
close_out oc
end;
- (* Convert to PPC *)
+ (* Convert to Asm *)
let ppc =
- match Main.transf_c_program csyntax with
+ match Compiler.transf_c_program csyntax with
| Errors.OK x -> x
| Errors.Error msg ->
print_error stderr msg;
exit 2 in
- (* Save PPC asm *)
+ (* Save asm *)
let oc = open_out ofile in
- PrintPPC.print_program oc ppc;
+ PrintAsm.print_program oc ppc;
close_out oc
(* From Cminor to asm *)
@@ -152,7 +152,7 @@ let compile_cminor_file ifile ofile =
let ic = open_in ifile in
let lb = Lexing.from_channel ic in
try
- match Main.transf_cminor_program
+ match Compiler.transf_cminor_program
(CMtypecheck.type_program
(CMparser.prog CMlexer.token lb)) with
| Errors.Error msg ->
@@ -160,7 +160,7 @@ let compile_cminor_file ifile ofile =
exit 2
| Errors.OK p ->
let oc = open_out ofile in
- PrintPPC.print_program oc p;
+ PrintAsm.print_program oc p;
close_out oc
with Parsing.Parse_error ->
eprintf "File %s, character %d: Syntax error\n"
diff --git a/extraction/.depend b/extraction/.depend
deleted file mode 100644
index a8ae227f12301e24203cd604401994149bf9dd98..0000000000000000000000000000000000000000
--- a/extraction/.depend
+++ /dev/null
@@ -1,529 +0,0 @@
-../caml/CMlexer.cmi: ../caml/CMparser.cmi
-../caml/CMparser.cmi: Cminor.cmi AST.cmi
-../caml/CMtypecheck.cmi: Cminor.cmi
-../caml/Coloringaux.cmi: Registers.cmi RTLtyping.cmi RTL.cmi Locations.cmi \
- InterfGraph.cmi
-../caml/PrintPPC.cmi: PPC.cmi
-../caml/Camlcoq.cmo: Integers.cmi Datatypes.cmi CString.cmi CList.cmi \
- BinPos.cmi BinInt.cmi Ascii.cmi
-../caml/Camlcoq.cmx: Integers.cmx Datatypes.cmx CString.cmx CList.cmx \
- BinPos.cmx BinInt.cmx Ascii.cmx
-../caml/Cil2Csyntax.cmo: Datatypes.cmi Csyntax.cmi ../caml/Camlcoq.cmo \
- CList.cmi AST.cmi
-../caml/Cil2Csyntax.cmx: Datatypes.cmx Csyntax.cmx ../caml/Camlcoq.cmx \
- CList.cmx AST.cmx
-../caml/CMlexer.cmo: ../caml/Camlcoq.cmo ../caml/CMparser.cmi \
- ../caml/CMlexer.cmi
-../caml/CMlexer.cmx: ../caml/Camlcoq.cmx ../caml/CMparser.cmx \
- ../caml/CMlexer.cmi
-../caml/CMparser.cmo: Integers.cmi Datatypes.cmi Cminor.cmi \
- ../caml/Camlcoq.cmo CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
- ../caml/CMparser.cmi
-../caml/CMparser.cmx: Integers.cmx Datatypes.cmx Cminor.cmx \
- ../caml/Camlcoq.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
- ../caml/CMparser.cmi
-../caml/CMtypecheck.cmo: Integers.cmi Datatypes.cmi Cminor.cmi \
- ../caml/Camlcoq.cmo CList.cmi AST.cmi ../caml/CMtypecheck.cmi
-../caml/CMtypecheck.cmx: Integers.cmx Datatypes.cmx Cminor.cmx \
- ../caml/Camlcoq.cmx CList.cmx AST.cmx ../caml/CMtypecheck.cmi
-../caml/Coloringaux.cmo: Registers.cmi RTLtyping.cmi RTL.cmi Maps.cmi \
- Locations.cmi InterfGraph.cmi Datatypes.cmi Conventions.cmi \
- ../caml/Camlcoq.cmo BinPos.cmi BinInt.cmi AST.cmi ../caml/Coloringaux.cmi
-../caml/Coloringaux.cmx: Registers.cmx RTLtyping.cmx RTL.cmx Maps.cmx \
- Locations.cmx InterfGraph.cmx Datatypes.cmx Conventions.cmx \
- ../caml/Camlcoq.cmx BinPos.cmx BinInt.cmx AST.cmx ../caml/Coloringaux.cmi
-../caml/Driver.cmo: ../caml/PrintPPC.cmi ../caml/PrintCsyntax.cmo Main.cmi \
- Errors.cmi Csyntax.cmi ../caml/Configuration.cmo ../caml/Clflags.cmo \
- ../caml/Cil2Csyntax.cmo ../caml/Camlcoq.cmo ../caml/CMtypecheck.cmi \
- ../caml/CMparser.cmi ../caml/CMlexer.cmi
-../caml/Driver.cmx: ../caml/PrintPPC.cmx ../caml/PrintCsyntax.cmx Main.cmx \
- Errors.cmx Csyntax.cmx ../caml/Configuration.cmx ../caml/Clflags.cmx \
- ../caml/Cil2Csyntax.cmx ../caml/Camlcoq.cmx ../caml/CMtypecheck.cmx \
- ../caml/CMparser.cmx ../caml/CMlexer.cmx
-../caml/Floataux.cmo: Integers.cmi ../caml/Camlcoq.cmo
-../caml/Floataux.cmx: Integers.cmx ../caml/Camlcoq.cmx
-../caml/Linearizeaux.cmo: Maps.cmi Lattice.cmi LTL.cmi Datatypes.cmi \
- Coqlib.cmi ../caml/Camlcoq.cmo CList.cmi BinPos.cmi
-../caml/Linearizeaux.cmx: Maps.cmx Lattice.cmx LTL.cmx Datatypes.cmx \
- Coqlib.cmx ../caml/Camlcoq.cmx CList.cmx BinPos.cmx
-../caml/PrintCshm.cmo: Integers.cmi Datatypes.cmi Csharpminor.cmi \
- ../caml/Camlcoq.cmo CList.cmi AST.cmi
-../caml/PrintCshm.cmx: Integers.cmx Datatypes.cmx Csharpminor.cmx \
- ../caml/Camlcoq.cmx CList.cmx AST.cmx
-../caml/PrintCsyntax.cmo: Datatypes.cmi Csyntax.cmi ../caml/Camlcoq.cmo \
- CList.cmi AST.cmi
-../caml/PrintCsyntax.cmx: Datatypes.cmx Csyntax.cmx ../caml/Camlcoq.cmx \
- CList.cmx AST.cmx
-../caml/PrintPPC.cmo: PPC.cmi Datatypes.cmi ../caml/Camlcoq.cmo CList.cmi \
- AST.cmi ../caml/PrintPPC.cmi
-../caml/PrintPPC.cmx: PPC.cmx Datatypes.cmx ../caml/Camlcoq.cmx CList.cmx \
- AST.cmx ../caml/PrintPPC.cmi
-../caml/RTLgenaux.cmo: Switch.cmi Integers.cmi Datatypes.cmi CminorSel.cmi \
- ../caml/Camlcoq.cmo
-../caml/RTLgenaux.cmx: Switch.cmx Integers.cmx Datatypes.cmx CminorSel.cmx \
- ../caml/Camlcoq.cmx
-../caml/RTLtypingaux.cmo: Registers.cmi RTL.cmi Op.cmi Maps.cmi Datatypes.cmi \
- ../caml/Camlcoq.cmo CList.cmi AST.cmi
-../caml/RTLtypingaux.cmx: Registers.cmx RTL.cmx Op.cmx Maps.cmx Datatypes.cmx \
- ../caml/Camlcoq.cmx CList.cmx AST.cmx
-Allocation.cmi: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi \
- Maps.cmi Locations.cmi LTL.cmi Errors.cmi Datatypes.cmi Coloring.cmi \
- CString.cmi CList.cmi BinPos.cmi Ascii.cmi AST.cmi
-Ascii.cmi: Specif.cmi Peano.cmi Datatypes.cmi Bool.cmi BinPos.cmi
-AST.cmi: Specif.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
- Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi Ascii.cmi
-BinInt.cmi: Datatypes.cmi BinPos.cmi BinNat.cmi
-BinNat.cmi: Specif.cmi Datatypes.cmi BinPos.cmi
-BinPos.cmi: Peano.cmi Datatypes.cmi
-Bool.cmi: Specif.cmi Datatypes.cmi
-Bounds.cmi: Zmax.cmi Locations.cmi Linear.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi
-CInt.cmi: Zmax.cmi ZArith_dec.cmi Specif.cmi BinPos.cmi BinInt.cmi
-CList.cmi: Specif.cmi Datatypes.cmi
-Cminorgen.cmi: Zmax.cmi Specif.cmi OrderedType.cmi Ordered.cmi Mem.cmi \
- Maps.cmi Integers.cmi Errors.cmi Datatypes.cmi Csharpminor.cmi Coqlib.cmi \
- Cminor.cmi CString.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi Ascii.cmi \
- AST.cmi
-Cminor.cmi: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Floats.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi
-CminorSel.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Cminor.cmi CList.cmi BinInt.cmi AST.cmi
-Coloring.cmi: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi Maps.cmi \
- Locations.cmi InterfGraph.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
- CList.cmi BinInt.cmi AST.cmi
-Compare_dec.cmi: Specif.cmi Datatypes.cmi
-Constprop.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Integers.cmi \
- Floats.cmi Datatypes.cmi CList.cmi Bool.cmi BinPos.cmi BinInt.cmi AST.cmi
-Conventions.cmi: Locations.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
- BinInt.cmi AST.cmi
-Coqlib.cmi: Zdiv.cmi ZArith_dec.cmi Wf.cmi Specif.cmi Datatypes.cmi CList.cmi \
- BinPos.cmi BinInt.cmi
-CSE.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Integers.cmi \
- Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi
-Csharpminor.cmi: Zmax.cmi Values.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Floats.cmi Datatypes.cmi Cminor.cmi CList.cmi BinInt.cmi \
- AST.cmi
-Cshmgen.cmi: Specif.cmi Peano.cmi Integers.cmi Floats.cmi Errors.cmi \
- Datatypes.cmi Csyntax.cmi Csharpminor.cmi Cminor.cmi CString.cmi \
- CList.cmi Ascii.cmi AST.cmi
-CString.cmi: Specif.cmi Datatypes.cmi Ascii.cmi
-Csyntax.cmi: Zmax.cmi Specif.cmi Integers.cmi Floats.cmi Errors.cmi \
- Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi \
- Ascii.cmi AST.cmi
-Ctyping.cmi: Specif.cmi Maps.cmi Datatypes.cmi Csyntax.cmi Coqlib.cmi \
- CList.cmi AST.cmi
-EqNat.cmi: Specif.cmi Datatypes.cmi
-Errors.cmi: Datatypes.cmi CString.cmi CList.cmi BinPos.cmi
-Floats.cmi: Specif.cmi Integers.cmi Datatypes.cmi
-FSetAVL.cmi: Wf.cmi Specif.cmi Peano.cmi OrderedType.cmi Datatypes.cmi \
- CList.cmi CInt.cmi BinPos.cmi BinInt.cmi
-FSetFacts.cmi: Specif.cmi Setoid.cmi FSetInterface.cmi Datatypes.cmi
-FSetInterface.cmi: Specif.cmi OrderedType.cmi Datatypes.cmi CList.cmi
-FSetList.cmi: Specif.cmi OrderedType.cmi Datatypes.cmi CList.cmi
-Globalenvs.cmi: Values.cmi Mem.cmi Maps.cmi Integers.cmi Datatypes.cmi \
- CList.cmi BinPos.cmi BinInt.cmi AST.cmi
-Integers.cmi: Zpower.cmi Zdiv.cmi Specif.cmi Datatypes.cmi Coqlib.cmi \
- CList.cmi Bool.cmi BinPos.cmi BinInt.cmi
-InterfGraph.cmi: Specif.cmi Registers.cmi OrderedType.cmi Locations.cmi \
- Datatypes.cmi Coqlib.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi
-Iteration.cmi: Wf.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi
-Kildall.cmi: Specif.cmi Setoid.cmi OrderedType.cmi Ordered.cmi Maps.cmi \
- Lattice.cmi Iteration.cmi Datatypes.cmi Coqlib.cmi CList.cmi CInt.cmi \
- BinPos.cmi BinInt.cmi
-Lattice.cmi: Specif.cmi Maps.cmi FSetInterface.cmi Datatypes.cmi Bool.cmi \
- BinPos.cmi
-Linearize.cmi: Specif.cmi OrderedType.cmi Ordered.cmi Op.cmi Maps.cmi \
- Lattice.cmi LTLin.cmi LTL.cmi Errors.cmi Datatypes.cmi Coqlib.cmi \
- CString.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi
-Linear.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi
-Locations.cmi: Values.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi \
- BinInt.cmi AST.cmi
-LTLin.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi
-LTL.cmi: Values.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Locations.cmi \
- Integers.cmi Globalenvs.cmi Datatypes.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi
-Mach.cmi: Values.cmi Specif.cmi Op.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi
-Main.cmi: Tunneling.cmi Stacking.cmi Selection.cmi Reload.cmi RTLgen.cmi \
- RTL.cmi PPCgen.cmi PPC.cmi Linearize.cmi Errors.cmi Datatypes.cmi \
- Ctyping.cmi Csyntax.cmi Cshmgen.cmi Constprop.cmi Cminorgen.cmi \
- Cminor.cmi CString.cmi CSE.cmi Ascii.cmi Allocation.cmi AST.cmi
-Maps.cmi: Specif.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinNat.cmi \
- BinInt.cmi
-Mem.cmi: Zmax.cmi Values.cmi Specif.cmi Integers.cmi Datatypes.cmi Coqlib.cmi \
- CList.cmi BinPos.cmi BinInt.cmi AST.cmi
-Op.cmi: Values.cmi Specif.cmi Mem.cmi Integers.cmi Globalenvs.cmi Floats.cmi \
- Datatypes.cmi CList.cmi Bool.cmi BinPos.cmi BinInt.cmi AST.cmi
-Ordered.cmi: Specif.cmi OrderedType.cmi Maps.cmi Datatypes.cmi Coqlib.cmi \
- BinPos.cmi
-OrderedType.cmi: Specif.cmi Datatypes.cmi
-Parallelmove.cmi: Parmov.cmi Locations.cmi Datatypes.cmi CList.cmi AST.cmi
-Parmov.cmi: Specif.cmi Peano.cmi Datatypes.cmi CList.cmi
-Peano.cmi: Datatypes.cmi
-PPCgen.cmi: Specif.cmi PPC.cmi Op.cmi Mach.cmi Locations.cmi Integers.cmi \
- Errors.cmi Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi Bool.cmi \
- BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi
-PPC.cmi: Values.cmi Specif.cmi Mem.cmi Integers.cmi Globalenvs.cmi Floats.cmi \
- Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
-Registers.cmi: Specif.cmi OrderedType.cmi Ordered.cmi Maps.cmi Datatypes.cmi \
- Coqlib.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi AST.cmi
-Reload.cmi: Specif.cmi Parallelmove.cmi Op.cmi Locations.cmi Linear.cmi \
- LTLin.cmi Integers.cmi Datatypes.cmi Conventions.cmi CList.cmi AST.cmi
-RTLgen.cmi: Switch.cmi Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi \
- Integers.cmi Errors.cmi Datatypes.cmi Coqlib.cmi CminorSel.cmi Cminor.cmi \
- CString.cmi CList.cmi BinPos.cmi Ascii.cmi AST.cmi
-RTL.cmi: Values.cmi Registers.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
-RTLtyping.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Errors.cmi \
- Datatypes.cmi Coqlib.cmi Conventions.cmi CString.cmi CList.cmi Ascii.cmi \
- AST.cmi
-Selection.cmi: Specif.cmi Op.cmi Integers.cmi Datatypes.cmi Compare_dec.cmi \
- CminorSel.cmi Cminor.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi
-Setoid.cmi: Datatypes.cmi
-Specif.cmi: Datatypes.cmi
-Stacking.cmi: Specif.cmi Op.cmi Mach.cmi Locations.cmi Linear.cmi \
- Integers.cmi Errors.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
- CString.cmi CList.cmi Bounds.cmi BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi
-Sumbool.cmi: Specif.cmi Datatypes.cmi
-Switch.cmi: Specif.cmi Integers.cmi EqNat.cmi Datatypes.cmi Coqlib.cmi \
- CList.cmi BinPos.cmi BinInt.cmi
-Tunneling.cmi: Maps.cmi LTL.cmi Datatypes.cmi AST.cmi
-Values.cmi: Specif.cmi Integers.cmi Floats.cmi Datatypes.cmi Coqlib.cmi \
- BinPos.cmi BinInt.cmi AST.cmi
-ZArith_dec.cmi: Sumbool.cmi Specif.cmi Datatypes.cmi BinInt.cmi
-Zbool.cmi: Zeven.cmi ZArith_dec.cmi Sumbool.cmi Specif.cmi Datatypes.cmi \
- BinInt.cmi
-Zdiv.cmi: Zbool.cmi ZArith_dec.cmi Specif.cmi Datatypes.cmi BinPos.cmi \
- BinInt.cmi
-Zeven.cmi: Specif.cmi Datatypes.cmi BinPos.cmi BinInt.cmi
-Zmax.cmi: Datatypes.cmi BinInt.cmi
-Zmisc.cmi: Datatypes.cmi BinPos.cmi BinInt.cmi
-Zpower.cmi: Zmisc.cmi Datatypes.cmi BinPos.cmi BinInt.cmi
-Allocation.cmo: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi \
- Maps.cmi Locations.cmi Lattice.cmi LTL.cmi Kildall.cmi Errors.cmi \
- Datatypes.cmi Coloring.cmi CString.cmi CList.cmi BinPos.cmi Ascii.cmi \
- AST.cmi Allocation.cmi
-Allocation.cmx: Specif.cmx Registers.cmx RTLtyping.cmx RTL.cmx Op.cmx \
- Maps.cmx Locations.cmx Lattice.cmx LTL.cmx Kildall.cmx Errors.cmx \
- Datatypes.cmx Coloring.cmx CString.cmx CList.cmx BinPos.cmx Ascii.cmx \
- AST.cmx Allocation.cmi
-Ascii.cmo: Specif.cmi Peano.cmi Datatypes.cmi Bool.cmi BinPos.cmi Ascii.cmi
-Ascii.cmx: Specif.cmx Peano.cmx Datatypes.cmx Bool.cmx BinPos.cmx Ascii.cmi
-AST.cmo: Specif.cmi Integers.cmi Floats.cmi Errors.cmi Datatypes.cmi \
- Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi
-AST.cmx: Specif.cmx Integers.cmx Floats.cmx Errors.cmx Datatypes.cmx \
- Coqlib.cmx CString.cmx CList.cmx BinPos.cmx BinInt.cmx Ascii.cmx AST.cmi
-BinInt.cmo: Datatypes.cmi BinPos.cmi BinNat.cmi BinInt.cmi
-BinInt.cmx: Datatypes.cmx BinPos.cmx BinNat.cmx BinInt.cmi
-BinNat.cmo: Specif.cmi Datatypes.cmi BinPos.cmi BinNat.cmi
-BinNat.cmx: Specif.cmx Datatypes.cmx BinPos.cmx BinNat.cmi
-BinPos.cmo: Peano.cmi Datatypes.cmi BinPos.cmi
-BinPos.cmx: Peano.cmx Datatypes.cmx BinPos.cmi
-Bool.cmo: Specif.cmi Datatypes.cmi Bool.cmi
-Bool.cmx: Specif.cmx Datatypes.cmx Bool.cmi
-Bounds.cmo: Zmax.cmi Locations.cmi Linear.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi Bounds.cmi
-Bounds.cmx: Zmax.cmx Locations.cmx Linear.cmx Conventions.cmx CList.cmx \
- BinPos.cmx BinInt.cmx AST.cmx Bounds.cmi
-CInt.cmo: Zmax.cmi ZArith_dec.cmi Specif.cmi BinPos.cmi BinInt.cmi CInt.cmi
-CInt.cmx: Zmax.cmx ZArith_dec.cmx Specif.cmx BinPos.cmx BinInt.cmx CInt.cmi
-CList.cmo: Specif.cmi Datatypes.cmi CList.cmi
-CList.cmx: Specif.cmx Datatypes.cmx CList.cmi
-Cminorgen.cmo: Zmax.cmi Specif.cmi OrderedType.cmi Ordered.cmi Mem.cmi \
- Maps.cmi Integers.cmi FSetAVL.cmi Errors.cmi Datatypes.cmi \
- Csharpminor.cmi Coqlib.cmi Cminor.cmi CString.cmi CList.cmi BinPos.cmi \
- BinInt.cmi Ascii.cmi AST.cmi Cminorgen.cmi
-Cminorgen.cmx: Zmax.cmx Specif.cmx OrderedType.cmx Ordered.cmx Mem.cmx \
- Maps.cmx Integers.cmx FSetAVL.cmx Errors.cmx Datatypes.cmx \
- Csharpminor.cmx Coqlib.cmx Cminor.cmx CString.cmx CList.cmx BinPos.cmx \
- BinInt.cmx Ascii.cmx AST.cmx Cminorgen.cmi
-Cminor.cmo: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Floats.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi Cminor.cmi
-Cminor.cmx: Values.cmx Specif.cmx Mem.cmx Maps.cmx Integers.cmx \
- Globalenvs.cmx Floats.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx \
- AST.cmx Cminor.cmi
-CminorSel.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Cminor.cmi CList.cmi BinInt.cmi AST.cmi \
- CminorSel.cmi
-CminorSel.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Integers.cmx \
- Globalenvs.cmx Datatypes.cmx Cminor.cmx CList.cmx BinInt.cmx AST.cmx \
- CminorSel.cmi
-Coloring.cmo: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi Maps.cmi \
- Locations.cmi InterfGraph.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
- ../caml/Coloringaux.cmi CList.cmi BinInt.cmi AST.cmi Coloring.cmi
-Coloring.cmx: Specif.cmx Registers.cmx RTLtyping.cmx RTL.cmx Op.cmx Maps.cmx \
- Locations.cmx InterfGraph.cmx Datatypes.cmx Coqlib.cmx Conventions.cmx \
- ../caml/Coloringaux.cmx CList.cmx BinInt.cmx AST.cmx Coloring.cmi
-Compare_dec.cmo: Specif.cmi Datatypes.cmi Compare_dec.cmi
-Compare_dec.cmx: Specif.cmx Datatypes.cmx Compare_dec.cmi
-Constprop.cmo: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Lattice.cmi \
- Kildall.cmi Integers.cmi Floats.cmi Datatypes.cmi CList.cmi Bool.cmi \
- BinPos.cmi BinInt.cmi AST.cmi Constprop.cmi
-Constprop.cmx: Specif.cmx Registers.cmx RTL.cmx Op.cmx Maps.cmx Lattice.cmx \
- Kildall.cmx Integers.cmx Floats.cmx Datatypes.cmx CList.cmx Bool.cmx \
- BinPos.cmx BinInt.cmx AST.cmx Constprop.cmi
-Conventions.cmo: Locations.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
- BinInt.cmi AST.cmi Conventions.cmi
-Conventions.cmx: Locations.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx \
- BinInt.cmx AST.cmx Conventions.cmi
-Coqlib.cmo: Zdiv.cmi ZArith_dec.cmi Wf.cmi Specif.cmi Datatypes.cmi CList.cmi \
- BinPos.cmi BinInt.cmi Coqlib.cmi
-Coqlib.cmx: Zdiv.cmx ZArith_dec.cmx Wf.cmx Specif.cmx Datatypes.cmx CList.cmx \
- BinPos.cmx BinInt.cmx Coqlib.cmi
-CSE.cmo: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Kildall.cmi \
- Integers.cmi Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
- AST.cmi CSE.cmi
-CSE.cmx: Specif.cmx Registers.cmx RTL.cmx Op.cmx Maps.cmx Kildall.cmx \
- Integers.cmx Floats.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx \
- AST.cmx CSE.cmi
-Csharpminor.cmo: Zmax.cmi Values.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Floats.cmi Datatypes.cmi Cminor.cmi CList.cmi BinInt.cmi \
- AST.cmi Csharpminor.cmi
-Csharpminor.cmx: Zmax.cmx Values.cmx Mem.cmx Maps.cmx Integers.cmx \
- Globalenvs.cmx Floats.cmx Datatypes.cmx Cminor.cmx CList.cmx BinInt.cmx \
- AST.cmx Csharpminor.cmi
-Cshmgen.cmo: Specif.cmi Peano.cmi Integers.cmi Floats.cmi Errors.cmi \
- Datatypes.cmi Csyntax.cmi Csharpminor.cmi Cminor.cmi CString.cmi \
- CList.cmi Ascii.cmi AST.cmi Cshmgen.cmi
-Cshmgen.cmx: Specif.cmx Peano.cmx Integers.cmx Floats.cmx Errors.cmx \
- Datatypes.cmx Csyntax.cmx Csharpminor.cmx Cminor.cmx CString.cmx \
- CList.cmx Ascii.cmx AST.cmx Cshmgen.cmi
-CString.cmo: Specif.cmi Datatypes.cmi Ascii.cmi CString.cmi
-CString.cmx: Specif.cmx Datatypes.cmx Ascii.cmx CString.cmi
-Csyntax.cmo: Zmax.cmi Specif.cmi Integers.cmi Floats.cmi Errors.cmi \
- Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi BinPos.cmi BinInt.cmi \
- Ascii.cmi AST.cmi Csyntax.cmi
-Csyntax.cmx: Zmax.cmx Specif.cmx Integers.cmx Floats.cmx Errors.cmx \
- Datatypes.cmx Coqlib.cmx CString.cmx CList.cmx BinPos.cmx BinInt.cmx \
- Ascii.cmx AST.cmx Csyntax.cmi
-Ctyping.cmo: Specif.cmi Maps.cmi Datatypes.cmi Csyntax.cmi Coqlib.cmi \
- CList.cmi AST.cmi Ctyping.cmi
-Ctyping.cmx: Specif.cmx Maps.cmx Datatypes.cmx Csyntax.cmx Coqlib.cmx \
- CList.cmx AST.cmx Ctyping.cmi
-Datatypes.cmo: Datatypes.cmi
-Datatypes.cmx: Datatypes.cmi
-EqNat.cmo: Specif.cmi Datatypes.cmi EqNat.cmi
-EqNat.cmx: Specif.cmx Datatypes.cmx EqNat.cmi
-Errors.cmo: Datatypes.cmi CString.cmi CList.cmi BinPos.cmi Errors.cmi
-Errors.cmx: Datatypes.cmx CString.cmx CList.cmx BinPos.cmx Errors.cmi
-Floats.cmo: Specif.cmi Integers.cmi ../caml/Floataux.cmo Datatypes.cmi \
- Floats.cmi
-Floats.cmx: Specif.cmx Integers.cmx ../caml/Floataux.cmx Datatypes.cmx \
- Floats.cmi
-FSetAVL.cmo: Wf.cmi Specif.cmi Peano.cmi OrderedType.cmi FSetList.cmi \
- Datatypes.cmi CList.cmi CInt.cmi BinPos.cmi BinInt.cmi FSetAVL.cmi
-FSetAVL.cmx: Wf.cmx Specif.cmx Peano.cmx OrderedType.cmx FSetList.cmx \
- Datatypes.cmx CList.cmx CInt.cmx BinPos.cmx BinInt.cmx FSetAVL.cmi
-FSetFacts.cmo: Specif.cmi Setoid.cmi OrderedType.cmi FSetInterface.cmi \
- Datatypes.cmi FSetFacts.cmi
-FSetFacts.cmx: Specif.cmx Setoid.cmx OrderedType.cmx FSetInterface.cmx \
- Datatypes.cmx FSetFacts.cmi
-FSetInterface.cmo: Specif.cmi OrderedType.cmi Datatypes.cmi CList.cmi \
- FSetInterface.cmi
-FSetInterface.cmx: Specif.cmx OrderedType.cmx Datatypes.cmx CList.cmx \
- FSetInterface.cmi
-FSetList.cmo: Specif.cmi OrderedType.cmi Datatypes.cmi CList.cmi FSetList.cmi
-FSetList.cmx: Specif.cmx OrderedType.cmx Datatypes.cmx CList.cmx FSetList.cmi
-Globalenvs.cmo: Values.cmi Mem.cmi Maps.cmi Integers.cmi Datatypes.cmi \
- CList.cmi BinPos.cmi BinInt.cmi AST.cmi Globalenvs.cmi
-Globalenvs.cmx: Values.cmx Mem.cmx Maps.cmx Integers.cmx Datatypes.cmx \
- CList.cmx BinPos.cmx BinInt.cmx AST.cmx Globalenvs.cmi
-Integers.cmo: Zpower.cmi Zdiv.cmi Specif.cmi Datatypes.cmi Coqlib.cmi \
- CList.cmi Bool.cmi BinPos.cmi BinInt.cmi Integers.cmi
-Integers.cmx: Zpower.cmx Zdiv.cmx Specif.cmx Datatypes.cmx Coqlib.cmx \
- CList.cmx Bool.cmx BinPos.cmx BinInt.cmx Integers.cmi
-InterfGraph.cmo: Specif.cmi Registers.cmi OrderedType.cmi Ordered.cmi \
- Locations.cmi FSetAVL.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi \
- BinInt.cmi InterfGraph.cmi
-InterfGraph.cmx: Specif.cmx Registers.cmx OrderedType.cmx Ordered.cmx \
- Locations.cmx FSetAVL.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx \
- BinInt.cmx InterfGraph.cmi
-Iteration.cmo: Wf.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi \
- Iteration.cmi
-Iteration.cmx: Wf.cmx Specif.cmx Datatypes.cmx Coqlib.cmx BinPos.cmx \
- Iteration.cmi
-Kildall.cmo: Specif.cmi Setoid.cmi OrderedType.cmi Ordered.cmi Maps.cmi \
- Lattice.cmi Iteration.cmi FSetFacts.cmi FSetAVL.cmi Datatypes.cmi \
- Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi Kildall.cmi
-Kildall.cmx: Specif.cmx Setoid.cmx OrderedType.cmx Ordered.cmx Maps.cmx \
- Lattice.cmx Iteration.cmx FSetFacts.cmx FSetAVL.cmx Datatypes.cmx \
- Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx Kildall.cmi
-Lattice.cmo: Specif.cmi Maps.cmi FSetInterface.cmi Datatypes.cmi Bool.cmi \
- BinPos.cmi Lattice.cmi
-Lattice.cmx: Specif.cmx Maps.cmx FSetInterface.cmx Datatypes.cmx Bool.cmx \
- BinPos.cmx Lattice.cmi
-Linearize.cmo: Specif.cmi OrderedType.cmi Ordered.cmi Op.cmi Maps.cmi \
- ../caml/Linearizeaux.cmo Lattice.cmi LTLin.cmi LTL.cmi Kildall.cmi \
- FSetAVL.cmi Errors.cmi Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi \
- BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi Linearize.cmi
-Linearize.cmx: Specif.cmx OrderedType.cmx Ordered.cmx Op.cmx Maps.cmx \
- ../caml/Linearizeaux.cmx Lattice.cmx LTLin.cmx LTL.cmx Kildall.cmx \
- FSetAVL.cmx Errors.cmx Datatypes.cmx Coqlib.cmx CString.cmx CList.cmx \
- BinPos.cmx BinInt.cmx Ascii.cmx AST.cmx Linearize.cmi
-Linear.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi Linear.cmi
-Linear.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Locations.cmx Integers.cmx \
- Globalenvs.cmx Datatypes.cmx Coqlib.cmx Conventions.cmx CList.cmx \
- BinPos.cmx BinInt.cmx AST.cmx Linear.cmi
-Locations.cmo: Values.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi \
- BinInt.cmi AST.cmi Locations.cmi
-Locations.cmx: Values.cmx Specif.cmx Datatypes.cmx Coqlib.cmx BinPos.cmx \
- BinInt.cmx AST.cmx Locations.cmi
-Logic.cmo: Logic.cmi
-Logic.cmx: Logic.cmi
-LTLin.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi LTLin.cmi
-LTLin.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Locations.cmx Integers.cmx \
- Globalenvs.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
- AST.cmx LTLin.cmi
-LTL.cmo: Values.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Locations.cmi \
- Integers.cmi Globalenvs.cmi Datatypes.cmi Conventions.cmi CList.cmi \
- BinPos.cmi BinInt.cmi AST.cmi LTL.cmi
-LTL.cmx: Values.cmx Specif.cmx Op.cmx Mem.cmx Maps.cmx Locations.cmx \
- Integers.cmx Globalenvs.cmx Datatypes.cmx Conventions.cmx CList.cmx \
- BinPos.cmx BinInt.cmx AST.cmx LTL.cmi
-Mach.cmo: Values.cmi Specif.cmi Op.cmi Maps.cmi Locations.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi Mach.cmi
-Mach.cmx: Values.cmx Specif.cmx Op.cmx Maps.cmx Locations.cmx Integers.cmx \
- Globalenvs.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
- AST.cmx Mach.cmi
-Main.cmo: Tunneling.cmi Stacking.cmi Selection.cmi Reload.cmi RTLgen.cmi \
- RTL.cmi PPCgen.cmi PPC.cmi Linearize.cmi Errors.cmi Datatypes.cmi \
- Ctyping.cmi Csyntax.cmi Cshmgen.cmi Constprop.cmi Cminorgen.cmi \
- Cminor.cmi CString.cmi CSE.cmi Ascii.cmi Allocation.cmi AST.cmi Main.cmi
-Main.cmx: Tunneling.cmx Stacking.cmx Selection.cmx Reload.cmx RTLgen.cmx \
- RTL.cmx PPCgen.cmx PPC.cmx Linearize.cmx Errors.cmx Datatypes.cmx \
- Ctyping.cmx Csyntax.cmx Cshmgen.cmx Constprop.cmx Cminorgen.cmx \
- Cminor.cmx CString.cmx CSE.cmx Ascii.cmx Allocation.cmx AST.cmx Main.cmi
-Maps.cmo: Specif.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinNat.cmi \
- BinInt.cmi Maps.cmi
-Maps.cmx: Specif.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinNat.cmx \
- BinInt.cmx Maps.cmi
-Mem.cmo: Zmax.cmi Values.cmi Specif.cmi Integers.cmi Datatypes.cmi Coqlib.cmi \
- CList.cmi BinPos.cmi BinInt.cmi AST.cmi Mem.cmi
-Mem.cmx: Zmax.cmx Values.cmx Specif.cmx Integers.cmx Datatypes.cmx Coqlib.cmx \
- CList.cmx BinPos.cmx BinInt.cmx AST.cmx Mem.cmi
-Op.cmo: Values.cmi Specif.cmi Mem.cmi Integers.cmi Globalenvs.cmi Floats.cmi \
- Datatypes.cmi CList.cmi Bool.cmi BinPos.cmi BinInt.cmi AST.cmi Op.cmi
-Op.cmx: Values.cmx Specif.cmx Mem.cmx Integers.cmx Globalenvs.cmx Floats.cmx \
- Datatypes.cmx CList.cmx Bool.cmx BinPos.cmx BinInt.cmx AST.cmx Op.cmi
-Ordered.cmo: Specif.cmi OrderedType.cmi Maps.cmi Datatypes.cmi Coqlib.cmi \
- BinPos.cmi Ordered.cmi
-Ordered.cmx: Specif.cmx OrderedType.cmx Maps.cmx Datatypes.cmx Coqlib.cmx \
- BinPos.cmx Ordered.cmi
-OrderedType.cmo: Specif.cmi Datatypes.cmi OrderedType.cmi
-OrderedType.cmx: Specif.cmx Datatypes.cmx OrderedType.cmi
-Parallelmove.cmo: Parmov.cmi Locations.cmi Datatypes.cmi CList.cmi AST.cmi \
- Parallelmove.cmi
-Parallelmove.cmx: Parmov.cmx Locations.cmx Datatypes.cmx CList.cmx AST.cmx \
- Parallelmove.cmi
-Parmov.cmo: Specif.cmi Peano.cmi Datatypes.cmi CList.cmi Parmov.cmi
-Parmov.cmx: Specif.cmx Peano.cmx Datatypes.cmx CList.cmx Parmov.cmi
-Peano.cmo: Datatypes.cmi Peano.cmi
-Peano.cmx: Datatypes.cmx Peano.cmi
-PPCgen.cmo: Specif.cmi PPC.cmi Op.cmi Mach.cmi Locations.cmi Integers.cmi \
- Errors.cmi Datatypes.cmi Coqlib.cmi CString.cmi CList.cmi Bool.cmi \
- BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi PPCgen.cmi
-PPCgen.cmx: Specif.cmx PPC.cmx Op.cmx Mach.cmx Locations.cmx Integers.cmx \
- Errors.cmx Datatypes.cmx Coqlib.cmx CString.cmx CList.cmx Bool.cmx \
- BinPos.cmx BinInt.cmx Ascii.cmx AST.cmx PPCgen.cmi
-PPC.cmo: Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi Globalenvs.cmi \
- Floats.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
- AST.cmi PPC.cmi
-PPC.cmx: Values.cmx Specif.cmx Mem.cmx Maps.cmx Integers.cmx Globalenvs.cmx \
- Floats.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
- AST.cmx PPC.cmi
-Registers.cmo: Specif.cmi OrderedType.cmi Ordered.cmi Maps.cmi FSetAVL.cmi \
- Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
- Registers.cmi
-Registers.cmx: Specif.cmx OrderedType.cmx Ordered.cmx Maps.cmx FSetAVL.cmx \
- Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
- Registers.cmi
-Reload.cmo: Specif.cmi Parallelmove.cmi Op.cmi Locations.cmi Linear.cmi \
- LTLin.cmi Integers.cmi Datatypes.cmi Conventions.cmi CList.cmi AST.cmi \
- Reload.cmi
-Reload.cmx: Specif.cmx Parallelmove.cmx Op.cmx Locations.cmx Linear.cmx \
- LTLin.cmx Integers.cmx Datatypes.cmx Conventions.cmx CList.cmx AST.cmx \
- Reload.cmi
-RTLgen.cmo: Switch.cmi Specif.cmi Registers.cmi ../caml/RTLgenaux.cmo RTL.cmi \
- Op.cmi Maps.cmi Integers.cmi Errors.cmi Datatypes.cmi Coqlib.cmi \
- CminorSel.cmi Cminor.cmi CString.cmi CList.cmi BinPos.cmi Ascii.cmi \
- AST.cmi RTLgen.cmi
-RTLgen.cmx: Switch.cmx Specif.cmx Registers.cmx ../caml/RTLgenaux.cmx RTL.cmx \
- Op.cmx Maps.cmx Integers.cmx Errors.cmx Datatypes.cmx Coqlib.cmx \
- CminorSel.cmx Cminor.cmx CString.cmx CList.cmx BinPos.cmx Ascii.cmx \
- AST.cmx RTLgen.cmi
-RTL.cmo: Values.cmi Registers.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
- Globalenvs.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
- RTL.cmi
-RTL.cmx: Values.cmx Registers.cmx Op.cmx Mem.cmx Maps.cmx Integers.cmx \
- Globalenvs.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
- RTL.cmi
-RTLtyping.cmo: Specif.cmi Registers.cmi ../caml/RTLtypingaux.cmo RTL.cmi \
- Op.cmi Maps.cmi Errors.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
- CString.cmi CList.cmi Ascii.cmi AST.cmi RTLtyping.cmi
-RTLtyping.cmx: Specif.cmx Registers.cmx ../caml/RTLtypingaux.cmx RTL.cmx \
- Op.cmx Maps.cmx Errors.cmx Datatypes.cmx Coqlib.cmx Conventions.cmx \
- CString.cmx CList.cmx Ascii.cmx AST.cmx RTLtyping.cmi
-Selection.cmo: Specif.cmi Op.cmi Integers.cmi Datatypes.cmi Compare_dec.cmi \
- CminorSel.cmi Cminor.cmi ../caml/Clflags.cmo CList.cmi BinPos.cmi \
- BinInt.cmi AST.cmi Selection.cmi
-Selection.cmx: Specif.cmx Op.cmx Integers.cmx Datatypes.cmx Compare_dec.cmx \
- CminorSel.cmx Cminor.cmx ../caml/Clflags.cmx CList.cmx BinPos.cmx \
- BinInt.cmx AST.cmx Selection.cmi
-Setoid.cmo: Datatypes.cmi Setoid.cmi
-Setoid.cmx: Datatypes.cmx Setoid.cmi
-Specif.cmo: Datatypes.cmi Specif.cmi
-Specif.cmx: Datatypes.cmx Specif.cmi
-Stacking.cmo: Specif.cmi Op.cmi Mach.cmi Locations.cmi Linear.cmi \
- Integers.cmi Errors.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
- CString.cmi CList.cmi Bounds.cmi BinPos.cmi BinInt.cmi Ascii.cmi AST.cmi \
- Stacking.cmi
-Stacking.cmx: Specif.cmx Op.cmx Mach.cmx Locations.cmx Linear.cmx \
- Integers.cmx Errors.cmx Datatypes.cmx Coqlib.cmx Conventions.cmx \
- CString.cmx CList.cmx Bounds.cmx BinPos.cmx BinInt.cmx Ascii.cmx AST.cmx \
- Stacking.cmi
-Sumbool.cmo: Specif.cmi Datatypes.cmi Sumbool.cmi
-Sumbool.cmx: Specif.cmx Datatypes.cmx Sumbool.cmi
-Switch.cmo: Specif.cmi Integers.cmi EqNat.cmi Datatypes.cmi Coqlib.cmi \
- CList.cmi BinPos.cmi BinInt.cmi Switch.cmi
-Switch.cmx: Specif.cmx Integers.cmx EqNat.cmx Datatypes.cmx Coqlib.cmx \
- CList.cmx BinPos.cmx BinInt.cmx Switch.cmi
-Tunneling.cmo: Maps.cmi LTL.cmi Datatypes.cmi AST.cmi Tunneling.cmi
-Tunneling.cmx: Maps.cmx LTL.cmx Datatypes.cmx AST.cmx Tunneling.cmi
-Values.cmo: Specif.cmi Integers.cmi Floats.cmi Datatypes.cmi Coqlib.cmi \
- BinPos.cmi BinInt.cmi AST.cmi Values.cmi
-Values.cmx: Specif.cmx Integers.cmx Floats.cmx Datatypes.cmx Coqlib.cmx \
- BinPos.cmx BinInt.cmx AST.cmx Values.cmi
-Wf.cmo: Wf.cmi
-Wf.cmx: Wf.cmi
-ZArith_dec.cmo: Sumbool.cmi Specif.cmi Datatypes.cmi BinInt.cmi \
- ZArith_dec.cmi
-ZArith_dec.cmx: Sumbool.cmx Specif.cmx Datatypes.cmx BinInt.cmx \
- ZArith_dec.cmi
-Zbool.cmo: Zeven.cmi ZArith_dec.cmi Sumbool.cmi Specif.cmi Datatypes.cmi \
- BinInt.cmi Zbool.cmi
-Zbool.cmx: Zeven.cmx ZArith_dec.cmx Sumbool.cmx Specif.cmx Datatypes.cmx \
- BinInt.cmx Zbool.cmi
-Zdiv.cmo: Zbool.cmi ZArith_dec.cmi Specif.cmi Datatypes.cmi BinPos.cmi \
- BinInt.cmi Zdiv.cmi
-Zdiv.cmx: Zbool.cmx ZArith_dec.cmx Specif.cmx Datatypes.cmx BinPos.cmx \
- BinInt.cmx Zdiv.cmi
-Zeven.cmo: Specif.cmi Datatypes.cmi BinPos.cmi BinInt.cmi Zeven.cmi
-Zeven.cmx: Specif.cmx Datatypes.cmx BinPos.cmx BinInt.cmx Zeven.cmi
-Zmax.cmo: Datatypes.cmi BinInt.cmi Zmax.cmi
-Zmax.cmx: Datatypes.cmx BinInt.cmx Zmax.cmi
-Zmisc.cmo: Datatypes.cmi BinPos.cmi BinInt.cmi Zmisc.cmi
-Zmisc.cmx: Datatypes.cmx BinPos.cmx BinInt.cmx Zmisc.cmi
-Zpower.cmo: Zmisc.cmi Datatypes.cmi BinPos.cmi BinInt.cmi Zpower.cmi
-Zpower.cmx: Zmisc.cmx Datatypes.cmx BinPos.cmx BinInt.cmx Zpower.cmi
diff --git a/extraction/Kildall.ml.patch b/extraction/Kildall.ml.patch
index a5b7bc93b636c04ec5347b46d7b4ce83e13b4588..453d40ce8c68cb1b49c1bf973fcf8b219655413b 100644
--- a/extraction/Kildall.ml.patch
+++ b/extraction/Kildall.ml.patch
@@ -1,5 +1,5 @@
-*** Kildall.ml.orig 2006-09-11 13:50:56.266682206 +0200
---- Kildall.ml 2006-09-11 14:29:50.392200227 +0200
+*** kildall.ml.orig 2006-09-11 13:50:56.266682206 +0200
+--- kildall.ml 2006-09-11 14:29:50.392200227 +0200
***************
*** 163,171 ****
Maps.PMap.t option **)
diff --git a/extraction/Makefile b/extraction/Makefile
index 044f89f04e98794edf3ce076a43b01d9ab37583b..d4163bb3b767f91bc32f74bbf82d5e20f3e4d142 100644
--- a/extraction/Makefile
+++ b/extraction/Makefile
@@ -12,66 +12,15 @@
include ../Makefile.config
-FILES=\
- Datatypes.ml Logic.ml Wf.ml Peano.ml Specif.ml Compare_dec.ml EqNat.ml \
- Bool.ml CList.ml Sumbool.ml Setoid.ml BinPos.ml BinNat.ml BinInt.ml \
- ZArith_dec.ml Zeven.ml Zmax.ml Zmisc.ml Zbool.ml Zpower.ml Zdiv.ml \
- Ascii.ml CString.ml \
- OrderedType.ml FSetInterface.ml FSetFacts.ml FSetList.ml \
- CInt.ml FSetAVL.ml \
- Coqlib.ml Maps.ml Ordered.ml Errors.ml AST.ml Iteration.ml Integers.ml \
- ../caml/Camlcoq.ml ../caml/Floataux.ml Floats.ml Parmov.ml Values.ml \
- Mem.ml Globalenvs.ml \
- ../caml/Clflags.ml \
- Csyntax.ml Ctyping.ml Cminor.ml Csharpminor.ml Cshmgen.ml \
- Cminorgen.ml \
- Op.ml CminorSel.ml \
- Selection.ml \
- Registers.ml RTL.ml \
- Switch.ml ../caml/RTLgenaux.ml RTLgen.ml \
- Locations.ml Conventions.ml \
- ../caml/RTLtypingaux.ml RTLtyping.ml \
- Lattice.ml Kildall.ml \
- Constprop.ml CSE.ml \
- LTL.ml LTLin.ml \
- InterfGraph.ml ../caml/Coloringaux.ml Coloring.ml \
- Allocation.ml \
- Tunneling.ml Linear.ml ../caml/Linearizeaux.ml Linearize.ml \
- Parallelmove.ml Reload.ml \
- Mach.ml Bounds.ml Stacking.ml \
- PPC.ml PPCgen.ml \
- Main.ml \
- ../caml/PrintCsyntax.ml ../caml/Cil2Csyntax.ml \
- ../caml/CMparser.ml ../caml/CMlexer.ml ../caml/CMtypecheck.ml \
- ../caml/PrintPPC.ml \
- ../caml/Configuration.ml ../caml/Driver.ml
+DIRS=lib common $(ARCH)/$(VARIANT) $(ARCH) backend cfrontend driver
-EXTRACTEDFILES:=$(filter-out ../caml/%, $(FILES))
-GENFILES:=$(EXTRACTEDFILES) $(EXTRACTEDFILES:.ml=.mli)
-
-CAMLINCL=-I ../caml -I ../cil/obj/$(ARCHOS)
-OCAMLC=ocamlc -g $(CAMLINCL)
-OCAMLOPT=ocamlopt $(CAMLINCL)
-OCAMLDEP=ocamldep $(CAMLINCL)
-OCAMLLIBS=unix.cma str.cma cil.cma
-
-COQINCL=-I ../lib -I ../common -I ../backend -I ../cfrontend
+COQINCL=$(patsubst %,-I ../%,$(DIRS))
COQEXEC=coqtop $(COQINCL) -batch -load-vernac-source
-executables: ../ccomp ../ccomp.byt
-
-../ccomp.byt: $(FILES:.ml=.cmo)
- $(OCAMLC) -o ../ccomp.byt $(OCAMLLIBS) $(FILES:.ml=.cmo)
-clean::
- rm -f ../ccomp.byt
-
-../ccomp: $(FILES:.ml=.cmx)
- $(OCAMLOPT) -o ../ccomp $(OCAMLLIBS:.cma=.cmxa) $(FILES:.ml=.cmx)
-clean::
- rm -f ../ccomp
+all: Configuration.ml extraction
extraction:
- @rm -f $(GENFILES)
+ rm -f [:lower:]*.mli [:lower:]*.ml
$(COQEXEC) extraction.v
@echo "Fixing file names..."
@mv list.ml CList.ml
@@ -80,61 +29,19 @@ extraction:
@mv string.mli CString.mli
@mv int.ml CInt.ml
@mv int.mli CInt.mli
- @for i in $(GENFILES); do \
- j=`./uncapitalize $$i`; \
- test -f $$i || (test -f $$j && mv $$j $$i); \
- done
@echo "Conversion List -> CList, String -> CString, Int -> CInt..."
- @./convert $(GENFILES)
+ @./convert *.mli *.ml
@echo "Patching files..."
@for i in *.patch; do patch < $$i; done
-../caml/CMparser.ml ../caml/CMparser.mli: ../caml/CMparser.mly
- ocamlyacc -v ../caml/CMparser.mly
-
-beforedepend:: ../caml/CMparser.ml ../caml/CMparser.mli
-clean::
- rm -f ../caml/CMparser.ml ../caml/CMparser.mli ../caml/CMparser.output
-
-../caml/CMlexer.ml: ../caml/CMlexer.mll
- ocamllex ../caml/CMlexer.mll
-
-beforedepend:: ../caml/CMlexer.ml
-clean::
- rm -f ../caml/CMlexer.ml
-
-../caml/Configuration.ml: ../Makefile.config
+Configuration.ml: ../Makefile.config
(echo 'let stdlib_path = "$(LIBDIR)"'; \
echo 'let prepro = "$(CPREPRO)"'; \
echo 'let asm = "$(CASM)"'; \
- echo 'let linker = "$(CLINKER)"') \
- > ../caml/Configuration.ml
-
-beforedepend:: ../caml/Configuration.ml
-clean::
- rm -f ../caml/Configuration.ml
-
-.SUFFIXES: .ml .mli .cmo .cmi .cmx
-
-.mli.cmi:
- $(OCAMLC) -c $*.mli
-.ml.cmo:
- $(OCAMLC) -c $*.ml
-.ml.cmx:
- $(OCAMLOPT) -c $*.ml
-
-clean::
- rm -f $(GENFILES)
- rm -f *.cm? *.o
- cd ../caml && rm -f *.cm? *.o
-
-depend: beforedepend
- $(OCAMLDEP) ../caml/*.mli ../caml/*.ml *.mli *.ml > .depend
-
-install:
- install -d $(BINDIR)
- install ../ccomp ../ccomp.byt $(BINDIR)
-
-include .depend
-
+ echo 'let linker = "$(CLINKER)"'; \
+ echo 'let arch = "$(ARCH)"'; \
+ echo 'let variant = "$(VARIANT)"') \
+ > Configuration.ml
+clean:
+ rm -f *.mli *.ml
diff --git a/extraction/extraction.v b/extraction/extraction.v
index cdb1fd636eccddc0eeee92c45859ecd6fcdbaea4..58da9c0615db528aa90fc0ab5c098bbf38af641b 100644
--- a/extraction/extraction.v
+++ b/extraction/extraction.v
@@ -16,7 +16,7 @@ Require Floats.
Require RTLgen.
Require Coloring.
Require Allocation.
-Require Main.
+Require Compiler.
(* Standard lib *)
Extract Inductive unit => "unit" [ "()" ].
@@ -68,16 +68,18 @@ Extract Constant Coloring.graph_coloring => "Coloringaux.graph_coloring".
(* Linearize *)
Extract Constant Linearize.enumerate_aux => "Linearizeaux.enumerate_aux".
-(* PPC *)
-Extract Constant PPC.low_half => "fun _ -> assert false".
-Extract Constant PPC.high_half => "fun _ -> assert false".
+(* Asm *)
+Extract Constant Asm.low_half => "fun _ -> assert false".
+Extract Constant Asm.high_half => "fun _ -> assert false".
(* Suppression of stupidly big equality functions *)
-Extract Constant CSE.eq_rhs => "fun (x: rhs) (y: rhs) -> x = y".
-Extract Constant Locations.mreg_eq => "fun (x: mreg) (y: mreg) -> x = y".
-Extract Constant PPC.ireg_eq => "fun (x: ireg) (y: ireg) -> x = y".
-Extract Constant PPC.freg_eq => "fun (x: freg) (y: freg) -> x = y".
-Extract Constant PPC.preg_eq => "fun (x: preg) (y: preg) -> x = y".
+Extract Constant Op.eq_operation => "fun (x: operation) (y: operation) -> x = y".
+Extract Constant Op.eq_addressing => "fun (x: addressing) (y: addressing) -> x = y".
+(*Extract Constant CSE.eq_rhs => "fun (x: rhs) (y: rhs) -> x = y".*)
+Extract Constant Machregs.mreg_eq => "fun (x: mreg) (y: mreg) -> x = y".
+Extract Constant Asm.ireg_eq => "fun (x: ireg) (y: ireg) -> x = y".
+Extract Constant Asm.freg_eq => "fun (x: freg) (y: freg) -> x = y".
+Extract Constant Asm.preg_eq => "fun (x: preg) (y: preg) -> x = y".
(* Go! *)
-Recursive Extraction Library Main.
+Recursive Extraction Library Compiler.
diff --git a/caml/Camlcoq.ml b/lib/Camlcoq.ml
similarity index 100%
rename from caml/Camlcoq.ml
rename to lib/Camlcoq.ml
diff --git a/caml/Floataux.ml b/lib/Floataux.ml
similarity index 100%
rename from caml/Floataux.ml
rename to lib/Floataux.ml
diff --git a/backend/PPC.v b/powerpc/Asm.v
similarity index 92%
rename from backend/PPC.v
rename to powerpc/Asm.v
index e47cba012db6e9d86df72f2d74f147e6cf234efa..7be155bf32adbddfc5db67b37945ce66c45c6dc1 100644
--- a/backend/PPC.v
+++ b/powerpc/Asm.v
@@ -22,6 +22,9 @@ Require Import Mem.
Require Import Events.
Require Import Globalenvs.
Require Import Smallstep.
+Require Import Locations.
+Require Stacklayout.
+Require Conventions.
(** * Abstract syntax *)
@@ -754,45 +757,79 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome
OK (nextinstr rs) m
end.
-(** Calling conventions for external functions. These are compatible with
- the calling conventions in module [Conventions], except that
+(** Translation of the LTL/Linear/Mach view of machine registers
+ to the PPC view. PPC has two different types for registers
+ (integer and float) while LTL et al have only one. The
+ [ireg_of] and [freg_of] are therefore partial in principle.
+ To keep things simpler, we make them return nonsensical
+ results when applied to a LTL register of the wrong type.
+ The proof in [Asmgenproof] will show that this never happens.
+
+ Note that no LTL register maps to [GPR12] nor [FPR13].
+ These two registers are reserved as temporaries, to be used
+ by the generated PPC code. *)
+
+Definition ireg_of (r: mreg) : ireg :=
+ match r with
+ | R3 => GPR3 | R4 => GPR4 | R5 => GPR5 | R6 => GPR6
+ | R7 => GPR7 | R8 => GPR8 | R9 => GPR9 | R10 => GPR10
+ | R13 => GPR13 | R14 => GPR14 | R15 => GPR15 | R16 => GPR16
+ | R17 => GPR17 | R18 => GPR18 | R19 => GPR19 | R20 => GPR20
+ | R21 => GPR21 | R22 => GPR22 | R23 => GPR23 | R24 => GPR24
+ | R25 => GPR25 | R26 => GPR26 | R27 => GPR27 | R28 => GPR28
+ | R29 => GPR29 | R30 => GPR30 | R31 => GPR31
+ | IT1 => GPR11 | IT2 => GPR0
+ | _ => GPR0 (* should not happen *)
+ end.
+
+Definition freg_of (r: mreg) : freg :=
+ match r with
+ | F1 => FPR1 | F2 => FPR2 | F3 => FPR3 | F4 => FPR4
+ | F5 => FPR5 | F6 => FPR6 | F7 => FPR7 | F8 => FPR8
+ | F9 => FPR9 | F10 => FPR10 | F14 => FPR14 | F15 => FPR15
+ | F16 => FPR16 | F17 => FPR17 | F18 => FPR18 | F19 => FPR19
+ | F20 => FPR20 | F21 => FPR21 | F22 => FPR22 | F23 => FPR23
+ | F24 => FPR24 | F25 => FPR25 | F26 => FPR26 | F27 => FPR27
+ | F28 => FPR28 | F29 => FPR29 | F30 => FPR30 | F31 => FPR31
+ | FT1 => FPR0 | FT2 => FPR11 | FT3 => FPR12
+ | _ => FPR0 (* should not happen *)
+ end.
+
+Definition preg_of (r: mreg) :=
+ match mreg_type r with
+ | Tint => IR (ireg_of r)
+ | Tfloat => FR (freg_of r)
+ end.
+
+(** Extract the values of the arguments of an external call.
+ We exploit the calling conventions from module [Conventions], except that
we use PPC registers instead of locations. *)
-Inductive extcall_args (rs: regset) (m: mem):
- list typ -> list ireg -> list freg -> Z -> list val -> Prop :=
- | extcall_args_nil: forall irl frl ofs,
- extcall_args rs m nil irl frl ofs nil
- | extcall_args_int_reg: forall tyl ir1 irl frl ofs v1 vl,
- v1 = rs (IR ir1) ->
- extcall_args rs m tyl irl frl ofs vl ->
- extcall_args rs m (Tint :: tyl) (ir1 :: irl) frl ofs (v1 :: vl)
- | extcall_args_int_stack: forall tyl frl ofs v1 vl,
- Mem.loadv Mint32 m (Val.add (rs (IR GPR1)) (Vint (Int.repr ofs))) = Some v1 ->
- extcall_args rs m tyl nil frl (ofs + 4) vl ->
- extcall_args rs m (Tint :: tyl) nil frl ofs (v1 :: vl)
- | extcall_args_float_reg: forall tyl irl fr1 frl ofs v1 vl,
- v1 = rs (FR fr1) ->
- extcall_args rs m tyl (list_drop2 irl) frl ofs vl ->
- extcall_args rs m (Tfloat :: tyl) irl (fr1 :: frl) ofs (v1 :: vl)
- | extcall_args_float_stack: forall tyl irl ofs v1 vl,
- Mem.loadv Mfloat64 m (Val.add (rs (IR GPR1)) (Vint (Int.repr ofs))) = Some v1 ->
- extcall_args rs m tyl irl nil (ofs + 8) vl ->
- extcall_args rs m (Tfloat :: tyl) irl nil ofs (v1 :: vl).
+Inductive extcall_arg (rs: regset) (m: mem): loc -> val -> Prop :=
+ | extcall_arg_reg: forall r,
+ extcall_arg rs m (R r) (rs (preg_of r))
+ | extcall_arg_int_stack: forall ofs bofs v,
+ bofs = Stacklayout.fe_ofs_arg + 4 * ofs ->
+ Mem.loadv Mint32 m (Val.add (rs (IR GPR1)) (Vint (Int.repr bofs))) = Some v ->
+ extcall_arg rs m (S (Outgoing ofs Tint)) v
+ | extcall_arg_float_stack: forall ofs bofs v,
+ bofs = Stacklayout.fe_ofs_arg + 4 * ofs ->
+ Mem.loadv Mfloat64 m (Val.add (rs (IR GPR1)) (Vint (Int.repr bofs))) = Some v ->
+ extcall_arg rs m (S (Outgoing ofs Tfloat)) v.
+
+Inductive extcall_args (rs: regset) (m: mem): list loc -> list val -> Prop :=
+ | extcall_args_nil:
+ extcall_args rs m nil nil
+ | extcall_args_cons: forall l1 ll v1 vl,
+ extcall_arg rs m l1 v1 -> extcall_args rs m ll vl ->
+ extcall_args rs m (l1 :: ll) (v1 :: vl).
Definition extcall_arguments
(rs: regset) (m: mem) (sg: signature) (args: list val) : Prop :=
- extcall_args rs m
- sg.(sig_args)
- (GPR3 :: GPR4 :: GPR5 :: GPR6 :: GPR7 :: GPR8 :: GPR9 :: GPR10 :: nil)
- (FPR1 :: FPR2 :: FPR3 :: FPR4 :: FPR5 :: FPR6 :: FPR7 :: FPR8 :: FPR9 :: FPR10 :: nil)
- 56 args.
-
-Definition loc_external_result (s: signature) : preg :=
- match s.(sig_res) with
- | None => GPR3
- | Some Tint => GPR3
- | Some Tfloat => FPR1
- end.
+ extcall_args rs m (Conventions.loc_arguments sg) args.
+
+Definition loc_external_result (sg: signature) : preg :=
+ preg_of (Conventions.loc_result sg).
(** Execution of the instruction at [rs#PC]. *)
diff --git a/backend/PPCgen.v b/powerpc/Asmgen.v
similarity index 90%
rename from backend/PPCgen.v
rename to powerpc/Asmgen.v
index faedcb1c8e20f59ea18192fbb90ca608cf726632..2ddaa6d09fba9828a386872f669fdac13d5ad0db 100644
--- a/backend/PPCgen.v
+++ b/powerpc/Asmgen.v
@@ -24,47 +24,9 @@ Require Import Globalenvs.
Require Import Op.
Require Import Locations.
Require Import Mach.
-Require Import PPC.
-
-(** Translation of the LTL/Linear/Mach view of machine registers
- to the PPC view. PPC has two different types for registers
- (integer and float) while LTL et al have only one. The
- [ireg_of] and [freg_of] are therefore partial in principle.
- To keep things simpler, we make them return nonsensical
- results when applied to a LTL register of the wrong type.
- The proof in [PPCgenproof] will show that this never happens.
-
- Note that no LTL register maps to [GPR12] nor [FPR13].
- These two registers are reserved as temporaries, to be used
- by the generated PPC code. *)
-
-Definition ireg_of (r: mreg) : ireg :=
- match r with
- | R3 => GPR3 | R4 => GPR4 | R5 => GPR5 | R6 => GPR6
- | R7 => GPR7 | R8 => GPR8 | R9 => GPR9 | R10 => GPR10
- | R13 => GPR13 | R14 => GPR14 | R15 => GPR15 | R16 => GPR16
- | R17 => GPR17 | R18 => GPR18 | R19 => GPR19 | R20 => GPR20
- | R21 => GPR21 | R22 => GPR22 | R23 => GPR23 | R24 => GPR24
- | R25 => GPR25 | R26 => GPR26 | R27 => GPR27 | R28 => GPR28
- | R29 => GPR29 | R30 => GPR30 | R31 => GPR31
- | IT1 => GPR11 | IT2 => GPR0
- | _ => GPR0 (* should not happen *)
- end.
-
-Definition freg_of (r: mreg) : freg :=
- match r with
- | F1 => FPR1 | F2 => FPR2 | F3 => FPR3 | F4 => FPR4
- | F5 => FPR5 | F6 => FPR6 | F7 => FPR7 | F8 => FPR8
- | F9 => FPR9 | F10 => FPR10 | F14 => FPR14 | F15 => FPR15
- | F16 => FPR16 | F17 => FPR17 | F18 => FPR18 | F19 => FPR19
- | F20 => FPR20 | F21 => FPR21 | F22 => FPR22 | F23 => FPR23
- | F24 => FPR24 | F25 => FPR25 | F26 => FPR26 | F27 => FPR27
- | F28 => FPR28 | F29 => FPR29 | F30 => FPR30 | F31 => FPR31
- | FT1 => FPR0 | FT2 => FPR11 | FT3 => FPR12
- | _ => FPR0 (* should not happen *)
- end.
+Require Import Asm.
-(** Decomposition of integer constants. As noted in file [PPC],
+(** Decomposition of integer constants. As noted in file [Asm],
immediate arguments to PowerPC instructions must fit into 16 bits,
and are interpreted after zero extension, sign extension, or
left shift by 16 bits, depending on the instruction. Integer
@@ -534,15 +496,15 @@ Fixpoint code_size (c: code) : Z :=
Open Local Scope string_scope.
-Definition transf_function (f: Mach.function) : res PPC.code :=
+Definition transf_function (f: Mach.function) : res Asm.code :=
let c := transl_function f in
if zlt Int.max_unsigned (code_size c)
then Errors.Error (msg "code size exceeded")
else Errors.OK c.
-Definition transf_fundef (f: Mach.fundef) : res PPC.fundef :=
+Definition transf_fundef (f: Mach.fundef) : res Asm.fundef :=
transf_partial_fundef transf_function f.
-Definition transf_program (p: Mach.program) : res PPC.program :=
+Definition transf_program (p: Mach.program) : res Asm.program :=
transform_partial_program transf_fundef p.
diff --git a/backend/PPCgenproof.v b/powerpc/Asmgenproof.v
similarity index 98%
rename from backend/PPCgenproof.v
rename to powerpc/Asmgenproof.v
index 6db8b4776a135a94255d2164908767967d85aa30..980925bda9c7da2b2705e458576380b3792a1777 100644
--- a/backend/PPCgenproof.v
+++ b/powerpc/Asmgenproof.v
@@ -28,15 +28,15 @@ Require Import Locations.
Require Import Mach.
Require Import Machconcr.
Require Import Machtyping.
-Require Import PPC.
-Require Import PPCgen.
-Require Import PPCgenretaddr.
-Require Import PPCgenproof1.
+Require Import Asm.
+Require Import Asmgen.
+Require Import Asmgenretaddr.
+Require Import Asmgenproof1.
Section PRESERVATION.
Variable prog: Mach.program.
-Variable tprog: PPC.program.
+Variable tprog: Asm.program.
Hypothesis TRANSF: transf_program prog = Errors.OK tprog.
Let ge := Genv.globalenv prog.
@@ -628,7 +628,7 @@ Inductive match_stack: list Machconcr.stackframe -> Prop :=
match_stack s ->
match_stack (Stackframe fb sp ra c :: s).
-Inductive match_states: Machconcr.state -> PPC.state -> Prop :=
+Inductive match_states: Machconcr.state -> Asm.state -> Prop :=
| match_states_intro:
forall s fb sp c ms m rs f
(STACKS: match_stack s)
@@ -638,7 +638,7 @@ Inductive match_states: Machconcr.state -> PPC.state -> Prop :=
(AT: transl_code_at_pc (rs PC) fb f c)
(AG: agree ms sp rs),
match_states (Machconcr.State s fb sp c ms m)
- (PPC.State rs m)
+ (Asm.State rs m)
| match_states_call:
forall s fb ms m rs
(STACKS: match_stack s)
@@ -646,14 +646,14 @@ Inductive match_states: Machconcr.state -> PPC.state -> Prop :=
(ATPC: rs PC = Vptr fb Int.zero)
(ATLR: rs LR = parent_ra s),
match_states (Machconcr.Callstate s fb ms m)
- (PPC.State rs m)
+ (Asm.State rs m)
| match_states_return:
forall s ms m rs
(STACKS: match_stack s)
(AG: agree ms (parent_sp s) rs)
(ATPC: rs PC = parent_ra s),
match_states (Machconcr.Returnstate s ms m)
- (PPC.State rs m).
+ (Asm.State rs m).
Lemma exec_straight_steps:
forall s fb sp m1 f c1 rs1 c2 m2 ms2,
@@ -1316,8 +1316,8 @@ Proof.
m); split.
apply plus_one. eapply exec_step_external; eauto.
eapply extcall_arguments_match; eauto.
- econstructor; eauto.
- rewrite loc_external_result_match. auto with ppcgen.
+ econstructor; eauto.
+ unfold loc_external_result. auto with ppcgen.
Qed.
Lemma exec_return_prop:
@@ -1356,7 +1356,7 @@ Proof
Lemma transf_initial_states:
forall st1, Machconcr.initial_state prog st1 ->
- exists st2, PPC.initial_state tprog st2 /\ match_states st1 st2.
+ exists st2, Asm.initial_state tprog st2 /\ match_states st1 st2.
Proof.
intros. inversion H. unfold ge0 in *.
econstructor; split.
@@ -1373,17 +1373,18 @@ Qed.
Lemma transf_final_states:
forall st1 st2 r,
- match_states st1 st2 -> Machconcr.final_state st1 r -> PPC.final_state st2 r.
+ match_states st1 st2 -> Machconcr.final_state st1 r -> Asm.final_state st2 r.
Proof.
intros. inv H0. inv H. constructor. auto.
+ compute in H1.
rewrite (ireg_val _ _ _ R3 AG) in H1. auto. auto.
Qed.
Theorem transf_program_correct:
forall (beh: program_behavior),
- Machconcr.exec_program prog beh -> PPC.exec_program tprog beh.
+ Machconcr.exec_program prog beh -> Asm.exec_program tprog beh.
Proof.
- unfold Machconcr.exec_program, PPC.exec_program; intros.
+ unfold Machconcr.exec_program, Asm.exec_program; intros.
eapply simulation_star_preservation with (measure := measure); eauto.
eexact transf_initial_states.
eexact transf_final_states.
diff --git a/backend/PPCgenproof1.v b/powerpc/Asmgenproof1.v
similarity index 95%
rename from backend/PPCgenproof1.v
rename to powerpc/Asmgenproof1.v
index dd142c5b10163d4b152e417df0d9960ff8e32d60..c17cb73717af322e402df7795fff673e8ce3be8f 100644
--- a/backend/PPCgenproof1.v
+++ b/powerpc/Asmgenproof1.v
@@ -25,8 +25,8 @@ Require Import Locations.
Require Import Mach.
Require Import Machconcr.
Require Import Machtyping.
-Require Import PPC.
-Require Import PPCgen.
+Require Import Asm.
+Require Import Asmgen.
Require Conventions.
(** * Properties of low half/high half decomposition *)
@@ -123,12 +123,6 @@ Hint Extern 2 (_ <> _) => discriminate: ppcgen.
(** Mapping from Mach registers to PPC registers. *)
-Definition preg_of (r: mreg) :=
- match mreg_type r with
- | Tint => IR (ireg_of r)
- | Tfloat => FR (freg_of r)
- end.
-
Lemma preg_of_injective:
forall r1 r2, preg_of r1 = preg_of r2 -> r1 = r2.
Proof.
@@ -198,7 +192,7 @@ Hint Resolve preg_of_not_GPR1: ppcgen.
(** Agreement between Mach register sets and PPC register sets. *)
-Definition agree (ms: Mach.regset) (sp: val) (rs: PPC.regset) :=
+Definition agree (ms: Mach.regset) (sp: val) (rs: Asm.regset) :=
rs#GPR1 = sp /\ forall r: mreg, ms r = rs#(preg_of r).
Lemma preg_val:
@@ -434,88 +428,40 @@ Proof.
Qed.
Hint Resolve gpr_or_zero_not_zero gpr_or_zero_zero: ppcgen.
-(** Connection between Mach and PPC calling conventions for external
+(** Connection between Mach and Asm calling conventions for external
functions. *)
-Lemma loc_external_result_match:
- forall sg,
- PPC.loc_external_result sg = preg_of (Conventions.loc_result sg).
+Lemma extcall_arg_match:
+ forall ms sp rs m l v,
+ agree ms sp rs ->
+ Machconcr.extcall_arg ms m sp l v ->
+ Asm.extcall_arg rs m l v.
Proof.
- intros. destruct sg as [sargs sres].
- destruct sres. destruct t; reflexivity. reflexivity.
+ intros. inv H0.
+ rewrite (preg_val _ _ _ r H). constructor.
+ rewrite (sp_val _ _ _ H) in H1.
+ destruct ty; unfold load_stack in H1.
+ econstructor. reflexivity. assumption.
+ econstructor. reflexivity. assumption.
Qed.
Lemma extcall_args_match:
- forall ms m sp rs,
- agree ms sp rs ->
- forall tyl iregl fregl ofs args,
- (forall r, In r iregl -> mreg_type r = Tint) ->
- (forall r, In r fregl -> mreg_type r = Tfloat) ->
- Machconcr.extcall_args ms m sp (Conventions.loc_arguments_rec tyl iregl fregl ofs) args ->
- PPC.extcall_args rs m tyl (List.map ireg_of iregl) (List.map freg_of fregl) (Stacking.fe_ofs_arg + 4 * ofs) args.
+ forall ms sp rs m, agree ms sp rs ->
+ forall ll vl,
+ Machconcr.extcall_args ms m sp ll vl ->
+ Asm.extcall_args rs m ll vl.
Proof.
- induction tyl; intros.
- inversion H2; constructor.
- destruct a.
- (* integer case *)
- destruct iregl as [ | ir1 irl].
- (* stack *)
- inversion H2; subst; clear H2. inversion H8; subst; clear H8.
- constructor. replace (rs GPR1) with sp. assumption.
- eapply sp_val; eauto.
- change (@nil ireg) with (ireg_of ## nil).
- replace (Stacking.fe_ofs_arg + 4 * ofs + 4) with (Stacking.fe_ofs_arg + 4 * (ofs + 1)) by omega.
- apply IHtyl; auto.
- (* register *)
- inversion H2; subst; clear H2. inversion H8; subst; clear H8.
- simpl map. econstructor. eapply ireg_val; eauto.
- apply H0; simpl; auto.
- replace (4 * ofs + 4) with (4 * (ofs + 1)) by omega.
- apply IHtyl; auto.
- intros; apply H0; simpl; auto.
- (* float case *)
- destruct fregl as [ | fr1 frl].
- (* stack *)
- inversion H2; subst; clear H2. inversion H8; subst; clear H8.
- constructor. replace (rs GPR1) with sp. assumption.
- eapply sp_val; eauto.
- change (@nil freg) with (freg_of ## nil).
- replace (Stacking.fe_ofs_arg + 4 * ofs + 8) with (Stacking.fe_ofs_arg + 4 * (ofs + 2)) by omega.
- apply IHtyl; auto.
- (* register *)
- inversion H2; subst; clear H2. inversion H8; subst; clear H8.
- simpl map. econstructor. eapply freg_val; eauto.
- apply H1; simpl; auto.
- rewrite list_map_drop2.
- apply IHtyl; auto.
- intros; apply H0. apply list_drop2_incl. auto.
- intros; apply H1; simpl; auto.
+ induction 2; constructor; auto. eapply extcall_arg_match; eauto.
Qed.
-Ltac ElimOrEq :=
- match goal with
- | |- (?x = ?y) \/ _ -> _ =>
- let H := fresh in
- (intro H; elim H; clear H;
- [intro H; rewrite <- H; clear H | ElimOrEq])
- | |- False -> _ =>
- let H := fresh in (intro H; contradiction)
- end.
-
Lemma extcall_arguments_match:
forall ms m sp rs sg args,
agree ms sp rs ->
Machconcr.extcall_arguments ms m sp sg args ->
- PPC.extcall_arguments rs m sg args.
+ Asm.extcall_arguments rs m sg args.
Proof.
- unfold Machconcr.extcall_arguments, PPC.extcall_arguments; intros.
- change (extcall_args rs m sg.(sig_args)
- (List.map ireg_of Conventions.int_param_regs)
- (List.map freg_of Conventions.float_param_regs)
- (Stacking.fe_ofs_arg + 4 * 8) args).
- eapply extcall_args_match; eauto.
- intro; simpl; ElimOrEq; reflexivity.
- intro; simpl; ElimOrEq; reflexivity.
+ unfold Machconcr.extcall_arguments, Asm.extcall_arguments; intros.
+ eapply extcall_args_match; eauto.
Qed.
(** * Execution of straight-line code *)
diff --git a/backend/PPCgenretaddr.v b/powerpc/Asmgenretaddr.v
similarity index 99%
rename from backend/PPCgenretaddr.v
rename to powerpc/Asmgenretaddr.v
index eab8599e7759ffe294469b465ddd50b97f00e6af..23bd186e1cae3b2416009dfb6834b057e8677b92 100644
--- a/backend/PPCgenretaddr.v
+++ b/powerpc/Asmgenretaddr.v
@@ -27,8 +27,8 @@ Require Import Globalenvs.
Require Import Op.
Require Import Locations.
Require Import Mach.
-Require Import PPC.
-Require Import PPCgen.
+Require Import Asm.
+Require Import Asmgen.
(** The ``code tail'' of an instruction list [c] is the list of instructions
starting at PC [pos]. *)
diff --git a/backend/Constprop.v b/powerpc/Constprop.v
similarity index 100%
rename from backend/Constprop.v
rename to powerpc/Constprop.v
diff --git a/backend/Constpropproof.v b/powerpc/Constpropproof.v
similarity index 100%
rename from backend/Constpropproof.v
rename to powerpc/Constpropproof.v
diff --git a/powerpc/Machregs.v b/powerpc/Machregs.v
new file mode 100644
index 0000000000000000000000000000000000000000..260a0e8598347aeac8ab8c8ee4154eb84123330e
--- /dev/null
+++ b/powerpc/Machregs.v
@@ -0,0 +1,107 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+
+(** ** Machine registers *)
+
+(** The following type defines the machine registers that can be referenced
+ as locations. These include:
+- Integer registers that can be allocated to RTL pseudo-registers ([Rxx]).
+- Floating-point registers that can be allocated to RTL pseudo-registers
+ ([Fxx]).
+- Two integer registers, not allocatable, reserved as temporaries for
+ spilling and reloading ([IT1, IT2]).
+- Two float registers, not allocatable, reserved as temporaries for
+ spilling and reloading ([FT1, FT2]).
+
+ The type [mreg] does not include special-purpose machine registers
+ such as the stack pointer and the condition codes. *)
+
+Inductive mreg: Set :=
+ (** Allocatable integer regs *)
+ | R3: mreg | R4: mreg | R5: mreg | R6: mreg
+ | R7: mreg | R8: mreg | R9: mreg | R10: mreg
+ | R13: mreg | R14: mreg | R15: mreg | R16: mreg
+ | R17: mreg | R18: mreg | R19: mreg | R20: mreg
+ | R21: mreg | R22: mreg | R23: mreg | R24: mreg
+ | R25: mreg | R26: mreg | R27: mreg | R28: mreg
+ | R29: mreg | R30: mreg | R31: mreg
+ (** Allocatable float regs *)
+ | F1: mreg | F2: mreg | F3: mreg | F4: mreg
+ | F5: mreg | F6: mreg | F7: mreg | F8: mreg
+ | F9: mreg | F10: mreg | F14: mreg | F15: mreg
+ | F16: mreg | F17: mreg | F18: mreg | F19: mreg
+ | F20: mreg | F21: mreg | F22: mreg | F23: mreg
+ | F24: mreg | F25: mreg | F26: mreg | F27: mreg
+ | F28: mreg | F29: mreg | F30: mreg | F31: mreg
+ (** Integer temporaries *)
+ | IT1: mreg (* R11 *) | IT2: mreg (* R0 *)
+ (** Float temporaries *)
+ | FT1: mreg (* F11 *) | FT2: mreg (* F12 *) | FT3: mreg (* F0 *).
+
+Lemma mreg_eq: forall (r1 r2: mreg), {r1 = r2} + {r1 <> r2}.
+Proof. decide equality. Qed.
+
+Definition mreg_type (r: mreg): typ :=
+ match r with
+ | R3 => Tint | R4 => Tint | R5 => Tint | R6 => Tint
+ | R7 => Tint | R8 => Tint | R9 => Tint | R10 => Tint
+ | R13 => Tint | R14 => Tint | R15 => Tint | R16 => Tint
+ | R17 => Tint | R18 => Tint | R19 => Tint | R20 => Tint
+ | R21 => Tint | R22 => Tint | R23 => Tint | R24 => Tint
+ | R25 => Tint | R26 => Tint | R27 => Tint | R28 => Tint
+ | R29 => Tint | R30 => Tint | R31 => Tint
+ | F1 => Tfloat | F2 => Tfloat | F3 => Tfloat | F4 => Tfloat
+ | F5 => Tfloat | F6 => Tfloat | F7 => Tfloat | F8 => Tfloat
+ | F9 => Tfloat | F10 => Tfloat | F14 => Tfloat | F15 => Tfloat
+ | F16 => Tfloat | F17 => Tfloat | F18 => Tfloat | F19 => Tfloat
+ | F20 => Tfloat | F21 => Tfloat | F22 => Tfloat | F23 => Tfloat
+ | F24 => Tfloat | F25 => Tfloat | F26 => Tfloat | F27 => Tfloat
+ | F28 => Tfloat | F29 => Tfloat | F30 => Tfloat | F31 => Tfloat
+ | IT1 => Tint | IT2 => Tint
+ | FT1 => Tfloat | FT2 => Tfloat | FT3 => Tfloat
+ end.
+
+Open Scope positive_scope.
+
+Module IndexedMreg <: INDEXED_TYPE.
+ Definition t := mreg.
+ Definition eq := mreg_eq.
+ Definition index (r: mreg): positive :=
+ match r with
+ | R3 => 1 | R4 => 2 | R5 => 3 | R6 => 4
+ | R7 => 5 | R8 => 6 | R9 => 7 | R10 => 8
+ | R13 => 9 | R14 => 10 | R15 => 11 | R16 => 12
+ | R17 => 13 | R18 => 14 | R19 => 15 | R20 => 16
+ | R21 => 17 | R22 => 18 | R23 => 19 | R24 => 20
+ | R25 => 21 | R26 => 22 | R27 => 23 | R28 => 24
+ | R29 => 25 | R30 => 26 | R31 => 27
+ | F1 => 28 | F2 => 29 | F3 => 30 | F4 => 31
+ | F5 => 32 | F6 => 33 | F7 => 34 | F8 => 35
+ | F9 => 36 | F10 => 37 | F14 => 38 | F15 => 39
+ | F16 => 40 | F17 => 41 | F18 => 42 | F19 => 43
+ | F20 => 44 | F21 => 45 | F22 => 46 | F23 => 47
+ | F24 => 48 | F25 => 49 | F26 => 50 | F27 => 51
+ | F28 => 52 | F29 => 53 | F30 => 54 | F31 => 55
+ | IT1 => 56 | IT2 => 57
+ | FT1 => 58 | FT2 => 59 | FT3 => 60
+ end.
+ Lemma index_inj:
+ forall r1 r2, index r1 = index r2 -> r1 = r2.
+ Proof.
+ destruct r1; destruct r2; simpl; intro; discriminate || reflexivity.
+ Qed.
+End IndexedMreg.
+
diff --git a/backend/Op.v b/powerpc/Op.v
similarity index 98%
rename from backend/Op.v
rename to powerpc/Op.v
index 5665d725b2920140be7faf013aa0807e16f729ed..20ebf7056b4f5ac7971b8cead8faacf566b80e0f 100644
--- a/backend/Op.v
+++ b/powerpc/Op.v
@@ -111,6 +111,25 @@ Inductive addressing: Set :=
| Abased: ident -> int -> addressing (**r Address is [symbol + offset + r1] *)
| Ainstack: int -> addressing. (**r Address is [stack_pointer + offset] *)
+(** Comparison functions (used in module [CSE]). *)
+
+Definition eq_operation (x y: operation): {x=y} + {x<>y}.
+Proof.
+ generalize Int.eq_dec; intro.
+ generalize Float.eq_dec; intro.
+ assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
+ assert (forall (x y: comparison), {x=y}+{x<>y}). decide equality.
+ assert (forall (x y: condition), {x=y}+{x<>y}). decide equality.
+ decide equality.
+Qed.
+
+Definition eq_addressing (x y: addressing) : {x=y} + {x<>y}.
+Proof.
+ generalize Int.eq_dec; intro.
+ assert (forall (x y: ident), {x=y}+{x<>y}). exact peq.
+ decide equality.
+Qed.
+
(** Evaluation of conditions, operators and addressing modes applied
to lists of values. Return [None] when the computation is undefined:
wrong number of arguments, arguments of the wrong types, undefined
diff --git a/caml/PrintPPC.ml b/powerpc/PrintAsm.ml
similarity index 99%
rename from caml/PrintPPC.ml
rename to powerpc/PrintAsm.ml
index 94c3a7b3f48f1a13978ccfbb989d53471a0b83c2..0e45c848f792f88bc01ee4afa83a5a3c521b5c4d 100644
--- a/caml/PrintPPC.ml
+++ b/powerpc/PrintAsm.ml
@@ -17,7 +17,7 @@ open Datatypes
open CList
open Camlcoq
open AST
-open PPC
+open Asm
(* On-the-fly label renaming *)
diff --git a/caml/PrintPPC.mli b/powerpc/PrintAsm.mli
similarity index 93%
rename from caml/PrintPPC.mli
rename to powerpc/PrintAsm.mli
index 2ebbb9556506476798c7f05bdf5e3363f901f469..aefe3a0a185c85543fe7976363828e8fbb878c26 100644
--- a/caml/PrintPPC.mli
+++ b/powerpc/PrintAsm.mli
@@ -10,4 +10,4 @@
(* *)
(* *********************************************************************)
-val print_program: out_channel -> PPC.program -> unit
+val print_program: out_channel -> Asm.program -> unit
diff --git a/backend/Selection.v b/powerpc/Selection.v
similarity index 100%
rename from backend/Selection.v
rename to powerpc/Selection.v
diff --git a/backend/Selectionproof.v b/powerpc/Selectionproof.v
similarity index 100%
rename from backend/Selectionproof.v
rename to powerpc/Selectionproof.v
diff --git a/powerpc/eabi/Conventions.v b/powerpc/eabi/Conventions.v
new file mode 100644
index 0000000000000000000000000000000000000000..6e27b9d2f43ba8a8896aa7192adfbd74f2ffdd94
--- /dev/null
+++ b/powerpc/eabi/Conventions.v
@@ -0,0 +1,798 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Function calling conventions and other conventions regarding the use of
+ machine registers and stack slots. *)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Locations.
+
+(** * Classification of machine registers *)
+
+(** Machine registers (type [mreg] in module [Locations]) are divided in
+ the following groups:
+- Temporaries used for spilling, reloading, and parallel move operations.
+- Allocatable registers, that can be assigned to RTL pseudo-registers.
+ These are further divided into:
+-- Callee-save registers, whose value is preserved across a function call.
+-- Caller-save registers that can be modified during a function call.
+
+ We follow the PowerPC/EABI application binary interface (ABI) in our choice
+ of callee- and caller-save registers.
+*)
+
+Definition int_caller_save_regs :=
+ R3 :: R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R10 :: nil.
+
+Definition float_caller_save_regs :=
+ F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: F8 :: F9 :: F10 :: nil.
+
+Definition int_callee_save_regs :=
+ R13 :: R14 :: R15 :: R16 :: R17 :: R18 :: R19 :: R20 :: R21 :: R22 ::
+ R23 :: R24 :: R25 :: R26 :: R27 :: R28 :: R29 :: R30 :: R31 :: nil.
+
+Definition float_callee_save_regs :=
+ F14 :: F15 :: F16 :: F17 :: F18 :: F19 :: F20 :: F21 :: F22 ::
+ F23 :: F24 :: F25 :: F26 :: F27 :: F28 :: F29 :: F30 :: F31 :: nil.
+
+Definition destroyed_at_call_regs :=
+ int_caller_save_regs ++ float_caller_save_regs.
+
+Definition destroyed_at_call :=
+ List.map R destroyed_at_call_regs.
+
+Definition int_temporaries := IT1 :: IT2 :: nil.
+
+Definition float_temporaries := FT1 :: FT2 :: FT3 :: nil.
+
+Definition temporaries :=
+ R IT1 :: R IT2 :: R FT1 :: R FT2 :: R FT3 :: nil.
+
+(** The [index_int_callee_save] and [index_float_callee_save] associate
+ a unique positive integer to callee-save registers. This integer is
+ used in [Stacking] to determine where to save these registers in
+ the activation record if they are used by the current function. *)
+
+Definition index_int_callee_save (r: mreg) :=
+ match r with
+ | R13 => 0 | R14 => 1 | R15 => 2 | R16 => 3
+ | R17 => 4 | R18 => 5 | R19 => 6 | R20 => 7
+ | R21 => 8 | R22 => 9 | R23 => 10 | R24 => 11
+ | R25 => 12 | R26 => 13 | R27 => 14 | R28 => 15
+ | R29 => 16 | R30 => 17 | R31 => 18 | _ => -1
+ end.
+
+Definition index_float_callee_save (r: mreg) :=
+ match r with
+ | F14 => 0 | F15 => 1 | F16 => 2 | F17 => 3
+ | F18 => 4 | F19 => 5 | F20 => 6 | F21 => 7
+ | F22 => 8 | F23 => 9 | F24 => 10 | F25 => 11
+ | F26 => 12 | F27 => 13 | F28 => 14 | F29 => 15
+ | F30 => 16 | F31 => 17 | _ => -1
+ end.
+
+Ltac ElimOrEq :=
+ match goal with
+ | |- (?x = ?y) \/ _ -> _ =>
+ let H := fresh in
+ (intro H; elim H; clear H;
+ [intro H; rewrite <- H; clear H | ElimOrEq])
+ | |- False -> _ =>
+ let H := fresh in (intro H; contradiction)
+ end.
+
+Ltac OrEq :=
+ match goal with
+ | |- (?x = ?x) \/ _ => left; reflexivity
+ | |- (?x = ?y) \/ _ => right; OrEq
+ | |- False => fail
+ end.
+
+Ltac NotOrEq :=
+ match goal with
+ | |- (?x = ?y) \/ _ -> False =>
+ let H := fresh in (
+ intro H; elim H; clear H; [intro; discriminate | NotOrEq])
+ | |- False -> False =>
+ contradiction
+ end.
+
+Lemma index_int_callee_save_pos:
+ forall r, In r int_callee_save_regs -> index_int_callee_save r >= 0.
+Proof.
+ intro r. simpl; ElimOrEq; unfold index_int_callee_save; omega.
+Qed.
+
+Lemma index_float_callee_save_pos:
+ forall r, In r float_callee_save_regs -> index_float_callee_save r >= 0.
+Proof.
+ intro r. simpl; ElimOrEq; unfold index_float_callee_save; omega.
+Qed.
+
+Lemma index_int_callee_save_pos2:
+ forall r, index_int_callee_save r >= 0 -> In r int_callee_save_regs.
+Proof.
+ destruct r; simpl; intro; omegaContradiction || OrEq.
+Qed.
+
+Lemma index_float_callee_save_pos2:
+ forall r, index_float_callee_save r >= 0 -> In r float_callee_save_regs.
+Proof.
+ destruct r; simpl; intro; omegaContradiction || OrEq.
+Qed.
+
+Lemma index_int_callee_save_inj:
+ forall r1 r2,
+ In r1 int_callee_save_regs ->
+ In r2 int_callee_save_regs ->
+ r1 <> r2 ->
+ index_int_callee_save r1 <> index_int_callee_save r2.
+Proof.
+ intros r1 r2.
+ simpl; ElimOrEq; ElimOrEq; unfold index_int_callee_save;
+ intros; congruence.
+Qed.
+
+Lemma index_float_callee_save_inj:
+ forall r1 r2,
+ In r1 float_callee_save_regs ->
+ In r2 float_callee_save_regs ->
+ r1 <> r2 ->
+ index_float_callee_save r1 <> index_float_callee_save r2.
+Proof.
+ intros r1 r2.
+ simpl; ElimOrEq; ElimOrEq; unfold index_float_callee_save;
+ intros; congruence.
+Qed.
+
+(** The following lemmas show that
+ (temporaries, destroyed at call, integer callee-save, float callee-save)
+ is a partition of the set of machine registers. *)
+
+Lemma int_float_callee_save_disjoint:
+ list_disjoint int_callee_save_regs float_callee_save_regs.
+Proof.
+ red; intros r1 r2. simpl; ElimOrEq; ElimOrEq; discriminate.
+Qed.
+
+Lemma register_classification:
+ forall r,
+ (In (R r) temporaries \/ In (R r) destroyed_at_call) \/
+ (In r int_callee_save_regs \/ In r float_callee_save_regs).
+Proof.
+ destruct r;
+ try (left; left; simpl; OrEq);
+ try (left; right; simpl; OrEq);
+ try (right; left; simpl; OrEq);
+ try (right; right; simpl; OrEq).
+Qed.
+
+Lemma int_callee_save_not_destroyed:
+ forall r,
+ In (R r) temporaries \/ In (R r) destroyed_at_call ->
+ ~(In r int_callee_save_regs).
+Proof.
+ intros; red; intros. elim H.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+Qed.
+
+Lemma float_callee_save_not_destroyed:
+ forall r,
+ In (R r) temporaries \/ In (R r) destroyed_at_call ->
+ ~(In r float_callee_save_regs).
+Proof.
+ intros; red; intros. elim H.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+ generalize H0. simpl; ElimOrEq; NotOrEq.
+Qed.
+
+Lemma int_callee_save_type:
+ forall r, In r int_callee_save_regs -> mreg_type r = Tint.
+Proof.
+ intro. simpl; ElimOrEq; reflexivity.
+Qed.
+
+Lemma float_callee_save_type:
+ forall r, In r float_callee_save_regs -> mreg_type r = Tfloat.
+Proof.
+ intro. simpl; ElimOrEq; reflexivity.
+Qed.
+
+Ltac NoRepet :=
+ match goal with
+ | |- list_norepet nil =>
+ apply list_norepet_nil
+ | |- list_norepet (?a :: ?b) =>
+ apply list_norepet_cons; [simpl; intuition discriminate | NoRepet]
+ end.
+
+Lemma int_callee_save_norepet:
+ list_norepet int_callee_save_regs.
+Proof.
+ unfold int_callee_save_regs; NoRepet.
+Qed.
+
+Lemma float_callee_save_norepet:
+ list_norepet float_callee_save_regs.
+Proof.
+ unfold float_callee_save_regs; NoRepet.
+Qed.
+
+(** * Acceptable locations for register allocation *)
+
+(** The following predicate describes the locations that can be assigned
+ to an RTL pseudo-register during register allocation: a non-temporary
+ machine register or a [Local] stack slot are acceptable. *)
+
+Definition loc_acceptable (l: loc) : Prop :=
+ match l with
+ | R r => ~(In l temporaries)
+ | S (Local ofs ty) => ofs >= 0
+ | S (Incoming _ _) => False
+ | S (Outgoing _ _) => False
+ end.
+
+Definition locs_acceptable (ll: list loc) : Prop :=
+ forall l, In l ll -> loc_acceptable l.
+
+Lemma temporaries_not_acceptable:
+ forall l, loc_acceptable l -> Loc.notin l temporaries.
+Proof.
+ unfold loc_acceptable; destruct l.
+ simpl. intuition congruence.
+ destruct s; try contradiction.
+ intro. simpl. tauto.
+Qed.
+Hint Resolve temporaries_not_acceptable: locs.
+
+Lemma locs_acceptable_disj_temporaries:
+ forall ll, locs_acceptable ll -> Loc.disjoint ll temporaries.
+Proof.
+ intros. apply Loc.notin_disjoint. intros.
+ apply temporaries_not_acceptable. auto.
+Qed.
+
+Lemma loc_acceptable_noteq_diff:
+ forall l1 l2,
+ loc_acceptable l1 -> l1 <> l2 -> Loc.diff l1 l2.
+Proof.
+ unfold loc_acceptable, Loc.diff; destruct l1; destruct l2;
+ try (destruct s); try (destruct s0); intros; auto; try congruence.
+ case (zeq z z0); intro.
+ compare t t0; intro.
+ subst z0; subst t0; tauto.
+ tauto. tauto.
+ contradiction. contradiction.
+Qed.
+
+Lemma loc_acceptable_notin_notin:
+ forall r ll,
+ loc_acceptable r ->
+ ~(In r ll) -> Loc.notin r ll.
+Proof.
+ induction ll; simpl; intros.
+ auto.
+ split. apply loc_acceptable_noteq_diff. assumption.
+ apply sym_not_equal. tauto.
+ apply IHll. assumption. tauto.
+Qed.
+
+(** * Function calling conventions *)
+
+(** The functions in this section determine the locations (machine registers
+ and stack slots) used to communicate arguments and results between the
+ caller and the callee during function calls. These locations are functions
+ of the signature of the function and of the call instruction.
+ Agreement between the caller and the callee on the locations to use
+ is guaranteed by our dynamic semantics for Cminor and RTL, which demand
+ that the signature of the call instruction is identical to that of the
+ called function.
+
+ Calling conventions are largely arbitrary: they must respect the properties
+ proved in this section (such as no overlapping between the locations
+ of function arguments), but this leaves much liberty in choosing actual
+ locations. To ensure binary interoperability of code generated by our
+ compiler with libraries compiled by another PowerPC compiler, we
+ implement the standard conventions defined in the PowerPC/EABI
+ application binary interface. *)
+
+(** ** Location of function result *)
+
+(** The result value of a function is passed back to the caller in
+ registers [R3] or [F1], depending on the type of the returned value.
+ We treat a function without result as a function with one integer result. *)
+
+Definition loc_result (s: signature) : mreg :=
+ match s.(sig_res) with
+ | None => R3
+ | Some Tint => R3
+ | Some Tfloat => F1
+ end.
+
+(** The result location has the type stated in the signature. *)
+
+Lemma loc_result_type:
+ forall sig,
+ mreg_type (loc_result sig) =
+ match sig.(sig_res) with None => Tint | Some ty => ty end.
+Proof.
+ intros; unfold loc_result.
+ destruct (sig_res sig).
+ destruct t; reflexivity.
+ reflexivity.
+Qed.
+
+(** The result location is acceptable. *)
+
+Lemma loc_result_acceptable:
+ forall sig, loc_acceptable (R (loc_result sig)).
+Proof.
+ intros. unfold loc_acceptable. red.
+ unfold loc_result. destruct (sig_res sig).
+ destruct t; simpl; NotOrEq.
+ simpl; NotOrEq.
+Qed.
+
+(** The result location is a caller-save register. *)
+
+Lemma loc_result_caller_save:
+ forall (s: signature), In (R (loc_result s)) destroyed_at_call.
+Proof.
+ intros; unfold loc_result.
+ destruct (sig_res s).
+ destruct t; simpl; OrEq.
+ simpl; OrEq.
+Qed.
+
+(** The result location is not a callee-save register. *)
+
+Lemma loc_result_not_callee_save:
+ forall (s: signature),
+ ~(In (loc_result s) int_callee_save_regs \/ In (loc_result s) float_callee_save_regs).
+Proof.
+ intros. generalize (loc_result_caller_save s).
+ generalize (int_callee_save_not_destroyed (loc_result s)).
+ generalize (float_callee_save_not_destroyed (loc_result s)).
+ tauto.
+Qed.
+
+(** ** Location of function arguments *)
+
+(** The PowerPC EABI states the following convention for passing arguments
+ to a function:
+- The first 8 integer arguments are passed in registers [R3] to [R10].
+- The first 8 float arguments are passed in registers [F1] to [F8].
+- Extra arguments are passed on the stack, in [Outgoing] slots, consecutively
+ assigned (1 word for an integer argument, 2 words for a float),
+ starting at word offset 0.
+- No stack space is reserved for the arguments that are passed in registers.
+*)
+
+Fixpoint loc_arguments_rec
+ (tyl: list typ) (iregl: list mreg) (fregl: list mreg)
+ (ofs: Z) {struct tyl} : list loc :=
+ match tyl with
+ | nil => nil
+ | Tint :: tys =>
+ match iregl with
+ | nil =>
+ S (Outgoing ofs Tint) :: loc_arguments_rec tys nil fregl (ofs + 1)
+ | ireg :: iregs =>
+ R ireg :: loc_arguments_rec tys iregs fregl ofs
+ end
+ | Tfloat :: tys =>
+ match fregl with
+ | nil =>
+ S (Outgoing ofs Tfloat) :: loc_arguments_rec tys iregl nil (ofs + 2)
+ | freg :: fregs =>
+ R freg :: loc_arguments_rec tys iregl fregs ofs
+ end
+ end.
+
+Definition int_param_regs :=
+ R3 :: R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R10 :: nil.
+Definition float_param_regs :=
+ F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: F8 :: nil.
+
+(** [loc_arguments s] returns the list of locations where to store arguments
+ when calling a function with signature [s]. *)
+
+Definition loc_arguments (s: signature) : list loc :=
+ loc_arguments_rec s.(sig_args) int_param_regs float_param_regs 0.
+
+(** [size_arguments s] returns the number of [Outgoing] slots used
+ to call a function with signature [s]. *)
+
+Fixpoint size_arguments_rec
+ (tyl: list typ) (iregl: list mreg) (fregl: list mreg)
+ (ofs: Z) {struct tyl} : Z :=
+ match tyl with
+ | nil => ofs
+ | Tint :: tys =>
+ match iregl with
+ | nil => size_arguments_rec tys nil fregl (ofs + 1)
+ | ireg :: iregs => size_arguments_rec tys iregs fregl ofs
+ end
+ | Tfloat :: tys =>
+ match fregl with
+ | nil => size_arguments_rec tys iregl nil (ofs + 2)
+ | freg :: fregs => size_arguments_rec tys iregl fregs ofs
+ end
+ end.
+
+Definition size_arguments (s: signature) : Z :=
+ size_arguments_rec s.(sig_args) int_param_regs float_param_regs 0.
+
+(** A tail-call is possible for a signature if the corresponding
+ arguments are all passed in registers. *)
+
+Definition tailcall_possible (s: signature) : Prop :=
+ forall l, In l (loc_arguments s) ->
+ match l with R _ => True | S _ => False end.
+
+(** Argument locations are either non-temporary registers or [Outgoing]
+ stack slots at nonnegative offsets. *)
+
+Definition loc_argument_acceptable (l: loc) : Prop :=
+ match l with
+ | R r => ~(In l temporaries)
+ | S (Outgoing ofs ty) => ofs >= 0
+ | _ => False
+ end.
+
+Remark loc_arguments_rec_charact:
+ forall tyl iregl fregl ofs l,
+ In l (loc_arguments_rec tyl iregl fregl ofs) ->
+ match l with
+ | R r => In r iregl \/ In r fregl
+ | S (Outgoing ofs' ty) => ofs' >= ofs
+ | S _ => False
+ end.
+Proof.
+ induction tyl; simpl loc_arguments_rec; intros.
+ elim H.
+ destruct a.
+ destruct iregl; elim H; intro.
+ subst l. omega.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto. destruct s; auto. omega.
+ subst l. auto with coqlib.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto. simpl; intuition.
+ destruct fregl; elim H; intro.
+ subst l. omega.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto. destruct s; auto. omega.
+ subst l. auto with coqlib.
+ generalize (IHtyl _ _ _ _ H0). destruct l; auto.
+ intros [A|B]. left; auto. right; auto with coqlib.
+Qed.
+
+Lemma loc_arguments_acceptable:
+ forall (s: signature) (r: loc),
+ In r (loc_arguments s) -> loc_argument_acceptable r.
+Proof.
+ unfold loc_arguments; intros.
+ generalize (loc_arguments_rec_charact _ _ _ _ _ H).
+ destruct r.
+ intro H0; elim H0. simpl. unfold not. ElimOrEq; NotOrEq.
+ simpl. unfold not. ElimOrEq; NotOrEq.
+ destruct s0; try contradiction.
+ simpl. omega.
+Qed.
+Hint Resolve loc_arguments_acceptable: locs.
+
+(** Arguments are parwise disjoint (in the sense of [Loc.norepet]). *)
+
+Remark loc_arguments_rec_notin_reg:
+ forall tyl iregl fregl ofs r,
+ ~(In r iregl) -> ~(In r fregl) ->
+ Loc.notin (R r) (loc_arguments_rec tyl iregl fregl ofs).
+Proof.
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl. auto.
+ simpl in H. split. apply sym_not_equal. tauto.
+ apply IHtyl. tauto. tauto.
+ destruct fregl; simpl. auto.
+ simpl in H0. split. apply sym_not_equal. tauto.
+ apply IHtyl.
+ red; intro. apply H. auto.
+ tauto.
+Qed.
+
+Remark loc_arguments_rec_notin_local:
+ forall tyl iregl fregl ofs ofs0 ty0,
+ Loc.notin (S (Local ofs0 ty0)) (loc_arguments_rec tyl iregl fregl ofs).
+Proof.
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl; auto.
+ destruct fregl; simpl; auto.
+Qed.
+
+Remark loc_arguments_rec_notin_outgoing:
+ forall tyl iregl fregl ofs ofs0 ty0,
+ ofs0 + typesize ty0 <= ofs ->
+ Loc.notin (S (Outgoing ofs0 ty0)) (loc_arguments_rec tyl iregl fregl ofs).
+Proof.
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl.
+ split. omega. eapply IHtyl. omega.
+ auto.
+ destruct fregl; simpl.
+ split. omega. eapply IHtyl. omega.
+ auto.
+Qed.
+
+Lemma loc_arguments_norepet:
+ forall (s: signature), Loc.norepet (loc_arguments s).
+Proof.
+ assert (forall tyl iregl fregl ofs,
+ list_norepet iregl ->
+ list_norepet fregl ->
+ list_disjoint iregl fregl ->
+ Loc.norepet (loc_arguments_rec tyl iregl fregl ofs)).
+ induction tyl; simpl; intros.
+ constructor.
+ destruct a.
+ destruct iregl; constructor.
+ apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
+ apply loc_arguments_rec_notin_reg. inversion H. auto.
+ apply list_disjoint_notin with (m :: iregl); auto with coqlib.
+ apply IHtyl. inv H; auto. auto.
+ eapply list_disjoint_cons_left; eauto.
+ destruct fregl; constructor.
+ apply loc_arguments_rec_notin_outgoing. simpl; omega. auto.
+ apply loc_arguments_rec_notin_reg.
+ red; intro. apply (H1 m m). auto.
+ auto with coqlib. auto. inv H0; auto.
+ apply IHtyl. auto.
+ inv H0; auto.
+ red; intros. apply H1. auto. auto with coqlib.
+
+ intro. unfold loc_arguments. apply H.
+ unfold int_param_regs. NoRepet.
+ unfold float_param_regs. NoRepet.
+ red; intros x y; simpl. ElimOrEq; ElimOrEq; discriminate.
+Qed.
+
+(** The offsets of [Outgoing] arguments are below [size_arguments s]. *)
+
+Remark size_arguments_rec_above:
+ forall tyl iregl fregl ofs0,
+ ofs0 <= size_arguments_rec tyl iregl fregl ofs0.
+Proof.
+ induction tyl; simpl; intros.
+ omega.
+ destruct a.
+ destruct iregl. apply Zle_trans with (ofs0 + 1); auto; omega. auto.
+ destruct fregl. apply Zle_trans with (ofs0 + 2); auto; omega. auto.
+Qed.
+
+Lemma size_arguments_above:
+ forall s, size_arguments s >= 0.
+Proof.
+ intros; unfold size_arguments. apply Zle_ge.
+ apply size_arguments_rec_above.
+Qed.
+
+Lemma loc_arguments_bounded:
+ forall (s: signature) (ofs: Z) (ty: typ),
+ In (S (Outgoing ofs ty)) (loc_arguments s) ->
+ ofs + typesize ty <= size_arguments s.
+Proof.
+ intros.
+ assert (forall tyl iregl fregl ofs0,
+ In (S (Outgoing ofs ty)) (loc_arguments_rec tyl iregl fregl ofs0) ->
+ ofs + typesize ty <= size_arguments_rec tyl iregl fregl ofs0).
+ induction tyl; simpl; intros.
+ elim H0.
+ destruct a. destruct iregl; elim H0; intro.
+ inv H1. simpl. apply size_arguments_rec_above. auto.
+ discriminate. auto.
+ destruct fregl; elim H0; intro.
+ inv H1. simpl. apply size_arguments_rec_above. auto.
+ discriminate. auto.
+ unfold size_arguments. eapply H0. unfold loc_arguments in H. eauto.
+Qed.
+
+(** Temporary registers do not overlap with argument locations. *)
+
+Lemma loc_arguments_not_temporaries:
+ forall sig, Loc.disjoint (loc_arguments sig) temporaries.
+Proof.
+ intros; red; intros x1 x2 H.
+ generalize (loc_arguments_rec_charact _ _ _ _ _ H).
+ destruct x1.
+ intro H0; elim H0; simpl; (ElimOrEq; ElimOrEq; congruence).
+ destruct s; try contradiction. intro.
+ simpl; ElimOrEq; auto.
+Qed.
+Hint Resolve loc_arguments_not_temporaries: locs.
+
+(** Argument registers are caller-save. *)
+
+Lemma arguments_caller_save:
+ forall sig r,
+ In (R r) (loc_arguments sig) -> In (R r) destroyed_at_call.
+Proof.
+ unfold loc_arguments; intros.
+ elim (loc_arguments_rec_charact _ _ _ _ _ H); simpl.
+ ElimOrEq; intuition.
+ ElimOrEq; intuition.
+Qed.
+
+(** Callee-save registers do not overlap with argument locations. *)
+
+Lemma arguments_not_preserved:
+ forall sig l,
+ Loc.notin l destroyed_at_call -> loc_acceptable l ->
+ Loc.notin l (loc_arguments sig).
+Proof.
+ intros. unfold loc_arguments. destruct l.
+ apply loc_arguments_rec_notin_reg.
+ generalize (Loc.notin_not_in _ _ H). intro; red; intro.
+ apply H1. generalize H2. simpl. ElimOrEq; OrEq.
+ generalize (Loc.notin_not_in _ _ H). intro; red; intro.
+ apply H1. generalize H2. simpl. ElimOrEq; OrEq.
+ destruct s; simpl in H0; try contradiction.
+ apply loc_arguments_rec_notin_local.
+Qed.
+Hint Resolve arguments_not_preserved: locs.
+
+(** Argument locations agree in number with the function signature. *)
+
+Lemma loc_arguments_length:
+ forall sig,
+ List.length (loc_arguments sig) = List.length sig.(sig_args).
+Proof.
+ assert (forall tyl iregl fregl ofs,
+ List.length (loc_arguments_rec tyl iregl fregl ofs) = List.length tyl).
+ induction tyl; simpl; intros.
+ auto.
+ destruct a.
+ destruct iregl; simpl; decEq; auto.
+ destruct fregl; simpl; decEq; auto.
+ intros. unfold loc_arguments. auto.
+Qed.
+
+(** Argument locations agree in types with the function signature. *)
+
+Lemma loc_arguments_type:
+ forall sig, List.map Loc.type (loc_arguments sig) = sig.(sig_args).
+Proof.
+ assert (forall tyl iregl fregl ofs,
+ (forall r, In r iregl -> mreg_type r = Tint) ->
+ (forall r, In r fregl -> mreg_type r = Tfloat) ->
+ List.map Loc.type (loc_arguments_rec tyl iregl fregl ofs) = tyl).
+ induction tyl; simpl; intros.
+ auto.
+ destruct a; [destruct iregl|destruct fregl]; simpl;
+ f_equal; eauto with coqlib.
+
+ intros. unfold loc_arguments. apply H.
+ intro; simpl. ElimOrEq; reflexivity.
+ intro; simpl. ElimOrEq; reflexivity.
+Qed.
+
+(** There is no partial overlap between an argument location and an
+ acceptable location: they are either identical or disjoint. *)
+
+Lemma no_overlap_arguments:
+ forall args sg,
+ locs_acceptable args ->
+ Loc.no_overlap args (loc_arguments sg).
+Proof.
+ unfold Loc.no_overlap; intros.
+ generalize (H r H0).
+ generalize (loc_arguments_acceptable _ _ H1).
+ destruct s; destruct r; simpl.
+ intros. case (mreg_eq m0 m); intro. left; congruence. tauto.
+ intros. right; destruct s; auto.
+ intros. right. auto.
+ destruct s; try tauto. destruct s0; tauto.
+Qed.
+
+(** Decide whether a tailcall is possible. *)
+
+Definition tailcall_is_possible (sg: signature) : bool :=
+ let fix tcisp (l: list loc) :=
+ match l with
+ | nil => true
+ | R _ :: l' => tcisp l'
+ | S _ :: l' => false
+ end
+ in tcisp (loc_arguments sg).
+
+Lemma tailcall_is_possible_correct:
+ forall s, tailcall_is_possible s = true -> tailcall_possible s.
+Proof.
+ intro s. unfold tailcall_is_possible, tailcall_possible.
+ generalize (loc_arguments s). induction l; simpl; intros.
+ elim H0.
+ destruct a.
+ destruct H0. subst l0. auto. apply IHl. auto. auto. discriminate.
+Qed.
+
+(** ** Location of function parameters *)
+
+(** A function finds the values of its parameter in the same locations
+ where its caller stored them, except that the stack-allocated arguments,
+ viewed as [Outgoing] slots by the caller, are accessed via [Incoming]
+ slots (at the same offsets and types) in the callee. *)
+
+Definition parameter_of_argument (l: loc) : loc :=
+ match l with
+ | S (Outgoing n ty) => S (Incoming n ty)
+ | _ => l
+ end.
+
+Definition loc_parameters (s: signature) :=
+ List.map parameter_of_argument (loc_arguments s).
+
+Lemma loc_parameters_type:
+ forall sig, List.map Loc.type (loc_parameters sig) = sig.(sig_args).
+Proof.
+ intros. unfold loc_parameters.
+ rewrite list_map_compose.
+ rewrite <- loc_arguments_type.
+ apply list_map_exten.
+ intros. destruct x; simpl. auto.
+ destruct s; reflexivity.
+Qed.
+
+Lemma loc_parameters_length:
+ forall sg, List.length (loc_parameters sg) = List.length sg.(sig_args).
+Proof.
+ intros. unfold loc_parameters. rewrite list_length_map.
+ apply loc_arguments_length.
+Qed.
+
+Lemma loc_parameters_not_temporaries:
+ forall sig, Loc.disjoint (loc_parameters sig) temporaries.
+Proof.
+ intro; red; intros.
+ unfold loc_parameters in H.
+ elim (list_in_map_inv _ _ _ H). intros y [EQ IN].
+ generalize (loc_arguments_not_temporaries sig y x2 IN H0).
+ subst x1. destruct x2.
+ destruct y; simpl. auto. destruct s; auto.
+ byContradiction. generalize H0. simpl. NotOrEq.
+Qed.
+
+Lemma no_overlap_parameters:
+ forall params sg,
+ locs_acceptable params ->
+ Loc.no_overlap (loc_parameters sg) params.
+Proof.
+ unfold Loc.no_overlap; intros.
+ unfold loc_parameters in H0.
+ elim (list_in_map_inv _ _ _ H0). intros t [EQ IN].
+ rewrite EQ.
+ generalize (loc_arguments_acceptable _ _ IN).
+ generalize (H s H1).
+ destruct s; destruct t; simpl.
+ intros. case (mreg_eq m0 m); intro. left; congruence. tauto.
+ intros. right; destruct s; simpl; auto.
+ intros; right; auto.
+ destruct s; try tauto. destruct s0; try tauto.
+ intros; simpl. tauto.
+Qed.
+
+(** ** Location of argument and result for dynamic memory allocation *)
+
+Definition loc_alloc_argument := R3.
+Definition loc_alloc_result := R3.
diff --git a/powerpc/eabi/Stacklayout.v b/powerpc/eabi/Stacklayout.v
new file mode 100644
index 0000000000000000000000000000000000000000..f641847e92c5c27161c81fef5d63c299315c97be
--- /dev/null
+++ b/powerpc/eabi/Stacklayout.v
@@ -0,0 +1,79 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Machine- and ABI-dependent layout information for activation records. *)
+
+Require Import Coqlib.
+Require Import Bounds.
+
+(** In the PowerPC/EABI application binary interface,
+ the general shape of activation records is as follows,
+ from bottom (lowest offsets) to top:
+- 8 reserved bytes. The first 4 bytes hold the back pointer to the
+ activation record of the caller. The next 4 bytes hold the
+ return address.
+- Space for outgoing arguments to function calls.
+- Local stack slots of integer type.
+- Saved values of integer callee-save registers used by the function.
+- One word of padding, if necessary to align the following data
+ on a 8-byte boundary.
+- Local stack slots of float type.
+- Saved values of float callee-save registers used by the function.
+- Space for the stack-allocated data declared in Cminor.
+
+To facilitate some of the proofs, the Cminor stack-allocated data
+starts at offset 0; the preceding areas in the activation record
+therefore have negative offsets. This part (with negative offsets)
+is called the ``frame'', by opposition with the ``Cminor stack data''
+which is the part with positive offsets.
+
+The [frame_env] compilation environment records the positions of
+the boundaries between areas in the frame part.
+*)
+
+Definition fe_ofs_arg := 8.
+
+Record frame_env : Set := mk_frame_env {
+ fe_size: Z;
+ fe_ofs_link: Z;
+ fe_ofs_retaddr: Z;
+ fe_ofs_int_local: Z;
+ fe_ofs_int_callee_save: Z;
+ fe_num_int_callee_save: Z;
+ fe_ofs_float_local: Z;
+ fe_ofs_float_callee_save: Z;
+ fe_num_float_callee_save: Z
+}.
+
+(** Computation of the frame environment from the bounds of the current
+ function. *)
+
+Definition make_env (b: bounds) :=
+ let oil := 8 + 4 * b.(bound_outgoing) in (* integer locals *)
+ let oics := oil + 4 * b.(bound_int_local) in (* integer callee-saves *)
+ let oendi := oics + 4 * b.(bound_int_callee_save) in
+ let ofl := align oendi 8 in (* float locals *)
+ let ofcs := ofl + 8 * b.(bound_float_local) in (* float callee-saves *)
+ let sz := ofcs + 8 * b.(bound_float_callee_save) in (* total frame size *)
+ mk_frame_env sz 0 4
+ oil oics b.(bound_int_callee_save)
+ ofl ofcs b.(bound_float_callee_save).
+
+
+Remark align_float_part:
+ forall b,
+ 8 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b <=
+ align (8 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b) 8.
+Proof.
+ intros. apply align_le. omega.
+Qed.
+
diff --git a/backend/Conventions.v b/powerpc/macosx/Conventions.v
similarity index 99%
rename from backend/Conventions.v
rename to powerpc/macosx/Conventions.v
index b7d931f553794f7dcdefc5461b617135756f5e96..4f06b415a7a4008996abd3b41f5642031c8ab64b 100644
--- a/backend/Conventions.v
+++ b/powerpc/macosx/Conventions.v
@@ -27,7 +27,7 @@ Require Import Locations.
-- Callee-save registers, whose value is preserved across a function call.
-- Caller-save registers that can be modified during a function call.
- We follow the PowerPC application binary interface (ABI) in our choice
+ We follow the PowerPC/MacOSX application binary interface (ABI) in our choice
of callee- and caller-save registers.
*)
@@ -304,8 +304,8 @@ Qed.
of function arguments), but this leaves much liberty in choosing actual
locations. To ensure binary interoperability of code generated by our
compiler with libraries compiled by another PowerPC compiler, we
- implement the standard conventions defined in the PowerPC application
- binary interface. *)
+ implement the standard conventions defined in the PowerPC/MacOS X
+ application binary interface. *)
(** ** Location of function result *)
diff --git a/powerpc/macosx/Stacklayout.v b/powerpc/macosx/Stacklayout.v
new file mode 100644
index 0000000000000000000000000000000000000000..0e9be22406bd3df650be4d1f9c286c03e939af17
--- /dev/null
+++ b/powerpc/macosx/Stacklayout.v
@@ -0,0 +1,79 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Xavier Leroy, INRIA Paris-Rocquencourt *)
+(* *)
+(* Copyright Institut National de Recherche en Informatique et en *)
+(* Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the INRIA Non-Commercial License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+(** Machine- and ABI-dependent layout information for activation records. *)
+
+Require Import Coqlib.
+Require Import Bounds.
+
+(** The general shape of activation records is as follows,
+ from bottom (lowest offsets) to top:
+- 24 reserved bytes. The first 4 bytes hold the back pointer to the
+ activation record of the caller. We use the 4 bytes at offset 12
+ to store the return address. (These are reserved by the PowerPC
+ application binary interface.) The remaining bytes are unused.
+- Space for outgoing arguments to function calls.
+- Local stack slots of integer type.
+- Saved values of integer callee-save registers used by the function.
+- One word of padding, if necessary to align the following data
+ on a 8-byte boundary.
+- Local stack slots of float type.
+- Saved values of float callee-save registers used by the function.
+- Space for the stack-allocated data declared in Cminor.
+
+To facilitate some of the proofs, the Cminor stack-allocated data
+starts at offset 0; the preceding areas in the activation record
+therefore have negative offsets. This part (with negative offsets)
+is called the ``frame'', by opposition with the ``Cminor stack data''
+which is the part with positive offsets.
+
+The [frame_env] compilation environment records the positions of
+the boundaries between areas in the frame part.
+*)
+
+Definition fe_ofs_arg := 24.
+
+Record frame_env : Set := mk_frame_env {
+ fe_size: Z;
+ fe_ofs_link: Z;
+ fe_ofs_retaddr: Z;
+ fe_ofs_int_local: Z;
+ fe_ofs_int_callee_save: Z;
+ fe_num_int_callee_save: Z;
+ fe_ofs_float_local: Z;
+ fe_ofs_float_callee_save: Z;
+ fe_num_float_callee_save: Z
+}.
+
+(** Computation of the frame environment from the bounds of the current
+ function. *)
+
+Definition make_env (b: bounds) :=
+ let oil := 24 + 4 * b.(bound_outgoing) in (* integer locals *)
+ let oics := oil + 4 * b.(bound_int_local) in (* integer callee-saves *)
+ let oendi := oics + 4 * b.(bound_int_callee_save) in
+ let ofl := align oendi 8 in (* float locals *)
+ let ofcs := ofl + 8 * b.(bound_float_local) in (* float callee-saves *)
+ let sz := ofcs + 8 * b.(bound_float_callee_save) in (* total frame size *)
+ mk_frame_env sz 0 12
+ oil oics b.(bound_int_callee_save)
+ ofl ofcs b.(bound_float_callee_save).
+
+
+Remark align_float_part:
+ forall b,
+ 24 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b <=
+ align (24 + 4 * bound_outgoing b + 4 * bound_int_local b + 4 * bound_int_callee_save b) 8.
+Proof.
+ intros. apply align_le. omega.
+Qed.
+