Fusion de la branche "traces":

- Ajout de traces d'evenements d'E/S dans les semantiques
- Ajout constructions switch et allocation dynamique
- Initialisation des variables globales
- Portage Coq 8.1 beta
Debut d'integration du front-end C:
- Traduction Clight -> Csharpminor dans cfrontend/
- Modifications de Csharpminor et Globalenvs en consequence.


git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@72 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

88 files changed, 11331 insertions, 8418 deletions

diff --git a/.depend b/.depend
index dc2aa64..c35ce16 100644
--- a/.depend
+++ b/.depend
@@ -5,60 +5,68 @@ lib/union_find.vo: lib/union_find.v
 lib/Inclusion.vo: lib/Inclusion.v
 lib/Lattice.vo: lib/Lattice.v lib/Coqlib.vo lib/Maps.vo
 lib/Ordered.vo: lib/Ordered.v lib/Coqlib.vo lib/Maps.vo
-lib/Integers.vo: lib/Integers.v lib/Coqlib.vo backend/AST.vo
-lib/Floats.vo: lib/Floats.v backend/AST.vo lib/Integers.vo
-backend/AST.vo: backend/AST.v lib/Coqlib.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/Integers.vo
+lib/Parmov.vo: lib/Parmov.v lib/Coqlib.vo
+backend/AST.vo: backend/AST.v lib/Coqlib.vo lib/Integers.vo lib/Floats.vo
 backend/Values.vo: backend/Values.v lib/Coqlib.vo backend/AST.vo lib/Integers.vo lib/Floats.vo
 backend/Mem.vo: backend/Mem.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo
+backend/Events.vo: backend/Events.v lib/Coqlib.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo
 backend/Globalenvs.vo: backend/Globalenvs.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo
 backend/Op.vo: backend/Op.v lib/Coqlib.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo
-backend/Cminor.vo: backend/Cminor.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Op.vo backend/Globalenvs.vo
+backend/Cminor.vo: backend/Cminor.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Events.vo backend/Values.vo backend/Mem.vo backend/Op.vo backend/Globalenvs.vo
 backend/Cmconstr.vo: backend/Cmconstr.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Op.vo backend/Globalenvs.vo backend/Cminor.vo
-backend/Cmconstrproof.vo: backend/Cmconstrproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Op.vo backend/Globalenvs.vo backend/Cminor.vo backend/Cmconstr.vo
-backend/Csharpminor.vo: backend/Csharpminor.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo
+backend/Cmconstrproof.vo: backend/Cmconstrproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Op.vo backend/Globalenvs.vo backend/Cminor.vo backend/Cmconstr.vo
+backend/Csharpminor.vo: backend/Csharpminor.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo
 backend/Cminorgen.vo: backend/Cminorgen.v lib/Coqlib.vo lib/Maps.vo lib/Sets.vo backend/AST.vo lib/Integers.vo backend/Mem.vo backend/Csharpminor.vo backend/Op.vo backend/Cminor.vo backend/Cmconstr.vo
-backend/Cminorgenproof.vo: backend/Cminorgenproof.v lib/Coqlib.vo lib/Maps.vo lib/Sets.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Csharpminor.vo backend/Op.vo backend/Cminor.vo backend/Cmconstr.vo backend/Cminorgen.vo backend/Cmconstrproof.vo
+backend/Cminorgenproof.vo: backend/Cminorgenproof.v lib/Coqlib.vo lib/Maps.vo lib/Sets.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo backend/Csharpminor.vo backend/Op.vo backend/Cminor.vo backend/Cmconstr.vo backend/Cminorgen.vo backend/Cmconstrproof.vo
 backend/Registers.vo: backend/Registers.v lib/Coqlib.vo backend/AST.vo lib/Maps.vo lib/Sets.vo
-backend/RTL.vo: backend/RTL.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo
+backend/RTL.vo: backend/RTL.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Events.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo
 backend/RTLgen.vo: backend/RTLgen.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Op.vo backend/Registers.vo backend/Cminor.vo backend/RTL.vo
-backend/RTLgenproof1.vo: backend/RTLgenproof1.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/Cminor.vo backend/RTL.vo backend/RTLgen.vo
-backend/RTLgenproof.vo: backend/RTLgenproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/Cminor.vo backend/RTL.vo backend/RTLgen.vo backend/RTLgenproof1.vo
-backend/RTLtyping.vo: backend/RTLtyping.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Op.vo backend/Registers.vo backend/RTL.vo lib/union_find.vo backend/Globalenvs.vo backend/Values.vo backend/Mem.vo lib/Integers.vo
-backend/Kildall.vo: backend/Kildall.v lib/Coqlib.vo lib/Maps.vo lib/Lattice.vo
+backend/RTLgenproof1.vo: backend/RTLgenproof1.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Events.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/Cminor.vo backend/RTL.vo backend/RTLgen.vo
+backend/RTLgenproof.vo: backend/RTLgenproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/Cminor.vo backend/RTL.vo backend/RTLgen.vo backend/RTLgenproof1.vo
+backend/RTLtyping.vo: backend/RTLtyping.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/Conventions.vo backend/Globalenvs.vo backend/Values.vo backend/Mem.vo lib/Integers.vo backend/Events.vo
+backend/Kildall.vo: backend/Kildall.v lib/Coqlib.vo lib/Iteration.vo lib/Maps.vo lib/Lattice.vo
 backend/Constprop.vo: backend/Constprop.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/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 backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo backend/Constprop.vo
+backend/Constpropproof.vo: backend/Constpropproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Events.vo backend/Mem.vo backend/Globalenvs.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 backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/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 backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Registers.vo backend/RTL.vo backend/Kildall.vo backend/CSE.vo
+backend/CSEproof.vo: backend/CSEproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.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 backend/AST.vo backend/Values.vo
 backend/Conventions.vo: backend/Conventions.v lib/Coqlib.vo backend/AST.vo backend/Locations.vo
-backend/LTL.vo: backend/LTL.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo
+backend/LTL.vo: backend/LTL.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Events.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo
 backend/LTLtyping.vo: backend/LTLtyping.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Op.vo backend/RTL.vo backend/Locations.vo backend/LTL.vo backend/Conventions.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 backend/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 backend/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/Parallelmove.vo: backend/Parallelmove.v backend/Conventions.vo lib/Coqlib.vo backend/Values.vo backend/LTL.vo backend/Locations.vo backend/AST.vo
+backend/Parallelmove.vo: backend/Parallelmove.v lib/Coqlib.vo lib/Parmov.vo backend/Values.vo backend/Events.vo backend/AST.vo backend/Locations.vo backend/Conventions.vo
 backend/Allocation.vo: backend/Allocation.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/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/Parallelmove.vo backend/LTL.vo
-backend/Allocproof_aux.vo: backend/Allocproof_aux.v lib/Coqlib.vo backend/Values.vo backend/Parallelmove.vo backend/Allocation.vo backend/LTL.vo backend/Locations.vo backend/Conventions.vo
-backend/Allocproof.vo: backend/Allocproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/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/Allocproof_aux.vo backend/LTL.vo
-backend/Alloctyping_aux.vo: backend/Alloctyping_aux.v lib/Coqlib.vo backend/Locations.vo backend/LTL.vo backend/Allocation.vo backend/LTLtyping.vo backend/Allocproof_aux.vo backend/Parallelmove.vo lib/Inclusion.vo
-backend/Alloctyping.vo: backend/Alloctyping.v lib/Coqlib.vo lib/Maps.vo backend/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/Alloctyping_aux.vo
+backend/Allocproof.vo: backend/Allocproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/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/Parallelmove.vo backend/Allocation.vo backend/LTL.vo
+backend/Alloctyping.vo: backend/Alloctyping.v lib/Coqlib.vo lib/Maps.vo backend/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/Parallelmove.vo
 backend/Tunneling.vo: backend/Tunneling.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Values.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo
-backend/Tunnelingproof.vo: backend/Tunnelingproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Tunneling.vo
+backend/Tunnelingproof.vo: backend/Tunnelingproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.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 backend/AST.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/LTLtyping.vo backend/Tunneling.vo
-backend/Linear.vo: backend/Linear.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Conventions.vo
+backend/Linear.vo: backend/Linear.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.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 backend/AST.vo backend/Op.vo backend/RTL.vo backend/Locations.vo backend/Linear.vo backend/Conventions.vo
 backend/Linearize.vo: backend/Linearize.v lib/Coqlib.vo lib/Maps.vo lib/Sets.vo backend/AST.vo backend/Values.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Linear.vo backend/Kildall.vo lib/Lattice.vo
-backend/Linearizeproof.vo: backend/Linearizeproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Linear.vo backend/Linearize.vo lib/Lattice.vo
+backend/Linearizeproof.vo: backend/Linearizeproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Linear.vo backend/Linearize.vo lib/Lattice.vo
 backend/Linearizetyping.vo: backend/Linearizetyping.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Op.vo backend/Locations.vo backend/LTL.vo backend/Linear.vo backend/Linearize.vo backend/LTLtyping.vo backend/Lineartyping.vo backend/Conventions.vo
-backend/Mach.vo: backend/Mach.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo
-backend/Machabstr.vo: backend/Machabstr.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Mem.vo lib/Integers.vo backend/Values.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Mach.vo
-backend/Machtyping.vo: backend/Machtyping.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Mem.vo lib/Integers.vo backend/Values.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Mach.vo backend/Machabstr.vo
+backend/Mach.vo: backend/Mach.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo
+backend/Machabstr.vo: backend/Machabstr.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Mem.vo lib/Integers.vo backend/Values.vo backend/Events.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Mach.vo
+backend/Machtyping.vo: backend/Machtyping.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Mem.vo lib/Integers.vo backend/Values.vo backend/Events.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Mach.vo backend/Machabstr.vo
 backend/Stacking.vo: backend/Stacking.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Op.vo backend/RTL.vo backend/Locations.vo backend/Linear.vo backend/Lineartyping.vo backend/Mach.vo backend/Conventions.vo
-backend/Stackingproof.vo: backend/Stackingproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Op.vo backend/Mem.vo backend/Globalenvs.vo backend/Locations.vo backend/Mach.vo backend/Machabstr.vo backend/Linear.vo backend/Lineartyping.vo backend/Conventions.vo backend/Stacking.vo
+backend/Stackingproof.vo: backend/Stackingproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Op.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo backend/Locations.vo backend/Mach.vo backend/Machabstr.vo backend/Linear.vo backend/Lineartyping.vo backend/Conventions.vo backend/Stacking.vo
 backend/Stackingtyping.vo: backend/Stackingtyping.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo backend/AST.vo backend/Op.vo backend/Locations.vo backend/Conventions.vo backend/Linear.vo backend/Lineartyping.vo backend/Mach.vo backend/Machtyping.vo backend/Stacking.vo backend/Stackingproof.vo
-backend/Machabstr2mach.vo: backend/Machabstr2mach.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Machabstr.vo backend/Mach.vo backend/Machtyping.vo backend/Stackingproof.vo
-backend/PPC.vo: backend/PPC.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo
+backend/Machabstr2mach.vo: backend/Machabstr2mach.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Machabstr.vo backend/Mach.vo backend/Machtyping.vo backend/Stackingproof.vo
+backend/PPC.vo: backend/PPC.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo
 backend/PPCgen.vo: backend/PPCgen.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/PPC.vo
-backend/PPCgenproof1.vo: backend/PPCgenproof1.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machtyping.vo backend/PPC.vo backend/PPCgen.vo
-backend/PPCgenproof.vo: backend/PPCgenproof.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machtyping.vo backend/PPC.vo backend/PPCgen.vo backend/PPCgenproof1.vo
+backend/PPCgenproof1.vo: backend/PPCgenproof1.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.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 backend/AST.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo backend/Op.vo backend/Locations.vo backend/Mach.vo backend/Machtyping.vo backend/PPC.vo backend/PPCgen.vo backend/PPCgenproof1.vo
 backend/Main.vo: backend/Main.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo backend/Values.vo backend/Csharpminor.vo backend/Cminor.vo backend/RTL.vo backend/LTL.vo backend/Linear.vo backend/Mach.vo backend/PPC.vo backend/Cminorgen.vo backend/RTLgen.vo backend/Constprop.vo backend/CSE.vo backend/Allocation.vo backend/Tunneling.vo backend/Linearize.vo backend/Stacking.vo backend/PPCgen.vo backend/RTLtyping.vo backend/LTLtyping.vo backend/Lineartyping.vo backend/Machtyping.vo backend/Cminorgenproof.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/Stackingproof.vo backend/Stackingtyping.vo backend/Machabstr2mach.vo backend/PPCgenproof.vo
+cfrontend/Csyntax.vo: cfrontend/Csyntax.v lib/Coqlib.vo lib/Integers.vo lib/Floats.vo backend/AST.vo
+cfrontend/Csem.vo: cfrontend/Csem.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo backend/Values.vo backend/AST.vo backend/Mem.vo backend/Events.vo backend/Globalenvs.vo cfrontend/Csyntax.vo
+cfrontend/Ctyping.vo: cfrontend/Ctyping.v lib/Coqlib.vo lib/Maps.vo backend/AST.vo cfrontend/Csyntax.vo
+cfrontend/Cshmgen.vo: cfrontend/Cshmgen.v lib/Coqlib.vo lib/Integers.vo lib/Floats.vo backend/AST.vo cfrontend/Csyntax.vo backend/Csharpminor.vo
+cfrontend/Cshmgenproof1.vo: cfrontend/Cshmgenproof1.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo backend/AST.vo backend/Values.vo backend/Events.vo backend/Mem.vo backend/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Csharpminor.vo cfrontend/Cshmgen.vo
+cfrontend/Cshmgenproof2.vo: cfrontend/Cshmgenproof2.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo backend/AST.vo backend/Values.vo backend/Events.vo backend/Mem.vo backend/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Csharpminor.vo cfrontend/Cshmgen.vo cfrontend/Cshmgenproof1.vo
+cfrontend/Cshmgenproof3.vo: cfrontend/Cshmgenproof3.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo backend/AST.vo backend/Values.vo backend/Events.vo backend/Mem.vo backend/Globalenvs.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Ctyping.vo backend/Csharpminor.vo cfrontend/Cshmgen.vo cfrontend/Cshmgenproof1.vo cfrontend/Cshmgenproof2.vo
diff --git a/Makefile b/Makefile
index 6900b3d..8df29ed 100644
--- a/Makefile
+++ b/Makefile
@@ -2,16 +2,16 @@ COQC=coqc $(INCLUDES)
 COQDEP=coqdep $(INCLUDES)
 COQDOC=coqdoc
 
-INCLUDES=-I lib -I backend
+INCLUDES=-I lib -I backend -I cfrontend
 
 # Files in lib/
 
 LIB=Coqlib.v Maps.v Sets.v union_find.v Inclusion.v Lattice.v Ordered.v \
-  Integers.v Floats.v
+  Iteration.v Integers.v Floats.v Parmov.v
 
 # Files in backend/
 
-BACKEND=AST.v Values.v Mem.v Globalenvs.v \
+BACKEND=AST.v Values.v Mem.v Events.v Globalenvs.v \
   Op.v Cminor.v \
   Cmconstr.v Cmconstrproof.v \
   Csharpminor.v Cminorgen.v Cminorgenproof.v \
@@ -24,8 +24,7 @@ BACKEND=AST.v Values.v Mem.v Globalenvs.v \
   Locations.v Conventions.v LTL.v LTLtyping.v \
   InterfGraph.v Coloring.v Coloringproof.v \
   Parallelmove.v Allocation.v \
-  Allocproof_aux.v Allocproof.v \
-  Alloctyping_aux.v Alloctyping.v \
+  Allocproof.v Alloctyping.v \
   Tunneling.v Tunnelingproof.v Tunnelingtyping.v \
   Linear.v Lineartyping.v \
   Linearize.v Linearizeproof.v Linearizetyping.v \
@@ -35,11 +34,16 @@ BACKEND=AST.v Values.v Mem.v Globalenvs.v \
   PPC.v PPCgen.v PPCgenproof1.v PPCgenproof.v \
   Main.v
 
+# Files in cfrontend/
+
+CFRONTEND=Csyntax.v Csem.v Ctyping.v Cshmgen.v \
+  Cshmgenproof1.v Cshmgenproof2.v Cshmgenproof3.v 
+
 # All source files
 
-FILES=$(LIB:%=lib/%) $(BACKEND:%=backend/%)
+FILES=$(LIB:%=lib/%) $(BACKEND:%=backend/%) $(CFRONTEND:%=cfrontend/%)
 
-FLATFILES=$(LIB) $(BACKEND)
+FLATFILES=$(LIB) $(BACKEND) $(CFRONTEND)
 
 proof: $(FILES:.v=.vo)
 
diff --git a/backend/AST.v b/backend/AST.v
index aae9e86..1342bef 100644
--- a/backend/AST.v
+++ b/backend/AST.v
@@ -2,6 +2,8 @@
   the abstract syntax trees of many of the intermediate languages. *)
 
 Require Import Coqlib.
+Require Import Integers.
+Require Import Floats.
 
 Set Implicit Arguments.
 
@@ -33,6 +35,12 @@ Record signature : Set := mksignature {
   sig_res: option typ
 }.
 
+Definition proj_sig_res (s: signature) : typ :=
+  match s.(sig_res) with
+  | None => Tint
+  | Some t => t
+  end.
+
 (** Memory accesses (load and store instructions) are annotated by
   a ``memory chunk'' indicating the type, size and signedness of the
   chunk of memory being accessed. *)
@@ -46,41 +54,20 @@ Inductive memory_chunk : Set :=
   | Mfloat32 : memory_chunk        (**r 32-bit single-precision float *)
   | Mfloat64 : memory_chunk.       (**r 64-bit double-precision float *)
 
-(** Comparison instructions can perform one of the six following comparisons
-  between their two operands. *)
-
-Inductive comparison : Set :=
-  | Ceq : comparison               (**r same *)
-  | Cne : comparison               (**r different *)
-  | Clt : comparison               (**r less than *)
-  | Cle : comparison               (**r less than or equal *)
-  | Cgt : comparison               (**r greater than *)
-  | Cge : comparison.              (**r greater than or equal *)
-
-Definition negate_comparison (c: comparison): comparison :=
-  match c with
-  | Ceq => Cne
-  | Cne => Ceq
-  | Clt => Cge
-  | Cle => Cgt
-  | Cgt => Cle
-  | Cge => Clt
-  end.
+(** Initialization data for global variables. *)
 
-Definition swap_comparison (c: comparison): comparison :=
-  match c with
-  | Ceq => Ceq
-  | Cne => Cne
-  | Clt => Cgt
-  | Cle => Cge
-  | Cgt => Clt
-  | Cge => Cle
-  end.
+Inductive init_data: Set :=
+  | Init_int8: int -> init_data
+  | Init_int16: int -> init_data
+  | Init_int32: int -> init_data
+  | Init_float32: float -> init_data
+  | Init_float64: float -> init_data
+  | Init_space: Z -> init_data.
 
 (** Whole programs consist of:
 - a collection of function definitions (name and description);
 - the name of the ``main'' function that serves as entry point in the program;
-- a collection of global variable declarations (name and size in bytes).
+- a collection of global variable declarations (name and initializer).
 
 The type of function descriptions varies among the various intermediate
 languages and is taken as parameter to the [program] type.  The other parts
@@ -89,7 +76,7 @@ of whole programs are common to all languages. *)
 Record program (funct: Set) : Set := mkprogram {
   prog_funct: list (ident * funct);
   prog_main: ident;
-  prog_vars: list (ident * Z)
+  prog_vars: list (ident * list init_data)
 }.
 
 (** We now define a general iterator over programs that applies a given
@@ -214,3 +201,50 @@ Proof.
 Qed.
 
 End TRANSF_PARTIAL_PROGRAM.
+
+(** For most languages, the functions composing the program are either
+  internal functions, defined within the language, or external functions
+  (a.k.a. system calls) that emit an event when applied.  We define
+  a type for such functions and some generic transformation functions. *)
+
+Record external_function : Set := mkextfun {
+  ef_id: ident;
+  ef_sig: signature
+}.
+
+Inductive fundef (F: Set): Set :=
+  | Internal: F -> fundef F
+  | External: external_function -> fundef F.
+
+Implicit Arguments External [F].
+
+Section TRANSF_FUNDEF.
+
+Variable A B: Set.
+Variable transf: A -> B.
+
+Definition transf_fundef (fd: fundef A): fundef B :=
+  match fd with
+  | Internal f => Internal (transf f)
+  | External ef => External ef
+  end.
+
+End TRANSF_FUNDEF.
+
+Section TRANSF_PARTIAL_FUNDEF.
+
+Variable A B: Set.
+Variable transf_partial: A -> option B.
+
+Definition transf_partial_fundef (fd: fundef A): option (fundef B) :=
+  match fd with
+  | Internal f =>
+      match transf_partial f with
+      | None => None
+      | Some f' => Some (Internal f')
+      end
+  | External ef => Some (External ef)
+  end.
+
+End TRANSF_PARTIAL_FUNDEF.
+
diff --git a/backend/Allocation.v b/backend/Allocation.v
index 30f9dcc..d919d1e 100644
--- a/backend/Allocation.v
+++ b/backend/Allocation.v
@@ -87,6 +87,8 @@ Definition transfer
       | Icall sig ros args res s =>
           reg_list_live args
            (reg_sum_live ros (reg_dead res after))
+      | Ialloc arg res s =>
+          reg_live arg (reg_dead res after)
       | Icond cond args ifso ifnot =>
           reg_list_live args after
       | Ireturn optarg =>
@@ -214,20 +216,10 @@ Definition add_move (src dst: loc) (k: block) :=
   length.  This is a parallel move, meaning that arbitrary overlap
   between the sources and destinations is permitted. *)
 
-Fixpoint listsLoc2Moves (src dst : list loc) {struct src} : Moves :=
-  match src, dst with
-  | nil, _ => nil
-  | s :: srcs, nil => nil
-  | s :: srcs, d :: dsts => (s, d) :: listsLoc2Moves srcs dsts
-  end.
-
-Definition parallel_move_order (src dst : list loc) :=
-   Parallelmove.P_move (listsLoc2Moves src dst).
-
 Definition parallel_move (srcs dsts: list loc) (k: block) : block :=
-  List.fold_left
-    (fun k p => add_move (fst p) (snd p) k)
-     (parallel_move_order srcs dsts) k.
+  List.fold_right
+    (fun p k => add_move (fst p) (snd p) k)
+     k (parmove srcs dsts).
 
 (** ** Constructors for LTL instructions *)
 
@@ -261,6 +253,10 @@ Definition add_store (chunk: memory_chunk) (addr: addressing)
         (Bstore chunk addr rargs rsrc (Bgoto s))
   end.
 
+Definition add_alloc (arg: loc) (res: loc) (s: node) :=
+  add_reload arg Conventions.loc_alloc_argument
+    (Balloc (add_spill Conventions.loc_alloc_result res (Bgoto s))).
+
 (** For function calls, we also add appropriate moves to and from
   the canonical locations for function arguments and function results,
   as dictated by the calling conventions. *)
@@ -344,10 +340,12 @@ Definition transf_instr
   | Icall sig ros args res s =>
       add_call sig (sum_left_map assign ros) (List.map assign args)
                    (assign res) s
+  | Ialloc arg res s =>
+      add_alloc (assign arg) (assign res) s
   | Icond cond args ifso ifnot =>
       add_cond cond (List.map assign args) ifso ifnot
   | Ireturn optarg =>
-      add_return (RTL.fn_sig f) (option_map assign optarg)
+      add_return f.(RTL.fn_sig) (option_map assign optarg)
   end.
 
 Definition transf_entrypoint
@@ -391,7 +389,7 @@ Qed.
   transformation as described above. *)
 
 Definition transf_function (f: RTL.function) : option LTL.function :=
-  match type_rtl_function f with
+  match type_function f with
   | None => None
   | Some env =>
     match analyze f with
@@ -413,6 +411,17 @@ Definition transf_function (f: RTL.function) : option LTL.function :=
     end
   end.
 
+Definition transf_fundef (fd: RTL.fundef) : option LTL.fundef :=
+  match fd with
+  | External ef =>
+      if type_external_function ef then Some (External ef) else None
+  | Internal f =>
+      match transf_function f with
+      | None => None
+      | Some tf => Some (Internal tf)
+      end
+  end.
+
 Definition transf_program (p: RTL.program) : option LTL.program :=
-  transform_partial_program transf_function p.
+  transform_partial_program transf_fundef p.
 
diff --git a/backend/Allocproof.v b/backend/Allocproof.v
index 138e6d7..07c0f58 100644
--- a/backend/Allocproof.v
+++ b/backend/Allocproof.v
@@ -8,6 +8,7 @@ Require Import AST.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Registers.
@@ -17,8 +18,8 @@ Require Import Locations.
 Require Import Conventions.
 Require Import Coloring.
 Require Import Coloringproof.
+Require Import Parallelmove.
 Require Import Allocation.
-Require Import Allocproof_aux.
 
 (** * Semantic properties of calling conventions *)
 
@@ -473,7 +474,7 @@ Qed.
 Lemma add_reload_correct:
   forall src dst k rs m,
   exists rs',
-  exec_instrs ge sp (add_reload src dst k) rs m k rs' m /\
+  exec_instrs ge sp (add_reload src dst k) rs m E0 k rs' m /\
   rs' (R dst) = rs src /\
   forall l, Loc.diff (R dst) l -> rs' l = rs l.
 Proof.
@@ -493,7 +494,7 @@ Qed.
 Lemma add_spill_correct:
   forall src dst k rs m,
   exists rs',
-  exec_instrs ge sp (add_spill src dst k) rs m k rs' m /\
+  exec_instrs ge sp (add_spill src dst k) rs m E0 k rs' m /\
   rs' dst = rs (R src) /\
   forall l, Loc.diff dst l -> rs' l = rs l.
 Proof.
@@ -520,7 +521,7 @@ Lemma add_reloads_correct_rec:
   list_norepet itmps ->
   list_norepet ftmps ->
   exists rs',
-  exec_instrs ge sp (add_reloads srcs (regs_for_rec srcs itmps ftmps) k) rs m k rs' m /\
+  exec_instrs ge sp (add_reloads srcs (regs_for_rec srcs itmps ftmps) k) rs m E0 k rs' m /\
   reglist (regs_for_rec srcs itmps ftmps) rs' = map rs srcs /\
   (forall r, ~(In r itmps) -> ~(In r ftmps) -> rs' (R r) = rs (R r)) /\
   (forall s, rs' (S s) = rs (S s)).
@@ -578,7 +579,7 @@ Proof.
   generalize (IHsrcs itmps ftmps k rs1 m R1 R2 R3 R4 R5 R6 R7).
   intros [rs' [EX [RES [OTH1 OTH2]]]].
   exists rs'.
-  split. eapply exec_trans; eauto.
+  split. eapply exec_trans; eauto. traceEq.
   split. simpl. apply (f_equal2 (@cons val)). 
   rewrite OTH1; auto.
   rewrite RES. apply list_map_exten. intros.
@@ -599,7 +600,7 @@ Lemma add_reloads_correct:
   (List.length srcs <= 3)%nat ->
   Loc.disjoint srcs temporaries ->
   exists rs',
-  exec_instrs ge sp (add_reloads srcs (regs_for srcs) k) rs m k rs' m /\
+  exec_instrs ge sp (add_reloads srcs (regs_for srcs) k) rs m E0 k rs' m /\
   reglist (regs_for srcs) rs' = List.map rs srcs /\
   forall l, Loc.notin l temporaries -> rs' l = rs l.
 Proof.
@@ -638,7 +639,7 @@ Qed.
 Lemma add_move_correct:
   forall src dst k rs m,
   exists rs',
-  exec_instrs ge sp (add_move src dst k) rs m k rs' m /\
+  exec_instrs ge sp (add_move src dst k) rs m E0 k rs' m /\
   rs' dst = rs src /\
   forall l, Loc.diff l dst -> Loc.diff l (R IT1) -> Loc.diff l (R FT1) -> rs' l = rs l.
 Proof.
@@ -660,13 +661,33 @@ Proof.
   generalize (add_spill_correct tmp (S s0) k rs1 m);
   intros [rs2 [EX2 [RES2 OTH2]]].
   exists rs2. split.
-  eapply exec_trans; eauto.
+  eapply exec_trans; eauto. traceEq.
   split. congruence.
   intros. rewrite OTH2. apply OTH1. 
   apply Loc.diff_sym. unfold tmp; case (slot_type s); auto.
   apply Loc.diff_sym; auto.
 Qed.
 
+Lemma effect_move_sequence:
+  forall k moves rs m,
+  let k' := List.fold_right (fun p k => add_move (fst p) (snd p) k) k moves in
+  exists rs',
+  exec_instrs ge sp k' rs m E0 k rs' m /\
+  effect_seqmove moves rs rs'.
+Proof.
+  induction moves; intros until m; simpl.
+  exists rs; split. constructor. constructor.
+  destruct a as [src dst]; simpl.
+  set (k1 := fold_right
+              (fun (p : loc * loc) (k : block) => add_move (fst p) (snd p) k)
+              k moves) in *.
+  destruct (add_move_correct src dst k1 rs m) as [rs1 [A [B C]]].
+  destruct (IHmoves rs1 m) as [rs' [D E]].
+  exists rs'; split. 
+  eapply exec_trans; eauto. traceEq.
+  econstructor; eauto. red. tauto. 
+Qed.
+
 Theorem parallel_move_correct:
   forall srcs dsts k rs m,
   List.length srcs = List.length dsts ->
@@ -675,13 +696,16 @@ Theorem parallel_move_correct:
   Loc.disjoint srcs temporaries ->
   Loc.disjoint dsts temporaries ->
   exists rs',
-  exec_instrs ge sp (parallel_move srcs dsts k) rs m k rs' m /\
+  exec_instrs ge sp (parallel_move srcs dsts k) rs m E0 k rs' m /\
   List.map rs' dsts = List.map rs srcs /\
   rs' (R IT3) = rs (R IT3) /\
   forall l, Loc.notin l dsts -> Loc.notin l temporaries -> rs' l = rs l.
 Proof.
-  apply (parallel_move_correctX ge sp).
-  apply add_move_correct.
+  intros. 
+  generalize (effect_move_sequence k (parmove srcs dsts) rs m).
+  intros [rs' [EXEC EFFECT]].
+  exists rs'. split. exact EXEC. 
+  apply effect_parmove; auto.
 Qed.
  
 Lemma add_op_correct:
@@ -690,7 +714,7 @@ Lemma add_op_correct:
   Loc.disjoint args temporaries ->
   eval_operation ge sp op (List.map rs args) = Some v ->
   exists rs',
-  exec_block ge sp (add_op op args res s) rs m (Cont s) rs' m /\
+  exec_block ge sp (add_op op args res s) rs m E0 (Cont s) rs' m /\
   rs' res =  v /\
   forall l, Loc.diff l res -> Loc.notin l temporaries -> rs' l = rs l.
 Proof.
@@ -721,7 +745,7 @@ Proof.
   split. apply exec_Bgoto. eapply exec_trans. eexact EX1. 
   eapply exec_trans; eauto. 
   apply exec_one. unfold rs2. apply exec_Bop. 
-  unfold rargs. rewrite RES1. auto.
+  unfold rargs. rewrite RES1. auto. traceEq.
   split. rewrite RES3. unfold rs2; apply Locmap.gss. 
   intros. rewrite OTHER3. unfold rs2. rewrite Locmap.gso.
   apply OTHER1. assumption. 
@@ -737,7 +761,7 @@ Lemma add_load_correct:
   eval_addressing ge sp addr (List.map rs args) = Some a ->
   loadv chunk m a = Some v ->
   exists rs',
-  exec_block ge sp (add_load chunk addr args res s) rs m (Cont s) rs' m /\
+  exec_block ge sp (add_load chunk addr args res s) rs m E0 (Cont s) rs' m /\
   rs' res = v /\
   forall l, Loc.diff l res -> Loc.notin l temporaries -> rs' l = rs l.
 Proof.
@@ -755,7 +779,7 @@ Proof.
   split. apply exec_Bgoto. eapply exec_trans; eauto.
   eapply exec_trans; eauto. 
   apply exec_one.  unfold rs2. apply exec_Bload with a.
-  unfold rargs; rewrite RES1. assumption. assumption.
+  unfold rargs; rewrite RES1. assumption. assumption. traceEq.
   split. rewrite RES3. unfold rs2; apply Locmap.gss.
   intros. rewrite OTHER3. unfold rs2. rewrite Locmap.gso. 
   apply OTHER1. assumption. 
@@ -772,7 +796,7 @@ Lemma add_store_correct:
   eval_addressing ge sp addr (List.map rs args) = Some a ->
   storev chunk m a (rs src) = Some m' ->
   exists rs',
-  exec_block ge sp (add_store chunk addr args src s) rs m (Cont s) rs' m' /\
+  exec_block ge sp (add_store chunk addr args src s) rs m E0 (Cont s) rs' m' /\
   forall l, Loc.notin l temporaries -> rs' l = rs l.
 Proof.
   intros. 
@@ -795,10 +819,42 @@ Proof.
   split. apply exec_Bgoto. 
   eapply exec_trans. rewrite <- EQ. eexact EX1. 
   apply exec_one. apply exec_Bstore with a. 
-  rewrite RES2. assumption. rewrite RES3. assumption.
+  rewrite RES2. assumption. rewrite RES3. assumption. traceEq.
   exact OTHER1.
 Qed.
 
+Lemma add_alloc_correct:
+  forall arg res s rs m m' sz b,
+  rs arg = Vint sz ->
+  Mem.alloc m 0 (Int.signed sz) = (m', b) ->
+  exists rs',
+  exec_block ge sp (add_alloc arg res s) rs m E0 (Cont s) rs' m' /\
+  rs' res = Vptr b Int.zero /\
+  forall l,
+    Loc.diff l (R Conventions.loc_alloc_argument) ->
+    Loc.diff l (R Conventions.loc_alloc_result) ->
+    Loc.diff l res -> 
+    rs' l = rs l.
+Proof.
+  intros; unfold add_alloc.
+  generalize (add_reload_correct arg loc_alloc_argument
+                (Balloc (add_spill loc_alloc_result res (Bgoto s)))
+                rs m).
+  intros [rs1 [EX1 [RES1 OTHER1]]].
+  pose (rs2 := Locmap.set (R loc_alloc_result) (Vptr b Int.zero) rs1).
+  generalize (add_spill_correct loc_alloc_result res (Bgoto s) rs2 m').
+  intros [rs3 [EX3 [RES3 OTHER3]]].
+  exists rs3.
+  split. apply exec_Bgoto. eapply exec_trans. eexact EX1.
+  eapply exec_trans. apply exec_one. eapply exec_Balloc; eauto. congruence. 
+  fold rs2. eexact EX3. reflexivity. traceEq. 
+  split. rewrite RES3; unfold rs2. apply Locmap.gss.
+  intros. rewrite OTHER3. unfold rs2. rewrite Locmap.gso.
+  apply OTHER1. apply Loc.diff_sym; auto.
+  apply Loc.diff_sym; auto.
+  apply Loc.diff_sym; auto.
+Qed.
+
 Lemma add_cond_correct:
   forall cond args ifso ifnot rs m b s,
   (List.length args <= 3)%nat ->
@@ -806,7 +862,7 @@ Lemma add_cond_correct:
   eval_condition cond (List.map rs args) = Some b ->
   s = (if b then ifso else ifnot) ->
   exists rs',
-  exec_block ge sp (add_cond cond args ifso ifnot) rs m (Cont s) rs' m /\
+  exec_block ge sp (add_cond cond args ifso ifnot) rs m E0 (Cont s) rs' m /\
   forall l, Loc.notin l temporaries -> rs' l = rs l.
 Proof.
   intros. unfold add_cond.
@@ -825,7 +881,7 @@ Proof.
   exact OTHER1.
 Qed.
 
-Definition find_function2 (los: loc + ident) (ls: locset) : option function :=
+Definition find_function2 (los: loc + ident) (ls: locset) : option fundef :=
   match los with
   | inl l => Genv.find_funct ge (ls l)
   | inr symb =>
@@ -836,21 +892,21 @@ Definition find_function2 (los: loc + ident) (ls: locset) : option function :=
   end.
 
 Lemma add_call_correct:
-  forall f vargs m vres m' sig los args res s ls
+  forall f vargs m t vres m' sig los args res s ls
     (EXECF:
       forall lsi,
-        List.map lsi (loc_arguments f.(fn_sig)) = vargs ->
+        List.map lsi (loc_arguments (funsig f)) = vargs ->
         exists lso,
-            exec_function ge f lsi m lso m'
-         /\ lso (R (loc_result f.(fn_sig))) = vres)
+            exec_function ge f lsi m t lso m'
+         /\ lso (R (loc_result (funsig f))) = vres)
     (FIND: find_function2 los ls = Some f)
-    (SIG: sig = f.(fn_sig))
+    (SIG: sig = funsig f)
     (VARGS: List.map ls args = vargs)
     (LARGS: List.length args = List.length sig.(sig_args))
     (AARGS: locs_acceptable args)
     (RES: loc_acceptable res),
   exists ls',
-  exec_block ge sp (add_call sig los args res s) ls m (Cont s) ls' m' /\
+  exec_block ge sp (add_call sig los args res s) ls m t (Cont s) ls' m' /\
   ls' res = vres /\
   forall l,
     Loc.notin l destroyed_at_call -> loc_acceptable l -> Loc.diff l res ->
@@ -896,7 +952,7 @@ Proof.
   eapply exec_trans. apply exec_one. apply exec_Bcall with f.
   unfold find_function. rewrite TMP2. rewrite RES1. 
   assumption. assumption. eexact EX3.
-  exact EX5.
+  eexact EX5. reflexivity. reflexivity. traceEq.
   (* Result *)
   split. rewrite RES5. unfold ls4. rewrite return_regs_result. 
   assumption.
@@ -936,7 +992,7 @@ Proof.
   eapply exec_trans. eexact EX2.
   eapply exec_trans. apply exec_one. apply exec_Bcall with f.
   unfold find_function. assumption. assumption. eexact EX3.
-  exact EX5.
+  eexact EX5. reflexivity. traceEq.
   (* Result *)
   split. rewrite RES5. 
   unfold ls4. rewrite return_regs_result. 
@@ -955,7 +1011,7 @@ Lemma add_undefs_correct:
   (forall l, In l res -> loc_acceptable l) ->
   (forall ofs ty, In (S (Local ofs ty)) res -> ls (S (Local ofs ty)) = Vundef) ->
   exists ls',
-  exec_instrs ge sp (add_undefs res b) ls m b ls' m /\
+  exec_instrs ge sp (add_undefs res b) ls m E0 b ls' m /\
   (forall l, In l res -> ls' l = Vundef) /\
   (forall l, Loc.notin l res -> ls' l = ls l).
 Proof.
@@ -972,7 +1028,7 @@ Proof.
   intros [ls2 [EX2 [RES2 OTHER2]]].
   exists ls2. split.
   eapply exec_trans. apply exec_one. apply exec_Bop. 
-  simpl; reflexivity. exact EX2.
+  simpl; reflexivity. eexact EX2. traceEq.
   split. intros. case (In_dec Loc.eq l res); intro.
   apply RES2; auto. 
   rewrite OTHER2. elim H1; intro.
@@ -1006,7 +1062,7 @@ Lemma add_entry_correct:
   locs_acceptable undefs ->
   (forall ofs ty, ls (S (Local ofs ty)) = Vundef) ->
   exists ls',
-  exec_block ge sp (add_entry sig params undefs s) ls m (Cont s) ls' m /\
+  exec_block ge sp (add_entry sig params undefs s) ls m E0 (Cont s) ls' m /\
   List.map ls' params = List.map ls (loc_parameters sig) /\
   (forall l, In l undefs -> ls' l = Vundef).
 Proof.
@@ -1029,7 +1085,7 @@ Proof.
   intros [ls2 [EX2 [RES2 OTHER2]]].
   exists ls2.
   split. apply exec_Bgoto. unfold add_entry. 
-  eapply exec_trans. eexact EX1. eexact EX2.
+  eapply exec_trans. eexact EX1. eexact EX2. traceEq.
   split. rewrite <- RES1. apply list_map_exten. 
   intros. symmetry. apply OTHER2. eapply Loc.disjoint_notin; eauto.
   exact RES2.
@@ -1038,7 +1094,7 @@ Qed.
 Lemma add_return_correct:
   forall sig optarg ls m,
   exists ls',
-  exec_block ge sp (add_return sig optarg) ls m Return ls' m /\
+  exec_block ge sp (add_return sig optarg) ls m E0 Return ls' m /\
   match optarg with
   | Some arg => ls' (R (loc_result sig)) = ls arg
   | None => ls' (R (loc_result sig)) = Vundef
@@ -1131,51 +1187,53 @@ Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
 Proof.
   intro. unfold ge, tge.
-  apply Genv.find_symbol_transf_partial with transf_function.
+  apply Genv.find_symbol_transf_partial with transf_fundef.
   exact TRANSF.
 Qed.
 
 Lemma functions_translated:
-  forall (v: val) (f: RTL.function),
+  forall (v: val) (f: RTL.fundef),
   Genv.find_funct ge v = Some f ->
   exists tf,
-  Genv.find_funct tge v = Some tf /\ transf_function f = Some tf.
+  Genv.find_funct tge v = Some tf /\ transf_fundef f = Some tf.
 Proof.  
   intros. 
   generalize 
-   (Genv.find_funct_transf_partial transf_function TRANSF H).
-  case (transf_function f).
+   (Genv.find_funct_transf_partial transf_fundef TRANSF H).
+  case (transf_fundef f).
   intros tf [A B]. exists tf. tauto.
   intros [A B]. elim B. reflexivity.
 Qed.
 
 Lemma function_ptr_translated:
-  forall (b: Values.block) (f: RTL.function),
+  forall (b: Values.block) (f: RTL.fundef),
   Genv.find_funct_ptr ge b = Some f ->
   exists tf,
-  Genv.find_funct_ptr tge b = Some tf /\ transf_function f = Some tf.
+  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = Some tf.
 Proof.  
   intros. 
   generalize 
-   (Genv.find_funct_ptr_transf_partial transf_function TRANSF H).
-  case (transf_function f).
+   (Genv.find_funct_ptr_transf_partial transf_fundef TRANSF H).
+  case (transf_fundef f).
   intros tf [A B]. exists tf. tauto.
   intros [A B]. elim B. reflexivity.
 Qed.
 
 Lemma sig_function_translated:
   forall f tf,
-  transf_function f = Some tf ->
-  tf.(LTL.fn_sig) = f.(RTL.fn_sig).
+  transf_fundef f = Some tf ->
+  LTL.funsig tf = RTL.funsig f.
 Proof.
-  intros f tf. unfold transf_function.
-  destruct (type_rtl_function f).
+  intros f tf. destruct f; simpl. 
+  unfold transf_function.
+  destruct (type_function f).
   destruct (analyze f).
-  destruct (regalloc f t0). 
+  destruct (regalloc f t). 
   intro EQ; injection EQ; intro EQ1; rewrite <- EQ1; simpl; auto.
-  intros; discriminate.
-  intros; discriminate.
-  intros; discriminate.
+  congruence. congruence. congruence.
+  destruct (type_external_function e).
+  intro EQ; inversion EQ; subst tf. reflexivity.
+  congruence.
 Qed.
 
 Lemma entrypoint_function_translated:
@@ -1184,9 +1242,9 @@ Lemma entrypoint_function_translated:
   tf.(LTL.fn_entrypoint) = f.(RTL.fn_nextpc).
 Proof.
   intros f tf. unfold transf_function.
-  destruct (type_rtl_function f).
+  destruct (type_function f).
   destruct (analyze f).
-  destruct (regalloc f t0). 
+  destruct (regalloc f t). 
   intro EQ; injection EQ; intro EQ1; rewrite <- EQ1; simpl; auto.
   intros; discriminate.
   intros; discriminate.
@@ -1220,43 +1278,43 @@ Qed.
 
 Definition exec_instr_prop
         (c: RTL.code) (sp: val)
-        (pc: node) (rs: regset) (m: mem)
+        (pc: node) (rs: regset) (m: mem) (t: trace)
         (pc': node) (rs': regset) (m': mem) : Prop :=
   forall f env live assign ls
          (CF: c = f.(RTL.fn_code))
-         (WT: wt_function env f)
+         (WT: wt_function f env)
          (ASG: regalloc f live (live0 f live) env = Some assign)
          (AG: agree assign (transfer f pc live!!pc) rs ls),
   let tc := PTree.map (transf_instr f live assign) c in
   exists ls',
-    exec_blocks tge tc sp pc ls m (Cont pc') ls' m' /\
+    exec_blocks tge tc sp pc ls m t (Cont pc') ls' m' /\
     agree assign live!!pc rs' ls'.
 
 Definition exec_instrs_prop
         (c: RTL.code) (sp: val)
-        (pc: node) (rs: regset) (m: mem)
+        (pc: node) (rs: regset) (m: mem) (t: trace)
         (pc': node) (rs': regset) (m': mem) : Prop :=
   forall f env live assign ls,
   forall (CF: c = f.(RTL.fn_code))
-         (WT: wt_function env f)
+         (WT: wt_function f env)
          (ANL: analyze f = Some live)
          (ASG: regalloc f live (live0 f live) env = Some assign)
          (AG: agree assign (transfer f pc live!!pc) rs ls)
          (VALIDPC': c!pc' <> None),
   let tc := PTree.map (transf_instr f live assign) c in
   exists ls',
-    exec_blocks tge tc sp pc ls m (Cont pc') ls' m' /\
+    exec_blocks tge tc sp pc ls m t (Cont pc') ls' m' /\
     agree assign (transfer f pc' live!!pc') rs' ls'.
 
 Definition exec_function_prop
-        (f: RTL.function) (args: list val) (m: mem)
-        (res: val) (m': mem) : Prop :=
+        (f: RTL.fundef) (args: list val) (m: mem)
+        (t: trace) (res: val) (m': mem) : Prop :=
   forall ls tf,
-  transf_function f = Some tf ->
-  List.map ls (Conventions.loc_arguments tf.(fn_sig)) = args ->
+  transf_fundef f = Some tf ->
+  List.map ls (Conventions.loc_arguments (funsig tf)) = args ->
   exists ls',
-    LTL.exec_function tge tf ls m ls' m' /\
-    ls' (R (Conventions.loc_result tf.(fn_sig))) = res.
+    LTL.exec_function tge tf ls m t ls' m' /\
+    ls' (R (Conventions.loc_result (funsig tf))) = res.
 
 (** The simulation proof is by structural induction over the RTL evaluation
   derivation.  We prove each case of the proof as a separate lemma.
@@ -1298,7 +1356,7 @@ Lemma transl_Inop_correct:
  forall (c : PTree.t instruction) (sp: val) (pc : positive)
     (rs : regset) (m : mem) (pc' : RTL.node),
   c ! pc = Some (Inop pc') ->
-  exec_instr_prop c sp pc rs m pc' rs m.
+  exec_instr_prop c sp pc rs m E0 pc' rs m.
 Proof.
   intros; red; intros; CleanupHyps.
   exists ls. split.
@@ -1312,7 +1370,7 @@ Lemma transl_Iop_correct:
     (res : reg) (pc' : RTL.node) (v: val),
   c ! pc = Some (Iop op args res pc') ->
   eval_operation ge sp op (rs ## args) = Some v ->
-  exec_instr_prop c sp pc rs m pc' (rs # res <- v) m.
+  exec_instr_prop c sp pc rs m E0 pc' (rs # res <- v) m.
 Proof.
   intros; red; intros; CleanupHyps.
   caseEq (Regset.mem res live!!pc); intro LV;
@@ -1364,7 +1422,7 @@ Lemma transl_Iload_correct:
   c ! pc = Some (Iload chunk addr args dst pc') ->
   eval_addressing ge sp addr rs ## args = Some a ->
   loadv chunk m a = Some v ->
-  exec_instr_prop c sp pc rs m pc' rs # dst <- v m.
+  exec_instr_prop c sp pc rs m E0 pc' rs # dst <- v m.
 Proof.
   intros; red; intros; CleanupHyps.
   caseEq (Regset.mem dst live!!pc); intro LV;
@@ -1407,7 +1465,7 @@ Lemma transl_Istore_correct:
   c ! pc = Some (Istore chunk addr args src pc') ->
   eval_addressing ge sp addr rs ## args = Some a ->
   storev chunk m a rs # src = Some m' ->
-  exec_instr_prop c sp pc rs m pc' rs m'.
+  exec_instr_prop c sp pc rs m E0 pc' rs m'.
 Proof.
   intros; red; intros; CleanupHyps.
   assert (LL: (List.length (List.map assign args) <= 2)%nat).
@@ -1444,19 +1502,19 @@ Lemma transl_Icall_correct:
  forall (c : PTree.t instruction) (sp: val) (pc : positive)
     (rs : regset) (m : mem) (sig : signature) (ros : reg + ident)
     (args : list reg) (res : reg) (pc' : RTL.node)
-    (f : RTL.function) (vres : val) (m' : mem),
+    (f : RTL.fundef) (vres : val) (m' : mem) (t: trace),
   c ! pc = Some (Icall sig ros args res pc') ->
   RTL.find_function ge ros rs = Some f ->
-  sig = RTL.fn_sig f ->
-  RTL.exec_function ge f (rs##args) m vres m' ->
-  exec_function_prop f (rs##args) m vres m' ->
-  exec_instr_prop c sp pc rs m pc' (rs#res <- vres) m'.
+  RTL.funsig f = sig ->
+  RTL.exec_function ge f (rs##args) m t vres m' ->
+  exec_function_prop f (rs##args) m t vres m' ->
+  exec_instr_prop c sp pc rs m t pc' (rs#res <- vres) m'.
 Proof.
   intros; red; intros; CleanupHyps.
   set (los := sum_left_map assign ros).
   assert (FIND: exists tf,
             find_function2 tge los ls = Some tf /\
-            transf_function f = Some tf).
+            transf_fundef f = Some tf).
     unfold los. destruct ros; simpl; simpl in H0.
     apply functions_translated. 
     replace (ls (assign r)) with rs#r. assumption.
@@ -1466,7 +1524,7 @@ Proof.
     apply function_ptr_translated. auto.
     discriminate.
   elim FIND; intros tf [AFIND TRF]; clear FIND.
-  assert (ASIG: sig = fn_sig tf).
+  assert (ASIG: sig = funsig tf).
     rewrite (sig_function_translated _ _ TRF). auto.
   generalize (fun ls => H3 ls tf TRF); intro AEXECF.
   assert (AVARGS: List.map ls (List.map assign args) = rs##args).
@@ -1482,7 +1540,7 @@ Proof.
   unfold correct_alloc_instr. intros [CORR1 CORR2].
   assert (ARES: loc_acceptable (assign res)).
     eapply regalloc_acceptable; eauto.
-  generalize (add_call_correct tge sp tf _ _ _ _ _ _ _ _ pc' _
+  generalize (add_call_correct tge sp tf _ _ _ _ _ _ _ _ _ pc' _
                 AEXECF AFIND ASIG AVARGS ALARGS
                 AACCEPT ARES).
   intros [ls' [EX [RES OTHER]]].
@@ -1491,13 +1549,42 @@ Proof.
   simpl. eapply agree_call; eauto.
 Qed.
 
+Lemma transl_Ialloc_correct:
+  forall (c : PTree.t instruction) (sp: val) (pc : positive)
+    (rs : Regmap.t val) (m : mem) (pc': RTL.node) (arg res: reg)
+    (sz: int) (m': mem) (b: Values.block),
+  c ! pc = Some (Ialloc arg res pc') ->
+  rs#arg = Vint sz ->
+  Mem.alloc m 0 (Int.signed sz) = (m', b) ->
+  exec_instr_prop c sp pc rs m E0 pc' (rs # res <- (Vptr b Int.zero)) m'.
+Proof.
+  intros; red; intros; CleanupHyps.
+  assert (SZ: ls (assign arg) = Vint sz).
+    rewrite <- H0. eapply agree_eval_reg. eauto.
+  generalize (add_alloc_correct tge sp (assign arg) (assign res)
+                                pc' ls m m' sz b SZ H1).
+  intros [ls' [EX [RES OTHER]]].
+  exists ls'. 
+  split. CleanupGoal. exact EX. 
+  rewrite CF in H.
+  generalize (regalloc_correct_1 f env live _ _ _ _ ASG H). 
+  unfold correct_alloc_instr.  intros [CORR1 CORR2].
+  eapply agree_call with (args := arg :: nil) (ros := inr reg 1%positive) (ls := ls) (ls' := ls'); eauto.
+  intros. apply OTHER. 
+  eapply Loc.in_notin_diff; eauto. 
+  unfold loc_alloc_argument, destroyed_at_call; simpl; tauto.
+  eapply Loc.in_notin_diff; eauto. 
+  unfold loc_alloc_argument, destroyed_at_call; simpl; tauto.
+  auto.
+Qed.
+
 Lemma transl_Icond_true_correct:
  forall (c : PTree.t instruction) (sp: val) (pc : positive)
     (rs : Regmap.t val) (m : mem) (cond : condition) (args : list reg)
     (ifso ifnot : RTL.node),
   c ! pc = Some (Icond cond args ifso ifnot) ->
   eval_condition cond rs ## args = Some true ->
-  exec_instr_prop c sp pc rs m ifso rs m.
+  exec_instr_prop c sp pc rs m E0 ifso rs m.
 Proof.
   intros; red; intros; CleanupHyps.
   assert (LL: (List.length (map assign args) <= 3)%nat).
@@ -1523,7 +1610,7 @@ Lemma transl_Icond_false_correct:
     (ifso ifnot : RTL.node),
   c ! pc = Some (Icond cond args ifso ifnot) ->
   eval_condition cond rs ## args = Some false ->
-  exec_instr_prop c sp pc rs m ifnot rs m.
+  exec_instr_prop c sp pc rs m E0 ifnot rs m.
 Proof.
   intros; red; intros; CleanupHyps.
   assert (LL: (List.length (map assign args) <= 3)%nat).
@@ -1545,7 +1632,7 @@ Qed.
 
 Lemma transl_refl_correct:
  forall (c : RTL.code) (sp: val) (pc : RTL.node) (rs : regset)
-    (m : mem), exec_instrs_prop c sp pc rs m pc rs m.
+    (m : mem), exec_instrs_prop c sp pc rs m E0 pc rs m.
 Proof.
   intros; red; intros. 
   exists ls. split. apply exec_blocks_refl. assumption.
@@ -1553,10 +1640,10 @@ Qed.
 
 Lemma transl_one_correct:
  forall (c : RTL.code) (sp: val) (pc : RTL.node) (rs : regset)
-    (m : mem) (pc' : RTL.node) (rs' : regset) (m' : mem),
-  RTL.exec_instr ge c sp pc rs m pc' rs' m' ->
-  exec_instr_prop c sp pc rs m pc' rs' m' ->
-  exec_instrs_prop c sp pc rs m pc' rs' m'.
+    (m : mem) (t: trace) (pc' : RTL.node) (rs' : regset) (m' : mem),
+  RTL.exec_instr ge c sp pc rs m t pc' rs' m' ->
+  exec_instr_prop c sp pc rs m t pc' rs' m' ->
+  exec_instrs_prop c sp pc rs m t pc' rs' m'.
 Proof.
   intros; red; intros.
   generalize (H0 f env live assign ls CF WT ASG AG).
@@ -1573,13 +1660,14 @@ Qed.
 
 Lemma transl_trans_correct:
  forall (c : RTL.code) (sp: val) (pc1 : RTL.node) (rs1 : regset)
-    (m1 : mem) (pc2 : RTL.node) (rs2 : regset) (m2 : mem)
-    (pc3 : RTL.node) (rs3 : regset) (m3 : mem),
-  RTL.exec_instrs ge c sp pc1 rs1 m1 pc2 rs2 m2 ->
-  exec_instrs_prop c sp pc1 rs1 m1 pc2 rs2 m2 ->
-  RTL.exec_instrs ge c sp pc2 rs2 m2 pc3 rs3 m3 ->
-  exec_instrs_prop c sp pc2 rs2 m2 pc3 rs3 m3 ->
-  exec_instrs_prop c sp pc1 rs1 m1 pc3 rs3 m3.
+    (m1 : mem) (t1: trace) (pc2 : RTL.node) (rs2 : regset) (m2 : mem)
+    (t2: trace) (pc3 : RTL.node) (rs3 : regset) (m3 : mem) (t3: trace),
+  RTL.exec_instrs ge c sp pc1 rs1 m1 t1 pc2 rs2 m2 ->
+  exec_instrs_prop c sp pc1 rs1 m1 t1 pc2 rs2 m2 ->
+  RTL.exec_instrs ge c sp pc2 rs2 m2 t2 pc3 rs3 m3 ->
+  exec_instrs_prop c sp pc2 rs2 m2 t2 pc3 rs3 m3 ->
+  t3 = t1 ** t2 ->
+  exec_instrs_prop c sp pc1 rs1 m1 t3 pc3 rs3 m3.
 Proof.
   intros; red; intros.
   assert (VALIDPC2: c!pc2 <> None).
@@ -1589,7 +1677,7 @@ Proof.
   generalize (H2 f env live assign ls1 CF WT ANL ASG AG1 VALIDPC'). 
   intros [ls2 [EX2 AG2]].
   exists ls2. split.
-  eapply exec_blocks_trans. eexact EX1. exact EX2.
+  eapply exec_blocks_trans. eexact EX1. eexact EX2. auto.
   exact AG2.
 Qed.
 
@@ -1609,14 +1697,14 @@ Qed.
 
 Lemma transf_entrypoint_correct:
   forall f env live assign c ls args sp m,
-  wt_function env f ->
+  wt_function f env ->
   regalloc f live (live0 f live) env = Some assign ->
   c!(RTL.fn_nextpc f) = None ->
   List.map ls (loc_parameters (RTL.fn_sig f)) = args ->
   (forall ofs ty, ls (S (Local ofs ty)) = Vundef) ->
   let tc := transf_entrypoint f live assign c in
   exists ls',
-  exec_blocks tge tc sp (RTL.fn_nextpc f) ls m
+  exec_blocks tge tc sp (RTL.fn_nextpc f) ls m E0
                         (Cont (RTL.fn_entrypoint f)) ls' m /\
   agree assign (transfer f (RTL.fn_entrypoint f) live!!(RTL.fn_entrypoint f))
         (init_regs args (RTL.fn_params f)) ls'.
@@ -1680,20 +1768,20 @@ Qed.
 
 Lemma transl_function_correct:
  forall (f : RTL.function) (m m1 : mem) (stk : Values.block)
-    (args : list val) (pc : RTL.node) (rs : regset) (m2 : mem)
+    (args : list val) (t: trace) (pc : RTL.node) (rs : regset) (m2 : mem)
     (or : option reg) (vres : val),
   alloc m 0 (RTL.fn_stacksize f) = (m1, stk) ->
   RTL.exec_instrs ge (RTL.fn_code f) (Vptr stk Int.zero)
-    (RTL.fn_entrypoint f) (init_regs args (fn_params f)) m1 pc rs m2 ->
+    (RTL.fn_entrypoint f) (init_regs args (fn_params f)) m1 t pc rs m2 ->
   exec_instrs_prop (RTL.fn_code f) (Vptr stk Int.zero)
-    (RTL.fn_entrypoint f) (init_regs args (fn_params f)) m1 pc rs m2 ->
+    (RTL.fn_entrypoint f) (init_regs args (fn_params f)) m1 t pc rs m2 ->
   (RTL.fn_code f) ! pc = Some (Ireturn or) ->
   vres = regmap_optget or Vundef rs ->
-  exec_function_prop f args m vres (free m2 stk).
+  exec_function_prop (Internal f) args m t vres (free m2 stk).
 Proof.
   intros; red; intros until tf.
-  unfold transf_function.
-  caseEq (type_rtl_function f).
+  unfold transf_fundef, transf_function.
+  caseEq (type_function f).
   intros env TRF. 
   caseEq (analyze f).
   intros live ANL.
@@ -1704,7 +1792,7 @@ Proof.
   set (tc1 := PTree.map (transf_instr f live alloc) (RTL.fn_code f)).
   set (tc2 := transf_entrypoint f live alloc tc1).
   intro EQ; injection EQ; intro TF; clear EQ. intro VARGS. 
-  generalize (type_rtl_function_correct _ _ TRF); intro WTF.
+  generalize (type_function_correct _ _ TRF); intro WTF.
   assert (NEWINSTR: tc1!(RTL.fn_nextpc f) = None).
     unfold tc1; rewrite PTree.gmap. unfold option_map.
     elim (RTL.fn_code_wf f (fn_nextpc f)); intro.
@@ -1712,7 +1800,7 @@ Proof.
     rewrite H4. auto.
   pose (ls1 := call_regs ls).
   assert (VARGS1: List.map ls1 (loc_parameters (RTL.fn_sig f)) = args).
-    replace (RTL.fn_sig f) with (fn_sig tf).
+    replace (RTL.fn_sig f) with (funsig tf).
     rewrite <- VARGS. unfold loc_parameters.
     rewrite list_map_compose. apply list_map_exten.
     intros. symmetry. unfold ls1. eapply call_regs_param_of_arg; eauto.
@@ -1732,9 +1820,9 @@ Proof.
   intros [ls4 [EX4 RES4]].
   exists ls4. 
   (* Execution *)
-  split. apply exec_funct with m1. 
-  rewrite <- TF; simpl; assumption.
-  rewrite <- TF; simpl. fold ls1. 
+  split. rewrite <- TF; apply exec_funct_internal with m1; simpl.
+  assumption.
+  fold ls1. 
   eapply exec_blocks_trans. eexact EX2. 
   apply exec_blocks_extends with tc1.
   intro p. unfold tc2. unfold transf_entrypoint.
@@ -1746,7 +1834,7 @@ Proof.
   eapply exec_blocks_trans. eexact EX3.
   eapply exec_blocks_one. 
   unfold tc1. rewrite PTree.gmap. rewrite H2. simpl. reflexivity.
-  exact EX4.
+  eexact EX4. reflexivity. traceEq.
   destruct or.
   simpl in RES4. simpl in H3.
   rewrite H3. rewrite <- TF; simpl. rewrite RES4.
@@ -1760,6 +1848,20 @@ Proof.
   intros; discriminate.
 Qed.
 
+Lemma transl_external_function_correct:
+  forall (ef : external_function) (args : list val) (m : mem)
+         (t: trace) (res: val),
+  event_match ef args t res ->
+  exec_function_prop (External ef) args m t res m.
+Proof.
+  intros; red; intros.
+  simpl in H0. 
+  destruct (type_external_function ef); simplify_eq H0; intro.
+  exists (Locmap.set (R (loc_result (funsig tf))) res ls); split.
+  subst tf. eapply exec_funct_external; eauto. 
+  apply Locmap.gss.
+Qed.
+
 (** The correctness of the code transformation is obtained by
   structural induction (and case analysis on the last rule used)
   on the RTL evaluation derivation.
@@ -1767,14 +1869,10 @@ Qed.
   [exec_instrs_prop] and [exec_function_prop] as the induction
   hypotheses, and the lemmas above as cases for the induction. *)
 
-Scheme exec_instr_ind_3 := Minimality for RTL.exec_instr Sort Prop
-  with exec_instrs_ind_3 := Minimality for RTL.exec_instrs Sort Prop
-  with exec_function_ind_3 := Minimality for RTL.exec_function Sort Prop.
-
 Theorem transl_function_correctness:
-  forall f args m res m',
-  RTL.exec_function ge f args m res m' ->
-  exec_function_prop f args m res m'.
+  forall f args m t res m',
+  RTL.exec_function ge f args m t res m' ->
+  exec_function_prop f args m t res m'.
 Proof
   (exec_function_ind_3 ge 
           exec_instr_prop 
@@ -1786,6 +1884,7 @@ Proof
           transl_Iload_correct
           transl_Istore_correct
           transl_Icall_correct
+          transl_Ialloc_correct
           transl_Icond_true_correct
           transl_Icond_false_correct
 
@@ -1793,23 +1892,24 @@ Proof
           transl_one_correct
           transl_trans_correct
 
-          transl_function_correct).
+          transl_function_correct
+          transl_external_function_correct).
 
 (** The semantic equivalence between the original and transformed programs
   follows easily. *)
 
 Theorem transl_program_correct:
-  forall (r: val),
-  RTL.exec_program prog r -> LTL.exec_program tprog r.
+  forall (t: trace) (r: val),
+  RTL.exec_program prog t r -> LTL.exec_program tprog t r.
 Proof.
-  intros r [b [f [m [FIND1 [FIND2 [SIG EXEC]]]]]].
+  intros t r [b [f [m [FIND1 [FIND2 [SIG EXEC]]]]]].
   generalize (function_ptr_translated _ _ FIND2).
   intros [tf [TFIND TRF]].
-  assert (SIG2: tf.(fn_sig) = mksignature nil (Some Tint)).
+  assert (SIG2: funsig tf = mksignature nil (Some Tint)).
     rewrite <- SIG. apply sig_function_translated; auto.
-  assert (VPARAMS: map (Locmap.init Vundef) (loc_arguments (fn_sig tf)) = nil).
+  assert (VPARAMS: map (Locmap.init Vundef) (loc_arguments (funsig tf)) = nil).
     rewrite SIG2. reflexivity.
-  generalize (transl_function_correctness _ _ _ _ _ EXEC
+  generalize (transl_function_correctness _ _ _ _ _ _ EXEC
                 (Locmap.init Vundef) tf TRF VPARAMS).
   intros [ls' [TEXEC RES]].
   red. exists b; exists tf; exists ls'; exists m.
diff --git a/backend/Allocproof_aux.v b/backend/Allocproof_aux.v
deleted file mode 100644
index d1b213e..0000000
--- a/backend/Allocproof_aux.v
+++ /dev/null
@@ -1,850 +0,0 @@
-(** Correctness results for the [parallel_move] function defined in
-  file [Allocation].
-
-  The present file, contributed by Laurence Rideau, glues the general
-  results over the parallel move algorithm (see file [Parallelmove])
-  with the correctness proof for register allocation (file [Allocproof]).
-*)
-
-Require Import Coqlib.
-Require Import Values.
-Require Import Parallelmove.
-Require Import Allocation.
-Require Import LTL.
-Require Import Locations.
-Require Import Conventions.
- 
-Section parallel_move_correction.
-Variable ge : LTL.genv.
-Variable sp : val.
-Hypothesis
-   add_move_correct :
-   forall src dst k rs m,
-    (exists rs' ,
-     exec_instrs ge sp (add_move src dst k) rs m k rs' m /\
-     (rs' dst = rs src /\
-      (forall l,
-       Loc.diff l dst ->
-       Loc.diff l (R IT1) -> Loc.diff l (R FT1) ->  rs' l = rs l)) ).
- 
-Lemma exec_instr_update:
- forall a1 a2 k e m,
-  (exists rs' ,
-   exec_instrs ge sp (add_move a1 a2 k) e m k rs' m /\
-   (rs' a2 = update e a2 (e a1) a2 /\
-    (forall l,
-     Loc.diff l a2 ->
-     Loc.diff l (R IT1) -> Loc.diff l (R FT1) ->  rs' l = (update e a2 (e a1)) l))
-   ).
-Proof.
-intros; destruct (add_move_correct a1 a2 k e m) as [rs' [Hf [R1 R2]]].
-exists rs'; (repeat split); auto.
-generalize (get_update_id e a2); unfold get, Locmap.get; intros H; rewrite H;
- auto.
-intros l H0; generalize (get_update_diff e a2); unfold get, Locmap.get;
- intros H; rewrite H; auto.
-apply Loc.diff_sym; assumption.
-Qed.
- 
-Lemma map_inv:
- forall (A B : Set) (f f' : A ->  B) l,
- map f l = map f' l -> forall x, In x l ->  f x = f' x.
-Proof.
-induction l; simpl; intros Hmap x Hin.
-elim Hin.
-inversion Hmap.
-elim Hin; intros H; [subst a | apply IHl]; auto.
-Qed.
- 
-Fixpoint reswellFormed (p : Moves) : Prop :=
- match p with
-   nil => True
-  | (s, d) :: l => Loc.notin s (getdst l) /\ reswellFormed l
- end.
- 
-Definition temporaries1 := R IT1 :: (R FT1 :: nil).
- 
-Lemma no_overlap_list_pop:
- forall p m, no_overlap_list (m :: p) ->  no_overlap_list p.
-Proof.
-induction p; unfold no_overlap_list, no_overlap; destruct m as [m1 m2]; simpl;
- auto.
-Qed.
- 
-Lemma exec_instrs_pmov:
- forall p k rs m,
- no_overlap_list p ->
- Loc.disjoint (getdst p) temporaries1 ->
- Loc.disjoint (getsrc p) temporaries1 ->
-  (exists rs' ,
-   exec_instrs
-    ge sp
-    (fold_left
-      (fun (k0 : block) => fun (p0 : loc * loc) => add_move (fst p0) (snd p0) k0)
-      p k) rs m k rs' m /\
-   (forall l,
-    (forall r, In r (getdst p) ->  r = l \/ Loc.diff r l) ->
-    Loc.diff l (Locations.R IT1) ->
-    Loc.diff l (Locations.R FT1) ->  rs' l = (sexec p rs) l) ).
-Proof.
-induction p; intros k rs m.
-simpl; exists rs; (repeat split); auto; apply exec_refl.
-destruct a as [a1 a2]; simpl; intros Hno_O Hdisd Hdiss;
- elim (IHp (add_move a1 a2 k) rs m);
- [idtac | apply no_overlap_list_pop with (a1, a2) |
-  apply (Loc.disjoint_cons_left a2) | apply (Loc.disjoint_cons_left a1)];
- (try assumption).
-intros rs' Hexec;
- destruct (add_move_correct a1 a2 k rs' m) as [rs'' [Hexec2 [R1 R2]]].
-exists rs''; elim Hexec; intros; (repeat split).
-apply exec_trans with ( b2 := add_move a1 a2 k ) ( rs2 := rs' ) ( m2 := m );
- auto.
-intros l Heqd Hdi Hdf; case (Loc.eq a2 l); intro.
-subst l; generalize get_update_id; unfold get, Locmap.get; intros Hgui;
- rewrite Hgui; rewrite R1.
-apply H0; auto.
-unfold no_overlap_list, no_overlap in Hno_O |-; simpl in Hno_O |-; intros;
- generalize (Hno_O a1).
-intros H8; elim H8 with ( s := r );
- [intros H9; left | intros H9; right; apply Loc.diff_sym | left | right]; auto.
-unfold Loc.disjoint in Hdiss |-; apply Hdiss; simpl; left; trivial.
-apply Hdiss; simpl; [left | right; left]; auto.
-elim (Heqd a2);
- [intros H7; absurd (a2 = l); auto | intros H7; auto | left; trivial].
-generalize get_update_diff; unfold get, Locmap.get; intros H6; rewrite H6; auto.
-rewrite R2; auto.
-apply Loc.diff_sym; auto.
-Qed.
- 
-Definition p_move :=
-   fun (l : list (loc * loc)) =>
-   fun (k : block) =>
-   fold_left
-    (fun (k0 : block) => fun (p : loc * loc) => add_move (fst p) (snd p) k0)
-    (P_move l) k.
- 
-Lemma norepet_SD: forall p, Loc.norepet (getdst p) ->  simpleDest p.
-Proof.
-induction p; (simpl; auto).
-destruct a as [a1 a2].
-intro; inversion H.
-split.
-apply notindst_nW; auto.
-apply IHp; auto.
-Qed.
- 
-Theorem SDone_stepf:
- forall S1, StateDone (stepf S1) = nil ->  StateDone S1 = nil.
-Proof.
-destruct S1 as [[t b] d]; destruct t.
-destruct b; auto.
-destruct m as [m1 m2]; simpl.
-destruct b.
-simpl; intro; discriminate.
-case (Loc.eq m2 (fst (last (m :: b)))); simpl; intros; discriminate.
-destruct m as [a1 a2]; simpl.
-destruct b.
-case (Loc.eq a1 a2); simpl; intros; auto.
-destruct m as [m1 m2]; case (Loc.eq a1 m2); intro; (try (simpl; auto; fail)).
-case (split_move t m2).
-(repeat destruct p); simpl; intros; auto.
-destruct b; (try (simpl; intro; discriminate)); auto.
-case (Loc.eq m2 (fst (last (m :: b)))); intro; simpl; intro; discriminate.
-Qed.
- 
-Theorem SDone_Pmov: forall S1, StateDone (Pmov S1) = nil ->  StateDone S1 = nil.
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1; intros Hrec.
-destruct S1 as [[t b] d].
-rewrite Pmov_equation.
-destruct t.
-destruct b; auto.
-intro; assert (StateDone (stepf (nil, m :: b, d)) = nil);
- [apply Hrec; auto; apply stepf1_dec | apply SDone_stepf]; auto.
-intro; assert (StateDone (stepf (m :: t, b, d)) = nil);
- [apply Hrec; auto; apply stepf1_dec | apply SDone_stepf]; auto.
-Qed.
- 
-Lemma no_overlap_temp: forall r s, In s temporaries ->  r = s \/ Loc.diff r s.
-Proof.
-intros r s H; case (Loc.eq r s); intros e; [left | right]; (try assumption).
-unfold Loc.diff; destruct r.
-destruct s; trivial.
-red; intro; elim e; rewrite H0; auto.
-destruct s0; destruct s; trivial;
- (elim H; [intros H1 | intros [H1|[H1|[H1|[H1|[H1|H1]]]]]]; (try discriminate);
-   inversion H1).
-Qed.
- 
-Lemma getsrcdst_app:
- forall l1 l2,
- getdst l1 ++ getdst l2 = getsrc l1 ++ getsrc l2 ->
-  getdst l1 = getsrc l1 /\ getdst l2 = getsrc l2.
-Proof.
-induction l1; simpl; auto.
-destruct a as [a1 a2]; intros; inversion H.
-subst a1; inversion H;
- (elim IHl1 with ( l2 := l2 );
-   [intros H0 H3; (try clear IHl1); (try exact H0) | idtac]; auto).
-rewrite H0; auto.
-Qed.
- 
-Lemma In_norepet:
- forall r x l, Loc.norepet l -> In x l -> In r l ->  r = x \/ Loc.diff r x.
-Proof.
-induction l; simpl; intros.
-elim H1.
-inversion H.
-subst hd.
-elim H1; intros H2; clear H1; elim H0; intros H1.
-rewrite <- H1; rewrite <- H2; auto.
-subst a; right; apply Loc.in_notin_diff with l; auto.
-subst a; right; apply Loc.diff_sym; apply Loc.in_notin_diff with l; auto.
-apply IHl; auto.
-Qed.
- 
-Definition no_overlap_stateD (S : State) :=
-   no_overlap
-    (getsrc (StateToMove S ++ (StateBeing S ++ StateDone S)))
-    (getdst (StateToMove S ++ (StateBeing S ++ StateDone S))).
- 
-Ltac
-incl_tac_rec :=
-(auto with datatypes; fail)
- ||
-   (apply in_cons; incl_tac_rec)
-    ||
-      (apply in_or_app; left; incl_tac_rec)
-       ||
-         (apply in_or_app; right; incl_tac_rec)
-          ||
-            (apply incl_appl; incl_tac_rec) ||
-             (apply incl_appr; incl_tac_rec) || (apply incl_tl; incl_tac_rec).
- 
-Ltac incl_tac := (repeat (apply incl_cons || apply incl_app)); incl_tac_rec.
- 
-Ltac
-in_tac :=
-match goal with
-| |- In ?x ?L1 =>
-match goal with
-| H:In x ?L2 |- _ =>
-let H1 := fresh "H" in
-(assert (H1: incl L2 L1); [incl_tac | apply (H1 x)]); auto; fail
-| _ => fail end end.
- 
-Lemma in_cons_noteq:
- forall (A : Set) (a b : A) (l : list A), In a (b :: l) -> a <> b ->  In a l.
-Proof.
-intros A a b l; simpl; intros.
-elim H; intros H1; (try assumption).
-absurd (a = b); auto.
-Qed.
- 
-Lemma no_overlapD_inv:
- forall S1 S2, step S1 S2 -> no_overlap_stateD S1 ->  no_overlap_stateD S2.
-Proof.
-intros S1 S2 STEP; inversion STEP; unfold no_overlap_stateD, no_overlap; simpl;
- auto; (repeat (rewrite getsrc_app; rewrite getdst_app; simpl)); intros.
-apply H1; in_tac.
-destruct m as [m1 m2]; apply H1; in_tac.
-apply H1; in_tac.
-case (Loc.eq r (T r0)); intros e.
-elim (no_overlap_temp s0 r);
- [intro; left; auto | intro; right; apply Loc.diff_sym; auto | unfold T in e |-].
-destruct (Loc.type r0); simpl; [right; left | right; right; right; right; left];
- auto.
-case (Loc.eq s0 (T r0)); intros es.
-apply (no_overlap_temp r s0); unfold T in es |-; destruct (Loc.type r0); simpl;
- [right; left | right; right; right; right; left]; auto.
-apply H1; apply in_cons_noteq with ( b := T r0 ); auto; in_tac.
-apply H3; in_tac.
-Qed.
- 
-Lemma no_overlapD_invpp:
- forall S1 S2, stepp S1 S2 -> no_overlap_stateD S1 ->  no_overlap_stateD S2.
-Proof.
-intros; induction H as [r|r1 r2 r3 H H1 HrecH]; auto.
-apply HrecH; auto.
-apply no_overlapD_inv with r1; auto.
-Qed.
- 
-Lemma no_overlapD_invf:
- forall S1, stepInv S1 -> no_overlap_stateD S1 ->  no_overlap_stateD (stepf S1).
-Proof.
-intros; destruct S1 as [[t1 b1] d1].
-destruct t1; destruct b1; auto.
-set (S1:=(nil (A:=Move), m :: b1, d1)).
-apply (no_overlapD_invpp S1); [apply dstep_step; auto | assumption].
-apply f2ind; [unfold S1 | idtac | idtac]; auto.
-generalize H0; clear H0; unfold no_overlap_stateD; destruct m as [m1 m2].
-intros; apply no_overlap_noOverlap.
-unfold no_overlap_state; simpl.
-generalize H0; clear H0; unfold no_overlap; (repeat rewrite getdst_app);
- (repeat rewrite getsrc_app); simpl; intros.
-apply H0.
-elim H1; intros H4; [left; assumption | right; in_tac].
-elim H2; intros H4; [left; assumption | right; in_tac].
-set (S1:=(m :: t1, nil (A:=Move), d1)).
-apply (no_overlapD_invpp S1); [apply dstep_step; auto | assumption].
-apply f2ind; [unfold S1 | idtac | idtac]; auto.
-generalize H0; clear H0; unfold no_overlap_stateD; destruct m as [m1 m2].
-intros; apply no_overlap_noOverlap.
-unfold no_overlap_state; simpl.
-generalize H0; clear H0; unfold no_overlap; (repeat rewrite getdst_app);
- (repeat rewrite getsrc_app); simpl; (repeat rewrite app_nil); intros.
-apply H0.
-elim H1; intros H4; [left; assumption | right; (try in_tac)].
-elim H2; intros H4; [left; assumption | right; in_tac].
-set (S1:=(m :: t1, m0 :: b1, d1)).
-apply (no_overlapD_invpp S1); [apply dstep_step; auto | assumption].
-apply f2ind; [unfold S1 | idtac | idtac]; auto.
-generalize H0; clear H0; unfold no_overlap_stateD; destruct m as [m1 m2].
-intros; apply no_overlap_noOverlap.
-unfold no_overlap_state; simpl.
-generalize H0; clear H0; unfold no_overlap; (repeat rewrite getdst_app);
- (repeat rewrite getsrc_app); destruct m0; simpl; intros.
-apply H0.
-elim H1; intros H4; [left; assumption | right; in_tac].
-elim H2; intros H4; [left; assumption | right; in_tac].
-Qed.
- 
-Lemma no_overlapD_res:
- forall S1, stepInv S1 -> no_overlap_stateD S1 ->  no_overlap_stateD (Pmov S1).
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1 Hrec.
-destruct S1 as [[t b] d].
-rewrite Pmov_equation.
-destruct t; auto.
-destruct b; auto.
-intros; apply Hrec.
-apply stepf1_dec; auto.
-apply (dstep_inv (nil, m :: b, d)); auto.
-apply f2ind'; auto.
-apply no_overlap_noOverlap.
-generalize H0; unfold no_overlap_stateD, no_overlap_state, no_overlap; simpl.
-destruct m; (repeat rewrite getdst_app); (repeat rewrite getsrc_app).
-intros H1 r1 H2 s H3; (try assumption).
-apply H1; in_tac.
-apply no_overlapD_invf; auto.
-intros; apply Hrec.
-apply stepf1_dec; auto.
-apply (dstep_inv (m :: t, b, d)); auto.
-apply f2ind'; auto.
-apply no_overlap_noOverlap.
-generalize H0; destruct m;
- unfold no_overlap_stateD, no_overlap_state, no_overlap; simpl;
- (repeat (rewrite getdst_app; simpl)); (repeat (rewrite getsrc_app; simpl)).
-simpl; intros H1 r1 H2 s H3; (try assumption).
-apply H1.
-elim H2; intros H4; [left; (try assumption) | right; in_tac].
-elim H3; intros H4; [left; (try assumption) | right; in_tac].
-apply no_overlapD_invf; auto.
-Qed.
- 
-Definition temporaries1_3 := R IT1 :: (R FT1 :: (R IT3 :: nil)).
- 
-Definition temporaries2 := R IT2 :: (R FT2 :: nil).
- 
-Definition no_tmp13_state (S1 : State) :=
-   Loc.disjoint (getsrc (StateDone S1)) temporaries1_3 /\
-   Loc.disjoint (getdst (StateDone S1)) temporaries1_3.
- 
-Definition Done_well_formed (S1 S2 : State) :=
-   forall x,
-    (In x (getsrc (StateDone S2)) ->
-      In x temporaries2 \/ In x (getsrc (StateToMove S1 ++ StateBeing S1))) /\
-    (In x (getdst (StateDone S2)) ->
-      In x temporaries2 \/ In x (getdst (StateToMove S1 ++ StateBeing S1))).
- 
-Lemma Done_notmp3_inv:
- forall S1 S2,
- step S1 S2 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT3)) ->
- forall x,
- In x (getdst (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  Loc.diff x (R IT3).
-Proof.
-intros S1 S2 STEP; inversion STEP; (try (simpl; trivial; fail));
- simpl StateDone; simpl StateToMove; simpl StateBeing; simpl getdst;
- (repeat (rewrite getdst_app; simpl)); intros.
-apply H1; in_tac.
-destruct m; apply H1; in_tac.
-apply H1; in_tac.
-case (Loc.eq x (T r0)); intros e.
-unfold T in e |-; destruct (Loc.type r0); rewrite e; simpl; red; intro;
- discriminate.
-apply H1; apply in_cons_noteq with ( b := T r0 ); auto; in_tac.
-apply H3; in_tac.
-Qed.
- 
-Lemma Done_notmp3_invpp:
- forall S1 S2,
- stepp S1 S2 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT3)) ->
- forall x,
- In x (getdst (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  Loc.diff x (R IT3).
-Proof.
-intros S1 S2 H H0; (try assumption).
-induction H as [r|r1 r2 r3 H1 H2 Hrec]; auto.
-apply Hrec; auto.
-apply Done_notmp3_inv with r1; auto.
-Qed.
- 
-Lemma Done_notmp3_invf:
- forall S1,
- stepInv S1 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT3)) ->
- forall x,
- In
-  x
-  (getdst
-    (StateToMove (stepf S1) ++ (StateBeing (stepf S1) ++ StateDone (stepf S1)))) ->
-  Loc.diff x (R IT3).
-Proof.
-intros S1 H H0; (try assumption).
-generalize H; unfold stepInv; intros [Hpath [HSD [HnoO [Hnotmp HnotmpL]]]].
-destruct S1 as [[t1 b1] d1]; set (S1:=(t1, b1, d1)); destruct t1; destruct b1;
- auto; apply (Done_notmp3_invpp S1); auto; apply dstep_step; auto; apply f2ind;
- unfold S1; auto.
-Qed.
- 
-Lemma Done_notmp3_res:
- forall S1,
- stepInv S1 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT3)) ->
- forall x,
- In
-  x
-  (getdst
-    (StateToMove (Pmov S1) ++ (StateBeing (Pmov S1) ++ StateDone (Pmov S1)))) ->
-  Loc.diff x (R IT3).
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1 Hrec.
-destruct S1 as [[t b] d]; set (S1:=(t, b, d)).
-unfold S1; rewrite Pmov_equation.
-intros H; generalize H; intros [Hpath [HSD [HnoO [Htmp HtmpL]]]].
-destruct t; [destruct b; auto | idtac];
- (intro; apply Hrec;
-   [apply stepf1_dec | apply (dstep_inv S1); auto; apply f2ind'
-    | apply Done_notmp3_invf]; auto).
-Qed.
- 
-Lemma Done_notmp1_inv:
- forall S1 S2,
- step S1 S2 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In x (getdst (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1 S2 STEP; inversion STEP; (try (simpl; trivial; fail));
- (repeat (rewrite getdst_app; simpl)); intros.
-apply H1; in_tac.
-destruct m; apply H1; in_tac.
-apply H1; in_tac.
-case (Loc.eq x (T r0)); intro.
-rewrite e; unfold T; case (Loc.type r0); simpl; split; red; intro; discriminate.
-apply H1; apply in_cons_noteq with ( b := T r0 ); (try assumption); in_tac.
-apply H3; in_tac.
-Qed.
- 
-Lemma Done_notmp1_invpp:
- forall S1 S2,
- stepp S1 S2 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In x (getdst (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1 S2 H H0; (try assumption).
-induction H as [r|r1 r2 r3 H1 H2 Hrec]; auto.
-apply Hrec; auto.
-apply Done_notmp1_inv with r1; auto.
-Qed.
- 
-Lemma Done_notmp1_invf:
- forall S1,
- stepInv S1 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In
-  x
-  (getdst
-    (StateToMove (stepf S1) ++ (StateBeing (stepf S1) ++ StateDone (stepf S1)))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1 H H0; (try assumption).
-generalize H; unfold stepInv; intros [Hpath [HSD [HnoO [Hnotmp HnotmpL]]]].
-destruct S1 as [[t1 b1] d1]; set (S1:=(t1, b1, d1)); destruct t1; destruct b1;
- auto; apply (Done_notmp1_invpp S1); auto; apply dstep_step; auto; apply f2ind;
- unfold S1; auto.
-Qed.
- 
-Lemma Done_notmp1_res:
- forall S1,
- stepInv S1 ->
- (forall x,
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In
-  x
-  (getdst
-    (StateToMove (Pmov S1) ++ (StateBeing (Pmov S1) ++ StateDone (Pmov S1)))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1 Hrec.
-destruct S1 as [[t b] d]; set (S1:=(t, b, d)).
-intros H; generalize H; intros [Hpath [HSD [HnoO [Htmp HtmpL]]]].
-unfold S1; rewrite Pmov_equation.
-destruct t; [destruct b; auto | idtac];
- (intro; apply Hrec;
-   [apply stepf1_dec | apply (dstep_inv S1); auto; apply f2ind'
-    | apply Done_notmp1_invf]; auto).
-Qed.
- 
-Lemma Done_notmp1src_inv:
- forall S1 S2,
- step S1 S2 ->
- (forall x,
-  In x (getsrc (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In x (getsrc (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1 S2 STEP; inversion STEP; (try (simpl; trivial; fail));
- (repeat (rewrite getsrc_app; simpl)); intros.
-apply H1; in_tac.
-destruct m; apply H1; in_tac.
-apply H1; in_tac.
-case (Loc.eq x (T r0)); intro.
-rewrite e; unfold T; case (Loc.type r0); simpl; split; red; intro; discriminate.
-apply H1; apply in_cons_noteq with ( b := T r0 ); (try assumption); in_tac.
-apply H3; in_tac.
-Qed.
- 
-Lemma Done_notmp1src_invpp:
- forall S1 S2,
- stepp S1 S2 ->
- (forall x,
-  In x (getsrc (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In x (getsrc (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1 S2 H H0; (try assumption).
-induction H as [r|r1 r2 r3 H1 H2 Hrec]; auto.
-apply Hrec; auto.
-apply Done_notmp1src_inv with r1; auto.
-Qed.
- 
-Lemma Done_notmp1src_invf:
- forall S1,
- stepInv S1 ->
- (forall x,
-  In x (getsrc (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In
-  x
-  (getsrc
-    (StateToMove (stepf S1) ++ (StateBeing (stepf S1) ++ StateDone (stepf S1)))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1 H H0.
-generalize H; unfold stepInv; intros [Hpath [HSD [HnoO [Hnotmp HnotmpL]]]].
-destruct S1 as [[t1 b1] d1]; set (S1:=(t1, b1, d1)); destruct t1; destruct b1;
- auto; apply (Done_notmp1src_invpp S1); auto; apply dstep_step; auto;
- apply f2ind; unfold S1; auto.
-Qed.
- 
-Lemma Done_notmp1src_res:
- forall S1,
- stepInv S1 ->
- (forall x,
-  In x (getsrc (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))) ->
-   Loc.diff x (R IT1) /\ Loc.diff x (R FT1)) ->
- forall x,
- In
-  x
-  (getsrc
-    (StateToMove (Pmov S1) ++ (StateBeing (Pmov S1) ++ StateDone (Pmov S1)))) ->
-  Loc.diff x (R IT1) /\ Loc.diff x (R FT1).
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1 Hrec.
-destruct S1 as [[t b] d]; set (S1:=(t, b, d)).
-intros H; generalize H; intros [Hpath [HSD [HnoO [Htmp HtmpL]]]].
-unfold S1; rewrite Pmov_equation.
-destruct t; [destruct b; auto | idtac];
- (intro; apply Hrec;
-   [apply stepf1_dec | apply (dstep_inv S1); auto; apply f2ind'
-    | apply Done_notmp1src_invf]; auto).
-Qed.
- 
-Lemma dst_tmp2_step:
- forall S1 S2,
- step S1 S2 ->
- forall x,
- In x (getdst (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  In x temporaries2 \/
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))).
-Proof.
-intros S1 S2 STEP; inversion STEP; (repeat (rewrite getdst_app; simpl)); intros;
- (try (right; in_tac)).
-destruct m; right; in_tac.
-case (Loc.eq x (T r0)); intro.
-rewrite e; unfold T; case (Loc.type r0); left; [left | right; left]; trivial.
-right; apply in_cons_noteq with ( b := T r0 ); auto; in_tac.
-Qed.
- 
-Lemma dst_tmp2_stepp:
- forall S1 S2,
- stepp S1 S2 ->
- forall x,
- In x (getdst (StateToMove S2 ++ (StateBeing S2 ++ StateDone S2))) ->
-  In x temporaries2 \/
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))).
-Proof.
-intros S1 S2 H.
-induction H as [r|r1 r2 r3 H1 H2 Hrec]; auto.
-intros.
-elim Hrec with ( x := x );
- [intros H0; (try clear Hrec); (try exact H0) | intros H0; (try clear Hrec)
-  | try clear Hrec]; auto.
-generalize (dst_tmp2_step r1 r2); auto.
-Qed.
- 
-Lemma dst_tmp2_stepf:
- forall S1,
- stepInv S1 ->
- forall x,
- In
-  x
-  (getdst
-    (StateToMove (stepf S1) ++ (StateBeing (stepf S1) ++ StateDone (stepf S1)))) ->
-  In x temporaries2 \/
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))).
-Proof.
-intros S1 H H0.
-generalize H; unfold stepInv; intros [Hpath [HSD [HnoO [Hnotmp HnotmpL]]]].
-destruct S1 as [[t1 b1] d1]; set (S1:=(t1, b1, d1)); destruct t1; destruct b1;
- auto; apply (dst_tmp2_stepp S1); auto; apply dstep_step; auto; apply f2ind;
- unfold S1; auto.
-Qed.
- 
-Lemma dst_tmp2_res:
- forall S1,
- stepInv S1 ->
- forall x,
- In
-  x
-  (getdst
-    (StateToMove (Pmov S1) ++ (StateBeing (Pmov S1) ++ StateDone (Pmov S1)))) ->
-  In x temporaries2 \/
-  In x (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1))).
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1 Hrec.
-destruct S1 as [[t b] d]; set (S1:=(t, b, d)).
-intros H; generalize H; intros [Hpath [HSD [HnoO [Htmp HtmpL]]]].
-unfold S1; rewrite Pmov_equation; intros.
-destruct t; auto.
-destruct b; auto.
-elim Hrec with ( y := stepf S1 ) ( x := x );
- [intros H1 | intros H1 | try clear Hrec | try clear Hrec | try assumption].
-left; (try assumption).
-apply dst_tmp2_stepf; auto.
-apply stepf1_dec; auto.
-apply (dstep_inv S1); auto; unfold S1; apply f2ind'; auto.
-elim Hrec with ( y := stepf S1 ) ( x := x );
- [intro; left; (try assumption) | intros H1; apply dst_tmp2_stepf; auto |
-  apply stepf1_dec; auto |
-  apply (dstep_inv S1); auto; unfold S1; apply f2ind'; auto | try assumption].
-Qed.
- 
-Lemma getdst_lists2moves:
- forall srcs dsts,
- length srcs = length dsts ->
-  getsrc (listsLoc2Moves srcs dsts) = srcs /\
-  getdst (listsLoc2Moves srcs dsts) = dsts.
-Proof.
-induction srcs; intros dsts; destruct dsts; simpl; auto; intro;
- (try discriminate).
-inversion H.
-elim IHsrcs with ( dsts := dsts ); auto; intros.
-rewrite H2; rewrite H0; auto.
-Qed.
- 
-Lemma stepInv_pnilnil:
- forall p,
- simpleDest p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
- no_overlap_list p ->  stepInv (p, nil, nil).
-Proof.
-unfold stepInv; simpl; (repeat split); auto.
-rewrite app_nil; auto.
-generalize (no_overlap_noOverlap (p, nil, nil)).
-simpl; (intros H3; apply H3).
-generalize H2; unfold no_overlap_state, no_overlap_list; simpl; intro.
-rewrite app_nil; auto.
-apply disjoint_tmp__noTmp; auto.
-Qed.
- 
-Lemma noO_list_pnilnil:
- forall (p : Moves),
- simpleDest p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
- no_overlap_list p ->  no_overlap_list (StateDone (Pmov (p, nil, nil))).
-Proof.
-intros; generalize (no_overlapD_res (p, nil, nil));
- unfold no_overlap_stateD, no_overlap_list.
-rewrite STM_Pmov; rewrite SB_Pmov; simpl; rewrite app_nil; intro.
-apply H3; auto.
-apply stepInv_pnilnil; auto.
-Qed.
- 
-Lemma dis_srctmp1_pnilnil:
- forall (p : Moves),
- simpleDest p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
- no_overlap_list p ->
-  Loc.disjoint (getsrc (StateDone (Pmov (p, nil, nil)))) temporaries1.
-Proof.
-intros; generalize (Done_notmp1src_res (p, nil, nil)); simpl.
-rewrite STM_Pmov; rewrite SB_Pmov; simpl; rewrite app_nil; intro.
-unfold temporaries1.
-apply Loc.notin_disjoint; auto.
-simpl; intros.
-assert (HsI: stepInv (p, nil, nil)); (try apply stepInv_pnilnil); auto.
-elim H3 with x; (try assumption).
-intros; (repeat split); auto.
-intros; split;
- (apply Loc.in_notin_diff with ( ll := temporaries );
-   [apply Loc.disjoint_notin with (getsrc p) | simpl]; auto).
-Qed.
- 
-Lemma dis_dsttmp1_pnilnil:
- forall (p : Moves),
- simpleDest p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
- no_overlap_list p ->
-  Loc.disjoint (getdst (StateDone (Pmov (p, nil, nil)))) temporaries1.
-Proof.
-intros; generalize (Done_notmp1_res (p, nil, nil)); simpl.
-rewrite STM_Pmov; rewrite SB_Pmov; simpl; rewrite app_nil; intro.
-unfold temporaries1.
-apply Loc.notin_disjoint; auto.
-simpl; intros.
-assert (HsI: stepInv (p, nil, nil)); (try apply stepInv_pnilnil); auto.
-elim H3 with x; (try assumption).
-intros; (repeat split); auto.
-intros; split;
- (apply Loc.in_notin_diff with ( ll := temporaries );
-   [apply Loc.disjoint_notin with (getdst p) | simpl]; auto).
-Qed.
- 
-Lemma parallel_move_correct':
- forall p k rs m,
- Loc.norepet (getdst p) ->
- no_overlap_list p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
-  (exists rs' ,
-   exec_instrs ge sp (p_move p k) rs m k rs' m /\
-   (List.map rs' (getdst p) = List.map rs (getsrc p) /\
-    (rs' (R IT3) = rs (R IT3) /\
-     (forall l,
-      Loc.notin l (getdst p) -> Loc.notin l temporaries ->  rs' l = rs l)))
-   ).
-Proof.
-unfold p_move, P_move.
-intros p k rs m Hnorepet HnoOverlap Hdisjointsrc Hdisjointdst.
-assert (HsD: simpleDest p); (try (apply norepet_SD; assumption)).
-assert (HsI: stepInv (p, nil, nil)); (try (apply stepInv_pnilnil; assumption)).
-generalize HsI; unfold stepInv; simpl StateToMove; simpl StateBeing;
- (repeat rewrite app_nil); intros [_ [_ [HnoO [Hnotmp _]]]].
-elim (exec_instrs_pmov (StateDone (Pmov (p, nil, nil))) k rs m); auto;
- (try apply noO_list_pnilnil); (try apply dis_dsttmp1_pnilnil);
- (try apply dis_srctmp1_pnilnil); auto.
-intros rs' [Hexec R]; exists rs'; (repeat split); auto.
-rewrite <- (Fpmov_correct_map p rs); auto.
-apply list_map_exten; intros; rewrite <- R; auto;
- (try
-   (apply Loc.in_notin_diff with ( ll := temporaries );
-     [apply Loc.disjoint_notin with (getdst p) | simpl]; auto)).
-generalize (dst_tmp2_res (p, nil, nil)); intros.
-elim H0 with ( x := r );
- [intros H2; right |
-  simpl; rewrite app_nil; intros H2; apply In_norepet with (getdst p); auto |
-  try assumption | rewrite STM_Pmov; rewrite SB_Pmov; auto].
-apply Loc.diff_sym; apply Loc.in_notin_diff with ( ll := temporaries );
- (try assumption).
-apply Loc.disjoint_notin with (getdst p); auto.
-generalize H2; unfold temporaries, temporaries2; intros; in_tac.
-rewrite <- (Fpmov_correct_IT3 p rs); auto; rewrite <- R;
- (try (simpl; intro; discriminate)); auto.
-intros r H; right; apply (Done_notmp3_res (p, nil, nil)); auto;
- (try (rewrite STM_Pmov; rewrite SB_Pmov; auto)).
-simpl; rewrite app_nil; intros; apply Loc.in_notin_diff with temporaries; auto.
-apply Loc.disjoint_notin with (getdst p); auto.
-simpl; right; right; left; trivial.
-intros; rewrite <- (Fpmov_correct_ext p rs); auto; rewrite <- R; auto;
- (try (apply Loc.in_notin_diff with temporaries; simpl; auto)).
-intros r H1; right; generalize (dst_tmp2_res (p, nil, nil)); intros.
-elim H2 with ( x := r );
- [intros H3 | simpl; rewrite app_nil; intros H3 | assumption
-  | rewrite STM_Pmov; rewrite SB_Pmov; auto].
-apply Loc.diff_sym; apply Loc.in_notin_diff with temporaries; auto.
-generalize H3; unfold temporaries, temporaries2; intros; in_tac.
-apply Loc.diff_sym; apply Loc.in_notin_diff with ( ll := getdst p ); auto.
-Qed.
- 
-Lemma parallel_move_correctX:
- forall srcs dsts k rs m,
- List.length srcs = List.length dsts ->
- no_overlap srcs dsts ->
- Loc.norepet dsts ->
- Loc.disjoint srcs temporaries ->
- Loc.disjoint dsts temporaries ->
-  (exists rs' ,
-   exec_instrs ge sp (parallel_move srcs dsts k) rs m k rs' m /\
-   (List.map rs' dsts = List.map rs srcs /\
-    (rs' (R IT3) = rs (R IT3) /\
-     (forall l, Loc.notin l dsts -> Loc.notin l temporaries ->  rs' l = rs l))) ).
-Proof.
-intros; unfold parallel_move, parallel_move_order;
- generalize (parallel_move_correct' (listsLoc2Moves srcs dsts) k rs m).
-elim (getdst_lists2moves srcs dsts); auto.
-intros heq1 heq2; rewrite heq1; rewrite heq2; unfold p_move.
-intros H4; apply H4; auto.
-unfold no_overlap_list; rewrite heq1; rewrite heq2; auto.
-Qed.
- 
-End parallel_move_correction.
diff --git a/backend/Alloctyping.v b/backend/Alloctyping.v
index 39e53ee..e4f9f96 100644
--- a/backend/Alloctyping.v
+++ b/backend/Alloctyping.v
@@ -15,7 +15,7 @@ Require Import Allocproof.
 Require Import RTLtyping.
 Require Import LTLtyping.
 Require Import Conventions.
-Require Import Alloctyping_aux.
+Require Import Parallelmove.
 
 (** This file proves that register allocation (the translation from
   RTL to LTL defined in file [Allocation]) preserves typing:
@@ -30,13 +30,13 @@ Variable live: PMap.t Regset.t.
 Variable alloc: reg -> loc.
 Variable tf: LTL.function.
 
-Hypothesis TYPE_RTL: type_rtl_function f = Some env.
+Hypothesis TYPE_RTL: type_function f = Some env.
 Hypothesis ALLOC: regalloc f live (live0 f live) env = Some alloc.
 Hypothesis TRANSL: transf_function f = Some tf.
 
-Lemma wt_rtl_function: RTLtyping.wt_function env f.
+Lemma wt_rtl_function: RTLtyping.wt_function f env.
 Proof.
-  apply type_rtl_function_correct; auto.
+  apply type_function_correct; auto.
 Qed.
 
 Lemma alloc_type: forall r, Loc.type (alloc r) = env r.
@@ -213,15 +213,34 @@ Proof.
   auto.
 Qed.
 
+Lemma wt_add_moves:
+  forall b moves,
+  (forall s d, In (s, d) moves ->
+      loc_read_ok s /\ loc_write_ok d /\ Loc.type s = Loc.type d) ->
+  wt_block tf b ->
+  wt_block tf 
+    (List.fold_right (fun p k => add_move (fst p) (snd p) k) b moves).
+Proof.
+  induction moves; simpl; intros.
+  auto.
+  destruct a as [s d]. simpl. 
+  elim (H s d). intros A [B C]. apply wt_add_move; auto. auto. 
+Qed.
+
 Theorem wt_parallel_move:
  forall srcs dsts b,
  List.map Loc.type srcs = List.map Loc.type dsts ->
  locs_read_ok srcs ->
  locs_write_ok dsts -> wt_block tf b ->  wt_block tf (parallel_move srcs dsts b).
 Proof.
-  unfold locs_read_ok, locs_write_ok.
-  apply wt_parallel_moveX; simpl; auto.
-  exact wt_add_move.
+  intros. unfold parallel_move. apply wt_add_moves; auto.
+  intros. 
+  elim (parmove_prop_2 _ _ _ _ H3); intros A B.
+  split. destruct A as [C|[C|C]]. 
+  apply H0; auto. subst s; exact I. subst s; exact I.
+  split. destruct B as [C|[C|C]]. 
+  apply H1; auto. subst d; exact I. subst d; exact I.
+  eapply parmove_prop_3; eauto.
 Qed.
  
 Lemma wt_add_op_move:
@@ -340,6 +359,18 @@ Proof.
   rewrite loc_result_type. auto. constructor.
 Qed.
 
+Lemma wt_add_alloc:
+  forall arg res s,
+  Loc.type arg = Tint -> Loc.type res = Tint ->
+  loc_read_ok arg -> loc_write_ok res ->
+  wt_block tf (add_alloc arg res s).
+Proof.
+  intros. 
+  unfold add_alloc. apply wt_add_reload. auto. rewrite H; reflexivity.
+  apply wt_Balloc. apply wt_add_spill. auto. rewrite H0; reflexivity.
+  apply wt_Bgoto. 
+Qed.
+
 Lemma wt_add_cond:
   forall cond args ifso ifnot,
   List.map Loc.type args = type_of_condition cond ->
@@ -387,7 +418,10 @@ Lemma wt_add_entry:
 Proof.
   set (sig := RTL.fn_sig f).
   assert (sig = tf.(fn_sig)).
-    unfold sig. symmetry. apply Allocproof.sig_function_translated. auto.
+    unfold sig. 
+    assert (transf_fundef (Internal f) = Some (Internal tf)).
+      unfold transf_fundef; rewrite TRANSL; auto.
+    generalize (Allocproof.sig_function_translated _ _ H). simpl; auto.
   assert (locs_read_ok (loc_parameters sig)).
     red; unfold loc_parameters. intros. 
     generalize (list_in_map_inv _ _ _ H0). intros [l1 [EQ IN]].
@@ -406,7 +440,7 @@ Qed.
 
 Lemma wt_transf_instr:
   forall pc instr,
-  RTLtyping.wt_instr env f instr ->
+  RTLtyping.wt_instr env f.(RTL.fn_sig) instr ->
   wt_block tf (transf_instr f live alloc pc instr).
 Proof.
   intros. inversion H; simpl.
@@ -441,6 +475,9 @@ Proof.
   auto with allocty.
   destruct ros; simpl; auto with allocty.
   auto with allocty.
+  (* alloc *)
+  apply wt_add_alloc; auto with allocty.
+  rewrite alloc_type; auto. rewrite alloc_type; auto.
   (* cond *)
   apply wt_add_cond. rewrite alloc_types; auto. auto with allocty.
   (* return *)
@@ -483,7 +520,7 @@ Lemma wt_transf_function:
   transf_function f = Some tf -> wt_function tf.
 Proof.
   intros. generalize H; unfold transf_function.
-  caseEq (type_rtl_function f). intros env TYP. 
+  caseEq (type_function f). intros env TYP. 
   caseEq (analyze f). intros live ANL.
   change (transfer f (RTL.fn_entrypoint f)
                      live!!(RTL.fn_entrypoint f))
@@ -497,13 +534,26 @@ Proof.
   intros; discriminate.
 Qed. 
 
+Lemma wt_transf_fundef:
+  forall f tf,
+  transf_fundef f = Some tf -> wt_fundef tf.
+Proof.
+  intros until tf; destruct f; simpl. 
+  caseEq (transf_function f). intros g TF EQ. inversion EQ.
+  constructor. eapply wt_transf_function; eauto.
+  congruence.
+  caseEq (type_external_function e); intros.
+  inversion H0. constructor. apply type_external_function_correct. auto.
+  congruence.
+Qed.
+
 Lemma program_typing_preserved:
   forall (p: RTL.program) (tp: LTL.program),
   transf_program p = Some tp ->
   LTLtyping.wt_program tp.
 Proof.
   intros; red; intros.
-  generalize (transform_partial_program_function transf_function p i f H H0).
+  generalize (transform_partial_program_function transf_fundef p i f H H0).
   intros [f0 [IN TRANSF]].
-  apply wt_transf_function with f0; auto.
+  apply wt_transf_fundef with f0; auto.
 Qed.
diff --git a/backend/Alloctyping_aux.v b/backend/Alloctyping_aux.v
deleted file mode 100644
index 0013c24..0000000
--- a/backend/Alloctyping_aux.v
+++ /dev/null
@@ -1,895 +0,0 @@
-(** Type preservation for parallel move compilation. *)
-
-(** This file, contributed by Laurence Rideau, shows that the parallel
-  move compilation algorithm (file [Parallelmove]) generates a well-typed
-  sequence of LTL instructions, provided the original problem is well-typed:
-  the types of source and destination locations match pairwise. *)
-
-Require Import Coqlib.
-Require Import Locations.
-Require Import LTL.
-Require Import Allocation.
-Require Import LTLtyping.
-Require Import Allocproof_aux.
-Require Import Parallelmove.
-Require Import Inclusion.
-
-Section wt_move_correction.
-Variable tf : LTL.function.
-Variable loc_read_ok : loc ->  Prop.
-Hypothesis loc_read_ok_R : forall r,  loc_read_ok (R r).
-Variable loc_write_ok : loc ->  Prop.
-Hypothesis loc_write_ok_R : forall r,  loc_write_ok (R r).
- 
-Let locs_read_ok (ll : list loc) : Prop :=
-   forall l, In l ll ->  loc_read_ok l.
- 
-Let locs_write_ok (ll : list loc) : Prop :=
-   forall l, In l ll ->  loc_write_ok l.
-
-Hypothesis
-   wt_add_move :
-   forall (src dst : loc) (b : LTL.block),
-   loc_read_ok src ->
-   loc_write_ok dst ->
-   Loc.type src = Loc.type dst ->
-   wt_block tf b ->  wt_block tf (add_move src dst b).
- 
-Lemma in_move__in_srcdst:
- forall m p, In m p ->  In (fst m) (getsrc p) /\ In (snd m) (getdst p).
-Proof.
-intros; induction p.
-inversion H.
-destruct a as [a1 a2]; destruct m as [m1 m2]; simpl.
-elim H; intro.
-inversion H0.
-subst a2; subst a1.
-split; [left; trivial | left; trivial].
-split; right; (elim IHp; simpl; intros; auto).
-Qed.
- 
-Lemma T_type: forall r,  Loc.type r = Loc.type (T r).
-Proof.
-intro; unfold T.
-case (Loc.type r); auto.
-Qed.
- 
-Theorem incl_nil: forall A (l : list A),  incl nil l.
-Proof.
-intros A l a; simpl; intros H; case H.
-Qed.
-Hint Resolve incl_nil :datatypes.
- 
-Lemma split_move_incl:
- forall (l t1 t2 : Moves) (s d : Reg),
- split_move l s = Some (t1, d, t2) ->  incl t1 l /\ incl t2 l.
-Proof.
-induction l.
-simpl; (intros; discriminate).
-intros t1 t2 s d; destruct a as [a1 a2]; simpl.
-case (Loc.eq a1 s); intro.
-intros.
-inversion H.
-split; auto.
-apply incl_nil.
-apply incl_tl; apply incl_refl; auto.
-caseEq (split_move l s); intro; (try (intros; discriminate)).
-destruct p as [[p1 p2] p3].
-intros.
-inversion H0.
-elim (IHl p1 p3 s p2); intros; auto.
-subst p3.
-split; auto.
-generalize H1; unfold incl; simpl.
-intros H4 a [H7|H6]; [try exact H7 | idtac].
-left; (try assumption).
-right; apply H4; auto.
-apply incl_tl; auto.
-Qed.
- 
-Lemma in_split_move:
- forall (l t1 t2 : Moves) (s d : Reg),
- split_move l s = Some (t1, d, t2) ->  In (s, d) l.
-Proof.
-induction l.
-simpl; intros; discriminate.
-intros t1 t2 s d; simpl.
-destruct a as [a1 a2].
-case (Loc.eq a1 s).
-intros.
-inversion H.
-subst a1; left; auto.
-intro; caseEq (split_move l s); (intros; (try discriminate)).
-destruct p as [[p1 p2] p3].
-right; inversion H0.
-subst p2.
-apply (IHl p1 p3); auto.
-Qed.
- 
-Lemma move_types_stepf:
- forall S1,
- (forall x1 x2,
-  In (x1, x2) (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1)) ->
-   Loc.type x1 = Loc.type x2) ->
- forall x1 x2,
- In
-  (x1, x2)
-  (StateToMove (stepf S1) ++ (StateBeing (stepf S1) ++ StateDone (stepf S1))) ->
-  Loc.type x1 = Loc.type x2.
-Proof.
-intros S1 H x1 x2.
-destruct S1 as [[t1 b1] d1]; set (S1:=(t1, b1, d1)); destruct t1; destruct b1;
- auto; simpl StateToMove in H |-; simpl StateBeing in H |-;
- simpl StateDone in H |-; simpl app in H |-.
-intro;
- elim
-  (in_app_or
-    (StateToMove (stepf S1)) (StateBeing (stepf S1) ++ StateDone (stepf S1))
-    (x1, x2)); auto.
-assert (StateToMove (stepf S1) = nil).
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq d (fst (last b1))); case b1; simpl; auto.
-rewrite H1; intros H2; inversion H2.
-intro; elim (in_app_or (StateBeing (stepf S1)) (StateDone (stepf S1)) (x1, x2));
- auto.
-assert
- (StateBeing (stepf S1) = nil \/
-  (StateBeing (stepf S1) = b1 \/ StateBeing (stepf S1) = replace_last_s b1)).
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq d (fst (last b1))); case b1; simpl; auto.
-elim H2; [intros H3; (try clear H2); (try exact H3) | intros H3; (try clear H2)].
-rewrite H3; intros H4; inversion H4.
-elim H3; [intros H2; (try clear H3); (try exact H2) | intros H2; (try clear H3)].
-rewrite H2; intros H4.
-apply H; (try in_tac).
-rewrite H2; intros H4.
-caseEq b1; intro; simpl; auto.
-rewrite H3 in H4; simpl in H4 |-; inversion H4.
-intros l H5; rewrite H5 in H4.
-generalize (app_rewriter _ l m0).
-intros [y [r H3]]; (try exact H3).
-rewrite H3 in H4.
-destruct y.
-rewrite last_replace in H4.
-elim (in_app_or r ((T r0, r1) :: nil) (x1, x2)); auto.
-intro; apply H.
-rewrite H5.
-rewrite H3; in_tac.
-intros H6; inversion H6.
-inversion H7.
-rewrite <- T_type.
-rewrite <- H10; apply H.
-rewrite H5; rewrite H3; (try in_tac).
-assert (In (r0, r1) ((r0, r1) :: nil)); [simpl; auto | in_tac].
-inversion H7.
-intro.
-destruct m as [s d].
-assert
- (StateDone (stepf S1) = (s, d) :: d1 \/
-  StateDone (stepf S1) = (s, d) :: ((d, T d) :: d1)).
-simpl.
-case (Loc.eq d (fst (last b1))); case b1; simpl; auto.
-elim H3; [intros H4; (try clear H3); (try exact H4) | intros H4; (try clear H3)].
-apply H; (try in_tac).
-rewrite H4 in H2; in_tac.
-rewrite H4 in H2.
-simpl in H2 |-.
-elim H2; [intros H3; apply H | intros H3; elim H3; intros; [idtac | apply H]];
- (try in_tac).
-simpl; left; auto.
-inversion H5; apply T_type.
-intro;
- elim
-  (in_app_or
-    (StateToMove (stepf S1)) (StateBeing (stepf S1) ++ StateDone (stepf S1))
-    (x1, x2)); auto.
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq s d); simpl; intros; apply H; in_tac.
-intro; elim (in_app_or (StateBeing (stepf S1)) (StateDone (stepf S1)) (x1, x2));
- auto.
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq s d); intros; apply H; (try in_tac).
-inversion H2.
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq s d); intros; apply H; (try in_tac).
-simpl in H2 |-; in_tac.
-simpl in H2 |-; in_tac.
-intro;
- elim
-  (in_app_or
-    (StateToMove (stepf S1)) (StateBeing (stepf S1) ++ StateDone (stepf S1))
-    (x1, x2)); auto.
-simpl stepf.
-destruct m as [s d].
-destruct m0 as [s0 d0].
-case (Loc.eq s d0); [simpl; intros; apply H; in_tac | idtac].
-caseEq (split_move t1 d0); intro.
-destruct p as [[t2 b2] d2].
-intros Hsplit Hd; simpl StateToMove; intro.
-elim (split_move_incl t1 t2 d2 d0 b2 Hsplit); auto.
-intros; apply H.
-assert (In (x1, x2) ((s, d) :: (t1 ++ t1))).
-generalize H1; simpl; intros.
-elim H4; [intros H5; left; (try exact H5) | intros H5; right].
-elim (in_app_or t2 d2 (x1, x2)); auto; intro; apply in_or_app; left.
-unfold incl in H2 |-.
-apply H2; auto.
-unfold incl in H3 |-; apply H3; auto.
-in_tac.
-intro; case (Loc.eq d0 (fst (last b1))); case b1; auto; simpl StateToMove;
- intros; apply H; in_tac.
-intro; elim (in_app_or (StateBeing (stepf S1)) (StateDone (stepf S1)) (x1, x2));
- auto.
-simpl stepf.
-destruct m as [s d].
-destruct m0 as [s0 d0].
-case (Loc.eq s d0).
-intros e; rewrite <- e; simpl StateBeing.
-rewrite <- e in H.
-intro; apply H; in_tac.
-caseEq (split_move t1 d0); intro.
-destruct p as [[t2 b2] d2].
-simpl StateBeing.
-intros.
-apply H.
-generalize (in_split_move t1 t2 d2 d0 b2 H2).
-intros.
-elim H3; intros.
-rewrite <- H5.
-in_tac.
-in_tac.
-caseEq b1.
-simpl; intros e n F; elim F.
-intros m l H3 H4.
-case (Loc.eq d0 (fst (last (m :: l)))).
-generalize (app_rewriter Move l m).
-intros [y [r H5]]; rewrite H5.
-simpl StateBeing.
-destruct y as [y1 y2]; generalize (last_replace r y1 y2).
-simpl; intros heq H6.
-unfold Move in heq |-; unfold Move.
-rewrite heq.
-intro.
-elim (in_app_or r ((T y1, y2) :: nil) (x1, x2)); auto.
-intro; apply H.
-rewrite H3; rewrite H5; in_tac.
-simpl; intros [H8|H8]; inversion H8.
-rewrite <- T_type.
-apply H.
-rewrite H3; rewrite H5.
-rewrite <- H11; assert (In (y1, y2) ((y1, y2) :: nil)); auto.
-simpl; auto.
-in_tac.
-simpl StateBeing; intros.
-apply H; rewrite H3; (try in_tac).
-simpl stepf.
-destruct m as [s d].
-destruct m0 as [s0 d0].
-case (Loc.eq s d0); [simpl; intros; apply H; in_tac | idtac].
-caseEq (split_move t1 d0); intro.
-destruct p as [[t2 b2] d2].
-intros Hsplit Hd; simpl StateDone; intro.
-apply H; (try in_tac).
-case (Loc.eq d0 (fst (last b1))); case b1; simpl StateDone; intros;
- (try (apply H; in_tac)).
-elim H3; intros.
-apply H.
-assert (In (x1, x2) ((s0, d0) :: nil)); auto.
-rewrite H4; auto.
-simpl; left; auto.
-in_tac.
-elim H4; intros.
-inversion H5; apply T_type.
-apply H; in_tac.
-Qed.
- 
-Lemma move_types_res:
- forall S1,
- (forall x1 x2,
-  In (x1, x2) (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1)) ->
-   Loc.type x1 = Loc.type x2) ->
- forall x1 x2,
- In
-  (x1, x2)
-  (StateToMove (Pmov S1) ++ (StateBeing (Pmov S1) ++ StateDone (Pmov S1))) ->
-  Loc.type x1 = Loc.type x2.
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1 Hrec.
-destruct S1 as [[t b] d]; set (S1:=(t, b, d)).
-unfold S1; rewrite Pmov_equation; intros.
-destruct t; auto.
-destruct b; auto.
-apply (Hrec (stepf S1)).
-apply stepf1_dec; auto.
-apply move_types_stepf; auto.
-unfold S1; auto.
-apply (Hrec (stepf S1)).
-apply stepf1_dec; auto.
-apply move_types_stepf; auto.
-unfold S1; auto.
-Qed.
- 
-Lemma srcdst_tmp2_stepf:
- forall S1 x1 x2,
- In
-  (x1, x2)
-  (StateToMove (stepf S1) ++ (StateBeing (stepf S1) ++ StateDone (stepf S1))) ->
-  (In x1 temporaries2 \/
-   In x1 (getsrc (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1)))) /\
-  (In x2 temporaries2 \/
-   In x2 (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1)))).
-Proof.
-intros S1 x1 x2 H.
-(repeat rewrite getsrc_app); (repeat rewrite getdst_app).
-destruct S1 as [[t1 b1] d1]; set (S1:=(t1, b1, d1)); destruct t1; destruct b1;
- auto.
-simpl in H |-.
-elim (in_move__in_srcdst (x1, x2) d1); intros; auto.
-elim
- (in_app_or
-   (StateToMove (stepf S1)) (StateBeing (stepf S1) ++ StateDone (stepf S1))
-   (x1, x2)); auto.
-assert (StateToMove (stepf S1) = nil).
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq d (fst (last b1))); case b1; simpl; auto.
-rewrite H0; intros H2; inversion H2.
-intro; elim (in_app_or (StateBeing (stepf S1)) (StateDone (stepf S1)) (x1, x2));
- auto.
-simpl stepf.
-destruct m as [s d].
-caseEq b1.
-simpl.
-intros h1 h2; inversion h2.
-intros m l heq; generalize (app_rewriter _ l m).
-intros [y [r H3]]; (try exact H3).
-rewrite H3.
-destruct y.
-rewrite last_app; simpl fst.
-case (Loc.eq d r0).
-intros heqd.
-rewrite last_replace.
-simpl.
-intro; elim (in_app_or r ((T r0, r1) :: nil) (x1, x2)); auto.
-rewrite heq; rewrite H3.
-rewrite getsrc_app; simpl; rewrite getdst_app; simpl.
-intro; elim (in_move__in_srcdst (x1, x2) r); auto; simpl; intros; split; right;
- right; in_tac.
-intro.
-inversion H2; inversion H4.
-split.
-unfold T; case (Loc.type r0); left; [left | right]; auto.
-right; right; (try assumption).
-rewrite heq; rewrite H3.
-rewrite H7; simpl.
-rewrite getdst_app; simpl.
-assert (In x2 (x2 :: nil)); simpl; auto.
-in_tac.
-simpl StateBeing.
-intros; elim (in_move__in_srcdst (x1, x2) (r ++ ((r0, r1) :: nil))); auto;
- intros; split; right; right.
-unfold snd in H4 |-; unfold fst in H2 |-; rewrite heq; rewrite H3; (try in_tac).
-unfold snd in H4 |-; unfold fst in H2 |-; rewrite heq; rewrite H3; (try in_tac).
-simpl stepf.
-destruct m as [s d].
-caseEq b1; intro.
-simpl StateDone; intro.
-unfold S1, StateToMove, StateBeing.
-simpl app.
-elim (in_move__in_srcdst (x1, x2) ((s, d) :: d1)); auto; intros; split; right.
-simpl snd in H4 |-; simpl fst in H3 |-; simpl getdst in H4 |-;
- simpl getsrc in H3 |-; (try in_tac).
-simpl snd in H4 |-; simpl fst in H3 |-; simpl getdst in H4 |-;
- simpl getsrc in H3 |-; (try in_tac).
-intros; generalize (app_rewriter _ l m).
-intros [y [r H4]].
-generalize H2; rewrite H4; rewrite last_app.
-destruct y as [y1 y2].
-simpl fst.
-case (Loc.eq d y1).
-simpl StateDone; intros.
-elim H3; [intros H6; inversion H6; (try exact H6) | intros H6; (try clear H5)].
-simpl; split; right; left; auto.
-elim H6; [intros H5; inversion H5; (try exact H5) | intros H5; (try clear H6)].
-split; [right; simpl; right | left].
-rewrite H1; rewrite H4; rewrite getsrc_app; simpl getsrc.
-rewrite <- e; rewrite H8; assert (In x1 (x1 :: nil)); simpl; auto; (try in_tac).
-unfold T; case (Loc.type x1); simpl; auto.
-elim (in_move__in_srcdst (x1, x2) d1); auto; intros; split; right; right;
- (try in_tac).
-intro; simpl StateDone.
-unfold S1, StateToMove, StateBeing, StateDone.
-simpl getsrc; simpl app; (try in_tac).
-intro; elim (in_move__in_srcdst (x1, x2) ((s, d) :: d1));
- (auto; (simpl fst; simpl snd; simpl getsrc; simpl getdst); intros);
- (split; right; (try in_tac)).
-unfold S1, StateToMove, StateBeing, StateDone.
-elim
- (in_app_or
-   (StateToMove (stepf S1)) (StateBeing (stepf S1) ++ StateDone (stepf S1))
-   (x1, x2)); auto.
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq s d).
-simpl StateToMove.
-intros; elim (in_move__in_srcdst (x1, x2) t1); auto;
- (repeat (rewrite getsrc_app; simpl getsrc));
- (repeat (rewrite getdst_app; simpl getdst)); simpl fst; simpl snd; intros;
- split; right; simpl; right; (try in_tac).
-simpl StateToMove.
-intros; elim (in_move__in_srcdst (x1, x2) t1); auto;
- (repeat (rewrite getsrc_app; simpl getsrc));
- (repeat (rewrite getdst_app; simpl getdst)); simpl fst; simpl snd; intros;
- split; right; simpl; right; (try in_tac).
-intro; elim (in_app_or (StateBeing (stepf S1)) (StateDone (stepf S1)) (x1, x2));
- auto.
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq s d).
-simpl StateBeing; intros h1 h2; inversion h2.
-simpl StateBeing; intros h1 h2.
-elim (in_move__in_srcdst (x1, x2) ((s, d) :: nil)); auto; simpl fst; simpl snd;
- simpl; intros; split; right; (try in_tac).
-elim H1; [intros H3; left; (try exact H3) | intros H3; inversion H3].
-elim H2; [intros H3; left; (try exact H3) | intros H3; inversion H3].
-simpl stepf.
-destruct m as [s d].
-case (Loc.eq s d).
-simpl StateDone; intros h1 h2.
-elim (in_move__in_srcdst (x1, x2) d1); auto; simpl fst; simpl snd; simpl;
- intros; split; right; right; (try in_tac).
-simpl StateDone; intros h1 h2.
-elim (in_move__in_srcdst (x1, x2) d1); auto; simpl fst; simpl snd; simpl;
- intros; split; right; right; (try in_tac).
-elim
- (in_app_or
-   (StateToMove (stepf S1)) (StateBeing (stepf S1) ++ StateDone (stepf S1))
-   (x1, x2)); auto.
-simpl stepf.
-destruct m as [s d].
-destruct m0 as [s0 d0].
-case (Loc.eq s d0).
-unfold S1, StateToMove, StateBeing, StateDone.
-simpl app at 1.
-intros; elim (in_move__in_srcdst (x1, x2) t1);
- (auto; simpl; intros; (split; right; right; (try in_tac))).
-intro; caseEq (split_move t1 d0); intro.
-destruct p as [[t2 b2] d2].
-intros Hsplit; unfold S1, StateToMove, StateBeing, StateDone; intro.
-elim (split_move_incl t1 t2 d2 d0 b2 Hsplit); auto.
-intros.
-assert (In (x1, x2) ((s, d) :: (t1 ++ t1))).
-generalize H0; simpl; intros.
-elim H3; [intros H5; left; (try exact H5) | intros H5; right].
-elim (in_app_or t2 d2 (x1, x2)); auto; intro; apply in_or_app; left.
-unfold incl in H1 |-.
-apply H1; auto.
-unfold incl in H2 |-; apply H2; auto.
-split; right.
-elim (in_move__in_srcdst (x1, x2) ((s, d) :: (t1 ++ t1)));
- (auto; simpl; intros; (try in_tac)).
-elim H4; [intros H6; (try clear H4); (try exact H6) | intros H6; (try clear H4)].
-left; (try assumption).
-right; (try in_tac).
-rewrite getsrc_app in H6; (try in_tac).
-elim (in_move__in_srcdst (x1, x2) ((s, d) :: (t1 ++ t1)));
- (auto; simpl; intros; (try in_tac)).
-elim H5; [intros H6; (try clear H5); (try exact H6) | intros H6; (try clear H5)].
-left; (try assumption).
-right; rewrite getdst_app in H6; (try in_tac).
-caseEq b1; intro.
-unfold S1, StateToMove, StateBeing, StateDone.
-intro; elim (in_move__in_srcdst (x1, x2) ((s, d) :: t1)); (auto; intros).
-simpl snd in H4 |-; simpl fst in H3 |-; split; right; (try in_tac).
-intros l heq; generalize (app_rewriter _ l m).
-intros [y [r H1]]; rewrite H1.
-destruct y as [y1 y2].
-rewrite last_app; simpl fst.
-case (Loc.eq d0 y1).
-unfold S1, StateToMove, StateBeing, StateDone.
-intros; elim (in_move__in_srcdst (x1, x2) ((s, d) :: t1)); auto; intros.
-simpl snd in H4 |-; simpl fst in H3 |-; (split; right; (try in_tac)).
-unfold S1, StateToMove, StateBeing, StateDone.
-intros; elim (in_move__in_srcdst (x1, x2) ((s, d) :: t1)); auto; intros.
-simpl snd in H4 |-; simpl fst in H3 |-; (split; right; (try in_tac)).
-intro; elim (in_app_or (StateBeing (stepf S1)) (StateDone (stepf S1)) (x1, x2));
- auto.
-simpl stepf.
-destruct m as [s d].
-destruct m0 as [s0 d0].
-case (Loc.eq s d0).
-intros e; rewrite <- e; simpl StateBeing.
-unfold S1, StateToMove, StateBeing, StateDone.
-intros; elim (in_move__in_srcdst (x1, x2) ((s, d) :: ((s0, s) :: b1))); auto;
- simpl; intros.
-split; right; (try in_tac).
-elim H2; [intros H4; left; (try exact H4) | intros H4; (try clear H2)].
-elim H4; [intros H2; right; (try exact H2) | intros H2; (try clear H4)].
-assert (In x1 (s0 :: nil)); auto; (try in_tac).
-simpl; auto.
-right; (try in_tac).
-elim H3; [intros H4; left; (try exact H4) | intros H4; (try clear H3)].
-elim H4; [intros H3; right; (try exact H3) | intros H3; (try clear H4)].
-rewrite <- e; (try in_tac).
-assert (In x2 (s :: nil)); [simpl; auto | try in_tac].
-right; (try in_tac).
-intro; caseEq (split_move t1 d0); intro.
-destruct p as [[t2 b2] d2].
-simpl StateBeing.
-intros.
-generalize (in_split_move t1 t2 d2 d0 b2 H1).
-intros.
-split; right; elim H2; intros.
-rewrite H4 in H3; elim (in_move__in_srcdst (x1, x2) t1); auto; intros.
-simpl snd in H6 |-; simpl fst in H5 |-; (try in_tac).
-unfold S1, StateToMove, StateBeing, StateDone.
-simpl getsrc; (try in_tac).
-elim (in_move__in_srcdst (x1, x2) ((s0, d0) :: b1)); (auto; intros).
-simpl snd in H6 |-; simpl fst in H5 |-; (try in_tac).
-unfold S1, StateToMove, StateBeing, StateDone.
-simpl.
-simpl in H5 |-.
-elim H5; [intros H7; (try clear H5); (try exact H7) | intros H7; (try clear H5)].
-assert (In x1 (s0 :: nil)); simpl; auto.
-right; in_tac.
-right; in_tac.
-inversion H4.
-simpl.
-subst b2.
-rewrite H4 in H3.
-elim (in_move__in_srcdst (x1, x2) t1); (auto; intros).
-simpl snd in H7 |-.
-right; in_tac.
-unfold S1, StateToMove, StateBeing, StateDone.
-elim (in_move__in_srcdst (x1, x2) ((s0, d0) :: b1)); auto; intros.
-simpl snd in H6 |-; (try in_tac).
-apply
- (in_or_app (getdst ((s, d) :: t1)) (getdst ((s0, d0) :: b1) ++ getdst d1) x2);
- right; (try in_tac).
-caseEq b1.
-intros h1 h2; inversion h2.
-intros m l heq.
-generalize (app_rewriter _ l m); intros [y [r H2]]; rewrite H2.
-destruct y as [y1 y2].
-rewrite last_app; simpl fst.
-case (Loc.eq d0 y1).
-unfold S1, StateToMove, StateBeing, StateDone.
-generalize (last_replace r y1 y2).
-unfold Move; intros H3 H6.
-rewrite H3.
-intro.
-elim (in_app_or r ((T y1, y2) :: nil) (x1, x2)); auto.
-intro.
-rewrite heq; rewrite H2; (split; right).
-elim (in_move__in_srcdst (x1, x2) r); auto; simpl fst; simpl snd; intros;
- (try in_tac).
-simpl.
-rewrite getsrc_app; (right; (try in_tac)).
-elim (in_move__in_srcdst (x1, x2) r); auto; simpl fst; simpl snd; intros;
- (try in_tac).
-simpl.
-rewrite getdst_app; right; (try in_tac).
-intros h; inversion h; inversion H5.
-split; [left; simpl; auto | right].
-unfold T; case (Loc.type y1); auto.
-subst y2.
-rewrite heq; rewrite H2.
-simpl.
-rewrite getdst_app; simpl.
-assert (In x2 (x2 :: nil)); [simpl; auto | right; (try in_tac)].
-unfold S1, StateToMove, StateBeing, StateDone.
-intro; rewrite heq; rewrite H2; (split; right).
-intros; elim (in_move__in_srcdst (x1, x2) (r ++ ((y1, y2) :: nil))); auto;
- intros.
-simpl snd in H5 |-; simpl fst in H4 |-.
-simpl.
-right; (try in_tac).
-apply in_or_app; right; simpl; right; (try in_tac).
-elim (in_move__in_srcdst (x1, x2) (r ++ ((y1, y2) :: nil))); auto; intros.
-simpl snd in H5 |-.
-simpl.
-right; (try in_tac).
-apply in_or_app; right; simpl; right; (try in_tac).
-simpl stepf.
-destruct m as [s d].
-destruct m0 as [s0 d0].
-case (Loc.eq s d0).
-unfold S1, StateToMove, StateBeing, StateDone.
-intros; elim (in_move__in_srcdst (x1, x2) d1); auto; intros.
-simpl in H3 |-; simpl in H2 |-.
-split; right; (try in_tac).
-intro; caseEq (split_move t1 d0); intro.
-destruct p as [[t2 b2] d2].
-simpl StateDone.
-unfold S1, StateToMove, StateBeing, StateDone.
-intros; elim (in_move__in_srcdst (x1, x2) d1); auto; intros.
-simpl in H3 |-; simpl in H4 |-.
-split; right; (try in_tac).
-caseEq b1.
-unfold S1, StateToMove, StateBeing, StateDone.
-intros; elim (in_move__in_srcdst (x1, x2) ((s0, d0) :: d1)); auto; intros.
-simpl in H5 |-; simpl in H4 |-; split; right; (try in_tac).
-simpl.
-elim H4; [intros H6; right; (try exact H6) | intros H6; (try clear H4)].
-assert (In x1 (x1 :: nil)); [simpl; auto | rewrite H6; (try in_tac)].
-right; (try in_tac).
-elim H5; [intros H6; right; simpl; (try exact H6) | intros H6; (try clear H5)].
-assert (In x2 (x2 :: nil)); [simpl; auto | rewrite H6; (try in_tac)].
-try in_tac.
-intros m l heq.
-generalize (app_rewriter _ l m); intros [y [r H2]]; rewrite H2.
-destruct y as [y1 y2].
-rewrite last_app; simpl fst.
-case (Loc.eq d0 y1).
-unfold S1, StateToMove, StateBeing, StateDone.
-unfold S1, StateToMove, StateBeing, StateDone.
-intros.
-elim H3; intros.
-inversion H4.
-simpl; split; right; auto.
-right; apply in_or_app; right; simpl; auto.
-right; apply in_or_app; right; simpl; auto.
-elim H4; intros.
-inversion H5.
-simpl; split; [right | left].
-rewrite heq; rewrite H2; simpl.
-rewrite <- e; rewrite H7.
-rewrite getsrc_app; simpl.
-right; assert (In x1 (x1 :: nil)); [simpl; auto | try in_tac].
-unfold T; case (Loc.type x1); auto.
-elim (in_move__in_srcdst (x1, x2) d1); (auto; intros).
-simpl snd in H7 |-; simpl fst in H6 |-; split; right; (try in_tac).
-unfold S1, StateToMove, StateBeing, StateDone.
-intros; elim (in_move__in_srcdst (x1, x2) ((s0, d0) :: d1));
- (auto; simpl; intros).
-split; right.
-elim H4; [intros H6; right; (try exact H6) | intros H6; (try clear H4)].
-apply in_or_app; right; simpl; auto.
-right; (try in_tac).
-elim H5; [intros H6; right; (try exact H6) | intros H6; (try clear H5)].
-apply in_or_app; right; simpl; auto.
-right; (try in_tac).
-Qed.
- 
-Lemma getsrc_f: forall s l, In s (getsrc l) ->  (exists d , In (s, d) l ).
-Proof.
-induction l; simpl getsrc.
-simpl; (intros h; elim h).
-intros; destruct a as [a1 a2].
-simpl in H |-.
-elim H; [intros H0; (try clear H); (try exact H0) | intros H0; (try clear H)].
-subst a1.
-exists a2; simpl; auto.
-simpl.
-elim IHl; [intros d H; (try clear IHl); (try exact H) | idtac]; auto.
-exists d; [right; (try assumption)].
-Qed.
- 
-Lemma incl_src: forall l1 l2, incl l1 l2 ->  incl (getsrc l1) (getsrc l2).
-Proof.
-intros.
-unfold incl in H |-.
-unfold incl.
-intros a H0; (try assumption).
-generalize (getsrc_f a).
-intros H1; elim H1 with ( l := l1 );
- [intros d H2; (try clear H1); (try exact H2) | idtac]; auto.
-assert (In (a, d) l2).
-apply H; auto.
-elim (in_move__in_srcdst (a, d) l2); auto.
-Qed.
- 
-Lemma getdst_f: forall d l, In d (getdst l) ->  (exists s , In (s, d) l ).
-Proof.
-induction l; simpl getdst.
-simpl; (intros h; elim h).
-intros; destruct a as [a1 a2].
-simpl in H |-.
-elim H; [intros H0; (try clear H); (try exact H0) | intros H0; (try clear H)].
-subst a2.
-exists a1; simpl; auto.
-simpl.
-elim IHl; [intros s H; (try clear IHl); (try exact H) | idtac]; auto.
-exists s; [right; (try assumption)].
-Qed.
- 
-Lemma incl_dst: forall l1 l2, incl l1 l2 ->  incl (getdst l1) (getdst l2).
-Proof.
-intros.
-unfold incl in H |-.
-unfold incl.
-intros a H0; (try assumption).
-generalize (getdst_f a).
-intros H1; elim H1 with ( l := l1 );
- [intros d H2; (try clear H1); (try exact H2) | idtac]; auto.
-assert (In (d, a) l2).
-apply H; auto.
-elim (in_move__in_srcdst (d, a) l2); auto.
-Qed.
- 
-Lemma src_tmp2_res:
- forall S1 x1 x2,
- In
-  (x1, x2)
-  (StateToMove (Pmov S1) ++ (StateBeing (Pmov S1) ++ StateDone (Pmov S1))) ->
-  (In x1 temporaries2 \/
-   In x1 (getsrc (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1)))) /\
-  (In x2 temporaries2 \/
-   In x2 (getdst (StateToMove S1 ++ (StateBeing S1 ++ StateDone S1)))).
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1 Hrec.
-destruct S1 as [[t b] d]; set (S1:=(t, b, d)).
-unfold S1; rewrite Pmov_equation; intros.
-destruct t.
-destruct b.
-apply srcdst_tmp2_stepf; auto.
-elim Hrec with ( y := stepf S1 ) ( x1 := x1 ) ( x2 := x2 );
- [idtac | apply stepf1_dec; auto | auto].
-intros.
-elim H1; [intros H2; (try clear H1); (try exact H2) | intros H2; (try clear H1)].
-elim H0; [intros H1; (try clear H0); (try exact H1) | intros H1; (try clear H0)].
-split; [left; (try assumption) | idtac].
-left; (try assumption).
-elim (getsrc_f x1) with ( 1 := H1 ); intros x3 H3.
-split; auto.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-elim H0; [intros H1; (try clear H0); (try exact H1) | intros H1; (try clear H0)].
-elim (getdst_f x2) with ( 1 := H2 ); intros x3 H3.
-split; auto.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-elim (getsrc_f x1) with ( 1 := H1 ); intros x3 H3.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-clear H3.
-elim (getdst_f x2) with ( 1 := H2 ); intros x4 H3.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-elim Hrec with ( y := stepf S1 ) ( x1 := x1 ) ( x2 := x2 );
- [idtac | apply stepf1_dec; auto | auto].
-intros.
-elim H1; [intros H2; (try clear H1); (try exact H2) | intros H2; (try clear H1)].
-elim H0; [intros H1; (try clear H0); (try exact H1) | intros H1; (try clear H0)].
-split; [left; (try assumption) | idtac].
-left; (try assumption).
-elim (getsrc_f x1) with ( 1 := H1 ); intros x3 H3.
-split; auto.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-elim H0; [intros H1; (try clear H0); (try exact H1) | intros H1; (try clear H0)].
-elim (getdst_f x2) with ( 1 := H2 ); intros x3 H3.
-split; auto.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-elim (getsrc_f x1) with ( 1 := H1 ); intros x3 H3.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-clear H3.
-elim (getdst_f x2) with ( 1 := H2 ); intros x4 H3.
-elim srcdst_tmp2_stepf with ( 1 := H3 ); auto.
-Qed.
- 
-Lemma wt_add_moves:
- forall p b,
- List.map Loc.type (getsrc p) = List.map Loc.type (getdst p) ->
- locs_read_ok (getsrc p) ->
- locs_write_ok (getdst p) ->
- wt_block tf b ->
-  wt_block
-   tf
-   (fold_left
-     (fun (k0 : LTL.block) =>
-      fun (p0 : loc * loc) => add_move (fst p0) (snd p0) k0) p b).
-Proof.
-induction p.
-intros; simpl; auto.
-intros; destruct a as [a1 a2]; simpl.
-apply IHp; auto.
-inversion H; auto.
-simpl in H0 |-.
-unfold locs_read_ok in H0 |-.
-simpl in H0 |-.
-unfold locs_read_ok; auto.
-generalize H1; unfold locs_write_ok; simpl; auto.
-apply wt_add_move; (try assumption).
-simpl in H0 |-.
-unfold locs_read_ok in H0 |-.
-apply H0.
-simpl; left; trivial.
-unfold locs_write_ok in H1 |-; apply H1.
-simpl; left; trivial.
-inversion H; auto.
-Qed.
- 
-Lemma map_f_getsrc_getdst:
- forall (b : Set) (f : Reg ->  b) p,
- map f (getsrc p) = map f (getdst p) ->
- forall x1 x2, In (x1, x2) p ->  f x1 = f x2.
-Proof.
-intros b f0 p; induction p; simpl; auto.
-intros; contradiction.
-destruct a.
-simpl.
-intros heq; injection heq.
-intros h1 h2.
-intros x1 x2 [H3|H3].
-injection H3.
-intros; subst; auto.
-apply IHp; auto.
-Qed.
- 
-Lemma wt_parallel_move':
- forall p b,
- List.map Loc.type (getsrc p) = List.map Loc.type (getdst p) ->
- locs_read_ok (getsrc p) ->
- locs_write_ok (getdst p) -> wt_block tf b ->  wt_block tf (p_move p b).
-Proof.
-unfold p_move.
-unfold P_move.
-intros; apply wt_add_moves; auto.
-rewrite getsrc_map; rewrite getdst_map.
-rewrite list_map_compose.
-rewrite list_map_compose.
-apply list_map_exten.
-generalize (move_types_res (p, nil, nil)); auto.
-destruct x as [x1 x2]; simpl; intros; auto.
-symmetry; apply H3.
-simpl.
-rewrite app_nil.
-apply map_f_getsrc_getdst; auto.
-in_tac.
-unfold locs_read_ok.
-intros l H3.
-elim getsrc_f with ( 1 := H3 ); intros x3 H4.
-elim (src_tmp2_res (p, nil, nil) l x3).
-simpl.
-rewrite app_nil.
-intros [[H'|[H'|H']]|H'] _.
-subst l; hnf; auto.
-subst l; hnf; auto.
-contradiction.
-apply H0; auto.
-in_tac.
-intros l H3.
-elim getdst_f with ( 1 := H3 ); intros x3 H4.
-elim (src_tmp2_res (p, nil, nil) x3 l).
-simpl.
-rewrite app_nil.
-intros _ [[H'|[H'|H']]|H'].
-subst l; hnf; auto.
-subst l; hnf; auto.
-contradiction.
-apply H1; auto.
-in_tac.
-Qed.
- 
-Theorem wt_parallel_moveX:
- forall srcs dsts b,
- List.map Loc.type srcs = List.map Loc.type dsts ->
- locs_read_ok srcs ->
- locs_write_ok dsts -> wt_block tf b ->  wt_block tf (parallel_move srcs dsts b).
-Proof.
-unfold parallel_move, parallel_move_order, P_move.
-intros.
-generalize (wt_parallel_move' (listsLoc2Moves srcs dsts)); intros H'.
-unfold p_move, P_move in H' |-.
-apply H'; auto.
-elim (getdst_lists2moves srcs dsts); auto.
-unfold Allocation.listsLoc2Moves, listsLoc2Moves.
-intros heq1 heq2; rewrite heq1; rewrite heq2; auto.
-repeat rewrite <- (list_length_map Loc.type).
-rewrite H; auto.
-elim (getdst_lists2moves srcs dsts); auto.
-unfold Allocation.listsLoc2Moves, listsLoc2Moves.
-intros heq1 heq2; rewrite heq1; auto.
-repeat rewrite <- (list_length_map Loc.type).
-rewrite H; auto.
-elim (getdst_lists2moves srcs dsts); auto.
-unfold Allocation.listsLoc2Moves, listsLoc2Moves.
-intros heq1 heq2; rewrite heq2; auto.
-repeat rewrite <- (list_length_map Loc.type).
-rewrite H; auto.
-Qed.
- 
-End wt_move_correction.
diff --git a/backend/CSE.v b/backend/CSE.v
index 243f6dd..6801013 100644
--- a/backend/CSE.v
+++ b/backend/CSE.v
@@ -178,6 +178,15 @@ Definition add_load (n: numbering) (rd: reg)
   let (n1, vs) := valnum_regs n rs in
   add_rhs n1 rd (Load chunk addr vs).
 
+(** [add_unknown n rd] returns a numbering where [rd] is mapped to a
+   fresh value number, and no equations are added.  This is useful
+   to model instructions with unpredictable results such as [Ialloc]. *)
+
+Definition add_unknown (n: numbering) (rd: reg) :=
+  mknumbering (Psucc n.(num_next))
+              n.(num_eqs)
+              (PTree.set rd n.(num_next) n.(num_reg)).
+
 (** [kill_load n] removes all equations involving memory loads.
   It is used to reflect the effect of a memory store, which can
   potentially invalidate all such equations. *)
@@ -328,6 +337,8 @@ Definition transfer (f: function) (pc: node) (before: numbering) :=
           kill_loads before
       | Icall sig ros args res s =>
           empty_numbering
+      | Ialloc arg res s =>
+          add_unknown before res
       | Icond cond args ifso ifnot =>
           before
       | Ireturn optarg =>
@@ -415,6 +426,8 @@ Definition transf_function (f: function) : function :=
         f.(fn_nextpc)
         (transf_code_wf f approxs f.(fn_code_wf)).
 
+Definition transf_fundef := AST.transf_fundef transf_function.
+
 Definition transf_program (p: program) : program :=
-  transform_program transf_function p.
+  transform_program transf_fundef p.
 
diff --git a/backend/CSEproof.v b/backend/CSEproof.v
index db8a973..4420269 100644
--- a/backend/CSEproof.v
+++ b/backend/CSEproof.v
@@ -7,6 +7,7 @@ Require Import Integers.
 Require Import Floats.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Registers.
@@ -177,6 +178,18 @@ Proof.
   apply wf_add_rhs; auto.
 Qed.
 
+Lemma wf_add_unknown:
+  forall n rd,
+  wf_numbering n ->
+  wf_numbering (add_unknown n rd).
+Proof.
+  intros. inversion H. unfold add_unknown. constructor; simpl.
+  intros. eapply wf_equation_increasing; eauto. auto with coqlib. 
+  intros until v. rewrite PTree.gsspec. case (peq r rd); intros.
+  inversion H2. auto with coqlib.
+  apply Plt_trans_succ. eauto.
+Qed.
+
 Lemma kill_load_eqs_incl:
   forall eqs, List.incl (kill_load_eqs eqs) eqs.
 Proof.
@@ -205,6 +218,7 @@ Proof.
   apply wf_add_load; auto.
   apply wf_kill_loads; auto.
   apply wf_empty_numbering.
+  apply wf_add_unknown; auto.
 Qed.
 
 (** As a consequence, the numberings computed by the static analysis
@@ -497,6 +511,47 @@ Proof.
   simpl. exists a; split; congruence. 
 Qed.
 
+(** [add_unknown] returns a numbering that is satisfiable in the
+  register set after setting the target register to any value. *)
+
+Lemma add_unknown_satisfiable:
+  forall n rs dst v,
+  wf_numbering n ->
+  numbering_satisfiable ge sp rs m n ->
+  numbering_satisfiable ge sp 
+     (rs#dst <- v) m (add_unknown n dst).
+Proof.
+  intros. destruct H0 as [valu A]. 
+  set (valu' := VMap.set n.(num_next) v valu).
+  assert (numbering_holds valu' ge sp rs m n). 
+    eapply numbering_holds_exten; eauto.
+    unfold valu'; red; intros. apply VMap.gso. auto with coqlib.
+  destruct H0 as [B C].
+  exists valu'; split; simpl; intros.
+  eauto.
+  rewrite PTree.gsspec in H0. rewrite Regmap.gsspec. 
+  destruct (peq r dst). inversion H0. unfold valu'. rewrite VMap.gss; auto.
+  eauto.
+Qed.
+
+(** Allocation of a fresh memory block preserves satisfiability. *)
+
+Lemma alloc_satisfiable:
+  forall lo hi b m' rs n,
+  Mem.alloc m lo hi = (m', b) ->
+  numbering_satisfiable ge sp rs m n ->
+  numbering_satisfiable ge sp rs m' n.
+Proof.
+  intros. destruct H0 as [valu [A B]].
+  exists valu; split; intros.
+  generalize (A _ _ H0). destruct rh; simpl.
+  auto.
+  intros [addr [C D]]. exists addr; split. auto.
+  destruct addr; simpl in *; try discriminate. 
+  eapply Mem.load_alloc_other; eauto. 
+  eauto.
+Qed.
+
 (** [kill_load] preserves satisfiability.  Moreover, the resulting numbering
   is satisfiable in any concrete memory state. *)
 
@@ -612,8 +667,8 @@ End SATISFIABILITY.
 (** The transfer function preserves satisfiability of numberings. *)
 
 Lemma transfer_correct:
-  forall ge c sp pc rs m pc' rs' m' f n,
-  exec_instr ge c sp pc rs m pc' rs' m' ->
+  forall ge c sp pc rs m t pc' rs' m' f n,
+  exec_instr ge c sp pc rs m t pc' rs' m' ->
   c = f.(fn_code) ->
   wf_numbering n ->
   numbering_satisfiable ge sp rs m n ->
@@ -628,6 +683,8 @@ Proof.
   eapply kill_load_satisfiable; eauto.
   (* Icall *)
   apply empty_numbering_satisfiable.
+  (* Ialloc *)
+  apply add_unknown_satisfiable; auto. eapply alloc_satisfiable; eauto.
 Qed.
 
 (** The numberings associated to each instruction by the static analysis
@@ -637,8 +694,8 @@ Qed.
   satisfiability at [pc']. *)
 
 Theorem analysis_correct_1:
-  forall ge c sp pc rs m pc' rs' m' f,
-  exec_instr ge c sp pc rs m pc' rs' m' ->
+  forall ge c sp pc rs m t pc' rs' m' f,
+  exec_instr ge c sp pc rs m t pc' rs' m' ->
   c = f.(fn_code) ->
   numbering_satisfiable ge sp rs m (analyze f)!!pc ->
   numbering_satisfiable ge sp rs' m' (analyze f)!!pc'.
@@ -655,15 +712,15 @@ Proof.
     eapply Solver.fixpoint_solution; eauto.
     elim (fn_code_wf f pc); intro. auto.
     rewrite <- CODE in H0.
-    elim (exec_instr_present _ _ _ _ _ _ _ _ _ EXEC H0).
+    elim (exec_instr_present _ _ _ _ _ _ _ _ _ _ EXEC H0).
     rewrite CODE in EXEC. eapply successors_correct; eauto.
   apply H0. auto.
   intros. rewrite PMap.gi. apply empty_numbering_satisfiable.
 Qed.
 
 Theorem analysis_correct_N:
-  forall ge c sp pc rs m pc' rs' m' f,
-  exec_instrs ge c sp pc rs m pc' rs' m' ->
+  forall ge c sp pc rs m t pc' rs' m' f,
+  exec_instrs ge c sp pc rs m t pc' rs' m' ->
   c = f.(fn_code) ->
   numbering_satisfiable ge sp rs m (analyze f)!!pc ->
   numbering_satisfiable ge sp rs' m' (analyze f)!!pc'.
@@ -702,19 +759,26 @@ Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof (Genv.find_symbol_transf transf_function prog).
+Proof (Genv.find_symbol_transf transf_fundef prog).
 
 Lemma functions_translated:
-  forall (v: val) (f: RTL.function),
+  forall (v: val) (f: RTL.fundef),
   Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (transf_function f).
-Proof (@Genv.find_funct_transf _ _ transf_function prog).
+  Genv.find_funct tge v = Some (transf_fundef f).
+Proof (@Genv.find_funct_transf _ _ transf_fundef prog).
 
 Lemma funct_ptr_translated:
-  forall (b: block) (f: RTL.function),
+  forall (b: block) (f: RTL.fundef),
   Genv.find_funct_ptr ge b = Some f ->
-  Genv.find_funct_ptr tge b = Some (transf_function f).
-Proof (@Genv.find_funct_ptr_transf _ _ transf_function prog).
+  Genv.find_funct_ptr tge b = Some (transf_fundef f).
+Proof (@Genv.find_funct_ptr_transf _ _ transf_fundef prog).
+
+Lemma sig_translated:
+  forall (f: RTL.fundef),
+  funsig (transf_fundef f) = funsig f.
+Proof.
+  intros; case f; intros; reflexivity.
+Qed.
 
 (** The proof of semantic preservation is a simulation argument using
   diagrams of the following form:
@@ -732,26 +796,26 @@ Proof (@Genv.find_funct_ptr_transf _ _ transf_function prog).
 
 Definition exec_instr_prop
         (c: code) (sp: val)
-        (pc: node) (rs: regset) (m: mem)
+        (pc: node) (rs: regset) (m: mem) (t: trace)
         (pc': node) (rs': regset) (m': mem) : Prop :=
   forall f
          (CF: c = f.(RTL.fn_code))
          (SAT: numbering_satisfiable ge sp rs m (analyze f)!!pc),
-  exec_instr tge (transf_code (analyze f) c) sp pc rs m pc' rs' m'.
+  exec_instr tge (transf_code (analyze f) c) sp pc rs m t pc' rs' m'.
 
 Definition exec_instrs_prop
         (c: code) (sp: val)
-        (pc: node) (rs: regset) (m: mem)
+        (pc: node) (rs: regset) (m: mem) (t: trace)
         (pc': node) (rs': regset) (m': mem) : Prop :=
   forall f
          (CF: c = f.(RTL.fn_code))
          (SAT: numbering_satisfiable ge sp rs m (analyze f)!!pc),
-  exec_instrs tge (transf_code (analyze f) c) sp pc rs m pc' rs' m'.
+  exec_instrs tge (transf_code (analyze f) c) sp pc rs m t pc' rs' m'.
 
 Definition exec_function_prop
-        (f: RTL.function) (args: list val) (m: mem)
+        (f: RTL.fundef) (args: list val) (m: mem) (t: trace)
         (res: val) (m': mem) : Prop :=
-  exec_function tge (transf_function f) args m res m'.
+  exec_function tge (transf_fundef f) args m t res m'.
 
 Ltac TransfInstr :=
   match goal with
@@ -766,9 +830,9 @@ Ltac TransfInstr :=
   derivation for the source program. *)
 
 Lemma transf_function_correct:
-  forall f args m res m',
-  exec_function ge f args m res m' ->
-  exec_function_prop f args m res m'.
+  forall f args m t res m',
+  exec_function ge f args m t res m' ->
+  exec_function_prop f args m t res m'.
 Proof.
   apply (exec_function_ind_3 ge
           exec_instr_prop exec_instrs_prop exec_function_prop);
@@ -804,12 +868,15 @@ Proof.
     rewrite <- H0. apply eval_addressing_preserved. exact symbols_preserved.
   intro; eapply exec_Istore; eauto. 
   (* Icall *)
-  assert (find_function tge ros rs = Some (transf_function f)).
+  assert (find_function tge ros rs = Some (transf_fundef f)).
     destruct ros; simpl in H0; simpl.
     apply functions_translated; auto.
     rewrite symbols_preserved. destruct (Genv.find_symbol ge i).
     apply funct_ptr_translated; auto. discriminate.
-  intro; eapply exec_Icall with (f := transf_function f); eauto. 
+  intro; eapply exec_Icall with (f := transf_fundef f); eauto. 
+  generalize (sig_translated f); congruence.
+  (* Ialloc *)
+  intro; eapply exec_Ialloc; eauto.
   (* Icond true *)
   intro; eapply exec_Icond_true; eauto. 
   (* Icond false *)
@@ -821,22 +888,23 @@ Proof.
   (* trans *)
   eapply exec_trans; eauto. apply H2; auto. 
   eapply analysis_correct_N; eauto.
-  (* function *)
-  intro. unfold transf_function; eapply exec_funct; simpl; eauto. 
+  (* internal function *)
+  intro. unfold transf_function; simpl; eapply exec_funct_internal; simpl; eauto. 
   eapply H1; eauto. eapply analysis_correct_entry; eauto.
+  (* external function *)
+  unfold transf_function; simpl. apply exec_funct_external; auto.
 Qed.
 
 Theorem transf_program_correct:
-  forall (r: val),
-  exec_program prog r -> exec_program tprog r.
+  forall (t: trace) (r: val),
+  exec_program prog t r -> exec_program tprog t r.
 Proof.
-  intros r [fptr [f [m [FINDS [FINDF [SIG EXEC]]]]]].
-  red. exists fptr; exists (transf_function f); exists m. 
+  intros t r [fptr [f [m [FINDS [FINDF [SIG EXEC]]]]]].
+  red. exists fptr; exists (transf_fundef f); exists m. 
   split. change (prog_main tprog) with (prog_main prog).
   rewrite symbols_preserved. assumption.
   split. apply funct_ptr_translated; auto.
-  split. unfold transf_function. 
-  rewrite <- SIG. destruct (analyze f); reflexivity.
+  split. generalize (sig_translated f); congruence.
   apply transf_function_correct. 
   unfold tprog, transf_program. rewrite Genv.init_mem_transf. 
   exact EXEC.
diff --git a/backend/Cmconstr.v b/backend/Cmconstr.v
index e6168d1..f3a63fa 100644
--- a/backend/Cmconstr.v
+++ b/backend/Cmconstr.v
@@ -57,6 +57,8 @@ Fixpoint lift_expr (p: nat) (a: expr) {struct a}: expr :=
   | 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
+  | Ealloc b =>
+      Ealloc (lift_expr p b)
   end
 
 with lift_condexpr (p: nat) (a: condexpr) {struct a}: condexpr :=
@@ -795,11 +797,6 @@ Definition divf (e1 e2: expr) := Eop Odivf (e1:::e2:::Enil).
 
 (** ** Truncations and sign extensions *)
 
-Definition cast8unsigned (e: expr) :=
-  rolm e Int.zero (Int.repr 255).
-Definition cast16unsigned (e: expr) :=
-  rolm e Int.zero (Int.repr 65535).
-
 Inductive cast8signed_cases: forall (e1: expr), Set :=
   | cast8signed_case1:
       forall (e2: expr),
@@ -822,6 +819,28 @@ Definition cast8signed (e: expr) :=
   | 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),
@@ -844,6 +863,28 @@ Definition cast16signed (e: expr) :=
   | 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),
diff --git a/backend/Cmconstrproof.v b/backend/Cmconstrproof.v
index f27fa73..b9976ee 100644
--- a/backend/Cmconstrproof.v
+++ b/backend/Cmconstrproof.v
@@ -16,6 +16,7 @@ Require Import Integers.
 Require Import Floats.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Op.
 Require Import Globalenvs.
 Require Import Cminor.
@@ -67,34 +68,67 @@ Scheme eval_expr_ind_3 := Minimality for eval_expr Sort Prop
   with eval_exprlist_ind_3 := Minimality for eval_exprlist Sort Prop.
 
 Hint Resolve eval_Evar eval_Eassign eval_Eop eval_Eload eval_Estore
-             eval_Ecall eval_Econdition
+             eval_Ecall eval_Econdition eval_Ealloc
              eval_Elet eval_Eletvar 
              eval_CEtrue eval_CEfalse eval_CEcond
              eval_CEcondition eval_Enil eval_Econs: evalexpr.
 
+Lemma eval_list_one:
+  forall sp le e1 m1 a t e2 m2 v,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
+  eval_exprlist ge sp le e1 m1 (a ::: Enil) t e2 m2 (v :: nil).
+Proof.
+  intros. econstructor. eauto. constructor. traceEq.
+Qed.
+
+Lemma eval_list_two:
+  forall sp le e1 m1 a1 t1 e2 m2 v1 a2 t2 e3 m3 v2 t,
+  eval_expr ge sp le e1 m1 a1 t1 e2 m2 v1 ->
+  eval_expr ge sp le e2 m2 a2 t2 e3 m3 v2 ->
+  t = t1 ** t2 ->
+  eval_exprlist ge sp le e1 m1 (a1 ::: a2 ::: Enil) t e3 m3 (v1 :: v2 :: nil).
+Proof.
+  intros. econstructor. eauto. econstructor. eauto. constructor. 
+  reflexivity. traceEq.
+Qed.
+
+Lemma eval_list_three:
+  forall sp le e1 m1 a1 t1 e2 m2 v1 a2 t2 e3 m3 v2 a3 t3 e4 m4 v3 t,
+  eval_expr ge sp le e1 m1 a1 t1 e2 m2 v1 ->
+  eval_expr ge sp le e2 m2 a2 t2 e3 m3 v2 ->
+  eval_expr ge sp le e3 m3 a3 t3 e4 m4 v3 ->
+  t = t1 ** t2 ** t3 ->
+  eval_exprlist ge sp le e1 m1 (a1 ::: a2 ::: a3 ::: Enil) t e4 m4 (v1 :: v2 :: v3 :: nil).
+Proof.
+  intros. econstructor. eauto. econstructor. eauto. econstructor. eauto. constructor. 
+  reflexivity. reflexivity. traceEq.
+Qed.
+
+Hint Resolve eval_list_one eval_list_two eval_list_three: evalexpr.
+
 Lemma eval_lift_expr:
-  forall w sp le e1 m1 a e2 m2 v,
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
+  forall w sp le e1 m1 a t e2 m2 v,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
   forall p le', insert_lenv le p w le' ->
-  eval_expr ge sp le' e1 m1 (lift_expr p a) e2 m2 v.
+  eval_expr ge sp le' e1 m1 (lift_expr p a) t e2 m2 v.
 Proof.
   intros w.
   apply (eval_expr_ind_3 ge
-    (fun sp le e1 m1 a e2 m2 v =>
+    (fun sp le e1 m1 a t e2 m2 v =>
       forall p le', insert_lenv le p w le' ->
-      eval_expr ge sp le' e1 m1 (lift_expr p a) e2 m2 v)
-    (fun sp le e1 m1 a e2 m2 vb =>
+      eval_expr ge sp le' e1 m1 (lift_expr p a) t e2 m2 v)
+    (fun sp le e1 m1 a t e2 m2 vb =>
       forall p le', insert_lenv le p w le' ->
-      eval_condexpr ge sp le' e1 m1 (lift_condexpr p a) e2 m2 vb)
-    (fun sp le e1 m1 al e2 m2 vl =>
+      eval_condexpr ge sp le' e1 m1 (lift_condexpr p a) t e2 m2 vb)
+    (fun sp le e1 m1 al t e2 m2 vl =>
       forall p le', insert_lenv le p w le' ->
-      eval_exprlist ge sp le' e1 m1 (lift_exprlist p al) e2 m2 vl));
+      eval_exprlist ge sp le' e1 m1 (lift_exprlist p al) t e2 m2 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.
+  eapply eval_Elet. eauto. apply H2. apply insert_lenv_S; auto. auto.
 
   case (le_gt_dec p n); intro. 
   apply eval_Eletvar. eapply insert_lenv_lookup2; eauto.
@@ -105,9 +139,9 @@ Proof.
 Qed.
 
 Lemma eval_lift:
-  forall sp le e1 m1 a e2 m2 v w,
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
-  eval_expr ge sp (w::le) e1 m1 (lift a) e2 m2 v.
+  forall sp le e1 m1 a t e2 m2 v w,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
+  eval_expr ge sp (w::le) e1 m1 (lift a) t e2 m2 v.
 Proof.
   intros. unfold lift. eapply eval_lift_expr.
   eexact H. apply insert_lenv_0. 
@@ -126,67 +160,69 @@ Ltac TrivialOp cstr :=
   of operator applications. *)  
 
 Lemma inv_eval_Eop_0:
-  forall sp le e1 m1 op e2 m2 v,
-  eval_expr ge sp le e1 m1 (Eop op Enil) e2 m2 v ->
-  e2 = e1 /\ m2 = m1 /\ eval_operation ge sp op nil = Some v.
+  forall sp le e1 m1 op t e2 m2 v,
+  eval_expr ge sp le e1 m1 (Eop op Enil) t e2 m2 v ->
+  t = E0 /\ e2 = e1 /\ m2 = m1 /\ eval_operation ge sp op nil = Some v.
 Proof.
   intros. inversion H. inversion H6. 
   intuition. congruence.
 Qed.
   
 Lemma inv_eval_Eop_1:
-  forall sp le e1 m1 op a1 e2 m2 v,
-  eval_expr ge sp le e1 m1 (Eop op (a1 ::: Enil)) e2 m2 v ->
+  forall sp le e1 m1 op t a1 e2 m2 v,
+  eval_expr ge sp le e1 m1 (Eop op (a1 ::: Enil)) t e2 m2 v ->
   exists v1,
-  eval_expr ge sp le e1 m1 a1 e2 m2 v1 /\
+  eval_expr ge sp le e1 m1 a1 t e2 m2 v1 /\
   eval_operation ge sp op (v1 :: nil) = Some v.
 Proof.
   intros. 
-  inversion H. inversion H6. inversion H21. 
-  subst e4; subst m4. subst e6; subst m6. 
-  exists v1; intuition. congruence.
+  inversion H. inversion H6. inversion H19. 
+  subst. exists v1; intuition. rewrite E0_right. auto.
 Qed.
 
 Lemma inv_eval_Eop_2:
-  forall sp le e1 m1 op a1 a2 e3 m3 v,
-  eval_expr ge sp le e1 m1 (Eop op (a1 ::: a2 ::: Enil)) e3 m3 v ->
-  exists e2, exists m2, exists v1, exists v2,
-  eval_expr ge sp le e1 m1 a1 e2 m2 v1 /\
-  eval_expr ge sp le e2 m2 a2 e3 m3 v2 /\
+  forall sp le e1 m1 op a1 a2 t3 e3 m3 v,
+  eval_expr ge sp le e1 m1 (Eop op (a1 ::: a2 ::: Enil)) t3 e3 m3 v ->
+  exists t1, exists t2, exists e2, exists m2, exists v1, exists v2,
+  eval_expr ge sp le e1 m1 a1 t1 e2 m2 v1 /\
+  eval_expr ge sp le e2 m2 a2 t2 e3 m3 v2 /\
+  t3 = t1 ** t2 /\
   eval_operation ge sp op (v1 :: v2 :: nil) = Some v.
 Proof.
   intros. 
-  inversion H. inversion H6. inversion H21. inversion H32.
-  subst e7; subst m7. subst e9; subst m9.
-  exists e4; exists m4; exists v1; exists v2. intuition. congruence.
+  inversion H. subst. inversion H6. subst. inversion H8. subst.
+  inversion H10. subst. 
+  exists t1; exists t0; exists e0; exists m0; exists v0; exists v1.
+  intuition. traceEq.
 Qed.
 
 Ltac SimplEval :=
   match goal with
-  | [ |- (eval_expr _ ?sp ?le ?e1 ?m1 (Eop ?op Enil) ?e2 ?m2 ?v) -> _] =>
+  | [ |- (eval_expr _ ?sp ?le ?e1 ?m1 (Eop ?op Enil) ?t ?e2 ?m2 ?v) -> _] =>
       intro XX1;
-      generalize (inv_eval_Eop_0 sp le e1 m1 op e2 m2 v XX1);
+      generalize (inv_eval_Eop_0 sp le e1 m1 op t e2 m2 v XX1);
       clear XX1;
-      intros [XX1 [XX2 XX3]];
-      subst e2; subst m2; simpl in XX3; 
-      try (simplify_eq XX3; clear XX3;
+      intros [XX1 [XX2 [XX3 XX4]]];
+      subst t e2 m2; simpl in XX4; 
+      try (simplify_eq XX4; clear XX4;
       let EQ := fresh "EQ" in (intro EQ; rewrite EQ))
-  | [ |- (eval_expr _ ?sp ?le ?e1 ?m1 (Eop ?op (?a1 ::: Enil)) ?e2 ?m2 ?v) -> _] =>
+  | [ |- (eval_expr _ ?sp ?le ?e1 ?m1 (Eop ?op (?a1 ::: Enil)) ?t ?e2 ?m2 ?v) -> _] =>
       intro XX1;
-      generalize (inv_eval_Eop_1 sp le e1 m1 op a1 e2 m2 v XX1);
+      generalize (inv_eval_Eop_1 sp le e1 m1 op t a1 e2 m2 v XX1);
       clear XX1;
       let v1 := fresh "v" in let EV := fresh "EV" in
       let EQ := fresh "EQ" in
       (intros [v1 [EV EQ]]; simpl in EQ)
-  | [ |- (eval_expr _ ?sp ?le ?e1 ?m1 (Eop ?op (?a1 ::: ?a2 ::: Enil)) ?e2 ?m2 ?v) -> _] =>
+  | [ |- (eval_expr _ ?sp ?le ?e1 ?m1 (Eop ?op (?a1 ::: ?a2 ::: Enil)) ?t ?e2 ?m2 ?v) -> _] =>
       intro XX1;
-      generalize (inv_eval_Eop_2 sp le e1 m1 op a1 a2 e2 m2 v XX1);
+      generalize (inv_eval_Eop_2 sp le e1 m1 op a1 a2 t e2 m2 v XX1);
       clear XX1;
+      let t1 := fresh "t" in let t2 := fresh "t" in
       let e := fresh "e" in let m := fresh "m" in
       let v1 := fresh "v" in let v2 := fresh "v" in
       let EV1 := fresh "EV" in let EV2 := fresh "EV" in
-      let EQ := fresh "EQ" in
-      (intros [e [m [v1 [v2 [EV1 [EV2 EQ]]]]]]; simpl in EQ)
+      let EQ := fresh "EQ" in let TR := fresh "TR" in
+      (intros [t1 [t2 [e [m [v1 [v2 [EV1 [EV2 [TR EQ]]]]]]]]]; simpl in EQ)
   | _ => idtac
   end.
 
@@ -209,57 +245,57 @@ Ltac InvEval H :=
 *)
 
 Theorem eval_negint:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (negint a) e2 m2 (Vint (Int.neg x)).
+  forall sp le e1 m1 a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (negint a) t e2 m2 (Vint (Int.neg x)).
 Proof.
   TrivialOp negint. 
 Qed.
 
 Theorem eval_negfloat:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e1 m1 (negfloat a) e2 m2 (Vfloat (Float.neg x)).
+  forall sp le e1 m1 a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e1 m1 (negfloat a) t e2 m2 (Vfloat (Float.neg x)).
 Proof.
   TrivialOp negfloat.
 Qed.
 
 Theorem eval_absfloat:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e1 m1 (absfloat a) e2 m2 (Vfloat (Float.abs x)).
+  forall sp le e1 m1 a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e1 m1 (absfloat a) t e2 m2 (Vfloat (Float.abs x)).
 Proof.
   TrivialOp absfloat.
 Qed.
 
 Theorem eval_intoffloat:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e1 m1 (intoffloat a) e2 m2 (Vint (Float.intoffloat x)).
+  forall sp le e1 m1 a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e1 m1 (intoffloat a) t e2 m2 (Vint (Float.intoffloat x)).
 Proof.
   TrivialOp intoffloat.
 Qed.
 
 Theorem eval_floatofint:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (floatofint a) e2 m2 (Vfloat (Float.floatofint x)).
+  forall sp le e1 m1 a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (floatofint a) t e2 m2 (Vfloat (Float.floatofint x)).
 Proof.
   TrivialOp floatofint.
 Qed.
 
 Theorem eval_floatofintu:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (floatofintu a) e2 m2 (Vfloat (Float.floatofintu x)).
+  forall sp le e1 m1 a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (floatofintu a) t e2 m2 (Vfloat (Float.floatofintu x)).
 Proof.
   TrivialOp floatofintu.
 Qed.
 
 Theorem eval_notint:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (notint a) e2 m2 (Vint (Int.not x)).
+  forall sp le e1 m1 a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (notint a) t e2 m2 (Vint (Int.not x)).
 Proof.
   unfold notint; intros until x; case (notint_match a); intros.
   InvEval H. FuncInv. EvalOp. simpl. congruence. 
@@ -269,15 +305,15 @@ Proof.
   eapply eval_Eop.
   eapply eval_Econs. apply eval_Eletvar. simpl. reflexivity.
   eapply eval_Econs. apply eval_Eletvar. simpl. reflexivity.
-  apply eval_Enil. 
-  simpl. rewrite Int.or_idem. auto.
+  apply eval_Enil. reflexivity. reflexivity. 
+  simpl. rewrite Int.or_idem. auto. traceEq.
 Qed.
 
 Lemma eval_notbool_base:
-  forall sp le e1 m1 a e2 m2 v b,
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
+  forall sp le e1 m1 a t e2 m2 v b,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
   Val.bool_of_val v b ->
-  eval_expr ge sp le e1 m1 (notbool_base a) e2 m2 (Val.of_bool (negb b)).
+  eval_expr ge sp le e1 m1 (notbool_base a) t e2 m2 (Val.of_bool (negb b)).
 Proof. 
   TrivialOp notbool_base. simpl. 
   inversion H0. 
@@ -290,10 +326,10 @@ 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 a sp le e1 m1 e2 m2 v b,
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
+  forall a sp le e1 m1 t e2 m2 v b,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
   Val.bool_of_val v b ->
-  eval_expr ge sp le e1 m1 (notbool a) e2 m2 (Val.of_bool (negb b)).
+  eval_expr ge sp le e1 m1 (notbool a) t e2 m2 (Val.of_bool (negb b)).
 Proof.
   assert (N1: forall v b, Val.is_false v -> Val.bool_of_val v b -> Val.is_true (Val.of_bool (negb b))).
     intros. inversion H0; simpl; auto; subst v; simpl in H.
@@ -305,34 +341,33 @@ Proof.
   induction a; simpl; intros; try (eapply eval_notbool_base; eauto).
   destruct o; try (eapply eval_notbool_base; eauto).
 
-  destruct e. inversion H. inversion H7. subst vl.
-  simpl in H11. inversion H11. subst v0; subst v.
+  destruct e. InvEval H. injection XX4; clear XX4; intro; subst v.
   inversion H0. rewrite Int.eq_false; auto. 
   simpl; eauto with evalexpr.
   rewrite Int.eq_true; simpl; eauto with evalexpr.
   eapply eval_notbool_base; eauto.
 
-  inversion H. subst sp0 le0 e0 m op al e3 m0 v0.
-  simpl in H11. eapply eval_Eop; eauto.
+  inversion H. subst. 
+  simpl in H12. eapply eval_Eop; eauto.
   simpl. caseEq (eval_condition c vl); intros.
-  rewrite H1 in H11. 
+  rewrite H1 in H12. 
   assert (b0 = b). 
-  destruct b0; inversion H11; subst v; inversion H0; auto.
+  destruct b0; inversion H12; subst v; inversion H0; auto.
   subst b0. rewrite (Op.eval_negate_condition _ _ H1). 
   destruct b; reflexivity.
-  rewrite H1 in H11; discriminate.
+  rewrite H1 in H12; discriminate.
 
   inversion H; eauto 10 with evalexpr valboolof.
   inversion H; eauto 10 with evalexpr valboolof.
 
-  inversion H. eapply eval_Econdition. eexact H11.
-  destruct v1; eauto.
+  inversion H. subst. eapply eval_Econdition with (t2 := t8). eexact H36.
+  destruct v4; eauto. auto.
 Qed.
 
 Theorem eval_addimm:
-  forall sp le e1 m1 n a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (addimm n a) e2 m2 (Vint (Int.add x n)).
+  forall sp le e1 m1 n a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (addimm n a) t e2 m2 (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.
@@ -341,16 +376,16 @@ Proof.
   InvEval H0. EvalOp. simpl. rewrite Int.add_commut. auto.
   InvEval H0. destruct (Genv.find_symbol ge s); discriminate.
   InvEval H0. 
-  destruct sp; simpl in XX3; discriminate.
+  destruct sp; simpl in XX4; discriminate.
   InvEval H0. FuncInv. EvalOp. simpl. subst x. 
   rewrite Int.add_assoc. decEq; decEq; decEq. apply Int.add_commut.
   EvalOp. 
 Qed. 
 
 Theorem eval_addimm_ptr:
-  forall sp le e1 m1 n a e2 m2 b ofs,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vptr b ofs) ->
-  eval_expr ge sp le e1 m1 (addimm n a) e2 m2 (Vptr b (Int.add ofs n)).
+  forall sp le e1 m1 n t a e2 m2 b ofs,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vptr b ofs) ->
+  eval_expr ge sp le e1 m1 (addimm n a) t e2 m2 (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.
@@ -361,8 +396,8 @@ Proof.
     destruct (Genv.find_symbol ge s). 
     rewrite Int.add_commut. congruence.
     discriminate.
-  InvEval H0. destruct sp; simpl in XX3; try discriminate.
-  inversion XX3. EvalOp. simpl. decEq. decEq. 
+  InvEval H0. destruct sp; simpl in XX4; try discriminate.
+  inversion XX4. EvalOp. simpl. decEq. decEq. 
   rewrite Int.add_assoc. decEq. apply Int.add_commut.
   InvEval H0. FuncInv. subst b0; subst ofs. EvalOp. simpl. 
     rewrite (Int.add_commut n m). rewrite Int.add_assoc. auto.
@@ -370,13 +405,14 @@ Proof.
 Qed.
 
 Theorem eval_add:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (add a b) e3 m3 (Vint (Int.add x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (add a b) (t1**t2) e3 m3 (Vint (Int.add x y)).
 Proof.
   intros until y. unfold add; case (add_match a b); intros.
-  InvEval H. rewrite Int.add_commut. apply eval_addimm. assumption.
+  InvEval H. rewrite Int.add_commut. apply eval_addimm. 
+  rewrite E0_left; assumption.
   InvEval H. FuncInv. InvEval H0. FuncInv. 
     replace (Int.add x y) with (Int.add (Int.add i i0) (Int.add n1 n2)).
     apply eval_addimm. EvalOp. 
@@ -387,7 +423,7 @@ Proof.
     apply eval_addimm. EvalOp.
     subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
   InvEval H0. FuncInv.
-    apply eval_addimm. auto.
+    apply eval_addimm. rewrite E0_right. auto.
   InvEval H0. FuncInv. 
     replace (Int.add x y) with (Int.add (Int.add x i) n2).
     apply eval_addimm. EvalOp.
@@ -396,10 +432,10 @@ Proof.
 Qed.
 
 Theorem eval_add_ptr:
-  forall sp le e1 m1 a e2 m2 p x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vptr p x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (add a b) e3 m3 (Vptr p (Int.add x y)).
+  forall sp le e1 m1 a t1 e2 m2 p x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vptr p x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (add a b) (t1**t2) e3 m3 (Vptr p (Int.add x y)).
 Proof.
   intros until y. unfold add; case (add_match a b); intros.
   InvEval H. 
@@ -412,7 +448,7 @@ Proof.
     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.
-  InvEval H0. apply eval_addimm_ptr. auto.
+  InvEval H0. apply eval_addimm_ptr. rewrite E0_right. auto.
   InvEval H0. FuncInv. 
     replace (Int.add x y) with (Int.add (Int.add x i) n2).
     apply eval_addimm_ptr. EvalOp.
@@ -421,14 +457,14 @@ Proof.
 Qed.
 
 Theorem eval_add_ptr_2:
-  forall sp le e1 m1 a e2 m2 p x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vptr p y) ->
-  eval_expr ge sp le e1 m1 (add a b) e3 m3 (Vptr p (Int.add y x)).
+  forall sp le e1 m1 a t1 e2 m2 p x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vptr p y) ->
+  eval_expr ge sp le e1 m1 (add a b) (t1**t2) e3 m3 (Vptr p (Int.add y x)).
 Proof.
   intros until y. unfold add; case (add_match a b); intros.
   InvEval H. 
-    apply eval_addimm_ptr. auto.
+    apply eval_addimm_ptr. rewrite E0_left. auto.
   InvEval H. FuncInv. InvEval H0. FuncInv. 
     replace (Int.add y x) with (Int.add (Int.add i0 i) (Int.add n1 n2)).
     apply eval_addimm_ptr. subst b0. EvalOp. 
@@ -448,15 +484,15 @@ Proof.
 Qed.
 
 Theorem eval_sub:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (sub a b) e3 m3 (Vint (Int.sub x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (sub a b) (t1**t2) e3 m3 (Vint (Int.sub x y)).
 Proof.
   intros until y.
   unfold sub; case (sub_match a b); intros.
   InvEval H0. rewrite Int.sub_add_opp. 
-    apply eval_addimm. assumption.
+    apply eval_addimm. rewrite E0_right. assumption.
   InvEval H. FuncInv. InvEval H0. FuncInv.
     replace (Int.sub x y) with (Int.add (Int.sub i i0) (Int.sub n1 n2)).
     apply eval_addimm. EvalOp.
@@ -476,15 +512,15 @@ Proof.
 Qed.
 
 Theorem eval_sub_ptr_int:
-  forall sp le e1 m1 a e2 m2 p x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vptr p x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (sub a b) e3 m3 (Vptr p (Int.sub x y)).
+  forall sp le e1 m1 a t1 e2 m2 p x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vptr p x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (sub a b) (t1**t2) e3 m3 (Vptr p (Int.sub x y)).
 Proof.
   intros until y.
   unfold sub; case (sub_match a b); intros.
   InvEval H0. rewrite Int.sub_add_opp. 
-    apply eval_addimm_ptr. assumption.
+    apply eval_addimm_ptr. rewrite E0_right. assumption.
   InvEval H. FuncInv. InvEval H0. FuncInv.
     subst b0.
     replace (Int.sub x y) with (Int.add (Int.sub i i0) (Int.sub n1 n2)).
@@ -505,10 +541,10 @@ Proof.
 Qed.
 
 Theorem eval_sub_ptr_ptr:
-  forall sp le e1 m1 a e2 m2 p x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vptr p x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vptr p y) ->
-  eval_expr ge sp le e1 m1 (sub a b) e3 m3 (Vint (Int.sub x y)).
+  forall sp le e1 m1 a t1 e2 m2 p x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vptr p x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vptr p y) ->
+  eval_expr ge sp le e1 m1 (sub a b) (t1**t2) e3 m3 (Vint (Int.sub x y)).
 Proof.
   intros until y.
   unfold sub; case (sub_match a b); intros.
@@ -535,9 +571,9 @@ Proof.
 Qed.
 
 Lemma eval_rolm:
-  forall sp le e1 m1 a amount mask e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (rolm a amount mask) e2 m2 (Vint (Int.rolm x amount mask)).
+  forall sp le e1 m1 a amount mask t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (rolm a amount mask) t e2 m2 (Vint (Int.rolm x amount mask)).
 Proof.
   intros until x. unfold rolm; case (rolm_match a); intros.
   InvEval H. eauto with evalexpr. 
@@ -554,10 +590,10 @@ Proof.
 Qed.
 
 Theorem eval_shlimm:
-  forall sp le e1 m1 a n e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
+  forall sp le e1 m1 a n t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
   Int.ltu n (Int.repr 32) = true ->
-  eval_expr ge sp le e1 m1 (shlimm a n) e2 m2 (Vint (Int.shl x n)).
+  eval_expr ge sp le e1 m1 (shlimm a n) t e2 m2 (Vint (Int.shl x n)).
 Proof.
   intros.  unfold shlimm.
   generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
@@ -568,10 +604,10 @@ Proof.
 Qed.
 
 Theorem eval_shruimm:
-  forall sp le e1 m1 a n e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
+  forall sp le e1 m1 a n t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
   Int.ltu n (Int.repr 32) = true ->
-  eval_expr ge sp le e1 m1 (shruimm a n) e2 m2 (Vint (Int.shru x n)).
+  eval_expr ge sp le e1 m1 (shruimm a n) t e2 m2 (Vint (Int.shru x n)).
 Proof.
   intros.  unfold shruimm.
   generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro.
@@ -582,9 +618,9 @@ Proof.
 Qed.
 
 Lemma eval_mulimm_base:
-  forall sp le e1 m1 a n e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (mulimm_base n a) e2 m2 (Vint (Int.mul x n)).
+  forall sp le e1 m1 a t n e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (mulimm_base n a) t e2 m2 (Vint (Int.mul x n)).
 Proof.
   intros; unfold mulimm_base. 
   generalize (Int.one_bits_decomp n). 
@@ -597,7 +633,7 @@ Proof.
   rewrite Int.add_zero. rewrite <- Int.shl_mul.
   apply eval_shlimm. auto. auto with coqlib. 
   destruct l.
-  intros. apply eval_Elet with e2 m2 (Vint x). auto.
+  intros. apply eval_Elet with t e2 m2 (Vint x) E0. auto.
   rewrite H1. simpl. rewrite Int.add_zero. 
   rewrite Int.mul_add_distr_r.
   rewrite <- Int.shl_mul.
@@ -609,18 +645,19 @@ Proof.
   apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity.
   auto with coqlib.
   auto with evalexpr.
-  reflexivity.
+  reflexivity. traceEq. reflexivity. traceEq. 
   intros. EvalOp. 
 Qed.
 
 Theorem eval_mulimm:
-  forall sp le e1 m1 a n e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (mulimm n a) e2 m2 (Vint (Int.mul x n)).
+  forall sp le e1 m1 a n t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (mulimm n a) t e2 m2 (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. eauto with evalexpr. 
+  subst n. rewrite Int.mul_zero. 
+  intro. eapply eval_Elet; eauto with evalexpr. traceEq.
   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.
@@ -633,24 +670,25 @@ Proof.
 Qed.
 
 Theorem eval_mul:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (mul a b) e3 m3 (Vint (Int.mul x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (mul a b) (t1**t2) e3 m3 (Vint (Int.mul x y)).
 Proof.
   intros until y.
   unfold mul; case (mul_match a b); intros.
-  InvEval H. rewrite Int.mul_commut. apply eval_mulimm. auto.
-  InvEval H0. apply eval_mulimm. auto.
+  InvEval H. rewrite Int.mul_commut. apply eval_mulimm. 
+  rewrite E0_left; auto.
+  InvEval H0. rewrite E0_right. apply eval_mulimm. auto.
   EvalOp.
 Qed.
 
 Theorem eval_divs:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   y <> Int.zero ->
-  eval_expr ge sp le e1 m1 (divs a b) e3 m3 (Vint (Int.divs x y)).
+  eval_expr ge sp le e1 m1 (divs a b) (t1**t2) e3 m3 (Vint (Int.divs x y)).
 Proof.
   TrivialOp divs. simpl. 
   predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto.
@@ -662,11 +700,11 @@ Lemma eval_mod_aux:
    y <> Int.zero ->
    eval_operation ge sp divop (Vint x :: Vint y :: nil) =
    Some (Vint (semdivop x y))) ->
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   y <> Int.zero ->
-  eval_expr ge sp le e1 m1 (mod_aux divop a b) e3 m3
+  eval_expr ge sp le e1 m1 (mod_aux divop a b) (t1**t2) e3 m3
    (Vint (Int.sub x (Int.mul (semdivop x y) y))).
 Proof.
   intros; unfold mod_aux.
@@ -678,18 +716,21 @@ Proof.
   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.
+  apply eval_Enil. reflexivity. reflexivity. 
+  apply H. assumption.
   eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
-  apply eval_Enil. simpl; reflexivity. apply eval_Enil. 
-  reflexivity.
+  apply eval_Enil. reflexivity. reflexivity. 
+  simpl; reflexivity. apply eval_Enil. 
+  reflexivity. reflexivity. reflexivity.
+  reflexivity. traceEq.
 Qed.
 
 Theorem eval_mods:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   y <> Int.zero ->
-  eval_expr ge sp le e1 m1 (mods a b) e3 m3 (Vint (Int.mods x y)).
+  eval_expr ge sp le e1 m1 (mods a b) (t1**t2) e3 m3 (Vint (Int.mods x y)).
 Proof.
   intros; unfold mods. 
   rewrite Int.mods_divs. 
@@ -699,44 +740,44 @@ Proof.
 Qed.
 
 Lemma eval_divu_base:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   y <> Int.zero ->
-  eval_expr ge sp le e1 m1 (Eop Odivu (a ::: b ::: Enil)) e3 m3 (Vint (Int.divu x y)).
+  eval_expr ge sp le e1 m1 (Eop Odivu (a ::: b ::: Enil)) (t1**t2) e3 m3 (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 sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   y <> Int.zero ->
-  eval_expr ge sp le e1 m1 (divu a b) e3 m3 (Vint (Int.divu x y)).
+  eval_expr ge sp le e1 m1 (divu a b) (t1**t2) e3 m3 (Vint (Int.divu x y)).
 Proof.
   intros until y.
   unfold divu; case (divu_match b); intros.
   InvEval H0. caseEq (Int.is_power2 y). 
   intros. rewrite (Int.divu_pow2 x y i H0).
-  apply eval_shruimm. auto.
+  apply eval_shruimm. rewrite E0_right. auto.
   apply Int.is_power2_range with y. auto.
   intros. subst n2. eapply eval_divu_base. eexact H. EvalOp. auto.
   eapply eval_divu_base; eauto.
 Qed.
 
 Theorem eval_modu:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   y <> Int.zero ->
-  eval_expr ge sp le e1 m1 (modu a b) e3 m3 (Vint (Int.modu x y)).
+  eval_expr ge sp le e1 m1 (modu a b) (t1**t2) e3 m3 (Vint (Int.modu x y)).
 Proof.
   intros until y; unfold modu; case (divu_match b); intros.
   InvEval H0. caseEq (Int.is_power2 y). 
   intros. rewrite (Int.modu_and x y i H0).
-  rewrite <- Int.rolm_zero. apply eval_rolm. auto.
+  rewrite <- Int.rolm_zero. apply eval_rolm. rewrite E0_right; auto.
   intro. rewrite Int.modu_divu. eapply eval_mod_aux. 
   intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero.
   contradiction. auto.
@@ -748,9 +789,9 @@ Proof.
 Qed.
 
 Theorem eval_andimm:
-  forall sp le e1 m1 n a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (andimm n a) e2 m2 (Vint (Int.and x n)).
+  forall sp le e1 m1 n a t e2 m2 x,
+  eval_expr ge sp le e1 m1 a t e2 m2 (Vint x) ->
+  eval_expr ge sp le e1 m1 (andimm n a) t e2 m2 (Vint (Int.and x n)).
 Proof.
   intros.  unfold andimm. case (Int.is_rlw_mask n).
   rewrite <- Int.rolm_zero. apply eval_rolm; auto.
@@ -758,25 +799,26 @@ Proof.
 Qed.
 
 Theorem eval_and:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (and a b) e3 m3 (Vint (Int.and x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (and a b) (t1**t2) e3 m3 (Vint (Int.and x y)).
 Proof.
   intros until y; unfold and; case (mul_match a b); intros.
-  InvEval H. rewrite Int.and_commut. apply eval_andimm; auto.
-  InvEval H0. apply eval_andimm; auto.
+  InvEval H. rewrite Int.and_commut. 
+  rewrite E0_left; apply eval_andimm; auto.
+  InvEval H0. rewrite E0_right; apply eval_andimm; auto.
   EvalOp.
 Qed.
 
 Remark eval_same_expr_pure:
-  forall a1 a2 sp le e1 m1 e2 m2 v1 e3 m3 v2,
+  forall a1 a2 sp le e1 m1 t1 e2 m2 v1 t2 e3 m3 v2,
   same_expr_pure a1 a2 = true ->
-  eval_expr ge sp le e1 m1 a1 e2 m2 v1 ->
-  eval_expr ge sp le e2 m2 a2 e3 m3 v2 ->
-  a2 = a1 /\ v2 = v1 /\ e2 = e1 /\ m2 = m1.
+  eval_expr ge sp le e1 m1 a1 t1 e2 m2 v1 ->
+  eval_expr ge sp le e2 m2 a2 t2 e3 m3 v2 ->
+  t1 = E0 /\ t2 = E0 /\ a2 = a1 /\ v2 = v1 /\ e2 = e1 /\ m2 = m1.
 Proof.
-  intros until v1.
+  intros until v2.
   destruct a1; simpl; try (intros; discriminate). 
   destruct a2; simpl; try (intros; discriminate).
   case (ident_eq i i0); intros.
@@ -786,22 +828,20 @@ Proof.
 Qed.
 
 Lemma eval_or:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (or a b) e3 m3 (Vint (Int.or x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (or a b) (t1**t2) e3 m3 (Vint (Int.or x y)).
 Proof.
   intros until y; unfold or; case (or_match a b); intros.
   generalize (Int.eq_spec amount1 amount2); case (Int.eq amount1 amount2); intro.
   case (Int.is_rlw_mask (Int.or mask1 mask2)).
-  caseEq (same_expr_pure t1 t2); intro.
+  caseEq (same_expr_pure t0 t3); intro.
   simpl. InvEval H. FuncInv. InvEval H0. FuncInv. 
-  generalize (eval_same_expr_pure _ _ _ _ _ _ _ _ _ _ _ _ H2 EV EV0).
-  intros [EQ1 [EQ2 [EQ3 EQ4]]]. 
-  injection EQ2; intro EQ5.
-  subst t2; subst e2; subst m2; subst i0.
-  EvalOp. simpl. subst x; subst y; subst amount2.
-  rewrite Int.or_rolm. auto.
+  generalize (eval_same_expr_pure _ _ _ _ _ _ _ _ _ _ _ _ _ _ H2 EV EV0).
+  intros [EQ1 [EQ2 [EQ3 [EQ4 [EQ5 EQ6]]]]]. 
+  injection EQ4; intro EQ7. subst.
+  EvalOp. simpl. rewrite Int.or_rolm. auto.
   simpl. EvalOp. 
   simpl. EvalOp. 
   simpl. EvalOp. 
@@ -809,173 +849,184 @@ Proof.
 Qed.
 
 Theorem eval_xor:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (xor a b) e3 m3 (Vint (Int.xor x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (xor a b) (t1**t2) e3 m3 (Vint (Int.xor x y)).
 Proof. TrivialOp xor. Qed.
 
 Theorem eval_shl:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   Int.ltu y (Int.repr 32) = true ->
-  eval_expr ge sp le e1 m1 (shl a b) e3 m3 (Vint (Int.shl x y)).
+  eval_expr ge sp le e1 m1 (shl a b) (t1**t2) e3 m3 (Vint (Int.shl x y)).
 Proof.
   intros until y; unfold shl; case (shift_match b); intros.
-  InvEval H0. apply eval_shlimm; auto.
+  InvEval H0. rewrite E0_right. apply eval_shlimm; auto.
   EvalOp. simpl. rewrite H1. auto.
 Qed.
 
 Theorem eval_shr:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   Int.ltu y (Int.repr 32) = true ->
-  eval_expr ge sp le e1 m1 (shr a b) e3 m3 (Vint (Int.shr x y)).
+  eval_expr ge sp le e1 m1 (shr a b) (t1**t2) e3 m3 (Vint (Int.shr x y)).
 Proof.
   TrivialOp shr. simpl. rewrite H1. auto.
 Qed.
 
 Theorem eval_shru:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
   Int.ltu y (Int.repr 32) = true ->
-  eval_expr ge sp le e1 m1 (shru a b) e3 m3 (Vint (Int.shru x y)).
+  eval_expr ge sp le e1 m1 (shru a b) (t1**t2) e3 m3 (Vint (Int.shru x y)).
 Proof.
   intros until y; unfold shru; case (shift_match b); intros.
-  InvEval H0. apply eval_shruimm; auto.
+  InvEval H0. rewrite E0_right; apply eval_shruimm; auto.
   EvalOp. simpl. rewrite H1. auto.
 Qed.
 
 Theorem eval_addf:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vfloat y) ->
-  eval_expr ge sp le e1 m1 (addf a b) e3 m3 (Vfloat (Float.add x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vfloat y) ->
+  eval_expr ge sp le e1 m1 (addf a b) (t1**t2) e3 m3 (Vfloat (Float.add x y)).
 Proof.
   intros until y; unfold addf; case (addf_match a b); intros.
-  InvEval H. FuncInv. EvalOp. simpl. subst x. reflexivity.
+  InvEval H. FuncInv. EvalOp. 
+  econstructor; eauto. econstructor; eauto. econstructor; eauto. constructor.
+  traceEq. simpl. subst x. reflexivity.
   InvEval H0. FuncInv. eapply eval_Elet. eexact H. EvalOp. 
-  eapply eval_Econs. apply eval_lift. eexact EV.
-  eapply eval_Econs. apply eval_lift. eexact EV0.
-  eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity.
-  apply eval_Enil. 
-  subst y. rewrite Float.addf_commut. reflexivity.
+  econstructor; eauto with evalexpr. 
+  econstructor; eauto with evalexpr. 
+  econstructor. apply eval_Eletvar. simpl; reflexivity.
+  constructor. reflexivity. traceEq.
+  subst y. rewrite Float.addf_commut. reflexivity. auto.
   EvalOp.
 Qed.
  
 Theorem eval_subf:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vfloat y) ->
-  eval_expr ge sp le e1 m1 (subf a b) e3 m3 (Vfloat (Float.sub x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vfloat y) ->
+  eval_expr ge sp le e1 m1 (subf a b) (t1**t2) e3 m3 (Vfloat (Float.sub x y)).
 Proof.
   intros until y; unfold subf; case (subf_match a b); intros.
-  InvEval H. FuncInv. EvalOp. subst x. reflexivity.
+  InvEval H. FuncInv. EvalOp. 
+  econstructor; eauto. econstructor; eauto. econstructor; eauto. constructor.
+  traceEq. subst x. reflexivity.
   EvalOp.
 Qed.
 
 Theorem eval_mulf:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vfloat y) ->
-  eval_expr ge sp le e1 m1 (mulf a b) e3 m3 (Vfloat (Float.mul x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vfloat y) ->
+  eval_expr ge sp le e1 m1 (mulf a b) (t1**t2) e3 m3 (Vfloat (Float.mul x y)).
 Proof. TrivialOp mulf. Qed.
 
 Theorem eval_divf:
-  forall sp le e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vfloat y) ->
-  eval_expr ge sp le e1 m1 (divf a b) e3 m3 (Vfloat (Float.div x y)).
+  forall sp le e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vfloat y) ->
+  eval_expr ge sp le e1 m1 (divf a b) (t1**t2) e3 m3 (Vfloat (Float.div x y)).
 Proof. TrivialOp divf. Qed.
 
 Theorem eval_cast8signed:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (cast8signed a) e2 m2 (Vint (Int.cast8signed x)).
+  forall sp le e1 m1 a t e2 m2 v,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
+  eval_expr ge sp le e1 m1 (cast8signed a) t e2 m2 (Val.cast8signed v).
 Proof. 
-  intros until x; unfold cast8signed; case (cast8signed_match a); intros.
-  InvEval H. FuncInv. EvalOp. subst x. rewrite Int.cast8_signed_idem. reflexivity.
+  intros until v; unfold cast8signed; case (cast8signed_match a); intros.
+  replace (Val.cast8signed v) with v. auto. 
+  InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast8_signed_idem. reflexivity.
   EvalOp.
 Qed.
 
 Theorem eval_cast8unsigned:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (cast8unsigned a) e2 m2 (Vint (Int.cast8unsigned x)).
+  forall sp le e1 m1 a t e2 m2 v,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
+  eval_expr ge sp le e1 m1 (cast8unsigned a) t e2 m2 (Val.cast8unsigned v).
 Proof. 
-  intros. unfold cast8unsigned. rewrite Int.cast8unsigned_and.
-  rewrite <- Int.rolm_zero. eapply eval_rolm; eauto. 
+  intros until v; unfold cast8unsigned; case (cast8unsigned_match a); intros.
+  replace (Val.cast8unsigned v) with v. auto. 
+  InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast8_unsigned_idem. reflexivity.
+  EvalOp.
 Qed.
-    
+
 Theorem eval_cast16signed:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (cast16signed a) e2 m2 (Vint (Int.cast16signed x)).
+  forall sp le e1 m1 a t e2 m2 v,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
+  eval_expr ge sp le e1 m1 (cast16signed a) t e2 m2 (Val.cast16signed v).
 Proof. 
-  intros until x; unfold cast16signed; case (cast16signed_match a); intros.
-  InvEval H. FuncInv. EvalOp. subst x. rewrite Int.cast16_signed_idem. reflexivity.
+  intros until v; unfold cast16signed; case (cast16signed_match a); intros.
+  replace (Val.cast16signed v) with v. auto. 
+  InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast16_signed_idem. reflexivity.
   EvalOp.
 Qed.
 
 Theorem eval_cast16unsigned:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e1 m1 (cast16unsigned a) e2 m2 (Vint (Int.cast16unsigned x)).
+  forall sp le e1 m1 a t e2 m2 v,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
+  eval_expr ge sp le e1 m1 (cast16unsigned a) t e2 m2 (Val.cast16unsigned v).
 Proof. 
-  intros. unfold cast16unsigned. rewrite Int.cast16unsigned_and.
-  rewrite <- Int.rolm_zero. eapply eval_rolm; eauto. 
+  intros until v; unfold cast16unsigned; case (cast16unsigned_match a); intros.
+  replace (Val.cast16unsigned v) with v. auto. 
+  InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Int.cast16_unsigned_idem. reflexivity.
+  EvalOp.
 Qed.
 
 Theorem eval_singleoffloat:
-  forall sp le e1 m1 a e2 m2 x,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e1 m1 (singleoffloat a) e2 m2 (Vfloat (Float.singleoffloat x)).
+  forall sp le e1 m1 a t e2 m2 v,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
+  eval_expr ge sp le e1 m1 (singleoffloat a) t e2 m2 (Val.singleoffloat v).
 Proof. 
-  intros until x; unfold singleoffloat; case (singleoffloat_match a); intros.
-  InvEval H. FuncInv. EvalOp. subst x. rewrite Float.singleoffloat_idem. reflexivity.
+  intros until v; unfold singleoffloat; case (singleoffloat_match a); intros.
+  replace (Val.singleoffloat v) with v. auto. 
+  InvEval H. inversion EQ. destruct v0; simpl; auto. rewrite Float.singleoffloat_idem. reflexivity.
   EvalOp.
 Qed.
 
 Theorem eval_cmp:
-  forall sp le c e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (cmp c a b) e3 m3 (Val.of_bool (Int.cmp c x y)).
+  forall sp le c e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (cmp c a b) (t1**t2) e3 m3 (Val.of_bool (Int.cmp c x y)).
 Proof. 
   TrivialOp cmp. 
   simpl. case (Int.cmp c x y); auto.
 Qed.
 
 Theorem eval_cmp_null_r:
-  forall sp le c e1 m1 a e2 m2 p x b e3 m3 v,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vptr p x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint Int.zero) ->
+  forall sp le c e1 m1 a t1 e2 m2 p x b t2 e3 m3 v,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vptr p x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint Int.zero) ->
   (c = Ceq /\ v = Vfalse) \/ (c = Cne /\ v = Vtrue) ->
-  eval_expr ge sp le e1 m1 (cmp c a b) e3 m3 v.
+  eval_expr ge sp le e1 m1 (cmp c a b) (t1**t2) e3 m3 v.
 Proof. 
   TrivialOp cmp. 
   simpl. elim H1; intros [EQ1 EQ2]; subst c; subst v; reflexivity.
 Qed.
 
 Theorem eval_cmp_null_l:
-  forall sp le c e1 m1 a e2 m2 p x b e3 m3 v,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint Int.zero) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vptr p x) ->
+  forall sp le c e1 m1 a t1 e2 m2 p x b t2 e3 m3 v,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint Int.zero) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vptr p x) ->
   (c = Ceq /\ v = Vfalse) \/ (c = Cne /\ v = Vtrue) ->
-  eval_expr ge sp le e1 m1 (cmp c a b) e3 m3 v.
+  eval_expr ge sp le e1 m1 (cmp c a b) (t1**t2) e3 m3 v.
 Proof. 
   TrivialOp cmp. 
   simpl. elim H1; intros [EQ1 EQ2]; subst c; subst v; reflexivity.
 Qed.
 
 Theorem eval_cmp_ptr:
-  forall sp le c e1 m1 a e2 m2 p x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vptr p x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vptr p y) ->
-  eval_expr ge sp le e1 m1 (cmp c a b) e3 m3 (Val.of_bool (Int.cmp c x y)).
+  forall sp le c e1 m1 a t1 e2 m2 p x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vptr p x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vptr p y) ->
+  eval_expr ge sp le e1 m1 (cmp c a b) (t1**t2) e3 m3 (Val.of_bool (Int.cmp c x y)).
 Proof. 
   TrivialOp cmp. 
   simpl. unfold eq_block. rewrite zeq_true. 
@@ -983,32 +1034,32 @@ Proof.
 Qed.
 
 Theorem eval_cmpu:
-  forall sp le c e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vint x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vint y) ->
-  eval_expr ge sp le e1 m1 (cmpu c a b) e3 m3 (Val.of_bool (Int.cmpu c x y)).
+  forall sp le c e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vint x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vint y) ->
+  eval_expr ge sp le e1 m1 (cmpu c a b) (t1**t2) e3 m3 (Val.of_bool (Int.cmpu c x y)).
 Proof. 
   TrivialOp cmpu. 
   simpl. case (Int.cmpu c x y); auto.
 Qed.
 
 Theorem eval_cmpf:
-  forall sp le c e1 m1 a e2 m2 x b e3 m3 y,
-  eval_expr ge sp le e1 m1 a e2 m2 (Vfloat x) ->
-  eval_expr ge sp le e2 m2 b e3 m3 (Vfloat y) ->
-  eval_expr ge sp le e1 m1 (cmpf c a b) e3 m3 (Val.of_bool (Float.cmp c x y)).
+  forall sp le c e1 m1 a t1 e2 m2 x b t2 e3 m3 y,
+  eval_expr ge sp le e1 m1 a t1 e2 m2 (Vfloat x) ->
+  eval_expr ge sp le e2 m2 b t2 e3 m3 (Vfloat y) ->
+  eval_expr ge sp le e1 m1 (cmpf c a b) (t1**t2) e3 m3 (Val.of_bool (Float.cmp c x y)).
 Proof. 
   TrivialOp cmpf. 
   simpl. case (Float.cmp c x y); auto.
 Qed.
 
 Lemma eval_base_condition_of_expr:
-  forall sp le a e1 m1 e2 m2 v (b: bool),
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
+  forall sp le a e1 m1 t e2 m2 v (b: bool),
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
   Val.bool_of_val v b ->
   eval_condexpr ge sp le e1 m1 
                 (CEcond (Ccompuimm Cne Int.zero) (a ::: Enil))
-                e2 m2 b.
+                t e2 m2 b.
 Proof.
   intros. 
   eapply eval_CEcond. eauto with evalexpr. 
@@ -1016,62 +1067,60 @@ Proof.
 Qed.
 
 Lemma eval_condition_of_expr:
-  forall a sp le e1 m1 e2 m2 v (b: bool),
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
+  forall a sp le e1 m1 t e2 m2 v (b: bool),
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
   Val.bool_of_val v b ->
-  eval_condexpr ge sp le e1 m1 (condexpr_of_expr a) e2 m2 b.
+  eval_condexpr ge sp le e1 m1 (condexpr_of_expr a) t e2 m2 b.
 Proof.
   induction a; simpl; intros;
     try (eapply eval_base_condition_of_expr; eauto; fail).
   destruct o; try (eapply eval_base_condition_of_expr; eauto; fail).
 
-  destruct e. inversion H. subst sp0 le0 e m op al e0 m0 v0.
-  inversion H7. subst sp0 le0 e m e1 m1 vl.
-  simpl in H11. inversion H11; subst v.
+  destruct e. InvEval H. inversion XX4; subst v.
   inversion H0. 
   rewrite Int.eq_false; auto. constructor.
   subst i; rewrite Int.eq_true. constructor.
   eapply eval_base_condition_of_expr; eauto.
 
-  inversion H. eapply eval_CEcond; eauto. simpl in H11.
+  inversion H. subst. eapply eval_CEcond; eauto. simpl in H12.
   destruct (eval_condition c vl); try discriminate.
-  destruct b0; inversion H11; subst v0; subst v; inversion H0; congruence.
+  destruct b0; inversion H12; subst; inversion H0; congruence.
 
-  inversion H. 
+  inversion H. subst.
   destruct v1; eauto with evalexpr.
 Qed.
 
 Theorem eval_conditionalexpr_true:
-  forall sp le e1 m1 a1 e2 m2 v1 a2 e3 m3 v2 a3,
-  eval_expr ge sp le e1 m1 a1 e2 m2 v1 ->
+  forall sp le e1 m1 a1 t1 e2 m2 v1 t2 a2 e3 m3 v2 a3,
+  eval_expr ge sp le e1 m1 a1 t1 e2 m2 v1 ->
   Val.is_true v1 ->
-  eval_expr ge sp le e2 m2 a2 e3 m3 v2 ->
-  eval_expr ge sp le e1 m1 (conditionalexpr a1 a2 a3) e3 m3 v2.
+  eval_expr ge sp le e2 m2 a2 t2 e3 m3 v2 ->
+  eval_expr ge sp le e1 m1 (conditionalexpr a1 a2 a3) (t1**t2) e3 m3 v2.
 Proof.
   intros; unfold conditionalexpr.
-  apply eval_Econdition with e2 m2 true; auto.
+  apply eval_Econdition with t1 e2 m2 true t2; auto.
   eapply eval_condition_of_expr; eauto with valboolof.
 Qed.
 
 Theorem eval_conditionalexpr_false:
-  forall sp le e1 m1 a1 e2 m2 v1 a2 e3 m3 v2 a3,
-  eval_expr ge sp le e1 m1 a1 e2 m2 v1 ->
+  forall sp le e1 m1 a1 t1 e2 m2 v1 a2 t2 e3 m3 v2 a3,
+  eval_expr ge sp le e1 m1 a1 t1 e2 m2 v1 ->
   Val.is_false v1 ->
-  eval_expr ge sp le e2 m2 a3 e3 m3 v2 ->
-  eval_expr ge sp le e1 m1 (conditionalexpr a1 a2 a3) e3 m3 v2.
+  eval_expr ge sp le e2 m2 a3 t2 e3 m3 v2 ->
+  eval_expr ge sp le e1 m1 (conditionalexpr a1 a2 a3) (t1**t2) e3 m3 v2.
 Proof.
   intros; unfold conditionalexpr.
-  apply eval_Econdition with e2 m2 false; auto.
+  apply eval_Econdition with t1 e2 m2 false t2; auto.
   eapply eval_condition_of_expr; eauto with valboolof.
 Qed.
 
 Lemma eval_addressing:
-  forall sp le e1 m1 a e2 m2 v b ofs,
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
+  forall sp le e1 m1 a t e2 m2 v b ofs,
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
   v = Vptr b ofs ->
   match addressing a with (mode, args) =>
     exists vl,
-    eval_exprlist ge sp le e1 m1 args e2 m2 vl /\ 
+    eval_exprlist ge sp le e1 m1 args t e2 m2 vl /\ 
     eval_addressing ge sp mode vl = Some v
   end.
 Proof.
@@ -1080,19 +1129,13 @@ Proof.
   simpl. auto.
   InvEval H. exists (@nil val). split. eauto with evalexpr. 
   simpl. auto.
-  InvEval H. FuncInv. 
+  InvEval H. InvEval EV. rewrite E0_left in TR. subst t1. FuncInv. 
     congruence.
-    InvEval EV. 
+    destruct (Genv.find_symbol ge s); congruence.
     exists (Vint i0 :: nil). split. eauto with evalexpr. 
     simpl. subst v. destruct (Genv.find_symbol ge s). congruence.
     discriminate.
   InvEval H. FuncInv. 
-    destruct (Genv.find_symbol ge s); congruence.
-    InvEval EV. 
-    exists (Vint i0 :: nil). split. eauto with evalexpr. 
-    simpl. destruct (Genv.find_symbol ge s). congruence.
-    discriminate.
-  InvEval H. FuncInv.
     congruence.
     exists (Vptr b0 i :: nil). split. eauto with evalexpr. 
     simpl. congruence.
@@ -1108,56 +1151,56 @@ Proof.
 Qed.
 
 Theorem eval_load:
-  forall sp le e1 m1 a e2 m2 v chunk v',
-  eval_expr ge sp le e1 m1 a e2 m2 v ->
+  forall sp le e1 m1 a t e2 m2 v chunk v',
+  eval_expr ge sp le e1 m1 a t e2 m2 v ->
   Mem.loadv chunk m2 v = Some v' ->
-  eval_expr ge sp le e1 m1 (load chunk a) e2 m2 v'.
+  eval_expr ge sp le e1 m1 (load chunk a) t e2 m2 v'.
 Proof.
   intros. generalize H0; destruct v; simpl; intro; try discriminate.
   unfold load. 
-  generalize (eval_addressing _ _ _ _ _ _ _ _ _ _ H (refl_equal _)).
+  generalize (eval_addressing _ _ _ _ _ _ _ _ _ _ _ H (refl_equal _)).
   destruct (addressing a). intros [vl [EV EQ]]. 
   eapply eval_Eload; eauto. 
 Qed.
 
 Theorem eval_store:
-  forall sp le e1 m1 a1 e2 m2 v1 a2 e3 m3 v2 chunk m4,
-  eval_expr ge sp le e1 m1 a1 e2 m2 v1 ->
-  eval_expr ge sp le e2 m2 a2 e3 m3 v2 ->
+  forall sp le e1 m1 a1 t1 e2 m2 v1 a2 t2 e3 m3 v2 chunk m4,
+  eval_expr ge sp le e1 m1 a1 t1 e2 m2 v1 ->
+  eval_expr ge sp le e2 m2 a2 t2 e3 m3 v2 ->
   Mem.storev chunk m3 v1 v2 = Some m4 ->
-  eval_expr ge sp le e1 m1 (store chunk a1 a2) e3 m4 v2.
+  eval_expr ge sp le e1 m1 (store chunk a1 a2) (t1**t2) e3 m4 v2.
 Proof.
   intros. generalize H1; destruct v1; simpl; intro; try discriminate.
   unfold store.
-  generalize (eval_addressing _ _ _ _ _ _ _ _ _ _ H (refl_equal _)).
+  generalize (eval_addressing _ _ _ _ _ _ _ _ _ _ _ H (refl_equal _)).
   destruct (addressing a1). intros [vl [EV EQ]]. 
   eapply eval_Estore; eauto. 
 Qed.
 
 Theorem exec_ifthenelse_true:
-  forall sp e1 m1 a e2 m2 v ifso ifnot e3 m3 out,
-  eval_expr ge sp nil e1 m1 a e2 m2 v ->
+  forall sp e1 m1 a t1 e2 m2 v ifso ifnot t2 e3 m3 out,
+  eval_expr ge sp nil e1 m1 a t1 e2 m2 v ->
   Val.is_true v ->
-  exec_stmt ge sp e2 m2 ifso e3 m3 out ->
-  exec_stmt ge sp e1 m1 (ifthenelse a ifso ifnot) e3 m3 out.
+  exec_stmt ge sp e2 m2 ifso t2 e3 m3 out ->
+  exec_stmt ge sp e1 m1 (ifthenelse a ifso ifnot) (t1**t2) e3 m3 out.
 Proof.
   intros. unfold ifthenelse.
-  apply exec_Sifthenelse with e2 m2 true.
+  apply exec_Sifthenelse with t1 e2 m2 true t2.
   eapply eval_condition_of_expr; eauto with valboolof.
-  auto.
+  auto. auto.
 Qed.
 
 Theorem exec_ifthenelse_false:
-  forall sp e1 m1 a e2 m2 v ifso ifnot e3 m3 out,
-  eval_expr ge sp nil e1 m1 a e2 m2 v ->
+  forall sp e1 m1 a t1 e2 m2 v ifso ifnot t2 e3 m3 out,
+  eval_expr ge sp nil e1 m1 a t1 e2 m2 v ->
   Val.is_false v ->
-  exec_stmt ge sp e2 m2 ifnot e3 m3 out ->
-  exec_stmt ge sp e1 m1 (ifthenelse a ifso ifnot) e3 m3 out.
+  exec_stmt ge sp e2 m2 ifnot t2 e3 m3 out ->
+  exec_stmt ge sp e1 m1 (ifthenelse a ifso ifnot) (t1**t2) e3 m3 out.
 Proof.
   intros. unfold ifthenelse.
-  apply exec_Sifthenelse with e2 m2 false.
+  apply exec_Sifthenelse with t1 e2 m2 false t2.
   eapply eval_condition_of_expr; eauto with valboolof.
-  auto.
+  auto. auto.
 Qed.
 
 End CMCONSTR.
diff --git a/backend/Cminor.v b/backend/Cminor.v
index 826c529..9eed009 100644
--- a/backend/Cminor.v
+++ b/backend/Cminor.v
@@ -5,6 +5,7 @@ Require Import Maps.
 Require Import AST.
 Require Import Integers.
 Require Import Floats.
+Require Import Events.
 Require Import Values.
 Require Import Mem.
 Require Import Op.
@@ -35,6 +36,7 @@ Inductive expr : Set :=
   | Econdition : condexpr -> expr -> expr -> expr
   | Elet : expr -> expr -> expr
   | Eletvar : nat -> expr
+  | Ealloc : expr -> expr
 
 with condexpr : Set :=
   | CEtrue: condexpr
@@ -77,7 +79,14 @@ Record function : Set := mkfunction {
   fn_body: stmt
 }.
 
-Definition program := AST.program function.
+Definition fundef := AST.fundef function.
+Definition program := AST.program fundef.
+
+Definition funsig (fd: fundef) :=
+  match fd with
+  | Internal f => f.(fn_sig)
+  | External ef => ef.(ef_sig)
+  end.
 
 (** * Operational semantics *)
 
@@ -120,7 +129,7 @@ Fixpoint switch_target (n: int) (dfl: nat) (cases: list (int * nat))
 - [lenv]: let environments, map de Bruijn indices to values.
 *)
 
-Definition genv := Genv.t function.
+Definition genv := Genv.t fundef.
 Definition env := PTree.t val.
 Definition letenv := list val.
 
@@ -157,56 +166,65 @@ Variable ge: genv.
 
 Inductive eval_expr:
          val -> letenv ->
-         env -> mem -> expr ->
+         env -> mem -> expr -> trace ->
          env -> mem -> val -> Prop :=
   | eval_Evar:
       forall sp le e m id v,
       PTree.get id e = Some v ->
-      eval_expr sp le e m (Evar id) e m v
+      eval_expr sp le e m (Evar id) E0 e m v
   | eval_Eassign:
-      forall sp le e m id a e1 m1 v,
-      eval_expr sp le e m a e1 m1 v ->
-      eval_expr sp le e m (Eassign id a) (PTree.set id v e1) m1 v
+      forall sp le e m id a t e1 m1 v,
+      eval_expr sp le e m a t e1 m1 v ->
+      eval_expr sp le e m (Eassign id a) t (PTree.set id v e1) m1 v
   | eval_Eop:
-      forall sp le e m op al e1 m1 vl v,
-      eval_exprlist sp le e m al e1 m1 vl ->
+      forall sp le e m op al t e1 m1 vl v,
+      eval_exprlist sp le e m al t e1 m1 vl ->
       eval_operation ge sp op vl = Some v ->
-      eval_expr sp le e m (Eop op al) e1 m1 v
+      eval_expr sp le e m (Eop op al) t e1 m1 v
   | eval_Eload:
-      forall sp le e m chunk addr al e1 m1 v vl a,
-      eval_exprlist sp le e m al e1 m1 vl ->
+      forall sp le e m chunk addr al t e1 m1 v vl a,
+      eval_exprlist sp le e m al t e1 m1 vl ->
       eval_addressing ge sp addr vl = Some a ->
       Mem.loadv chunk m1 a = Some v ->
-      eval_expr sp le e m (Eload chunk addr al) e1 m1 v
+      eval_expr sp le e m (Eload chunk addr al) t e1 m1 v
   | eval_Estore:
-      forall sp le e m chunk addr al b e1 m1 vl e2 m2 m3 v a,
-      eval_exprlist sp le e m al e1 m1 vl ->
-      eval_expr sp le e1 m1 b e2 m2 v ->
+      forall sp le e m chunk addr al b t t1 e1 m1 vl t2 e2 m2 m3 v a,
+      eval_exprlist sp le e m al t1 e1 m1 vl ->
+      eval_expr sp le e1 m1 b t2 e2 m2 v ->
       eval_addressing ge sp addr vl = Some a ->
       Mem.storev chunk m2 a v = Some m3 ->
-      eval_expr sp le e m (Estore chunk addr al b) e2 m3 v
+      t = t1 ** t2 ->
+      eval_expr sp le e m (Estore chunk addr al b) t e2 m3 v
   | eval_Ecall:
-      forall sp le e m sig a bl e1 e2 m1 m2 m3 vf vargs vres f,
-      eval_expr sp le e m a e1 m1 vf ->
-      eval_exprlist sp le e1 m1 bl e2 m2 vargs ->
+      forall sp le e m sig a bl t t1 e1 m1 t2 e2 m2 t3 m3 vf vargs vres f,
+      eval_expr sp le e m a t1 e1 m1 vf ->
+      eval_exprlist sp le e1 m1 bl t2 e2 m2 vargs ->
       Genv.find_funct ge vf = Some f ->
-      f.(fn_sig) = sig ->
-      eval_funcall m2 f vargs m3 vres ->
-      eval_expr sp le e m (Ecall sig a bl) e2 m3 vres
+      funsig f = sig ->
+      eval_funcall m2 f vargs t3 m3 vres ->
+      t = t1 ** t2 ** t3 ->
+      eval_expr sp le e m (Ecall sig a bl) t e2 m3 vres
   | eval_Econdition:
-      forall sp le e m a b c e1 m1 v1 e2 m2 v2,
-      eval_condexpr sp le e m a e1 m1 v1 ->
-      eval_expr sp le e1 m1 (if v1 then b else c) e2 m2 v2 ->
-      eval_expr sp le e m (Econdition a b c) e2 m2 v2
+      forall sp le e m a b c t t1 e1 m1 v1 t2 e2 m2 v2,
+      eval_condexpr sp le e m a t1 e1 m1 v1 ->
+      eval_expr sp le e1 m1 (if v1 then b else c) t2 e2 m2 v2 ->
+      t = t1 ** t2 ->
+      eval_expr sp le e m (Econdition a b c) t e2 m2 v2
   | eval_Elet:
-      forall sp le e m a b e1 m1 v1 e2 m2 v2,
-      eval_expr sp le e m a e1 m1 v1 ->
-      eval_expr sp (v1::le) e1 m1 b e2 m2 v2 ->
-      eval_expr sp le e m (Elet a b) e2 m2 v2
+      forall sp le e m a b t t1 e1 m1 v1 t2 e2 m2 v2,
+      eval_expr sp le e m a t1 e1 m1 v1 ->
+      eval_expr sp (v1::le) e1 m1 b t2 e2 m2 v2 ->
+      t = t1 ** t2 ->
+      eval_expr sp le e m (Elet a b) t e2 m2 v2
   | eval_Eletvar:
       forall sp le e m n v,
       nth_error le n = Some v ->
-      eval_expr sp le e m (Eletvar n) e m v
+      eval_expr sp le e m (Eletvar n) E0 e m v
+  | eval_Ealloc:
+      forall sp le e m a t e1 m1 n m2 b,
+      eval_expr sp le e m a t e1 m1 (Vint n) ->
+      Mem.alloc m1 0 (Int.signed n) = (m2, b) ->
+      eval_expr sp le e m (Ealloc a) t e1 m2 (Vptr b Int.zero)
 
 (** Evaluation of a condition expression:
   [eval_condexpr ge sp le e m a e' m' b]
@@ -216,24 +234,25 @@ Inductive eval_expr:
 
 with eval_condexpr:
          val -> letenv ->
-         env -> mem -> condexpr ->
+         env -> mem -> condexpr -> trace ->
          env -> mem -> bool -> Prop :=
   | eval_CEtrue:
       forall sp le e m,
-      eval_condexpr sp le e m CEtrue e m true
+      eval_condexpr sp le e m CEtrue E0 e m true
   | eval_CEfalse:
       forall sp le e m,
-      eval_condexpr sp le e m CEfalse e m false
+      eval_condexpr sp le e m CEfalse E0 e m false
   | eval_CEcond:
-      forall sp le e m cond al e1 m1 vl b,
-      eval_exprlist sp le e m al e1 m1 vl ->
+      forall sp le e m cond al t1 e1 m1 vl b,
+      eval_exprlist sp le e m al t1 e1 m1 vl ->
       eval_condition cond vl = Some b ->
-      eval_condexpr sp le e m (CEcond cond al) e1 m1 b
+      eval_condexpr sp le e m (CEcond cond al) t1 e1 m1 b
   | eval_CEcondition:
-      forall sp le e m a b c e1 m1 vb1 e2 m2 vb2,
-      eval_condexpr sp le e m a e1 m1 vb1 ->
-      eval_condexpr sp le e1 m1 (if vb1 then b else c) e2 m2 vb2 ->
-      eval_condexpr sp le e m (CEcondition a b c) e2 m2 vb2
+      forall sp le e m a b c t t1 e1 m1 vb1 t2 e2 m2 vb2,
+      eval_condexpr sp le e m a t1 e1 m1 vb1 ->
+      eval_condexpr sp le e1 m1 (if vb1 then b else c) t2 e2 m2 vb2 ->
+      t = t1 ** t2 ->
+      eval_condexpr sp le e m (CEcondition a b c) t e2 m2 vb2
 
 (** Evaluation of a list of expressions:
   [eval_exprlist ge sp le al m a e' m' vl]
@@ -244,16 +263,17 @@ with eval_condexpr:
 
 with eval_exprlist:
          val -> letenv ->
-         env -> mem -> exprlist ->
+         env -> mem -> exprlist -> trace ->
          env -> mem -> list val -> Prop :=
   | eval_Enil:
       forall sp le e m,
-      eval_exprlist sp le e m Enil e m nil
+      eval_exprlist sp le e m Enil E0 e m nil
   | eval_Econs:
-      forall sp le e m a bl e1 m1 v e2 m2 vl,
-      eval_expr sp le e m a e1 m1 v ->
-      eval_exprlist sp le e1 m1 bl e2 m2 vl ->
-      eval_exprlist sp le e m (Econs a bl) e2 m2 (v :: vl)
+      forall sp le e m a bl t t1 e1 m1 v t2 e2 m2 vl,
+      eval_expr sp le e m a t1 e1 m1 v ->
+      eval_exprlist sp le e1 m1 bl t2 e2 m2 vl ->
+      t = t1 ** t2 ->
+      eval_exprlist sp le e m (Econs a bl) t e2 m2 (v :: vl)
 
 (** Evaluation of a function invocation: [eval_funcall ge m f args m' res]
   means that the function [f], applied to the arguments [args] in
@@ -261,15 +281,19 @@ with eval_exprlist:
 *)
 
 with eval_funcall:
-        mem -> function -> list val ->
+        mem -> fundef -> list val -> trace ->
         mem -> val -> Prop :=
-  | eval_funcall_intro:
-      forall m f vargs m1 sp e e2 m2 out vres,
+  | eval_funcall_internal:
+      forall m f vargs m1 sp e t e2 m2 out vres,
       Mem.alloc m 0 f.(fn_stackspace) = (m1, sp) ->
       set_locals f.(fn_vars) (set_params vargs f.(fn_params)) = e ->
-      exec_stmt (Vptr sp Int.zero) e m1 f.(fn_body) e2 m2 out ->
+      exec_stmt (Vptr sp Int.zero) e m1 f.(fn_body) t e2 m2 out ->
       outcome_result_value out f.(fn_sig).(sig_res) vres ->
-      eval_funcall m f vargs (Mem.free m2 sp) vres
+      eval_funcall m (Internal f) vargs t (Mem.free m2 sp) vres
+  | eval_funcall_external:
+      forall ef m args t res,
+      event_match ef args t res ->
+      eval_funcall m (External ef) args t m res
 
 (** Execution of a statement: [exec_stmt ge sp e m s e' m' out]
   means that statement [s] executes with outcome [out].
@@ -277,59 +301,62 @@ with eval_funcall:
 
 with exec_stmt:
          val ->
-         env -> mem -> stmt ->
+         env -> mem -> stmt -> trace ->
          env -> mem -> outcome -> Prop :=
   | exec_Sskip:
       forall sp e m,
-      exec_stmt sp e m Sskip e m Out_normal
+      exec_stmt sp e m Sskip E0 e m Out_normal
   | exec_Sexpr:
-      forall sp e m a e1 m1 v,
-      eval_expr sp nil e m a e1 m1 v ->
-      exec_stmt sp e m (Sexpr a) e1 m1 Out_normal
+      forall sp e m a t e1 m1 v,
+      eval_expr sp nil e m a t e1 m1 v ->
+      exec_stmt sp e m (Sexpr a) t e1 m1 Out_normal
   | exec_Sifthenelse:
-      forall sp e m a s1 s2 e1 m1 v1 e2 m2 out,
-      eval_condexpr sp nil e m a e1 m1 v1 ->
-      exec_stmt sp e1 m1 (if v1 then s1 else s2) e2 m2 out ->
-      exec_stmt sp e m (Sifthenelse a s1 s2) e2 m2 out
+      forall sp e m a s1 s2 t t1 e1 m1 v1 t2 e2 m2 out,
+      eval_condexpr sp nil e m a t1 e1 m1 v1 ->
+      exec_stmt sp e1 m1 (if v1 then s1 else s2) t2 e2 m2 out ->
+      t = t1 ** t2 ->
+      exec_stmt sp e m (Sifthenelse a s1 s2) t e2 m2 out
   | exec_Sseq_continue:
-      forall sp e m s1 e1 m1 s2 e2 m2 out,
-      exec_stmt sp e m s1 e1 m1 Out_normal ->
-      exec_stmt sp e1 m1 s2 e2 m2 out ->
-      exec_stmt sp e m (Sseq s1 s2) e2 m2 out
+      forall sp e m t s1 t1 e1 m1 s2 t2 e2 m2 out,
+      exec_stmt sp e m s1 t1 e1 m1 Out_normal ->
+      exec_stmt sp e1 m1 s2 t2 e2 m2 out ->
+      t = t1 ** t2 ->
+      exec_stmt sp e m (Sseq s1 s2) t e2 m2 out
   | exec_Sseq_stop:
-      forall sp e m s1 s2 e1 m1 out,
-      exec_stmt sp e m s1 e1 m1 out ->
+      forall sp e m t s1 s2 e1 m1 out,
+      exec_stmt sp e m s1 t e1 m1 out ->
       out <> Out_normal ->
-      exec_stmt sp e m (Sseq s1 s2) e1 m1 out
+      exec_stmt sp e m (Sseq s1 s2) t e1 m1 out
   | exec_Sloop_loop:
-      forall sp e m s e1 m1 e2 m2 out,
-      exec_stmt sp e m s e1 m1 Out_normal ->
-      exec_stmt sp e1 m1 (Sloop s) e2 m2 out ->
-      exec_stmt sp e m (Sloop s) e2 m2 out
+      forall sp e m s t t1 e1 m1 t2 e2 m2 out,
+      exec_stmt sp e m s t1 e1 m1 Out_normal ->
+      exec_stmt sp e1 m1 (Sloop s) t2 e2 m2 out ->
+      t = t1 ** t2 ->
+      exec_stmt sp e m (Sloop s) t e2 m2 out
   | exec_Sloop_stop:
-      forall sp e m s e1 m1 out,
-      exec_stmt sp e m s e1 m1 out ->
+      forall sp e m t s e1 m1 out,
+      exec_stmt sp e m s t e1 m1 out ->
       out <> Out_normal ->
-      exec_stmt sp e m (Sloop s) e1 m1 out
+      exec_stmt sp e m (Sloop s) t e1 m1 out
   | exec_Sblock:
-      forall sp e m s e1 m1 out,
-      exec_stmt sp e m s e1 m1 out ->
-      exec_stmt sp e m (Sblock s) e1 m1 (outcome_block out)
+      forall sp e m s t e1 m1 out,
+      exec_stmt sp e m s t e1 m1 out ->
+      exec_stmt sp e m (Sblock s) t e1 m1 (outcome_block out)
   | exec_Sexit:
       forall sp e m n,
-      exec_stmt sp e m (Sexit n) e m (Out_exit n)
+      exec_stmt sp e m (Sexit n) E0 e m (Out_exit n)
   | exec_Sswitch:
-      forall sp e m a cases default e1 m1 n,
-      eval_expr sp nil e m a e1 m1 (Vint n) ->
+      forall sp e m a cases default t1 e1 m1 n,
+      eval_expr sp nil e m a t1 e1 m1 (Vint n) ->
       exec_stmt sp e m (Sswitch a cases default)
-                   e1 m1 (Out_exit (switch_target n default cases))
+                t1 e1 m1 (Out_exit (switch_target n default cases))
   | exec_Sreturn_none:
       forall sp e m,
-      exec_stmt sp e m (Sreturn None) e m (Out_return None)
+      exec_stmt sp e m (Sreturn None) E0 e m (Out_return None)
   | exec_Sreturn_some:
-      forall sp e m a e1 m1 v,
-      eval_expr sp nil e m a e1 m1 v ->
-      exec_stmt sp e m (Sreturn (Some a)) e1 m1 (Out_return (Some v)).
+      forall sp e m a t e1 m1 v,
+      eval_expr sp nil e m a t e1 m1 v ->
+      exec_stmt sp e m (Sreturn (Some a)) t e1 m1 (Out_return (Some v)).
 
 End RELSEM.
 
@@ -337,12 +364,12 @@ End RELSEM.
   holds if the application of [p]'s main function to no arguments
   in the initial memory state for [p] eventually returns value [r]. *)
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv p in
   let m0 := Genv.init_mem p in
   exists b, exists f, exists m,
   Genv.find_symbol ge p.(prog_main) = Some b /\
   Genv.find_funct_ptr ge b = Some f /\
-  f.(fn_sig) = mksignature nil (Some Tint) /\
-  eval_funcall ge m0 f nil m r.
+  funsig f = mksignature nil (Some Tint) /\
+  eval_funcall ge m0 f nil t m r.
 
diff --git a/backend/Cminorgen.v b/backend/Cminorgen.v
index cb88992..4c611b4 100644
--- a/backend/Cminorgen.v
+++ b/backend/Cminorgen.v
@@ -104,18 +104,27 @@ Definition make_cast (chunk: memory_chunk) (e: expr): expr :=
 Definition make_load (chunk: memory_chunk) (e: expr): expr :=
   Cmconstr.load chunk e.
 
-(** In Csharpminor, the value of a store expression is the stored data
-  normalized to the memory chunk.  In Cminor, it is the stored data.
-  For the translation, we could normalize before storing.  However,
-  the memory model performs automatic normalization of the stored
-  data.  It is therefore correct to store the data as is, then
-  normalize the result value of the store expression.  This is more
-  efficient in general because often the result value is ignored:
-  the normalization code will therefore be eliminated later as dead
-  code. *)
-
-Definition make_store (chunk: memory_chunk) (e1 e2: expr): expr :=
-  make_cast chunk (Cmconstr.store chunk e1 e2).
+Definition store_arg (chunk: memory_chunk) (e: expr) : expr :=
+  match e with
+  | Eop op (Econs e1 Enil) =>
+      match op with
+      | Ocast8signed =>
+          match chunk with Mint8signed => e1 | _ => e end
+      | Ocast8unsigned =>
+          match chunk with Mint8unsigned => e1 | _ => e end
+      | Ocast16signed =>
+          match chunk with Mint16signed => e1 | _ => e end
+      | Ocast16unsigned =>
+          match chunk with Mint16unsigned => e1 | _ => e end
+      | Osingleoffloat =>
+          match chunk with Mfloat32 => e1 | _ => e end
+      | _ => e
+      end
+  | _ => e
+  end.
+
+Definition make_store (chunk: memory_chunk) (e1 e2: expr): stmt :=
+  Sexpr(Cmconstr.store chunk e1 (store_arg chunk e2)).
 
 Definition make_stackaddr (ofs: Z): expr :=
   Eop (Oaddrstack (Int.repr ofs)) Enil.
@@ -156,10 +165,10 @@ Definition var_get (cenv: compilenv) (id: ident): option expr :=
       None
   end.
 
-Definition var_set (cenv: compilenv) (id: ident) (rhs: expr): option expr :=
+Definition var_set (cenv: compilenv) (id: ident) (rhs: expr): option stmt :=
   match PMap.get id cenv with
   | Var_local chunk =>
-      Some(Eassign id (make_cast chunk rhs))
+      Some(Sexpr(Eassign id (make_cast chunk rhs)))
   | Var_stack_scalar chunk ofs =>
       Some(make_store chunk (make_stackaddr ofs) rhs)
   | Var_global_scalar chunk =>
@@ -199,16 +208,10 @@ Fixpoint transl_expr (cenv: compilenv) (e: Csharpminor.expr)
   match e with
   | Csharpminor.Evar id => var_get cenv id
   | Csharpminor.Eaddrof id => var_addr cenv id
-  | Csharpminor.Eassign id e =>
-      do te <- transl_expr cenv e; var_set cenv id te
   | Csharpminor.Eop op el =>
       do tel <- transl_exprlist cenv el; make_op op tel
   | Csharpminor.Eload chunk e =>
       do te <- transl_expr cenv e; Some (make_load chunk te)
-  | Csharpminor.Estore chunk e1 e2 =>
-      do te1 <- transl_expr cenv e1;
-      do te2 <- transl_expr cenv e2;
-      Some (make_store chunk te1 te2)
   | Csharpminor.Ecall sig e el =>
       do te <- transl_expr cenv e;
       do tel <- transl_exprlist cenv el;
@@ -224,6 +227,9 @@ Fixpoint transl_expr (cenv: compilenv) (e: Csharpminor.expr)
       Some (Elet te1 te2)
   | Csharpminor.Eletvar n =>
       Some (Eletvar n)
+  | Csharpminor.Ealloc e =>
+      do te <- transl_expr cenv e;
+      Some (Ealloc te)
   end
 
 with transl_exprlist (cenv: compilenv) (el: Csharpminor.exprlist)
@@ -246,6 +252,12 @@ Fixpoint transl_stmt (cenv: compilenv) (s: Csharpminor.stmt)
       Some Sskip
   | Csharpminor.Sexpr e =>
       do te <- transl_expr cenv e; Some(Sexpr te)
+  | Csharpminor.Sassign id e =>
+      do te <- transl_expr cenv e; var_set cenv id te
+  | Csharpminor.Sstore chunk e1 e2 =>
+      do te1 <- transl_expr cenv e1;
+      do te2 <- transl_expr cenv e2;
+      Some (make_store chunk te1 te2)
   | Csharpminor.Sseq s1 s2 =>
       do ts1 <- transl_stmt cenv s1;
       do ts2 <- transl_stmt cenv s2;
@@ -280,11 +292,8 @@ Fixpoint addr_taken_expr (e: Csharpminor.expr): Identset.t :=
   match e with
   | Csharpminor.Evar id => Identset.empty
   | Csharpminor.Eaddrof id => Identset.add id Identset.empty
-  | Csharpminor.Eassign id e => addr_taken_expr e
   | Csharpminor.Eop op el => addr_taken_exprlist el
   | Csharpminor.Eload chunk e => addr_taken_expr e
-  | Csharpminor.Estore chunk e1 e2 =>
-      Identset.union (addr_taken_expr e1) (addr_taken_expr e2)
   | Csharpminor.Ecall sig e el =>
       Identset.union (addr_taken_expr e) (addr_taken_exprlist el)
   | Csharpminor.Econdition e1 e2 e3 =>
@@ -293,6 +302,7 @@ Fixpoint addr_taken_expr (e: Csharpminor.expr): Identset.t :=
   | Csharpminor.Elet e1 e2 =>
       Identset.union (addr_taken_expr e1) (addr_taken_expr e2)
   | Csharpminor.Eletvar n => Identset.empty
+  | Csharpminor.Ealloc e => addr_taken_expr e
   end
 
 with addr_taken_exprlist (e: Csharpminor.exprlist): Identset.t :=
@@ -306,6 +316,9 @@ Fixpoint addr_taken_stmt (s: Csharpminor.stmt): Identset.t :=
   match s with
   | Csharpminor.Sskip => Identset.empty
   | Csharpminor.Sexpr e => addr_taken_expr e
+  | Csharpminor.Sassign id e => addr_taken_expr e
+  | Csharpminor.Sstore chunk e1 e2 =>
+      Identset.union (addr_taken_expr e1) (addr_taken_expr e2)
   | Csharpminor.Sseq s1 s2 =>
       Identset.union (addr_taken_stmt s1) (addr_taken_stmt s2)
   | Csharpminor.Sifthenelse e s1 s2 =>
@@ -362,10 +375,10 @@ Definition build_compilenv
     (globenv, 0).
 
 Definition assign_global_variable
-     (ce: compilenv) (id_vi: ident * var_kind) : compilenv :=
-  match id_vi with
-  | (id, Vscalar chunk) => PMap.set id (Var_global_scalar chunk) ce
-  | (id, Varray sz) => PMap.set id Var_global_array ce
+     (ce: compilenv) (info: ident * var_kind * list init_data) : compilenv :=
+  match info with
+  | (id, Vscalar chunk, _) => PMap.set id (Var_global_scalar chunk) ce
+  | (id, Varray _, _) => PMap.set id Var_global_array ce
   end.
 
 Definition build_global_compilenv (p: Csharpminor.program) : compilenv :=
@@ -387,7 +400,7 @@ Fixpoint store_parameters
           Sseq (Sexpr (Eassign id (make_cast chunk (Evar id))))
                (store_parameters cenv rem)
       | Var_stack_scalar chunk ofs =>
-          Sseq (Sexpr (make_store chunk (make_stackaddr ofs) (Evar id)))
+          Sseq (make_store chunk (make_stackaddr ofs) (Evar id))
                (store_parameters cenv rem)
       | _ =>
           Sskip (* should never happen *)
@@ -412,6 +425,9 @@ Definition transl_function
               (Sseq (store_parameters cenv f.(Csharpminor.fn_params)) tbody))
   else None.
 
+Definition transl_fundef (gce: compilenv) (f: Csharpminor.fundef): option fundef :=
+  transf_partial_fundef (transl_function gce) f.
+
 Definition transl_program (p: Csharpminor.program) : option program :=
   let gce := build_global_compilenv p in
-  transform_partial_program (transl_function gce) (program_of_program p).
+  transform_partial_program (transl_fundef gce) (program_of_program p).
diff --git a/backend/Cminorgenproof.v b/backend/Cminorgenproof.v
index 7b3bc9b..7820095 100644
--- a/backend/Cminorgenproof.v
+++ b/backend/Cminorgenproof.v
@@ -8,6 +8,7 @@ Require Import Integers.
 Require Import Floats.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Csharpminor.
 Require Import Op.
@@ -29,38 +30,51 @@ Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
 Proof.
   intro. unfold ge, tge. 
-  apply Genv.find_symbol_transf_partial with (transl_function gce).
+  apply Genv.find_symbol_transf_partial with (transl_fundef gce).
   exact TRANSL.
 Qed.
 
 Lemma function_ptr_translated:
-  forall (b: block) (f: Csharpminor.function),
+  forall (b: block) (f: Csharpminor.fundef),
   Genv.find_funct_ptr ge b = Some f ->
   exists tf,
-  Genv.find_funct_ptr tge b = Some tf /\ transl_function gce f = Some tf.
+  Genv.find_funct_ptr tge b = Some tf /\ transl_fundef gce f = Some tf.
 Proof.
   intros. 
   generalize 
-   (Genv.find_funct_ptr_transf_partial (transl_function gce) TRANSL H).
-  case (transl_function gce f).
+   (Genv.find_funct_ptr_transf_partial (transl_fundef gce) TRANSL H).
+  case (transl_fundef gce f).
   intros tf [A B]. exists tf. tauto.
   intros [A B]. elim B. reflexivity.
 Qed.
 
 Lemma functions_translated:
-  forall (v: val) (f: Csharpminor.function),
+  forall (v: val) (f: Csharpminor.fundef),
   Genv.find_funct ge v = Some f ->
   exists tf,
-  Genv.find_funct tge v = Some tf /\ transl_function gce f = Some tf.
+  Genv.find_funct tge v = Some tf /\ transl_fundef gce f = Some tf.
 Proof.
   intros. 
   generalize 
-   (Genv.find_funct_transf_partial (transl_function gce) TRANSL H).
-  case (transl_function gce f).
+   (Genv.find_funct_transf_partial (transl_fundef gce) TRANSL H).
+  case (transl_fundef gce f).
   intros tf [A B]. exists tf. tauto.
   intros [A B]. elim B. reflexivity.
 Qed.
 
+Lemma sig_preserved:
+  forall f tf,
+  transl_fundef gce f = Some tf -> 
+  Cminor.funsig tf = Csharpminor.funsig f.
+Proof.
+  intros until tf; destruct f; simpl.
+  unfold transl_function. destruct (build_compilenv gce f).
+  case (zle z Int.max_signed); try congruence.
+  intro. case (transl_stmt c (Csharpminor.fn_body f)); simpl; try congruence.
+  intros. inversion H. reflexivity.
+  intro. inversion H; reflexivity.
+Qed.
+
 Definition global_compilenv_match (ce: compilenv) (gv: gvarenv) : Prop :=
   forall id,
   match ce!!id with
@@ -72,9 +86,9 @@ Definition global_compilenv_match (ce: compilenv) (gv: gvarenv) : Prop :=
 Lemma global_compilenv_charact:
   global_compilenv_match gce (global_var_env prog).
 Proof.
-  set (mkgve := fun gv vars =>
+  set (mkgve := fun gv (vars: list (ident * var_kind * list init_data)) =>
          List.fold_left
-          (fun gv (id_vi: ident * var_kind) => PTree.set (fst id_vi) (snd id_vi) gv)
+          (fun gve x => match x with (id, k, init) => PTree.set id k gve end)
           vars gv).
   assert (forall vars gv ce,
             global_compilenv_match ce gv ->
@@ -83,7 +97,7 @@ Proof.
   induction vars; simpl; intros.
   auto.
   apply IHvars. intro id1. unfold assign_global_variable.
-  destruct a as [id2 lv2]. destruct lv2; simpl; rewrite PMap.gsspec; rewrite PTree.gsspec.
+  destruct a as [[id2 lv2] init2]. destruct lv2; simpl; rewrite PMap.gsspec; rewrite PTree.gsspec.
   case (peq id1 id2); intro. auto. apply H. 
   case (peq id1 id2); intro. auto. apply H.
 
@@ -283,6 +297,7 @@ Qed.
   must be normalized with respect to the memory chunk of the variable,
   in the following sense. *)
 
+(*
 Definition val_normalized (chunk: memory_chunk) (v: val) : Prop :=
   exists v0, v = Val.load_result chunk v0.
 
@@ -305,34 +320,31 @@ Lemma load_result_normalized:
 Proof.
   intros chunk v [v0 EQ]. rewrite EQ. apply load_result_idem. 
 Qed.
-
+*)
 Lemma match_env_store_local:
   forall f cenv e m1 m2 te sp lo hi id b chunk v tv,
   e!id = Some(b, Vscalar chunk) ->
-  val_inject f v tv ->
-  val_normalized chunk tv ->
+  val_inject f (Val.load_result chunk v) tv ->
   store chunk m1 b 0 v = Some m2 ->
   match_env f cenv e m1 te sp lo hi ->
   match_env f cenv e m2 (PTree.set id tv te) sp lo hi.
 Proof.
-  intros. inversion H3. constructor; auto.
+  intros. inversion H2. constructor; auto.
   intros. generalize (me_vars0 id0); intro.
-  inversion H4; subst.
+  inversion H3; subst.
   (* var_local *)
   case (peq id id0); intro.
     (* the stored variable *)
     subst id0. 
-    change Csharpminor.var_kind with var_kind in H5. 
-    rewrite H in H6. injection H6; clear H6; intros; subst b0 chunk0.
+    change Csharpminor.var_kind with var_kind in H4. 
+    rewrite H in H5. injection H5; clear H5; intros; subst b0 chunk0.
     econstructor. eauto. 
     eapply load_store_same; eauto. auto. 
     rewrite PTree.gss. reflexivity.
-    replace tv with (Val.load_result chunk tv).
-    apply Mem.load_result_inject. constructor; auto. 
-    apply load_result_normalized; auto.    
+    auto.
     (* a different variable *)
     econstructor; eauto.
-    rewrite <- H7. eapply load_store_other; eauto. 
+    rewrite <- H6. eapply load_store_other; eauto. 
     rewrite PTree.gso; auto.
   (* var_stack_scalar *)
   econstructor; eauto.
@@ -375,16 +387,15 @@ Qed.
 Lemma match_callstack_store_local:
   forall f cenv e te sp lo hi cs bound tbound m1 m2 id b chunk v tv,
   e!id = Some(b, Vscalar chunk) ->
-  val_inject f v tv ->
-  val_normalized chunk tv ->
+  val_inject f (Val.load_result chunk v) tv ->
   store chunk m1 b 0 v = Some m2 ->
   match_callstack f (mkframe cenv e te sp lo hi :: cs) bound tbound m1 ->
   match_callstack f (mkframe cenv e (PTree.set id tv te) sp lo hi :: cs) bound tbound m2.
 Proof.
-  intros. inversion H3. constructor; auto.
+  intros. inversion H2. constructor; auto.
   eapply match_env_store_local; eauto.
   eapply match_callstack_store_above; eauto.
-  inversion H17. 
+  inversion H16. 
   generalize (me_bounded0 _ _ _ H). omega.
 Qed.
 
@@ -409,20 +420,19 @@ Qed.
 Lemma match_callstack_store_local_unchanged:
   forall f cenv e te sp lo hi cs bound tbound m1 m2 id b chunk v tv,
   e!id = Some(b, Vscalar chunk) ->
-  val_inject f v tv ->
-  val_normalized chunk tv ->
+  val_inject f (Val.load_result chunk v) tv ->
   store chunk m1 b 0 v = Some m2 ->
   te!id = Some tv ->
   match_callstack f (mkframe cenv e te sp lo hi :: cs) bound tbound m1 ->
   match_callstack f (mkframe cenv e te sp lo hi :: cs) bound tbound m2.
 Proof.
-  intros. inversion H4. constructor; auto.
+  intros. inversion H3. constructor; auto.
   apply match_env_extensional with (PTree.set id tv te).
   eapply match_env_store_local; eauto.
   intros. rewrite PTree.gsspec. 
   case (peq id0 id); intros. congruence. auto.
   eapply match_callstack_store_above; eauto.
-  inversion H18. 
+  inversion H17. 
   generalize (me_bounded0 _ _ _ H). omega.
 Qed.
 
@@ -698,6 +708,90 @@ Proof.
   injection H; intros. rewrite <- H2; simpl. omega.
 Qed.
 
+Lemma match_env_alloc:
+  forall m1 l h m2 b tm1 tm2 tb f1 ce e te sp lo hi,
+  alloc m1 l h = (m2, b) ->
+  alloc tm1 l h = (tm2, tb) ->
+  match_env f1 ce e m1 te sp lo hi ->
+  hi <= m1.(nextblock) ->
+  sp < tm1.(nextblock) ->
+  let f2 := extend_inject b (Some(tb, 0)) f1 in
+  inject_incr f1 f2 ->
+  match_env f2 ce e m2 te sp lo hi.
+Proof.
+  intros. 
+  assert (BEQ: b = m1.(nextblock)). injection H; auto.
+  assert (TBEQ: tb = tm1.(nextblock)). injection H0; auto.
+  inversion H1. constructor; auto.
+  (* me_vars *)
+  intros. generalize (me_vars0 id); intro. inversion H5.
+    (* var_local *)
+    econstructor; eauto. 
+    generalize (me_bounded0 _ _ _ H7). intro. 
+    unfold f2, extend_inject. case (eq_block b0 b); intro. 
+    subst b0. rewrite BEQ in H12. omegaContradiction. 
+    auto.
+    (* var_stack_scalar *)
+    econstructor; eauto.
+    (* var_stack_array *)
+    econstructor; eauto.
+    (* var_global_scalar *)
+    econstructor; eauto.
+    (* var_global_array *)
+    econstructor; eauto.
+  (* me_bounded *)
+  intros until delta. unfold f2, extend_inject. case (eq_block b0 b); intro.
+  intro. injection H5; clear H5; intros. 
+  rewrite H6 in TBEQ. rewrite TBEQ in H3. omegaContradiction.
+  eauto.
+  (* me_inj *)
+  intros until delta. unfold f2, extend_inject. case (eq_block b0 b); intros.
+  injection H5; clear H5; intros; subst b0 tb0 delta.
+  rewrite BEQ in H6. omegaContradiction. 
+  eauto.
+Qed.
+
+Lemma match_callstack_alloc_rec:
+  forall f1 cs bound tbound m1,
+  match_callstack f1 cs bound tbound m1 ->
+  forall l h m2 b tm1 tm2 tb,
+  alloc m1 l h = (m2, b) ->
+  alloc tm1 l h = (tm2, tb) ->
+  bound <= m1.(nextblock) ->
+  tbound <= tm1.(nextblock) ->
+  let f2 := extend_inject b (Some(tb, 0)) f1 in
+  inject_incr f1 f2 ->
+  match_callstack f2 cs bound tbound m2.
+Proof.
+  induction 1; intros.
+  constructor. 
+    inversion H. constructor.
+    intros. elim (mg_symbols0 _ _ H5); intros.
+    split; auto. elim (H4 b0); intros; congruence.
+    intros. generalize (mg_functions0 _ H5). elim (H4 b0); congruence.
+  constructor. auto. auto. 
+  unfold f2. eapply match_env_alloc; eauto. omega. omega. 
+  unfold f2; eapply IHmatch_callstack; eauto.
+  inversion H1; omega.
+  omega.
+Qed.
+
+Lemma match_callstack_alloc:
+  forall f1 cs m1 tm1 l h m2 b tm2 tb,
+  match_callstack f1 cs m1.(nextblock) tm1.(nextblock) m1 ->
+  alloc m1 l h = (m2, b) ->
+  alloc tm1 l h = (tm2, tb) ->
+  let f2 := extend_inject b (Some(tb, 0)) f1 in
+  inject_incr f1 f2 ->
+  match_callstack f2 cs m2.(nextblock) tm2.(nextblock) m2.
+Proof.
+  intros. unfold f2 in *. 
+  apply match_callstack_incr_bound with m1.(nextblock) tm1.(nextblock).
+  eapply match_callstack_alloc_rec; eauto. omega. omega. 
+  injection H0; intros; subst m2; simpl; omega. 
+  injection H1; intros; subst tm2; simpl; omega. 
+Qed.
+
 (** [match_callstack] implies [match_globalenvs]. *)
 
 Lemma match_callstack_match_globalenvs:
@@ -757,14 +851,14 @@ Qed.
   provided arguments match pairwise ([val_list_inject f] hypothesis). *)
 
 Lemma make_op_correct:
-  forall al a op vl m2 v sp le te1 tm1 te2 tm2 tvl f,
+  forall al a op vl m2 v sp le te1 tm1 t te2 tm2 tvl f,
   make_op op al = Some a ->
   Csharpminor.eval_operation op vl m2 = Some v ->
-  eval_exprlist tge (Vptr sp Int.zero) le te1 tm1 al te2 tm2 tvl ->
+  eval_exprlist tge (Vptr sp Int.zero) le te1 tm1 al t te2 tm2 tvl ->
   val_list_inject f vl tvl ->
   mem_inject f m2 tm2 ->
   exists tv,
-     eval_expr tge (Vptr sp Int.zero) le te1 tm1 a te2 tm2 tv
+     eval_expr tge (Vptr sp Int.zero) le te1 tm1 a t te2 tm2 tv
   /\ val_inject f v tv.
 Proof.
   intros. 
@@ -782,23 +876,27 @@ Proof.
   (* floatconst *)
   TrivialOp. econstructor. constructor. reflexivity.
   (* Unary operators *)
-  inversion H1. subst sp0 le0 e m a0 bl e2 m0 tvl.
-  inversion H14. subst sp0 le0 e m e1 m1 vl0.
-  inversion H2. subst vl v' vl'. inversion H8. subst vl0.
+  inversion H1; clear H1; subst.
+  inversion H11; clear H11; subst.
+  rewrite E0_right. 
+  inversion H2; clear H2; subst. inversion H8; clear H8; subst.
   destruct op; simplify_eq H; intro; subst a;
   simpl in H0; destruct v1; simplify_eq H0; intro; subst v;
   inversion H7; subst v0;
   TrivialOp.
+  change (Vint (Int.cast8unsigned i)) with (Val.cast8unsigned (Vint i)). eauto with evalexpr.
+  change (Vint (Int.cast8signed i)) with (Val.cast8signed (Vint i)). eauto with evalexpr.
+  change (Vint (Int.cast16unsigned i)) with (Val.cast16unsigned (Vint i)). eauto with evalexpr.
+  change (Vint (Int.cast16signed i)) with (Val.cast16signed (Vint i)). eauto with evalexpr.
+  change (Vfloat (Float.singleoffloat f0)) with (Val.singleoffloat (Vfloat f0)). eauto with evalexpr.
   (* Binary operations *)
-  inversion H1. subst sp0 le0 e m a0 bl e2 m0 tvl.
-  inversion H14. subst sp0 le0 e m a0 bl e2 m3 vl0.
-  inversion H16. subst sp0 le0 e m e0 m0 vl1.
-  inversion H2. subst vl v' vl'.
-  inversion H8. subst vl0 v' vl'.
-  inversion H12. subst vl.
+  inversion H1; clear H1; subst. inversion H11; clear H11; subst.
+  inversion H12; clear H12; subst. rewrite E0_right. 
+  inversion H2; clear H2; subst. inversion H9; clear H9; subst.
+  inversion H10; clear H10; subst.
   destruct op; simplify_eq H; intro; subst a;
   simpl in H0; destruct v2; destruct v3; simplify_eq H0; intro; try subst v;
-  inversion H7; inversion H9; subst v0; subst v1;
+  inversion H7; inversion H8; subst v0; subst v1;
   TrivialOp.
   (* add int ptr *)
   exists (Vptr b2 (Int.add ofs2 i)); split.
@@ -815,7 +913,8 @@ Proof.
   (* sub ptr ptr *)
   destruct (eq_block b b0); simplify_eq H0; intro; subst v; subst b0.
   assert (b4 = b2). congruence. subst b4.
-  exists (Vint (Int.sub ofs2 ofs3)); split. eauto with evalexpr.
+  exists (Vint (Int.sub ofs3 ofs2)); split. 
+  eauto with evalexpr. 
   subst ofs2 ofs3. replace x0 with x. rewrite Int.sub_shifted. constructor.
   congruence.
   (* divs *)
@@ -842,11 +941,11 @@ Proof.
   (* cmp int ptr *)
   elim (eval_compare_null_inv _ _ _ H0); intros; subst i1 i.
   exists v; split. eauto with evalexpr. 
-  elim H18; intros [A B]; subst v; unfold Vtrue, Vfalse; constructor.
+  elim H12; intros [A B]; subst v; unfold Vtrue, Vfalse; constructor.
   (* cmp ptr int *)
   elim (eval_compare_null_inv _ _ _ H0); intros; subst i1 i0.
   exists v; split. eauto with evalexpr. 
-  elim H18; intros [A B]; subst v; unfold Vtrue, Vfalse; constructor.
+  elim H12; intros [A B]; subst v; unfold Vtrue, Vfalse; constructor.
   (* cmp ptr ptr *)
   caseEq (valid_pointer m2 b (Int.signed i) && valid_pointer m2 b0 (Int.signed i0)); 
   intro EQ; rewrite EQ in H0; try discriminate.
@@ -854,7 +953,7 @@ Proof.
   assert (b4 = b2); [congruence|subst b4].
   assert (x0 = x); [congruence|subst x0].
   elim (andb_prop _ _ EQ); intros.
-  exists (Val.of_bool (Int.cmp c ofs2 ofs3)); split.
+  exists (Val.of_bool (Int.cmp c ofs3 ofs2)); split.
   eauto with evalexpr. 
   subst ofs2 ofs3. rewrite Int.translate_cmp. 
   apply val_inject_val_of_bool. 
@@ -866,55 +965,51 @@ Qed.
   normalized according to the given memory chunk. *)
 
 Lemma make_cast_correct:
-  forall f sp le te1 tm1 a te2 tm2 v chunk v' tv,
-  eval_expr tge (Vptr sp Int.zero) le te1 tm1 a te2 tm2 tv ->
-  cast chunk v = Some v' ->
+  forall f sp le te1 tm1 a t te2 tm2 v chunk tv,
+  eval_expr tge (Vptr sp Int.zero) le te1 tm1 a t te2 tm2 tv ->
   val_inject f v tv ->
   exists tv',
   eval_expr tge (Vptr sp Int.zero) le
             te1 tm1 (make_cast chunk a)
-            te2 tm2 tv'
-  /\ val_inject f v' tv'
-  /\ val_normalized chunk tv'.
+          t te2 tm2 tv'
+  /\ val_inject f (Val.load_result chunk v) tv'.
 Proof.
-  intros. destruct chunk; destruct v; simplify_eq H0; intro; subst v'; simpl;
-  inversion H1; subst tv.
+  intros. destruct chunk.
 
-  exists (Vint (Int.cast8signed i)). 
+  exists (Val.cast8signed tv). 
   split. apply eval_cast8signed; auto. 
-  split. constructor. exists (Vint i); reflexivity.
+  inversion H0; simpl; constructor.
 
-  exists (Vint (Int.cast8unsigned i)).
+  exists (Val.cast8unsigned tv). 
   split. apply eval_cast8unsigned; auto. 
-  split. constructor. exists (Vint i); reflexivity.
+  inversion H0; simpl; constructor.
 
-  exists (Vint (Int.cast16signed i)). 
+  exists (Val.cast16signed tv). 
   split. apply eval_cast16signed; auto. 
-  split. constructor. exists (Vint i); reflexivity.
+  inversion H0; simpl; constructor.
 
-  exists (Vint (Int.cast16unsigned i)).
+  exists (Val.cast16unsigned tv). 
   split. apply eval_cast16unsigned; auto. 
-  split. constructor. exists (Vint i); reflexivity.
-
-  exists (Vint i).
-  split. auto. split. auto. exists (Vint i); reflexivity.
+  inversion H0; simpl; constructor.
 
-  exists (Vptr b2 ofs2).
-  split. auto. split. auto. exists (Vptr b2 ofs2); reflexivity.
+  exists tv. 
+  split. simpl; auto.
+  inversion H0; simpl; econstructor; eauto.
 
-  exists (Vfloat (Float.singleoffloat f0)).
+  exists (Val.singleoffloat tv). 
   split. apply eval_singleoffloat; auto. 
-  split. constructor. exists (Vfloat f0); reflexivity.
+  inversion H0; simpl; constructor.
 
-  exists (Vfloat f0).
-  split. auto. split. auto. exists (Vfloat f0); reflexivity.
+  exists tv. 
+  split. simpl; auto.
+  inversion H0; simpl; constructor. 
 Qed.
 
 Lemma make_stackaddr_correct:
   forall sp le te tm ofs,
   eval_expr tge (Vptr sp Int.zero) le
             te tm (make_stackaddr ofs)
-            te tm (Vptr sp (Int.repr ofs)).
+         E0 te tm (Vptr sp (Int.repr ofs)).
 Proof.
   intros; unfold make_stackaddr.
   eapply eval_Eop. econstructor. simpl. decEq. decEq.
@@ -926,7 +1021,7 @@ Lemma make_globaladdr_correct:
   Genv.find_symbol tge id = Some b ->
   eval_expr tge (Vptr sp Int.zero) le
             te tm (make_globaladdr id)
-            te tm (Vptr b Int.zero).
+         E0 te tm (Vptr b Int.zero).
 Proof.
   intros; unfold make_globaladdr.
   eapply eval_Eop. econstructor. simpl. rewrite H. auto.
@@ -935,67 +1030,75 @@ Qed.
 (** Correctness of [make_load] and [make_store]. *)
 
 Lemma make_load_correct:
-  forall sp le te1 tm1 a te2 tm2 va chunk v,
-  eval_expr tge (Vptr sp Int.zero) le te1 tm1 a te2 tm2 va ->
+  forall sp le te1 tm1 a t te2 tm2 va chunk v,
+  eval_expr tge (Vptr sp Int.zero) le te1 tm1 a t te2 tm2 va ->
   Mem.loadv chunk tm2 va = Some v ->
   eval_expr tge (Vptr sp Int.zero) le
             te1 tm1 (make_load chunk a)
-            te2 tm2 v.
+          t te2 tm2 v.
 Proof.
   intros; unfold make_load.
   eapply eval_load; eauto.
 Qed.
 
-Lemma val_content_inject_cast:
-  forall f chunk v1 v2 tv1,
-  cast chunk v1 = Some v2 ->
-  val_inject f v1 tv1 ->
-  val_content_inject f (mem_chunk chunk) v2 tv1.
+Lemma store_arg_content_inject:
+  forall f sp le te1 tm1 a t te2 tm2 v va chunk,
+  eval_expr tge (Vptr sp Int.zero) le te1 tm1 a t te2 tm2 va ->
+  val_inject f v va ->
+  exists vb,
+  eval_expr tge (Vptr sp Int.zero) le te1 tm1 (store_arg chunk a) t te2 tm2 vb  
+  /\ val_content_inject f (mem_chunk chunk) v vb.
 Proof.
-  intros. destruct chunk; destruct v1; simplify_eq H; intro; subst v2;
-  inversion H0; simpl.
-  apply val_content_inject_8. apply Int.cast8_unsigned_signed.
-  apply val_content_inject_8. apply Int.cast8_unsigned_idem.
-  apply val_content_inject_16. apply Int.cast16_unsigned_signed.
-  apply val_content_inject_16. apply Int.cast16_unsigned_idem.
-  constructor; constructor.
-  constructor; econstructor; eauto.
-  apply val_content_inject_32. apply Float.singleoffloat_idem.
-  constructor; constructor. 
+  intros. 
+  assert (exists vb,
+    eval_expr tge (Vptr sp Int.zero) le te1 tm1 a t te2 tm2 vb  
+    /\ val_content_inject f (mem_chunk chunk) v vb).
+  exists va; split. assumption. constructor. assumption.
+  inversion H; clear H; subst; simpl; trivial.
+  inversion H2; clear H2; subst; trivial.
+  inversion H4; clear H4; subst; trivial.
+  rewrite E0_right. rewrite E0_right in H1.
+  destruct op; trivial; destruct chunk; trivial;
+  exists v0; (split; [auto|
+  simpl in H3; inversion H3; clear H3; subst va; 
+  destruct v0; simpl in H0; inversion H0; subst; try (constructor; constructor)]).
+  apply val_content_inject_8. apply Int.cast8_unsigned_signed. 
+  apply val_content_inject_8. apply Int.cast8_unsigned_idem. 
+  apply val_content_inject_16. apply Int.cast16_unsigned_signed. 
+  apply val_content_inject_16. apply Int.cast16_unsigned_idem. 
+  apply val_content_inject_32. apply Float.singleoffloat_idem. 
 Qed.
 
 Lemma make_store_correct:
-  forall f sp le te1 tm1 addr te2 tm2 tvaddr rhs te3 tm3 tvrhs
-         chunk vrhs v m3 vaddr m4,
-  eval_expr tge (Vptr sp Int.zero) le
-            te1 tm1 addr te2 tm2 tvaddr ->
-  eval_expr tge (Vptr sp Int.zero) le
-            te2 tm2 rhs te3 tm3 tvrhs ->
-  cast chunk vrhs = Some v ->
-  Mem.storev chunk m3 vaddr v = Some m4 ->
+  forall f sp te1 tm1 addr te2 tm2 tvaddr rhs te3 tm3 tvrhs
+         chunk vrhs m3 vaddr m4 t1 t2,
+  eval_expr tge (Vptr sp Int.zero) nil
+            te1 tm1 addr t1 te2 tm2 tvaddr ->
+  eval_expr tge (Vptr sp Int.zero) nil
+            te2 tm2 rhs t2 te3 tm3 tvrhs ->
+  Mem.storev chunk m3 vaddr vrhs = Some m4 ->
   mem_inject f m3 tm3 ->
   val_inject f vaddr tvaddr ->
   val_inject f vrhs tvrhs ->
-  exists tm4, exists tv,
-  eval_expr tge (Vptr sp Int.zero) le
+  exists tm4,
+  exec_stmt tge (Vptr sp Int.zero)
             te1 tm1 (make_store chunk addr rhs)
-            te3 tm4 tv
+            (t1**t2) te3 tm4 Out_normal
   /\ mem_inject f m4 tm4
-  /\ val_inject f v tv
   /\ nextblock tm4 = nextblock tm3.
 Proof.
   intros. unfold make_store.
-  assert (val_content_inject f (mem_chunk chunk) v tvrhs).
-    eapply val_content_inject_cast; eauto.
-  elim (storev_mapped_inject_1 _ _ _ _ _ _ _ _ _ H3 H2 H4 H6).
-  intros tm4 [STORE MEMINJ].
-  generalize (eval_store _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ H H0 STORE).
+  exploit store_arg_content_inject. eexact H0. eauto. 
+  intros [tv [EVAL VCINJ]].
+  exploit storev_mapped_inject_1; eauto.
+  intros [tm4 [STORE MEMINJ]].
+  exploit eval_store. eexact H. eexact EVAL. eauto. 
   intro EVALSTORE.
-  elim (make_cast_correct _ _ _ _ _ _ _ _ _ _ _ _ EVALSTORE H1 H5). 
-  intros tv [EVALCAST [VALINJ VALNORM]].
-  exists tm4; exists tv. intuition.
+  exists tm4. 
+  split. apply exec_Sexpr with tv. auto. 
+  split. auto. 
   unfold storev in STORE; destruct tvaddr; try discriminate.
-  generalize (store_inv _ _ _ _ _ _ STORE). simpl. tauto.
+  exploit store_inv; eauto. simpl. tauto.
 Qed.
 
 (** Correctness of the variable accessors [var_get], [var_set]
@@ -1009,7 +1112,7 @@ Lemma var_get_correct:
   eval_var_ref prog e id b chunk ->
   load chunk m b 0 = Some v ->
   exists tv,
-    eval_expr tge (Vptr sp Int.zero) le te tm a te tm tv /\
+    eval_expr tge (Vptr sp Int.zero) le te tm a E0 te tm tv /\
     val_inject f v tv.
 Proof.
   unfold var_get; intros.
@@ -1025,8 +1128,8 @@ Proof.
   inversion H2; [subst|congruence].
   assert (b0 = b). congruence. subst b0.
   assert (chunk0 = chunk). congruence. subst chunk0.
-  assert (loadv chunk m (Vptr b Int.zero) = Some v). assumption.
-  generalize (loadv_inject _ _ _ _ _ _ _ H1 H9 H7).
+  exploit loadv_inject; eauto.
+    unfold loadv. eexact H3. 
   intros [tv [LOAD INJ]].
   exists tv; split. 
   eapply make_load_correct; eauto. eapply make_stackaddr_correct; eauto.
@@ -1052,7 +1155,7 @@ Lemma var_addr_correct:
   var_addr cenv id = Some a ->
   eval_var_addr prog e id b ->
   exists tv,
-    eval_expr tge (Vptr sp Int.zero) le te tm a te tm tv /\
+    eval_expr tge (Vptr sp Int.zero) le te tm a E0 te tm tv /\
     val_inject f (Vptr b Int.zero) tv.
 Proof.
   unfold var_addr; intros.
@@ -1086,65 +1189,61 @@ Proof.
 Qed.
 
 Lemma var_set_correct:
-  forall cenv id rhs a f e te2 sp lo hi m2 cs tm2 le te1 tm1 vrhs b chunk v1 v2 m3,
+  forall cenv id rhs a f e te2 sp lo hi m2 cs tm2 te1 tm1 tv b chunk v m3 t,
   var_set cenv id rhs = Some a ->
   match_callstack f (mkframe cenv e te2 sp lo hi :: cs) m2.(nextblock) tm2.(nextblock) m2 ->
-  eval_expr tge (Vptr sp Int.zero) le te1 tm1 rhs te2 tm2 vrhs ->
-  val_inject f v1 vrhs ->
+  eval_expr tge (Vptr sp Int.zero) nil te1 tm1 rhs t te2 tm2 tv ->
+  val_inject f v tv ->
   mem_inject f m2 tm2 ->
   eval_var_ref prog e id b chunk ->
-  cast chunk v1 = Some v2 ->
-  store chunk m2 b 0 v2 = Some m3 ->
-  exists te3, exists tm3, exists tv,
-    eval_expr tge (Vptr sp Int.zero) le te1 tm1 a te3 tm3 tv /\
-    val_inject f v2 tv /\
+  store chunk m2 b 0 v = Some m3 ->
+  exists te3, exists tm3,
+    exec_stmt tge (Vptr sp Int.zero) te1 tm1 a t te3 tm3 Out_normal /\
     mem_inject f m3 tm3 /\
     match_callstack f (mkframe cenv e te3 sp lo hi :: cs) m3.(nextblock) tm3.(nextblock) m3.
 Proof.
   unfold var_set; intros.
   assert (NEXTBLOCK: nextblock m3 = nextblock m2).
-    generalize (store_inv _ _ _ _ _ _ H6). simpl. tauto.
+    exploit store_inv; eauto. simpl; tauto.
   inversion H0. subst f0 cenv0 e0 te sp0 lo0 hi0 cs0 bound tbound m.
-  assert (match_var f id e m2 te2 sp cenv!!id). inversion H20; auto.
-  inversion H7; subst; rewrite <- H8 in H; inversion H; subst; clear H.
+  assert (match_var f id e m2 te2 sp cenv!!id). inversion H19; auto.
+  inversion H6; subst; rewrite <- H7 in H; inversion H; subst; clear H.
   (* var_local *)
   inversion H4; [subst|congruence]. 
   assert (b0 = b). congruence. subst b0.
   assert (chunk0 = chunk). congruence. subst chunk0.
-  elim (make_cast_correct _ _ _ _ _ _ _ _ _ _ _ _ H1 H5 H2).
-  intros tv [EVAL [INJ NORM]].
-  exists (PTree.set id tv te2); exists tm2; exists tv.
-  split. eapply eval_Eassign. auto. 
-  split. auto.
+  exploit make_cast_correct; eauto.  
+  intros [tv' [EVAL INJ]].
+  exists (PTree.set id tv' te2); exists tm2.
+  split. eapply exec_Sexpr. eapply eval_Eassign. eauto. 
   split. eapply store_unmapped_inject; eauto. 
   rewrite NEXTBLOCK. eapply match_callstack_store_local; eauto.
   (* var_stack_scalar *)
   inversion H4; [subst|congruence]. 
   assert (b0 = b). congruence. subst b0.
   assert (chunk0 = chunk). congruence. subst chunk0.  
-  assert (storev chunk m2 (Vptr b Int.zero) v2 = Some m3). assumption.
-  generalize (make_stackaddr_correct sp le te1 tm1 ofs). intro EVALSTACKADDR.
-  generalize (make_store_correct _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-                 EVALSTACKADDR H1 H5 H11 H3 H10 H2).
-  intros [tm3 [tv [EVAL [MEMINJ [VALINJ TNEXTBLOCK]]]]].
-  exists te2; exists tm3; exists tv.
-  split. auto. split. auto. split. auto. 
+  assert (storev chunk m2 (Vptr b Int.zero) v = Some m3). assumption.
+  exploit make_store_correct.
+    eapply make_stackaddr_correct.
+    eauto. eauto. eauto. eauto. eauto. 
+  rewrite E0_left. intros [tm3 [EVAL [MEMINJ TNEXTBLOCK]]].
+  exists te2; exists tm3.
+  split. auto. split. auto.  
   rewrite NEXTBLOCK; rewrite TNEXTBLOCK.
   eapply match_callstack_mapped; eauto. 
-  inversion H10; congruence.
+  inversion H9; congruence.
   (* var_global_scalar *)
   inversion H4; [congruence|subst]. 
   assert (chunk0 = chunk). congruence. subst chunk0.  
-  assert (storev chunk m2 (Vptr b Int.zero) v2 = Some m3). assumption.
+  assert (storev chunk m2 (Vptr b Int.zero) v = Some m3). assumption.
   assert (match_globalenvs f). eapply match_callstack_match_globalenvs; eauto.
-  inversion H14. destruct (mg_symbols0 _ _ H11) as [A B].
-  assert (val_inject f (Vptr b Int.zero) (Vptr b Int.zero)). econstructor; eauto.    
-  generalize (make_globaladdr_correct sp le te1 tm1 id b B). intro EVALGLOBALADDR.
-  generalize (make_store_correct _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-                 EVALGLOBALADDR H1 H5 H13 H3 H15 H2).
-  intros [tm3 [tv [EVAL [MEMINJ [VALINJ TNEXTBLOCK]]]]].
-  exists te2; exists tm3; exists tv.
-  split. auto. split. auto. split. auto. 
+  inversion H13. destruct (mg_symbols0 _ _ H10) as [A B].
+  exploit make_store_correct.
+    eapply make_globaladdr_correct; eauto.
+    eauto. eauto. eauto. eauto. eauto. 
+  rewrite E0_left. intros [tm3 [EVAL [MEMINJ TNEXTBLOCK]]].
+  exists te2; exists tm3.
+  split. auto. split. auto. 
   rewrite NEXTBLOCK; rewrite TNEXTBLOCK.
   eapply match_callstack_mapped; eauto. congruence.
 Qed.
@@ -1228,36 +1327,26 @@ Proof.
       omega. omega. omega. omega. unfold sizeof; rewrite LV. omega. 
       intros. left. generalize (BOUND _ _ H5). omega. 
     elim H3; intros MINJ1 INCR1; clear H3.
-    assert (MATCH1: match_callstack f1
-             (mkframe cenv1 (PTree.set id (b1, lv) e) te sp lo (nextblock m1) :: cs)
-             (nextblock m1) (nextblock tm) m1).
-    unfold f1; rewrite <- H2; eapply match_callstack_alloc_left; eauto.
-    assert (SZ1POS: 0 <= sz1). rewrite <- H1. omega.
-    assert (BOUND1: forall b delta, f1 b = Some(sp, delta) ->
-                                    high_bound m1 b + delta <= sz1).
+    exploit IHalloc_variables; eauto.
+      unfold f1; rewrite <- H2; eapply match_callstack_alloc_left; eauto.
+      rewrite <- H1. omega.
       intros until delta; unfold f1, extend_inject, eq_block.
       rewrite (high_bound_alloc _ _ b _ _ _ H).
       case (zeq b b1); intros. 
       inversion H3. unfold sizeof; rewrite LV. omega.
       generalize (BOUND _ _ H3). omega. 
-    generalize (IHalloc_variables _ _ _ ASVS MATCH1 MINJ1 SZ1POS BOUND1 DEFINED1).
     intros [f' [INCR2 [MINJ2 MATCH2]]].
     exists f'; intuition. eapply inject_incr_trans; eauto. 
   (* 1.2 info = Var_local chunk *)
     intro EQ; injection EQ; intros; clear EQ. subst sz1.
-    generalize (alloc_unmapped_inject _ _ _ _ _ _ _ MINJ H).
+    exploit alloc_unmapped_inject; eauto.
     set (f1 := extend_inject b1 None f). intros [MINJ1 INCR1].
-    assert (MATCH1: match_callstack f1
-             (mkframe cenv1 (PTree.set id (b1, lv) e) te sp lo (nextblock m1) :: cs)
-             (nextblock m1) (nextblock tm) m1).
-    unfold f1; rewrite <- H2; eapply match_callstack_alloc_left; eauto.
-    assert (BOUND1: forall b delta, f1 b = Some(sp, delta) ->
-                                    high_bound m1 b + delta <= sz).
+    exploit IHalloc_variables; eauto.
+      unfold f1; rewrite <- H2; eapply match_callstack_alloc_left; eauto.
       intros until delta; unfold f1, extend_inject, eq_block.
       rewrite (high_bound_alloc _ _ b _ _ _ H).
       case (zeq b b1); intros. discriminate.
       eapply BOUND; eauto.
-    generalize (IHalloc_variables _ _ _ ASVS MATCH1 MINJ1 SZPOS BOUND1 DEFINED1).
     intros [f' [INCR2 [MINJ2 MATCH2]]].
     exists f'; intuition. eapply inject_incr_trans; eauto. 
   (* 2. lv = LVarray dim, info = Var_stack_array *)
@@ -1273,20 +1362,15 @@ Proof.
     unfold f1; eapply alloc_mapped_inject; eauto.
     omega. omega. omega. omega. unfold sizeof; rewrite LV. omega. 
     intros. left. generalize (BOUND _ _ H8). omega. 
-    elim H6; intros MINJ1 INCR1; clear H6.
-    assert (MATCH1: match_callstack f1
-             (mkframe cenv1 (PTree.set id (b1, lv) e) te sp lo (nextblock m1) :: cs)
-             (nextblock m1) (nextblock tm) m1).
+  destruct H6 as [MINJ1 INCR1].
+  exploit IHalloc_variables; eauto.  
     unfold f1; rewrite <- H2; eapply match_callstack_alloc_left; eauto.
-    assert (SZ1POS: 0 <= sz1). rewrite <- H1. omega.
-    assert (BOUND1: forall b delta, f1 b = Some(sp, delta) ->
-                                    high_bound m1 b + delta <= sz1).
-      intros until delta; unfold f1, extend_inject, eq_block.
-      rewrite (high_bound_alloc _ _ b _ _ _ H).
-      case (zeq b b1); intros. 
-      inversion H6. unfold sizeof; rewrite LV. omega.
-      generalize (BOUND _ _ H6). omega. 
-    generalize (IHalloc_variables _ _ _ ASVS MATCH1 MINJ1 SZ1POS BOUND1 DEFINED1).
+    rewrite <- H1. omega.
+    intros until delta; unfold f1, extend_inject, eq_block.
+    rewrite (high_bound_alloc _ _ b _ _ _ H).
+    case (zeq b b1); intros. 
+    inversion H6. unfold sizeof; rewrite LV. omega.
+    generalize (BOUND _ _ H6). omega. 
     intros [f' [INCR2 [MINJ2 MATCH2]]].
     exists f'; intuition. eapply inject_incr_trans; eauto. 
 Qed.
@@ -1370,15 +1454,15 @@ Proof.
     (* me_inj *)
     intros until lv2. unfold Csharpminor.empty_env; rewrite PTree.gempty; congruence.
     (* me_inv *)
-    intros. elim (mi_mappedblocks _ _ _ H4 _ _ _ H5); intros.
-    elim (fresh_block_alloc _ _ _ _ _ H2 H6).
+    intros. exploit mi_mappedblocks; eauto. intros [A B].
+    elim (fresh_block_alloc _ _ _ _ _ H2 A).
     (* me_incr *)
-    intros. elim (mi_mappedblocks _ _ _ H4 _ _ _ H5); intros.
+    intros. exploit mi_mappedblocks; eauto. intros [A B].
     rewrite SP; auto.
   rewrite SP; auto.
   eapply alloc_right_inject; eauto.
   omega.
-  intros. elim (mi_mappedblocks _ _ _ H4 _ _ _ H5); intros.
+  intros. exploit mi_mappedblocks; eauto. intros [A B].
   unfold block in SP; omegaContradiction.
   (* defined *)
   intros. unfold te. apply set_locals_params_defined. 
@@ -1421,7 +1505,7 @@ Proof.
     unfold block; rewrite H2; omega.
   elim H4; intro. left; congruence. right; auto.
   elim H3; intro. subst b b1. 
-  generalize (alloc_variables_nextblock_incr _ _ _ _ _ _ H0). 
+  generalize (alloc_variables_nextblock_incr _ _ _ _ _ _ H0).
   rewrite H2. omega.
   generalize (B H4). rewrite H2. omega.
 Qed.
@@ -1465,7 +1549,7 @@ Lemma store_parameters_correct:
   exists te2, exists tm2,
      exec_stmt tge (Vptr sp Int.zero)
                    te1 tm1 (store_parameters cenv params)
-                   te2 tm2 Out_normal
+                E0 te2 tm2 Out_normal
   /\ mem_inject f m2 tm2
   /\ match_callstack f (mkframe cenv e te2 sp lo hi :: cs) m2.(nextblock) tm2.(nextblock) m2.
 Proof.
@@ -1476,59 +1560,54 @@ Proof.
   intros until tm1.  intros VVM NOREPET MINJ MATCH. simpl.
   inversion VVM. subst f0 id0 chunk0 vars v vals te.
   inversion MATCH. subst f0 cenv0 e0 te sp0 lo0 hi0 cs0 bound tbound m0.
-  inversion H19. 
+  inversion H18.
   inversion NOREPET. subst hd tl.
   assert (NEXT: nextblock m1 = nextblock m).
-    generalize (store_inv _ _ _ _ _ _ H1). simpl; tauto. 
-  generalize (me_vars0 id). intro. inversion H3; subst.
+    exploit store_inv; eauto. simpl; tauto.
+  generalize (me_vars0 id). intro. inversion H2; subst.
   (* cenv!!id = Var_local chunk *)
   assert (b0 = b). congruence. subst b0.
   assert (chunk0 = chunk). congruence. subst chunk0.
   assert (v' = tv). congruence. subst v'.
-  assert (eval_expr tge (Vptr sp Int.zero) nil te1 tm1 (Evar id) te1 tm1 tv).
-    constructor. auto.
-  generalize (make_cast_correct _ _ _ _ _ _ _ _ _ _ _ _
-               H15 H0 H11).
-  intros [tv' [EVAL1 [VINJ1 VNORM]]].
+  exploit make_cast_correct.
+    apply eval_Evar with (id := id). eauto.
+    eexact H10. 
+  intros [tv' [EVAL1 VINJ1]].
   set (te2 := PTree.set id tv' te1).
   assert (VVM2: vars_vals_match f params vl te2).
     apply vars_vals_match_extensional with te1; auto.
     intros. unfold te2; apply PTree.gso. red; intro; subst id0.
-    elim H5. change id with (fst (id, lv)). apply List.in_map; auto.
-  generalize (store_unmapped_inject _ _ _ _ _ _ _ _ MINJ H1 H9); intro MINJ2.
-  generalize (match_callstack_store_local _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-                H VINJ1 VNORM H1 MATCH); 
+    elim H4. change id with (fst (id, lv)). apply List.in_map; auto.
+  exploit store_unmapped_inject; eauto. intro MINJ2.
+  exploit match_callstack_store_local; eauto. 
   fold te2; rewrite <- NEXT; intro MATCH2.
-  destruct (IHbind_parameters _ _ _ _ _ _ _ _ VVM2 H6 MINJ2 MATCH2)
-        as [te3 [tm3 [EXEC3 [MINJ3 MATCH3]]]].
+  exploit IHbind_parameters; eauto.
+  intros [te3 [tm3 [EXEC3 [MINJ3 MATCH3]]]].
   exists te3; exists tm3. 
   (* execution *)
-  split. apply exec_Sseq_continue with te2 tm1. 
-  econstructor. unfold te2. constructor. assumption. 
-  assumption.
+  split. apply exec_Sseq_continue with E0 te2 tm1 E0. 
+  econstructor. unfold te2. constructor. eassumption. 
+  assumption. traceEq.
   (* meminj & match_callstack *)
   tauto.
 
   (* cenv!!id = Var_stack_scalar *)
   assert (b0 = b). congruence. subst b0.
   assert (chunk0 = chunk). congruence. subst chunk0.
-  pose (EVAL1 := make_stackaddr_correct sp nil te1 tm1 ofs).
-  assert (EVAL2: eval_expr tge (Vptr sp Int.zero) nil te1 tm1 (Evar id) te1 tm1 tv).
-    constructor. auto.
-  destruct (make_store_correct _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-              (Vptr b Int.zero) _
-              EVAL1 EVAL2 H0 H1 MINJ H8 H11) 
-  as [tm2 [tv' [EVAL3 [MINJ2 [VINJ NEXT1]]]]].
-  assert (f b <> None). inversion H8. congruence.
-  generalize (match_callstack_mapped _ _ _ _ _ MATCH _ _ _ _ _ H9 H1).
+  exploit make_store_correct.
+    eapply make_stackaddr_correct.
+    apply eval_Evar with (id := id).
+    eauto. 2:eauto. 2:eauto. unfold storev; eexact H0. eauto.
+  intros [tm2 [EVAL3 [MINJ2 NEXT1]]].
+  exploit match_callstack_mapped.
+    eexact MATCH. 2:eauto. inversion H7. congruence. 
   rewrite <- NEXT; rewrite <- NEXT1; intro MATCH2.
-  destruct (IHbind_parameters _ _ _ _ _ _ _ _
-              H12 H6 MINJ2 MATCH2) as [te3 [tm3 [EVAL4 [MINJ3 MATCH3]]]].
+  exploit IHbind_parameters; eauto.
+  intros  [te3 [tm3 [EVAL4 [MINJ3 MATCH3]]]].
   exists te3; exists tm3.
   (* execution *)
-  split. apply exec_Sseq_continue with te1 tm2. 
-  econstructor. eauto.
-  assumption.
+  split. apply exec_Sseq_continue with (E0**E0) te1 tm2 E0. 
+  auto. assumption. traceEq.
   (* meminj & match_callstack *)
   tauto.
 
@@ -1589,44 +1668,6 @@ Proof.
   induction 1; simpl; eauto.
 Qed.
 
-(****
-Lemma build_compilenv_domain:
-  forall f id chunk,
-  In (id, chunk) f.(Csharpminor.fn_params) -> 
-  (fst (build_compilenv gce f))!id <> None.
-Proof.
-  assert (forall atk id lv cenv_sz id0,
-    let cenv_sz' := assign_variable atk (id, lv) cenv_sz in
-    (fst cenv_sz')!id <> None
-    /\ ((fst cenv_sz)!id0 <> None -> (fst cenv_sz')!id0 <> None)).
-  intros. unfold cenv_sz'. destruct cenv_sz as [cenv sz].
-  unfold assign_variable. destruct lv.
-  case (Identset.mem id atk); simpl. split. rewrite PTree.gss. congruence.
-  rewrite PTree.gsspec. case (peq id0 id); intros. congruence. auto.
-  split. rewrite PTree.gss. congruence.
-  rewrite PTree.gsspec. case (peq id0 id); intros. congruence. auto.
-  simpl. split. rewrite PTree.gss. congruence.
-  rewrite PTree.gsspec. case (peq id0 id); intros. congruence. auto.
-
-  assert (forall atk id_lv_list cenv_sz id lv,
-    In (id, lv) id_lv_list \/ (fst cenv_sz)!id <> None ->
-    (fst (assign_variables atk id_lv_list cenv_sz))!id <> None).
-  induction id_lv_list; simpl; intros. 
-  tauto.
-  apply IHid_lv_list with lv. 
-  destruct a as [id0 lv0].
-  generalize (H atk id0 lv0 cenv_sz id). 
-  simpl. intro. intuition. injection H0; intros; subst id0 lv0. intuition. 
-
-  intros. unfold build_compilenv. apply H0 with (Vscalar chunk). 
-  left. unfold fn_variables. apply List.in_or_app. left. 
-  set (g := fun (id_chunk : ident * memory_chunk) => (fst id_chunk, Vscalar (snd id_chunk))).
-  change positive with ident.
-  change (id, Vscalar chunk) with (g (id, chunk)). 
-  apply List.in_map. auto.
-Qed.
-****)
-
 (** The final result in this section: the behaviour of function entry
   in the generated Cminor code (allocate stack data block and store
   parameters whose address is taken) simulates what happens at function
@@ -1649,7 +1690,7 @@ Lemma function_entry_ok:
   exists f2, exists te2, exists tm2,
      exec_stmt tge (Vptr sp Int.zero)
                te tm1 (store_parameters cenv fn.(Csharpminor.fn_params))
-               te2 tm2 Out_normal
+            E0 te2 tm2 Out_normal
   /\ mem_inject f2 m2 tm2
   /\ inject_incr f f2
   /\ match_callstack f2
@@ -1658,24 +1699,21 @@ Lemma function_entry_ok:
   /\ (forall b, m.(nextblock) <= b < m1.(nextblock) <-> In b lb).
 Proof.
   intros. 
-  generalize (bind_parameters_length _ _ _ _ _ H0); intro LEN1.
-  destruct (match_callstack_alloc_variables _ _ _ _ _ _ _ _ _ _ _ _ tvargs
-              H2 H3 H H4 H1 H6)
-  as [f1 [INCR1 [MINJ1 MATCH1]]].
-  fold te in MATCH1. 
-  assert (VLI: val_list_inject f1 vargs tvargs).
-    eapply val_list_inject_incr; eauto.
-  generalize (vars_vals_match_holds _ _ _ _ LEN1 VLI _ 
-                (list_norepet_append_commut _ _ H7)).
-  fold te. intro VVM.
-  assert (NOREPET: list_norepet (List.map (@fst ident memory_chunk) fn.(Csharpminor.fn_params))).
-    unfold fn_params_names in H7.
-    eapply list_norepet_append_left; eauto.
-  destruct (store_parameters_correct _ _ _ _ _ H0 _ _ _ _ _ _ _ _
-                    VVM NOREPET MINJ1 MATCH1)
-  as [te2 [tm2 [EXEC [MINJ2 MATCH2]]]].
+  exploit bind_parameters_length; eauto. intro LEN1.
+  exploit match_callstack_alloc_variables; eauto.
+  intros [f1 [INCR1 [MINJ1 MATCH1]]].
+  exploit vars_vals_match_holds.
+    eauto. apply val_list_inject_incr with f. eauto. eauto. 
+    apply list_norepet_append_commut. 
+    unfold fn_vars_names in H7. eexact H7.
+  intro VVM.
+  exploit store_parameters_correct.
+    eauto. eauto. 
+    unfold fn_params_names in H7. eapply list_norepet_append_left; eauto.
+    eexact MINJ1. eauto. 
+  intros [te2 [tm2 [EXEC [MINJ2 MATCH2]]]].
   exists f1; exists te2; exists tm2.
-  split. auto. split. auto. split. auto. split. auto.
+  split; auto. split; auto. split; auto. split; auto.
   intros; eapply alloc_variables_list_block; eauto. 
 Qed.
 
@@ -1745,7 +1783,7 @@ Ltac monadInv H :=
   hypotheses in the proof of simulation. *)
 
 Definition eval_expr_prop
-    (le: Csharpminor.letenv) (e: Csharpminor.env) (m1: mem) (a: Csharpminor.expr) (m2: mem) (v: val) : Prop :=
+    (le: Csharpminor.letenv) (e: Csharpminor.env) (m1: mem) (a: Csharpminor.expr) (t: trace) (m2: mem) (v: val) : Prop :=
   forall cenv ta f1 tle te1 tm1 sp lo hi cs
   (TR: transl_expr cenv a = Some ta)
   (LINJ: val_list_inject f1 le tle)
@@ -1754,7 +1792,7 @@ Definition eval_expr_prop
            (mkframe cenv e te1 sp lo hi :: cs)
            m1.(nextblock) tm1.(nextblock) m1),
   exists f2, exists te2, exists tm2, exists tv,
-     eval_expr tge (Vptr sp Int.zero) tle te1 tm1 ta te2 tm2 tv
+     eval_expr tge (Vptr sp Int.zero) tle te1 tm1 ta t te2 tm2 tv
   /\ val_inject f2 v tv
   /\ mem_inject f2 m2 tm2
   /\ inject_incr f1 f2
@@ -1763,7 +1801,7 @@ Definition eval_expr_prop
         m2.(nextblock) tm2.(nextblock) m2.
 
 Definition eval_exprlist_prop
-    (le: Csharpminor.letenv) (e: Csharpminor.env) (m1: mem) (al: Csharpminor.exprlist) (m2: mem) (vl: list val) : Prop :=
+    (le: Csharpminor.letenv) (e: Csharpminor.env) (m1: mem) (al: Csharpminor.exprlist) (t: trace) (m2: mem) (vl: list val) : Prop :=
   forall cenv tal f1 tle te1 tm1 sp lo hi cs
   (TR: transl_exprlist cenv al = Some tal)
   (LINJ: val_list_inject f1 le tle)
@@ -1772,7 +1810,7 @@ Definition eval_exprlist_prop
            (mkframe cenv e te1 sp lo hi :: cs)
            m1.(nextblock) tm1.(nextblock) m1),
   exists f2, exists te2, exists tm2, exists tvl,
-     eval_exprlist tge (Vptr sp Int.zero) tle te1 tm1 tal te2 tm2 tvl
+     eval_exprlist tge (Vptr sp Int.zero) tle te1 tm1 tal t te2 tm2 tvl
   /\ val_list_inject f2 vl tvl
   /\ mem_inject f2 m2 tm2
   /\ inject_incr f1 f2
@@ -1781,14 +1819,14 @@ Definition eval_exprlist_prop
         m2.(nextblock) tm2.(nextblock) m2.
 
 Definition eval_funcall_prop
-    (m1: mem) (fn: Csharpminor.function) (args: list val) (m2: mem) (res: val) : Prop :=
+    (m1: mem) (fn: Csharpminor.fundef) (args: list val) (t: trace) (m2: mem) (res: val) : Prop :=
   forall tfn f1 tm1 cs targs
-  (TR: transl_function gce fn = Some tfn)
+  (TR: transl_fundef gce fn = Some tfn)
   (MINJ: mem_inject f1 m1 tm1)
   (MATCH: match_callstack f1 cs m1.(nextblock) tm1.(nextblock) m1)
   (ARGSINJ: val_list_inject f1 args targs),
   exists f2, exists tm2, exists tres,
-     eval_funcall tge tm1 tfn targs tm2 tres
+     eval_funcall tge tm1 tfn targs t tm2 tres
   /\ val_inject f2 res tres
   /\ mem_inject f2 m2 tm2
   /\ inject_incr f1 f2
@@ -1807,7 +1845,7 @@ Inductive outcome_inject (f: meminj) : Csharpminor.outcome -> outcome -> Prop :=
       outcome_inject f (Csharpminor.Out_return (Some v1)) (Out_return (Some v2)).
 
 Definition exec_stmt_prop
-    (e: Csharpminor.env) (m1: mem) (s: Csharpminor.stmt) (m2: mem) (out: Csharpminor.outcome): Prop :=
+    (e: Csharpminor.env) (m1: mem) (s: Csharpminor.stmt) (t: trace) (m2: mem) (out: Csharpminor.outcome): Prop :=
   forall cenv ts f1 te1 tm1 sp lo hi cs
   (TR: transl_stmt cenv s = Some ts)
   (MINJ: mem_inject f1 m1 tm1)
@@ -1815,7 +1853,7 @@ Definition exec_stmt_prop
            (mkframe cenv e te1 sp lo hi :: cs)
            m1.(nextblock) tm1.(nextblock) m1),
   exists f2, exists te2, exists tm2, exists tout,
-     exec_stmt tge (Vptr sp Int.zero) te1 tm1 ts te2 tm2 tout
+     exec_stmt tge (Vptr sp Int.zero) te1 tm1 ts t te2 tm2 tout
   /\ outcome_inject f2 out tout
   /\ mem_inject f2 m2 tm2
   /\ inject_incr f1 f2
@@ -1823,14 +1861,6 @@ Definition exec_stmt_prop
         (mkframe cenv e te2 sp lo hi :: cs)
         m2.(nextblock) tm2.(nextblock) m2.
 
-(*
-Check (eval_funcall_ind4 prog
-     eval_expr_prop
-     eval_exprlist_prop
-     eval_funcall_prop
-     exec_stmt_prop).
-*)
-
 (** There are as many cases in the inductive proof as there are evaluation
   rules in the Csharpminor semantics.  We treat each case as a separate
   lemma. *)
@@ -1841,33 +1871,12 @@ Lemma transl_expr_Evar_correct:
      (b : block) (chunk : memory_chunk) (v : val),
    eval_var_ref prog e id b chunk ->
    load chunk m b 0 = Some v ->
-   eval_expr_prop le e m (Csharpminor.Evar id) m v.
+   eval_expr_prop le e m (Csharpminor.Evar id) E0 m v.
 Proof.
   intros; red; intros. unfold transl_expr in TR.
-  generalize (var_get_correct _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ tle
-               TR MATCH MINJ H H0).
+  exploit var_get_correct; eauto.
   intros [tv [EVAL VINJ]].
-  exists f1; exists te1; exists tm1; exists tv; intuition.
-Qed.
-
-Lemma transl_expr_Eassign_correct:
-   forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (id : positive) (a : Csharpminor.expr) (m1 : mem) (b : block)
-     (chunk : memory_chunk) (v1 v2 : val) (m2 : mem),
-   Csharpminor.eval_expr prog le e m a m1 v1 ->
-   eval_expr_prop le e m a m1 v1 ->
-   eval_var_ref prog e id b chunk ->
-   cast chunk v1 = Some v2 ->
-   store chunk m1 b 0 v2 = Some m2 ->
-   eval_expr_prop le e m (Csharpminor.Eassign id a) m2 v2.
-Proof.
-  intros; red; intros. monadInv TR; intro EQ0. 
-  generalize (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH).
-  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR12 MATCH1]]]]]]]].
-  generalize (var_set_correct _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-                EQ0 MATCH1 EVAL1 VINJ1 MINJ1 H1 H2 H3).
-  intros [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 MATCH2]]]]]].
-  exists f2; exists te3; exists tm3; exists tv2. tauto.
+  exists f1; exists te1; exists tm1; exists tv; intuition eauto.
 Qed.
 
 Lemma transl_expr_Eaddrof_correct:
@@ -1875,199 +1884,162 @@ Lemma transl_expr_Eaddrof_correct:
      (e : Csharpminor.env) (m : mem) (id : positive)
      (b : block),
    eval_var_addr prog e id b ->
-   eval_expr_prop le e m (Eaddrof id) m (Vptr b Int.zero).
+   eval_expr_prop le e m (Eaddrof id) E0 m (Vptr b Int.zero).
 Proof.
   intros; red; intros. simpl in TR. 
-  generalize (var_addr_correct _ _ _ _ _ _ _ _ _ _ _ _ _ tle
-                MATCH TR H).
+  exploit var_addr_correct; eauto.
   intros [tv [EVAL VINJ]].
-  exists f1; exists te1; exists tm1; exists tv. intuition.
+  exists f1; exists te1; exists tm1; exists tv. intuition eauto.
 Qed.
 
 Lemma transl_expr_Eop_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (op : Csharpminor.operation) (al : Csharpminor.exprlist) (m1 : mem)
-     (vl : list val) (v : val),
-   Csharpminor.eval_exprlist prog le e m al m1 vl ->
-   eval_exprlist_prop le e m al m1 vl ->
+     (op : Csharpminor.operation) (al : Csharpminor.exprlist) 
+     (t: trace) (m1 : mem) (vl : list val) (v : val),
+   Csharpminor.eval_exprlist prog le e m al t m1 vl ->
+   eval_exprlist_prop le e m al t m1 vl ->
    Csharpminor.eval_operation op vl m1 = Some v ->
-   eval_expr_prop le e m (Csharpminor.Eop op al) m1 v.
+   eval_expr_prop le e m (Csharpminor.Eop op al) t m1 v.
 Proof.
   intros; red; intros. monadInv TR; intro EQ0.
-  generalize (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH).
+  exploit H0; eauto.
   intros [f2 [te2 [tm2 [tvl [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
-  generalize (make_op_correct _ _ _ _ _ _ _ _ _ _ _ _ _ _
-                 EQ0 H1 EVAL1 VINJ1 MINJ1).
+  exploit make_op_correct; eauto.
   intros [tv [EVAL2 VINJ2]].
   exists f2; exists te2; exists tm2; exists tv. intuition.
 Qed.
 
 Lemma transl_expr_Eload_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (chunk : memory_chunk) (a : Csharpminor.expr) (m1 : mem)
+     (chunk : memory_chunk) (a : Csharpminor.expr) (t: trace) (m1 : mem)
      (v1 v : val),
-   Csharpminor.eval_expr prog le e m a m1 v1 ->
-   eval_expr_prop le e m a m1 v1 ->
+   Csharpminor.eval_expr prog le e m a t m1 v1 ->
+   eval_expr_prop le e m a t m1 v1 ->
    loadv chunk m1 v1 = Some v ->
-   eval_expr_prop le e m (Csharpminor.Eload chunk a) m1 v.
+   eval_expr_prop le e m (Csharpminor.Eload chunk a) t m1 v.
 Proof.
   intros; red; intros.
   monadInv TR. 
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]]].
-  destruct (loadv_inject _ _ _ _ _ _ _ MINJ2 H1 VINJ1)
-  as [tv [TLOAD VINJ]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]]].
+  exploit loadv_inject; eauto. 
+  intros [tv [TLOAD VINJ]].
   exists f2; exists te2; exists tm2; exists tv.
   intuition.
   subst ta. eapply make_load_correct; eauto. 
 Qed.
 
-Lemma transl_expr_Estore_correct:
-   forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (chunk : memory_chunk) (a b : Csharpminor.expr) (m1 : mem)
-     (v1 : val) (m2 : mem) (v2 : val) (m3 : mem) (v3 : val),
-   Csharpminor.eval_expr prog le e m a m1 v1 ->
-   eval_expr_prop le e m a m1 v1 ->
-   Csharpminor.eval_expr prog le e m1 b m2 v2 ->
-   eval_expr_prop le e m1 b m2 v2 ->
-   cast chunk v2 = Some v3 ->
-   storev chunk m2 v1 v3 = Some m3 ->
-   eval_expr_prop le e m (Csharpminor.Estore chunk a b) m3 v3.
-Proof.
-  intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
-  assert (LINJ2: val_list_inject f2 le tle). eapply val_list_inject_incr; eauto.
-  destruct (H2 _ _ _ _ _ _ _ _ _ _ EQ0 LINJ2 MINJ2 MATCH2)
-  as [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
-  assert (VINJ1': val_inject f3 v1 tv1). eapply val_inject_incr; eauto.
-  destruct (make_store_correct _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-              EVAL1 EVAL2 H3 H4 MINJ3 VINJ1' VINJ2)
-  as [tm4 [tv [EVAL [MINJ4 [VINJ4 NEXTBLOCK]]]]].
-  exists f3; exists te3; exists tm4; exists tv.
-  rewrite <- H6. intuition. 
-  eapply inject_incr_trans; eauto.
-  assert (val_inject f3 v1 tv1). eapply val_inject_incr; eauto.
-  unfold storev in H4; destruct v1; try discriminate.
-  inversion H5. 
-  rewrite NEXTBLOCK. replace (nextblock m3) with (nextblock m2).
-  eapply match_callstack_mapped; eauto. congruence. 
-  generalize (store_inv _ _ _ _ _ _ H4). simpl; symmetry; tauto.
-Qed.
-
-Lemma sig_transl_function:
-  forall f tf, transl_function gce f = Some tf -> tf.(fn_sig) = f.(Csharpminor.fn_sig).
-Proof.
-  intros f tf. unfold transl_function.
-  destruct (build_compilenv gce f).
-  case (zle z Int.max_signed); intros. 
-  monadInv H. subst tf; reflexivity.
-  congruence.
-Qed.
-
 Lemma transl_expr_Ecall_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
      (sig : signature) (a : Csharpminor.expr) (bl : Csharpminor.exprlist)
-     (m1 m2 m3 : mem) (vf : val) (vargs : list val) (vres : val)
-     (f : Csharpminor.function),
-   Csharpminor.eval_expr prog le e m a m1 vf ->
-   eval_expr_prop le e m a m1 vf ->
-   Csharpminor.eval_exprlist prog le e m1 bl m2 vargs ->
-   eval_exprlist_prop le e m1 bl m2 vargs ->
+     (t1: trace) (m1: mem) (t2: trace) (m2: mem) (t3: trace) (m3: mem) 
+     (vf : val) (vargs : list val) (vres : val)
+     (f : Csharpminor.fundef) (t: trace),
+   Csharpminor.eval_expr prog le e m a t1 m1 vf ->
+   eval_expr_prop le e m a t1 m1 vf ->
+   Csharpminor.eval_exprlist prog le e m1 bl t2 m2 vargs ->
+   eval_exprlist_prop le e m1 bl t2 m2 vargs ->
    Genv.find_funct ge vf = Some f ->
-   Csharpminor.fn_sig f = sig ->
-   Csharpminor.eval_funcall prog m2 f vargs m3 vres ->
-   eval_funcall_prop m2 f vargs m3 vres ->
-   eval_expr_prop le e m (Csharpminor.Ecall sig a bl) m3 vres.
+   Csharpminor.funsig f = sig ->
+   Csharpminor.eval_funcall prog m2 f vargs t3 m3 vres ->
+   eval_funcall_prop m2 f vargs t3 m3 vres ->
+   t = t1 ** t2 ** t3 ->
+   eval_expr_prop le e m (Csharpminor.Ecall sig a bl) t m3 vres.
 Proof.
   intros;red;intros. monadInv TR. subst ta. 
-  generalize (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH).
+  exploit H0; eauto.
   intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
-  assert (LINJ1: val_list_inject f2 le tle). eapply val_list_inject_incr; eauto.
-  generalize (H2 _ _ _ _ _ _ _ _ _ _ EQ0 LINJ1 MINJ1 MATCH1).
+  exploit H2.
+    eauto. eapply val_list_inject_incr; eauto. eauto. eauto. 
   intros [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]]].
   assert (tv1 = vf).
     elim (Genv.find_funct_inv H3). intros bf VF. rewrite VF in H3.
     rewrite Genv.find_funct_find_funct_ptr in H3. 
     generalize (Genv.find_funct_ptr_inv H3). intro.
     assert (match_globalenvs f2). eapply match_callstack_match_globalenvs; eauto.
-    generalize (mg_functions _ H8 _ H7). intro.
+    generalize (mg_functions _ H9 _ H8). intro.
     rewrite VF in VINJ1. inversion VINJ1. subst vf. 
     decEq. congruence. 
     subst ofs2. replace x with 0. reflexivity. congruence.
   subst tv1. elim (functions_translated _ _ H3). intros tf [FIND TRF].
-  generalize (H6 _ _ _ _ _ TRF MINJ2 MATCH2 VINJ2).
+  exploit H6; eauto.
   intros [f4 [tm4 [tres [EVAL3 [VINJ3 [MINJ3 [INCR3 MATCH3]]]]]]].
   exists f4; exists te3; exists tm4; exists tres. intuition.
-  eapply eval_Ecall; eauto. rewrite <- H4. apply sig_transl_function; auto.
+  eapply eval_Ecall; eauto. 
+  rewrite <- H4. apply sig_preserved; auto.
   apply inject_incr_trans with f2; auto. 
   apply inject_incr_trans with f3; auto.
 Qed.
 
 Lemma transl_expr_Econdition_true_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (a b c : Csharpminor.expr) (m1 : mem) (v1 : val) (m2 : mem)
-     (v2 : val),
-   Csharpminor.eval_expr prog le e m a m1 v1 ->
-   eval_expr_prop le e m a m1 v1 ->
+     (a b c : Csharpminor.expr) (t1: trace) (m1 : mem) (v1 : val)
+     (t2: trace) (m2 : mem) (v2 : val) (t: trace),
+   Csharpminor.eval_expr prog le e m a t1 m1 v1 ->
+   eval_expr_prop le e m a t1 m1 v1 ->
    Val.is_true v1 ->
-   Csharpminor.eval_expr prog le e m1 b m2 v2 ->
-   eval_expr_prop le e m1 b m2 v2 ->
-   eval_expr_prop le e m (Csharpminor.Econdition a b c) m2 v2.
+   Csharpminor.eval_expr prog le e m1 b t2 m2 v2 ->
+   eval_expr_prop le e m1 b t2 m2 v2 ->
+   t = t1 ** t2 ->
+   eval_expr_prop le e m (Csharpminor.Econdition a b c) t m2 v2.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
-  assert (LINJ1: val_list_inject f2 le tle). eapply val_list_inject_incr; eauto.
-  destruct (H3 _ _ _ _ _ _ _ _ _ _ EQ0 LINJ1 MINJ1 MATCH1)
-  as [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
+  exploit H3.
+    eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
+  intros [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]]].
   exists f3; exists te3; exists tm3; exists tv2.
   intuition.
-  rewrite <- H5. eapply eval_conditionalexpr_true; eauto. 
+  rewrite <- H6. subst t; eapply eval_conditionalexpr_true; eauto. 
   inversion VINJ1; subst v1 tv1; simpl in H1; simpl; contradiction || auto.
   eapply inject_incr_trans; eauto.
 Qed.
 
 Lemma transl_expr_Econdition_false_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (a b c : Csharpminor.expr) (m1 : mem) (v1 : val) (m2 : mem)
-     (v2 : val),
-   Csharpminor.eval_expr prog le e m a m1 v1 ->
-   eval_expr_prop le e m a m1 v1 ->
+     (a b c : Csharpminor.expr) (t1: trace) (m1 : mem) (v1 : val)
+     (t2: trace) (m2 : mem) (v2 : val) (t: trace),
+   Csharpminor.eval_expr prog le e m a t1 m1 v1 ->
+   eval_expr_prop le e m a t1 m1 v1 ->
    Val.is_false v1 ->
-   Csharpminor.eval_expr prog le e m1 c m2 v2 ->
-   eval_expr_prop le e m1 c m2 v2 ->
-   eval_expr_prop le e m (Csharpminor.Econdition a b c) m2 v2.
+   Csharpminor.eval_expr prog le e m1 c t2 m2 v2 ->
+   eval_expr_prop le e m1 c t2 m2 v2 ->
+   t = t1 ** t2 ->
+   eval_expr_prop le e m (Csharpminor.Econdition a b c) t m2 v2.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
-  assert (LINJ1: val_list_inject f2 le tle). eapply val_list_inject_incr; eauto.
-  destruct (H3 _ _ _ _ _ _ _ _ _ _ EQ1 LINJ1 MINJ1 MATCH1)
-  as [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
+  exploit H3.
+    eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
+  intros [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]]].
   exists f3; exists te3; exists tm3; exists tv2.
   intuition.
-  rewrite <- H5. eapply eval_conditionalexpr_false; eauto. 
+  rewrite <- H6. subst t; eapply eval_conditionalexpr_false; eauto. 
   inversion VINJ1; subst v1 tv1; simpl in H1; simpl; contradiction || auto.
   eapply inject_incr_trans; eauto.
 Qed.
 
 Lemma transl_expr_Elet_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (a b : Csharpminor.expr) (m1 : mem) (v1 : val) (m2 : mem) (v2 : val),
-   Csharpminor.eval_expr prog le e m a m1 v1 ->
-   eval_expr_prop le e m a m1 v1 ->
-   Csharpminor.eval_expr prog (v1 :: le) e m1 b m2 v2 ->
-   eval_expr_prop (v1 :: le) e m1 b m2 v2 ->
-   eval_expr_prop le e m (Csharpminor.Elet a b) m2 v2.
+     (a b : Csharpminor.expr) (t1: trace) (m1 : mem) (v1 : val)
+     (t2: trace) (m2 : mem) (v2 : val) (t: trace),
+   Csharpminor.eval_expr prog le e m a t1 m1 v1 ->
+   eval_expr_prop le e m a t1 m1 v1 ->
+   Csharpminor.eval_expr prog (v1 :: le) e m1 b t2 m2 v2 ->
+   eval_expr_prop (v1 :: le) e m1 b t2 m2 v2 ->
+   t = t1 ** t2 ->
+   eval_expr_prop le e m (Csharpminor.Elet a b) t m2 v2.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
-  assert (LINJ1: val_list_inject f2 (v1 :: le) (tv1 :: tle)).
-    constructor. auto. eapply val_list_inject_incr; eauto.
-  destruct (H2 _ _ _ _ _ _ _ _ _ _ EQ0 LINJ1 MINJ1 MATCH1)
-  as [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR1 MATCH1]]]]]]]].
+  exploit H2.
+    eauto. 
+    constructor. eauto. eapply val_list_inject_incr; eauto.
+    eauto. eauto.
+  intros [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ2 [INCR2 MATCH2]]]]]]]].
   exists f3; exists te3; exists tm3; exists tv2.
   intuition.
   subst ta; eapply eval_Elet; eauto.
@@ -2089,19 +2061,46 @@ Lemma transl_expr_Eletvar_correct:
    forall (le : list val) (e : Csharpminor.env) (m : mem) (n : nat)
      (v : val),
    nth_error le n = Some v ->
-   eval_expr_prop le e m (Csharpminor.Eletvar n) m v.
+   eval_expr_prop le e m (Csharpminor.Eletvar n) E0 m v.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (val_list_inject_nth _ _ _ LINJ _ _ H)
-  as [tv [A B]].
+  exploit val_list_inject_nth; eauto. intros [tv [A B]].
   exists f1; exists te1; exists tm1; exists tv.
   intuition.
   subst ta. eapply eval_Eletvar; auto.
 Qed.
 
+Lemma transl_expr_Ealloc_correct:
+  forall (le: list val) (e: Csharpminor.env) (m1: mem) (a: Csharpminor.expr)
+         (t: trace) (m2: mem) (n: int) (m3: mem) (b: block),
+  Csharpminor.eval_expr prog le e m1 a t m2 (Vint n) ->
+  eval_expr_prop le e m1 a t m2 (Vint n) ->
+  Mem.alloc m2 0 (Int.signed n) = (m3, b) ->
+  eval_expr_prop le e m1 (Csharpminor.Ealloc a) t m3 (Vptr b Int.zero).
+Proof.
+  intros; red; intros. monadInv TR. 
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  inversion VINJ1. subst tv1 i. 
+  caseEq (alloc tm2 0 (Int.signed n)). intros tm3 tb TALLOC.
+  assert (LB: Int.min_signed <= 0). compute. congruence.
+  assert (HB: Int.signed n <= Int.max_signed). 
+    generalize (Int.signed_range n); omega.
+  exploit alloc_parallel_inject; eauto.
+  intros [MINJ3 INCR3].
+  exists (extend_inject b (Some (tb, 0)) f2); 
+  exists te2; exists tm3; exists (Vptr tb Int.zero).
+  split. subst ta; econstructor; eauto.
+  split. econstructor. unfold extend_inject, eq_block. rewrite zeq_true. reflexivity.
+  reflexivity.
+  split. assumption.
+  split. eapply inject_incr_trans; eauto. 
+  eapply match_callstack_alloc; eauto.
+Qed.
+
 Lemma transl_exprlist_Enil_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem),
-   eval_exprlist_prop le e m Csharpminor.Enil m nil.
+   eval_exprlist_prop le e m Csharpminor.Enil E0 m nil.
 Proof.
   intros; red; intros. monadInv TR. 
   exists f1; exists te1; exists tm1; exists (@nil val).
@@ -2110,50 +2109,55 @@ Qed.
 
 Lemma transl_exprlist_Econs_correct:
    forall (le : Csharpminor.letenv) (e : Csharpminor.env) (m : mem)
-     (a : Csharpminor.expr) (bl : Csharpminor.exprlist) (m1 : mem)
-     (v : val) (m2 : mem) (vl : list val),
-   Csharpminor.eval_expr prog le e m a m1 v ->
-   eval_expr_prop le e m a m1 v ->
-   Csharpminor.eval_exprlist prog le e m1 bl m2 vl ->
-   eval_exprlist_prop le e m1 bl m2 vl ->
-   eval_exprlist_prop le e m (Csharpminor.Econs a bl) m2 (v :: vl).
+     (a : Csharpminor.expr) (bl : Csharpminor.exprlist)
+     (t1: trace) (m1 : mem) (v : val) 
+     (t2: trace) (m2 : mem) (vl : list val) (t: trace),
+   Csharpminor.eval_expr prog le e m a t1 m1 v ->
+   eval_expr_prop le e m a t1 m1 v ->
+   Csharpminor.eval_exprlist prog le e m1 bl t2 m2 vl ->
+   eval_exprlist_prop le e m1 bl t2 m2 vl ->
+   t = t1 ** t2 ->
+   eval_exprlist_prop le e m (Csharpminor.Econs a bl) t m2 (v :: vl).
 Proof.
   intros; red; intros. monadInv TR. 
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ LINJ MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
-  assert (LINJ2: val_list_inject f2 le tle). eapply val_list_inject_incr; eauto.
-  destruct (H2 _ _ _ _ _ _ _ _ _ _ EQ0 LINJ2 MINJ2 MATCH2)
-  as [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
-  assert (VINJ1': val_inject f3 v tv1). eapply val_inject_incr; eauto.
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H2.
+    eauto. eapply val_list_inject_incr; eauto. eauto. eauto.
+  intros [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
   exists f3; exists te3; exists tm3; exists (tv1 :: tv2).
   intuition. subst tal; econstructor; eauto.
+  constructor. eapply val_inject_incr; eauto. auto.
   eapply inject_incr_trans; eauto.
 Qed.
 
-Lemma transl_funcall_correct:
+Lemma transl_funcall_internal_correct:
    forall (m : mem) (f : Csharpminor.function) (vargs : list val)
-     (e : Csharpminor.env) (m1 : mem) (lb : list block) (m2 m3 : mem)
-     (out : Csharpminor.outcome) (vres : val),
+     (e : Csharpminor.env) (m1 : mem) (lb : list block) (m2: mem)
+     (t: trace) (m3 : mem) (out : Csharpminor.outcome) (vres : val),
    list_norepet (fn_params_names f ++ fn_vars_names f) ->
    alloc_variables empty_env m (fn_variables f) e m1 lb ->
    bind_parameters e m1 (Csharpminor.fn_params f) vargs m2 ->
-   Csharpminor.exec_stmt prog e m2 (Csharpminor.fn_body f) m3 out ->
-   exec_stmt_prop e m2 (Csharpminor.fn_body f) m3 out ->
+   Csharpminor.exec_stmt prog e m2 (Csharpminor.fn_body f) t m3 out ->
+   exec_stmt_prop e m2 (Csharpminor.fn_body f) t m3 out ->
    Csharpminor.outcome_result_value out (sig_res (Csharpminor.fn_sig f)) vres ->
-   eval_funcall_prop m f vargs (free_list m3 lb) vres.
+   eval_funcall_prop m (Internal f) vargs t (free_list m3 lb) vres.
 Proof.
   intros; red. intros tfn f1 tm; intros.
-  unfold transl_function in TR. 
+  generalize TR; clear TR.
+  unfold transl_fundef, transf_partial_fundef.
+  caseEq (transl_function gce f); try congruence. 
+  intros tf TR EQ. inversion EQ; clear EQ; subst tfn.
+  unfold transl_function in TR.
   caseEq (build_compilenv gce f); intros cenv stacksize CENV.
   rewrite CENV in TR. 
   destruct (zle stacksize Int.max_signed); try discriminate.
   monadInv TR. clear TR. 
   caseEq (alloc tm 0 stacksize). intros tm1 sp ALLOC.
-  destruct (function_entry_ok _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-             H0 H1 MATCH CENV z ALLOC ARGSINJ MINJ H)
-  as [f2 [te2 [tm2 [STOREPARAM [MINJ2 [INCR12 [MATCH2 BLOCKS]]]]]]].
-  destruct (H3 _ _ _ _ _ _ _ _ _ EQ MINJ2 MATCH2)
-  as [f3 [te3 [tm3 [tout [EXECBODY [OUTINJ [MINJ3 [INCR23 MATCH3]]]]]]]].
+  exploit function_entry_ok; eauto. 
+  intros [f2 [te2 [tm2 [STOREPARAM [MINJ2 [INCR12 [MATCH2 BLOCKS]]]]]]].
+  red in H3; exploit H3; eauto. 
+  intros [f3 [te3 [tm3 [tout [EXECBODY [OUTINJ [MINJ3 [INCR23 MATCH3]]]]]]]].
   assert (exists tvres, 
            outcome_result_value tout f.(Csharpminor.fn_sig).(sig_res) tvres /\
            val_inject f3 vres tvres).
@@ -2167,13 +2171,14 @@ Proof.
     destruct (sig_res (Csharpminor.fn_sig f)); intro. 
       exists v2; split. auto. subst vres; auto.
       contradiction.
-  elim H5; clear H5; intros tvres [TOUT VINJRES].
+  destruct H5 as [tvres [TOUT VINJRES]].
   exists f3; exists (Mem.free tm3 sp); exists tvres.
   (* execution *)
   split. rewrite <- H6; econstructor; simpl; eauto.
-  apply exec_Sseq_continue with te2 tm2.
+  apply exec_Sseq_continue with E0 te2 tm2 t.
   exact STOREPARAM.
   eexact EXECBODY.
+  traceEq.
   (* val_inject *)
   split. assumption.
   (* mem_inject *)
@@ -2190,9 +2195,22 @@ Proof.
   intros. elim (BLOCKS b); intros B1 B2. generalize (B2 H7). omega.
 Qed.
 
+Lemma transl_funcall_external_correct:
+  forall (m : mem) (ef : external_function) (vargs : list val)
+         (t : trace) (vres : val),
+  event_match ef vargs t vres ->
+  eval_funcall_prop m (External ef) vargs t m vres.
+Proof.
+  intros; red; intros.
+  simpl in TR. inversion TR; clear TR; subst tfn.
+  exploit event_match_inject; eauto. intros [A B].
+  exists f1; exists tm1; exists vres; intuition.
+  constructor; auto. 
+Qed.
+
 Lemma transl_stmt_Sskip_correct:
   forall (e : Csharpminor.env) (m : mem),
-  exec_stmt_prop e m Csharpminor.Sskip m Csharpminor.Out_normal.
+  exec_stmt_prop e m Csharpminor.Sskip E0 m Csharpminor.Out_normal.
 Proof.
   intros; red; intros. monadInv TR. 
   exists f1; exists te1; exists tm1; exists Out_normal.
@@ -2201,33 +2219,90 @@ Qed.
 
 Lemma transl_stmt_Sexpr_correct:
    forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
-     (m1 : mem) (v : val),
-   Csharpminor.eval_expr prog nil e m a m1 v ->
-   eval_expr_prop nil e m a m1 v ->
-   exec_stmt_prop e m (Csharpminor.Sexpr a) m1 Csharpminor.Out_normal.
+          (t: trace) (m1 : mem) (v : val),
+   Csharpminor.eval_expr prog nil e m a t m1 v ->
+   eval_expr_prop nil e m a t m1 v ->
+   exec_stmt_prop e m (Csharpminor.Sexpr a) t m1 Csharpminor.Out_normal.
 Proof.
   intros; red; intros. monadInv TR. 
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ (val_nil_inject f1) MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
   exists f2; exists te2; exists tm2; exists Out_normal.
   intuition. subst ts. econstructor; eauto.
   constructor.
 Qed.
 
+Lemma transl_stmt_Sassign_correct:
+   forall (e : Csharpminor.env) (m : mem)
+     (id : ident) (a : Csharpminor.expr) (t: trace) (m1 : mem) (b : block)
+     (chunk : memory_chunk) (v : val) (m2 : mem),
+   Csharpminor.eval_expr prog nil e m a t m1 v ->
+   eval_expr_prop nil e m a t m1 v ->
+   eval_var_ref prog e id b chunk ->
+   store chunk m1 b 0 v = Some m2 ->
+   exec_stmt_prop e m (Csharpminor.Sassign id a) t m2 Csharpminor.Out_normal.
+Proof.
+  intros; red; intros. monadInv TR; intro EQ0. 
+  exploit H0; eauto. 
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ1 [INCR12 MATCH1]]]]]]]].
+  exploit var_set_correct; eauto.
+  intros [te3 [tm3 [EVAL2 [MINJ2 MATCH2]]]].
+  exists f2; exists te3; exists tm3; exists Out_normal.
+  intuition. constructor.
+Qed.
+
+Lemma transl_stmt_Sstore_correct:
+   forall (e : Csharpminor.env) (m : mem)
+     (chunk : memory_chunk) (a b : Csharpminor.expr) (t1: trace) (m1 : mem)
+     (v1 : val) (t2: trace) (m2 : mem) (v2 : val) 
+     (t3: trace) (m3 : mem),
+   Csharpminor.eval_expr prog nil e m a t1 m1 v1 ->
+   eval_expr_prop nil e m a t1 m1 v1 ->
+   Csharpminor.eval_expr prog nil e m1 b t2 m2 v2 ->
+   eval_expr_prop nil e m1 b t2 m2 v2 ->
+   storev chunk m2 v1 v2 = Some m3 ->
+   t3 = t1 ** t2 ->
+   exec_stmt_prop e m (Csharpminor.Sstore chunk a b) t3 m3 Csharpminor.Out_normal.
+Proof.
+  intros; red; intros. monadInv TR.
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H2.
+    eauto. 
+    eapply val_list_inject_incr; eauto.
+    eauto. eauto. 
+  intros [f3 [te3 [tm3 [tv2 [EVAL2 [VINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
+  exploit make_store_correct.
+    eexact EVAL1. eexact EVAL2. eauto. eauto. 
+    eapply val_inject_incr; eauto. eauto.
+  intros [tm4 [EVAL [MINJ4 NEXTBLOCK]]].
+  exists f3; exists te3; exists tm4; exists Out_normal.
+  rewrite <- H6. subst t3. intuition. 
+  constructor.
+  eapply inject_incr_trans; eauto.
+  assert (val_inject f3 v1 tv1). eapply val_inject_incr; eauto.
+  unfold storev in H3; destruct v1; try discriminate.
+  inversion H4. 
+  rewrite NEXTBLOCK. replace (nextblock m3) with (nextblock m2).
+  eapply match_callstack_mapped; eauto. congruence. 
+  exploit store_inv; eauto. simpl; symmetry; tauto.
+Qed.
+
 Lemma transl_stmt_Sseq_continue_correct:
   forall (e : Csharpminor.env) (m : mem) (s1 s2 : Csharpminor.stmt)
-         (m1 m2 : mem) (out : Csharpminor.outcome),
-  Csharpminor.exec_stmt prog e m s1 m1 Csharpminor.Out_normal ->
-  exec_stmt_prop e m s1 m1 Csharpminor.Out_normal ->
-  Csharpminor.exec_stmt prog e m1 s2 m2 out ->
-  exec_stmt_prop e m1 s2 m2 out ->
-  exec_stmt_prop e m (Csharpminor.Sseq s1 s2) m2 out.
+         (t1 t2: trace) (m1 m2 : mem) (t: trace) (out : Csharpminor.outcome),
+  Csharpminor.exec_stmt prog e m s1 t1 m1 Csharpminor.Out_normal ->
+  exec_stmt_prop e m s1 t1 m1 Csharpminor.Out_normal ->
+  Csharpminor.exec_stmt prog e m1 s2 t2 m2 out ->
+  exec_stmt_prop e m1 s2 t2 m2 out ->
+  t = t1 ** t2 ->
+  exec_stmt_prop e m (Csharpminor.Sseq s1 s2) t m2 out.
 Proof.
   intros; red; intros; monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
-  as [f2 [te2 [tm2 [tout1 [EXEC1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
-  destruct (H2 _ _ _ _ _ _ _ _ _ EQ0 MINJ2 MATCH2)
-  as [f3 [te3 [tm3 [tout2 [EXEC2 [OINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tout1 [EXEC1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H2; eauto.
+  intros [f3 [te3 [tm3 [tout2 [EXEC2 [OINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
   exists f3; exists te3; exists tm3; exists tout2.
   intuition. subst ts; eapply exec_Sseq_continue; eauto.
   inversion OINJ1. subst tout1. auto.
@@ -2236,15 +2311,15 @@ Qed.
 
 Lemma transl_stmt_Sseq_stop_correct:
   forall (e : Csharpminor.env) (m : mem) (s1 s2 : Csharpminor.stmt)
-         (m1 : mem) (out : Csharpminor.outcome),
-  Csharpminor.exec_stmt prog e m s1 m1 out ->
-  exec_stmt_prop e m s1 m1 out ->
+         (t1: trace) (m1 : mem) (out : Csharpminor.outcome),
+  Csharpminor.exec_stmt prog e m s1 t1 m1 out ->
+  exec_stmt_prop e m s1 t1 m1 out ->
   out <> Csharpminor.Out_normal ->
-  exec_stmt_prop e m (Csharpminor.Sseq s1 s2) m1 out.
+  exec_stmt_prop e m (Csharpminor.Sseq s1 s2) t1 m1 out.
 Proof.
   intros; red; intros; monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
-  as [f2 [te2 [tm2 [tout1 [EXEC1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tout1 [EXEC1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
   exists f2; exists te2; exists tm2; exists tout1.
   intuition. subst ts; eapply exec_Sseq_stop; eauto.
   inversion OINJ1; subst out tout1; congruence.
@@ -2252,64 +2327,70 @@ Qed.
 
 Lemma transl_stmt_Sifthenelse_true_correct:
    forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
-     (sl1 sl2 : Csharpminor.stmt) (m1 : mem) (v1 : val) (m2 : mem)
-     (out : Csharpminor.outcome),
-   Csharpminor.eval_expr prog nil e m a m1 v1 ->
-   eval_expr_prop nil e m a m1 v1 ->
+     (sl1 sl2 : Csharpminor.stmt) 
+     (t1: trace) (m1 : mem) (v1 : val) (t2: trace) (m2 : mem)
+     (out : Csharpminor.outcome) (t: trace),
+   Csharpminor.eval_expr prog nil e m a t1 m1 v1 ->
+   eval_expr_prop nil e m a t1 m1 v1 ->
    Val.is_true v1 ->
-   Csharpminor.exec_stmt prog e m1 sl1 m2 out ->
-   exec_stmt_prop e m1 sl1 m2 out ->
-   exec_stmt_prop e m (Csharpminor.Sifthenelse a sl1 sl2) m2 out.
+   Csharpminor.exec_stmt prog e m1 sl1 t2 m2 out ->
+   exec_stmt_prop e m1 sl1 t2 m2 out ->
+   t = t1 ** t2 ->
+   exec_stmt_prop e m (Csharpminor.Sifthenelse a sl1 sl2) t m2 out.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ (val_nil_inject f1) MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
-  destruct (H3 _ _ _ _ _ _ _ _ _ EQ0 MINJ2 MATCH2)
-  as [f3 [te3 [tm3 [tout [EVAL2 [OINJ [MINJ3 [INCR3 MATCH3]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H3; eauto.
+  intros [f3 [te3 [tm3 [tout [EVAL2 [OINJ [MINJ3 [INCR3 MATCH3]]]]]]]].
   exists f3; exists te3; exists tm3; exists tout.
   intuition. 
-  subst ts. eapply exec_ifthenelse_true; eauto.
+  subst ts t. eapply exec_ifthenelse_true; eauto.
   inversion VINJ1; subst v1 tv1; simpl in H1; simpl; contradiction || auto.
   eapply inject_incr_trans; eauto.
 Qed.
 
 Lemma transl_stmt_Sifthenelse_false_correct:
    forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
-     (sl1 sl2 : Csharpminor.stmt) (m1 : mem) (v1 : val) (m2 : mem)
-     (out : Csharpminor.outcome),
-   Csharpminor.eval_expr prog nil e m a m1 v1 ->
-   eval_expr_prop nil e m a m1 v1 ->
+     (sl1 sl2 : Csharpminor.stmt) 
+     (t1: trace) (m1 : mem) (v1 : val) (t2: trace) (m2 : mem)
+     (out : Csharpminor.outcome) (t: trace),
+   Csharpminor.eval_expr prog nil e m a t1 m1 v1 ->
+   eval_expr_prop nil e m a t1 m1 v1 ->
    Val.is_false v1 ->
-   Csharpminor.exec_stmt prog e m1 sl2 m2 out ->
-   exec_stmt_prop e m1 sl2 m2 out ->
-   exec_stmt_prop e m (Csharpminor.Sifthenelse a sl1 sl2) m2 out.
+   Csharpminor.exec_stmt prog e m1 sl2 t2 m2 out ->
+   exec_stmt_prop e m1 sl2 t2 m2 out ->
+   t = t1 ** t2 ->
+   exec_stmt_prop e m (Csharpminor.Sifthenelse a sl1 sl2) t m2 out.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ (val_nil_inject f1) MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
-  destruct (H3 _ _ _ _ _ _ _ _ _ EQ1 MINJ2 MATCH2)
-  as [f3 [te3 [tm3 [tout [EVAL2 [OINJ [MINJ3 [INCR3 MATCH3]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL1 [VINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H3; eauto.
+  intros [f3 [te3 [tm3 [tout [EVAL2 [OINJ [MINJ3 [INCR3 MATCH3]]]]]]]].
   exists f3; exists te3; exists tm3; exists tout.
   intuition. 
-  subst ts. eapply exec_ifthenelse_false; eauto.
+  subst ts t. eapply exec_ifthenelse_false; eauto.
   inversion VINJ1; subst v1 tv1; simpl in H1; simpl; contradiction || auto.
   eapply inject_incr_trans; eauto.
 Qed.
 
 Lemma transl_stmt_Sloop_loop_correct:
    forall (e : Csharpminor.env) (m : mem) (sl : Csharpminor.stmt)
-     (m1 m2 : mem) (out : Csharpminor.outcome),
-   Csharpminor.exec_stmt prog e m sl m1 Csharpminor.Out_normal ->
-   exec_stmt_prop e m sl m1 Csharpminor.Out_normal ->
-   Csharpminor.exec_stmt prog e m1 (Csharpminor.Sloop sl) m2 out ->
-   exec_stmt_prop e m1 (Csharpminor.Sloop sl) m2 out ->
-   exec_stmt_prop e m (Csharpminor.Sloop sl) m2 out.
+     (t1: trace) (m1: mem) (t2: trace) (m2 : mem)
+     (out : Csharpminor.outcome) (t: trace),
+   Csharpminor.exec_stmt prog e m sl t1 m1 Csharpminor.Out_normal ->
+   exec_stmt_prop e m sl t1 m1 Csharpminor.Out_normal ->
+   Csharpminor.exec_stmt prog e m1 (Csharpminor.Sloop sl) t2 m2 out ->
+   exec_stmt_prop e m1 (Csharpminor.Sloop sl) t2 m2 out ->
+   t = t1 ** t2 ->
+   exec_stmt_prop e m (Csharpminor.Sloop sl) t m2 out.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
-  as [f2 [te2 [tm2 [tout1 [EVAL1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
-  destruct (H2 _ _ _ _ _ _ _ _ _ TR MINJ2 MATCH2)
-  as [f3 [te3 [tm3 [tout2 [EVAL2 [OINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tout1 [EVAL1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H2; eauto.
+  intros [f3 [te3 [tm3 [tout2 [EVAL2 [OINJ2 [MINJ3 [INCR3 MATCH3]]]]]]]].
   exists f3; exists te3; exists tm3; exists tout2.
   intuition. 
   subst ts. eapply exec_Sloop_loop; eauto.
@@ -2317,18 +2398,17 @@ Proof.
   eapply inject_incr_trans; eauto.
 Qed.
 
-
 Lemma transl_stmt_Sloop_exit_correct:
    forall (e : Csharpminor.env) (m : mem) (sl : Csharpminor.stmt)
-     (m1 : mem) (out : Csharpminor.outcome),
-   Csharpminor.exec_stmt prog e m sl m1 out ->
-   exec_stmt_prop e m sl m1 out ->
+     (t1: trace) (m1 : mem) (out : Csharpminor.outcome),
+   Csharpminor.exec_stmt prog e m sl t1 m1 out ->
+   exec_stmt_prop e m sl t1 m1 out ->
    out <> Csharpminor.Out_normal ->
-   exec_stmt_prop e m (Csharpminor.Sloop sl) m1 out.
+   exec_stmt_prop e m (Csharpminor.Sloop sl) t1 m1 out.
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
-  as [f2 [te2 [tm2 [tout1 [EVAL1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tout1 [EVAL1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
   exists f2; exists te2; exists tm2; exists tout1.
   intuition. subst ts; eapply exec_Sloop_stop; eauto.
   inversion OINJ1; subst out tout1; congruence.
@@ -2336,15 +2416,15 @@ Qed.
 
 Lemma transl_stmt_Sblock_correct:
    forall (e : Csharpminor.env) (m : mem) (sl : Csharpminor.stmt)
-     (m1 : mem) (out : Csharpminor.outcome),
-   Csharpminor.exec_stmt prog e m sl m1 out ->
-   exec_stmt_prop e m sl m1 out ->
-   exec_stmt_prop e m (Csharpminor.Sblock sl) m1
+     (t1: trace) (m1 : mem) (out : Csharpminor.outcome),
+   Csharpminor.exec_stmt prog e m sl t1 m1 out ->
+   exec_stmt_prop e m sl t1 m1 out ->
+   exec_stmt_prop e m (Csharpminor.Sblock sl) t1 m1
      (Csharpminor.outcome_block out).
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ EQ MINJ MATCH)
-  as [f2 [te2 [tm2 [tout1 [EVAL1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tout1 [EVAL1 [OINJ1 [MINJ2 [INCR2 MATCH2]]]]]]]].
   exists f2; exists te2; exists tm2; exists (outcome_block tout1).
   intuition. subst ts; eapply exec_Sblock; eauto.
   inversion OINJ1; subst out tout1; simpl.
@@ -2356,7 +2436,7 @@ Qed.
 
 Lemma transl_stmt_Sexit_correct:
    forall (e : Csharpminor.env) (m : mem) (n : nat),
-   exec_stmt_prop e m (Csharpminor.Sexit n) m (Csharpminor.Out_exit n).
+   exec_stmt_prop e m (Csharpminor.Sexit n) E0 m (Csharpminor.Out_exit n).
 Proof.
   intros; red; intros. monadInv TR.
   exists f1; exists te1; exists tm1; exists (Out_exit n).
@@ -2366,15 +2446,15 @@ Qed.
 Lemma transl_stmt_Sswitch_correct:
   forall (e : Csharpminor.env) (m : mem)
          (a : Csharpminor.expr) (cases : list (int * nat)) (default : nat)
-         (m1 : mem) (n : int),
-  Csharpminor.eval_expr prog nil e m a m1 (Vint n) ->
-  eval_expr_prop nil e m a m1 (Vint n) ->
-  exec_stmt_prop e m (Csharpminor.Sswitch a cases default) m1
+         (t1 : trace) (m1 : mem) (n : int),
+  Csharpminor.eval_expr prog nil e m a t1 m1 (Vint n) ->
+  eval_expr_prop nil e m a t1 m1 (Vint n) ->
+  exec_stmt_prop e m (Csharpminor.Sswitch a cases default) t1 m1
        (Csharpminor.Out_exit (Csharpminor.switch_target n default cases)).
 Proof.
   intros; red; intros. monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ (val_nil_inject f1) MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]]].
+  exploit H0; eauto. 
+  intros [f2 [te2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]]].
   exists f2; exists te2; exists tm2; 
   exists (Out_exit (switch_target n default cases)). intuition. 
   subst ts. constructor. inversion VINJ1. subst tv1. assumption.
@@ -2383,7 +2463,7 @@ Qed.
 
 Lemma transl_stmt_Sreturn_none_correct:
    forall (e : Csharpminor.env) (m : mem),
-   exec_stmt_prop e m (Csharpminor.Sreturn None) m
+   exec_stmt_prop e m (Csharpminor.Sreturn None) E0 m
      (Csharpminor.Out_return None).
 Proof.
   intros; red; intros. monadInv TR.
@@ -2393,15 +2473,15 @@ Qed.
 
 Lemma transl_stmt_Sreturn_some_correct:
    forall (e : Csharpminor.env) (m : mem) (a : Csharpminor.expr)
-     (m1 : mem) (v : val),
-   Csharpminor.eval_expr prog nil e m a m1 v ->
-   eval_expr_prop nil e m a m1 v ->
-   exec_stmt_prop e m (Csharpminor.Sreturn (Some a)) m1
+     (t1: trace) (m1 : mem) (v : val),
+   Csharpminor.eval_expr prog nil e m a t1 m1 v ->
+   eval_expr_prop nil e m a t1 m1 v ->
+   exec_stmt_prop e m (Csharpminor.Sreturn (Some a)) t1 m1
      (Csharpminor.Out_return (Some v)).
 Proof.
   intros; red; intros; monadInv TR.
-  destruct (H0 _ _ _ _ _ _ _ _ _ _ EQ (val_nil_inject f1) MINJ MATCH)
-  as [f2 [te2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]]].
+  exploit H0; eauto.
+  intros [f2 [te2 [tm2 [tv1 [EVAL [VINJ1 [MINJ2 [INCR MATCH2]]]]]]]].
   exists f2; exists te2; exists tm2; exists (Out_return (Some tv1)).
   intuition. subst ts; econstructor; eauto. constructor; auto.
 Qed.
@@ -2410,9 +2490,9 @@ Qed.
   evaluation derivation, using the lemmas above for each case. *)
 
 Lemma transl_function_correct:
-   forall m1 f vargs m2 vres,
-   Csharpminor.eval_funcall prog m1 f vargs m2 vres ->
-   eval_funcall_prop m1 f vargs m2 vres.
+   forall m1 f vargs t m2 vres,
+   Csharpminor.eval_funcall prog m1 f vargs t m2 vres ->
+   eval_funcall_prop m1 f vargs t m2 vres.
 Proof
   (eval_funcall_ind4 prog
      eval_expr_prop
@@ -2421,21 +2501,23 @@ Proof
      exec_stmt_prop
 
      transl_expr_Evar_correct
-     transl_expr_Eassign_correct
      transl_expr_Eaddrof_correct
      transl_expr_Eop_correct
      transl_expr_Eload_correct
-     transl_expr_Estore_correct
      transl_expr_Ecall_correct
      transl_expr_Econdition_true_correct
      transl_expr_Econdition_false_correct
      transl_expr_Elet_correct
      transl_expr_Eletvar_correct
+     transl_expr_Ealloc_correct
      transl_exprlist_Enil_correct
      transl_exprlist_Econs_correct
-     transl_funcall_correct
+     transl_funcall_internal_correct
+     transl_funcall_external_correct
      transl_stmt_Sskip_correct
      transl_stmt_Sexpr_correct
+     transl_stmt_Sassign_correct
+     transl_stmt_Sstore_correct
      transl_stmt_Sseq_continue_correct
      transl_stmt_Sseq_stop_correct
      transl_stmt_Sifthenelse_true_correct
@@ -2472,11 +2554,11 @@ Qed.
   follows. *)
 
 Theorem transl_program_correct:
-  forall n,
-  Csharpminor.exec_program prog (Vint n) ->
-  exec_program tprog (Vint n).
+  forall t n,
+  Csharpminor.exec_program prog t (Vint n) ->
+  exec_program tprog t (Vint n).
 Proof.
-  intros n [b [fn [m [FINDS [FINDF [SIG EVAL]]]]]].
+  intros t n [b [fn [m [FINDS [FINDF [SIG EVAL]]]]]].
   elim (function_ptr_translated _ _ FINDF). intros tfn [TFIND TR].
   set (m0 := Genv.init_mem (program_of_program prog)) in *.
   set (f := fun b => if zlt b m0.(nextblock) then Some(b, 0) else None).
@@ -2488,26 +2570,25 @@ Proof.
     split. auto. 
     constructor. compute. split; congruence. left; auto. 
     intros; omega. 
-    generalize (Genv.initmem_undef (program_of_program prog) b0). fold m0. intros [lo [hi EQ]].
-    rewrite EQ. simpl. constructor. 
+    generalize (Genv.initmem_block_init (program_of_program prog) b0). fold m0. intros [idata EQ].
+    rewrite EQ. simpl. apply Mem.contents_init_data_inject. 
     destruct (zlt b1 (nextblock m0)); try discriminate.
     destruct (zlt b2 (nextblock m0)); try discriminate.
     left; congruence. 
   assert (MATCH0: match_callstack f nil m0.(nextblock) m0.(nextblock) m0).
     constructor. unfold f; apply match_globalenvs_init.
   fold ge in EVAL.
-  destruct (transl_function_correct _ _ _ _ _ EVAL 
-                                    _ _ _ _ _ TR MINJ0 MATCH0 (val_nil_inject f))
-  as [f1 [tm1 [tres [TEVAL [VINJ [MINJ1 [INCR MATCH1]]]]]]].
+  exploit transl_function_correct; eauto.
+  intros [f1 [tm1 [tres [TEVAL [VINJ [MINJ1 [INCR MATCH1]]]]]]].
   exists b; exists tfn; exists tm1.
   split. fold tge. rewrite <- FINDS. 
   replace (prog_main prog) with (AST.prog_main tprog). fold ge. apply symbols_preserved.
   transitivity (AST.prog_main (program_of_program prog)).
-  apply transform_partial_program_main with (transl_function gce). assumption.
+  apply transform_partial_program_main with (transl_fundef gce). assumption.
   reflexivity.
   split. assumption.
-  split. rewrite <- SIG. apply sig_transl_function; auto.
-  rewrite (Genv.init_mem_transf_partial (transl_function gce) _ TRANSL).
+  split. rewrite <- SIG. apply sig_preserved; auto.
+  rewrite (Genv.init_mem_transf_partial (transl_fundef gce) _ TRANSL).
   inversion VINJ; subst tres. assumption. 
 Qed.
 
diff --git a/backend/Coloring.v b/backend/Coloring.v
index 1a34a12..0a2487c 100644
--- a/backend/Coloring.v
+++ b/backend/Coloring.v
@@ -150,6 +150,12 @@ Definition add_edges_instr
           (add_interf_op res live
             (add_interf_call
               (Regset.remove res live) destroyed_at_call_regs g)))
+  | Ialloc arg res s =>
+      add_pref_mreg arg loc_alloc_argument
+        (add_pref_mreg res loc_alloc_result
+          (add_interf_op res live
+            (add_interf_call
+              (Regset.remove res live) destroyed_at_call_regs g)))
   | Ireturn (Some r) =>
       add_pref_mreg r (loc_result sig) g
   | _ => g
diff --git a/backend/Coloringproof.v b/backend/Coloringproof.v
index 39b208e..54d24cc 100644
--- a/backend/Coloringproof.v
+++ b/backend/Coloringproof.v
@@ -332,6 +332,10 @@ Proof.
   eapply graph_incl_trans; [idtac|apply add_pref_mreg_incl].
   eapply graph_incl_trans; [idtac|apply add_interf_op_incl].
   apply add_interf_call_incl.
+  eapply graph_incl_trans; [idtac|apply add_pref_mreg_incl].
+  eapply graph_incl_trans; [idtac|apply add_pref_mreg_incl].
+  eapply graph_incl_trans; [idtac|apply add_interf_op_incl].
+  apply add_interf_call_incl.
   destruct o.
   apply add_pref_mreg_incl.
   apply graph_incl_refl.
@@ -370,6 +374,15 @@ Definition correct_interf_instr
    /\ (forall r,
         Regset.mem r live = true ->
         r <> res -> interfere r res g)
+  | Ialloc arg res s =>
+      (forall r mr,
+        Regset.mem r live = true ->
+        In mr destroyed_at_call_regs ->
+        r <> res ->
+        interfere_mreg r mr g)
+   /\ (forall r,
+        Regset.mem r live = true ->
+        r <> res -> interfere r res g)
   | _ =>
       True
   end.
@@ -389,6 +402,9 @@ Proof.
   intros [A B]. split.
   intros. eapply interfere_mreg_incl; eauto.
   intros. eapply interfere_incl; eauto.
+  intros [A B]. split.
+  intros. eapply interfere_mreg_incl; eauto.
+  intros. eapply interfere_incl; eauto.
 Qed.
 
 Lemma add_edges_instr_correct:
@@ -417,6 +433,19 @@ Proof.
   eapply graph_incl_trans; [idtac|apply add_prefs_call_incl].
   apply add_pref_mreg_incl.
   apply add_interf_op_correct; auto.
+
+  split; intros.
+  apply interfere_mreg_incl with
+    (add_interf_call (Regset.remove r0 live) destroyed_at_call_regs g).
+  eapply graph_incl_trans; [idtac|apply add_pref_mreg_incl].
+  eapply graph_incl_trans; [idtac|apply add_pref_mreg_incl].
+  apply add_interf_op_incl.
+  apply add_interf_call_correct; auto.
+  rewrite Regset.mem_remove_other; auto.
+
+  eapply interfere_incl.
+  eapply graph_incl_trans; apply add_pref_mreg_incl.
+  apply add_interf_op_correct; auto.
 Qed.
 
 Lemma add_edges_instrs_incl_aux:
@@ -541,7 +570,7 @@ Proof.
                   then false else true)).
   red. unfold OrderedRegReg.eq. unfold OrderedReg.eq.
   intros x y [EQ1 EQ2]. rewrite EQ1; rewrite EQ2; auto.
-  generalize (SetRegReg.for_all_2 H1 H H0). 
+  generalize (SetRegReg.for_all_2 _ _ H1 H _ H0). 
   simpl. case (Loc.eq (coloring r1) (coloring r2)); intro.
   intro; discriminate. auto.
 Qed.
@@ -558,7 +587,7 @@ Proof.
                   then false else true)).
   red. unfold OrderedRegMreg.eq. unfold OrderedReg.eq.
   intros x y [EQ1 EQ2]. rewrite EQ1; rewrite EQ2; auto.
-  generalize (SetRegMreg.for_all_2 H1 H H0). 
+  generalize (SetRegMreg.for_all_2 _ _ H1 H _ H0). 
   simpl. case (Loc.eq (coloring r1) (R mr2)); intro.
   intro; discriminate. auto.
 Qed.
@@ -702,6 +731,14 @@ Definition correct_alloc_instr
    /\ (forall r,
         Regset.mem r live!!pc = true ->
         r <> res -> alloc r <> alloc res)
+  | Ialloc arg res s =>
+      (forall r,
+        Regset.mem r live!!pc = true ->
+        r <> res ->
+        ~(In (alloc r) Conventions.destroyed_at_call))
+   /\ (forall r,
+        Regset.mem r live!!pc = true ->
+        r <> res -> alloc r <> alloc res)
   | _ =>
       True
   end.
@@ -780,6 +817,14 @@ Proof.
   generalize (A r0 mr H IN H0). intro.
   generalize (ALL2 _ _ H2). contradiction.
   auto.
+  intros [A B]. split. 
+  intros; red; intros. 
+  unfold destroyed_at_call in H1.
+  generalize (list_in_map_inv R _ _ H1). 
+  intros [mr [EQ IN]]. 
+  generalize (A r1 mr H IN H0). intro.
+  generalize (ALL2 _ _ H2). contradiction.
+  auto.
 Qed.
   
 Lemma regalloc_correct_1:
diff --git a/backend/Constprop.v b/backend/Constprop.v
index b1c5a2b..3820311 100644
--- a/backend/Constprop.v
+++ b/backend/Constprop.v
@@ -195,7 +195,9 @@ Definition eval_static_operation (op: operation) (vl: list approx) :=
   | Ofloatconst n, nil => F n
   | Oaddrsymbol s n, nil => S s n
   | Ocast8signed, I n1 :: nil => I(Int.cast8signed n)
+  | Ocast8unsigned, I n1 :: nil => I(Int.cast8unsigned n)
   | Ocast16signed, I n1 :: nil => I(Int.cast16signed n)
+  | Ocast16unsigned, I n1 :: nil => I(Int.cast16unsigned n)
   | Oadd, I n1 :: I n2 :: nil => I(Int.add n1 n2)
   | Oadd, S s1 n1 :: I n2 :: nil => S s1 (Int.add n1 n2)
   | Oaddimm n, I n1 :: nil => I (Int.add n1 n)
@@ -379,6 +381,12 @@ Inductive eval_static_operation_cases: forall (op: operation) (vl: list approx),
   | eval_static_operation_case47:
       forall c vl,
       eval_static_operation_cases (Ocmp c) (vl)
+  | eval_static_operation_case48:
+      forall n1,
+      eval_static_operation_cases (Ocast8unsigned) (I n1 :: nil)
+  | eval_static_operation_case49:
+      forall n1,
+      eval_static_operation_cases (Ocast16unsigned) (I n1 :: nil)
   | eval_static_operation_default:
       forall (op: operation) (vl: list approx),
       eval_static_operation_cases op vl.
@@ -475,6 +483,10 @@ Definition eval_static_operation_match (op: operation) (vl: list approx) :=
       eval_static_operation_case46 n1
   | Ocmp c, vl =>
       eval_static_operation_case47 c vl
+  | Ocast8unsigned, I n1 :: nil =>
+      eval_static_operation_case48 n1
+  | Ocast16unsigned, I n1 :: nil =>
+      eval_static_operation_case49 n1
   | op, vl =>
       eval_static_operation_default op vl
   end.
@@ -574,6 +586,10 @@ Definition eval_static_operation (op: operation) (vl: list approx) :=
       | None => Unknown
       | Some b => I(if b then Int.one else Int.zero)
       end
+  | eval_static_operation_case48 n1 =>
+      I(Int.cast8unsigned n1)
+  | eval_static_operation_case49 n1 =>
+      I(Int.cast16unsigned n1)
   | eval_static_operation_default op vl =>
       Unknown
   end.
@@ -603,6 +619,8 @@ Definition transfer (f: function) (pc: node) (before: D.t) :=
           before
       | Icall sig ros args res s =>
           D.set res Unknown before
+      | Ialloc arg res s =>
+          D.set res Unknown before
       | Icond cond args ifso ifnot =>
           before
       | Ireturn optarg =>
@@ -986,6 +1004,8 @@ Definition transf_instr (approx: D.t) (instr: instruction) :=
         | inr s => ros
         end in
       Icall sig ros' args res s
+  | 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 =>
@@ -1028,5 +1048,7 @@ Definition transf_function (f: function) : function :=
         (transf_code_wf f approxs f.(fn_code_wf))
   end.
 
+Definition transf_fundef := AST.transf_fundef transf_function.
+
 Definition transf_program (p: program) : program :=
-  transform_program transf_function p.
+  transform_program transf_fundef p.
diff --git a/backend/Constpropproof.v b/backend/Constpropproof.v
index 080aa74..38ba38b 100644
--- a/backend/Constpropproof.v
+++ b/backend/Constpropproof.v
@@ -6,6 +6,7 @@ Require Import AST.
 Require Import Integers.
 Require Import Floats.
 Require Import Values.
+Require Import Events.
 Require Import Mem.
 Require Import Globalenvs.
 Require Import Op.
@@ -144,11 +145,12 @@ Proof.
   case (eval_static_operation_match op al); intros;
   InvVLMA; simpl in *; FuncInv; try congruence.
 
-  replace v with v0. auto. 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.
+
   exists b. split. auto. congruence. 
   exists b. split. auto. congruence.
   exists b. split. auto. congruence.
@@ -178,12 +180,17 @@ Proof.
   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 _ _ _ _ H H1).
   intro. rewrite H2 in H0. 
   destruct b; injection H0; intro; subst v; simpl; auto.
   intros; simpl; auto.
 
+  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
+  rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence.
+
   auto.
 Qed.
 
@@ -193,8 +200,8 @@ Qed.
   the static approximation returned by the transfer function. *)
 
 Lemma transfer_correct:
-  forall f c sp pc rs m pc' rs' m' ra,
-  exec_instr ge c sp pc rs m pc' rs' m' ->
+  forall f c sp pc rs m t pc' rs' m' ra,
+  exec_instr ge c sp pc rs m t pc' rs' m' ->
   c = f.(fn_code) ->
   regs_match_approx ra rs ->
   regs_match_approx (transfer f pc ra) rs'.
@@ -208,6 +215,8 @@ Proof.
   apply regs_match_approx_update; auto. simpl; auto.
   (* Icall *)
   apply regs_match_approx_update; auto. simpl; auto.
+  (* Ialloc *)
+  apply regs_match_approx_update; auto. simpl; auto.
 Qed.
 
 (** The correctness of the static analysis follows from the results
@@ -217,8 +226,8 @@ Qed.
 Lemma analyze_correct_1:
   forall f approxs,
   analyze f = Some approxs ->
-  forall c sp pc rs m pc' rs' m',
-  exec_instr ge c sp pc rs m pc' rs' m' ->
+  forall c sp pc rs m t pc' rs' m',
+  exec_instr ge c sp pc rs m t pc' rs' m' ->
   c = f.(fn_code) ->
   regs_match_approx approxs!!pc rs ->
   regs_match_approx approxs!!pc' rs'.
@@ -228,7 +237,7 @@ Proof.
   eapply DS.fixpoint_solution. 
   unfold analyze in H. eexact H. 
   elim (fn_code_wf f pc); intro. auto. 
-  generalize (exec_instr_present _ _ _ _ _ _ _ _ _ H0).
+  generalize (exec_instr_present _ _ _ _ _ _ _ _ _ _ H0).
   rewrite H1. intro. contradiction.
   eapply successors_correct. rewrite <- H1. eauto.
   eapply transfer_correct; eauto.
@@ -237,8 +246,8 @@ Qed.
 Lemma analyze_correct_2:
   forall f approxs,
   analyze f = Some approxs ->
-  forall c sp pc rs m pc' rs' m',
-  exec_instrs ge c sp pc rs m pc' rs' m' ->
+  forall c sp pc rs m t pc' rs' m',
+  exec_instrs ge c sp pc rs m t pc' rs' m' ->
   c = f.(fn_code) ->
   regs_match_approx approxs!!pc rs ->
   regs_match_approx approxs!!pc' rs'.
@@ -638,19 +647,28 @@ Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof (Genv.find_symbol_transf transf_function prog).
+Proof (Genv.find_symbol_transf transf_fundef prog).
 
 Lemma functions_translated:
-  forall (v: val) (f: RTL.function),
+  forall (v: val) (f: RTL.fundef),
   Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (transf_function f).
-Proof (@Genv.find_funct_transf _ _ transf_function prog).
+  Genv.find_funct tge v = Some (transf_fundef f).
+Proof (@Genv.find_funct_transf _ _ transf_fundef prog).
 
 Lemma function_ptr_translated:
-  forall (v: block) (f: RTL.function),
+  forall (v: block) (f: RTL.fundef),
   Genv.find_funct_ptr ge v = Some f ->
-  Genv.find_funct_ptr tge v = Some (transf_function f).
-Proof (@Genv.find_funct_ptr_transf _ _ transf_function prog).
+  Genv.find_funct_ptr tge v = Some (transf_fundef f).
+Proof (@Genv.find_funct_ptr_transf _ _ transf_fundef prog).
+
+Lemma sig_translated:
+  forall (f: RTL.fundef),
+  funsig (transf_fundef f) = funsig f.
+Proof.
+  intro. case f; intros; simpl. 
+  unfold transf_function. case (analyze f0); intros; reflexivity.
+  reflexivity.
+Qed.
 
 (** The proof of semantic preservation is a simulation argument
   based on diagrams of the following form:
@@ -676,30 +694,30 @@ Proof (@Genv.find_funct_ptr_transf _ _ transf_function prog).
 
 Definition exec_instr_prop
         (c: code) (sp: val)
-        (pc: node) (rs: regset) (m: mem)
+        (pc: node) (rs: regset) (m: mem) (t: trace)
         (pc': node) (rs': regset) (m': mem) : Prop :=
-  exec_instr tge c sp pc rs m pc' rs' m' /\
+  exec_instr tge c sp pc rs m t pc' rs' m' /\
   forall f approxs
          (CF: c = f.(RTL.fn_code))
          (ANL: analyze f = Some approxs)
          (MATCH: regs_match_approx ge approxs!!pc rs),
-  exec_instr tge (transf_code approxs c) sp pc rs m pc' rs' m'.
+  exec_instr tge (transf_code approxs c) sp pc rs m t pc' rs' m'.
 
 Definition exec_instrs_prop
         (c: code) (sp: val)
-        (pc: node) (rs: regset) (m: mem)
+        (pc: node) (rs: regset) (m: mem) (t: trace)
         (pc': node) (rs': regset) (m': mem) : Prop :=
-  exec_instrs tge c sp pc rs m pc' rs' m' /\
+  exec_instrs tge c sp pc rs m t pc' rs' m' /\
   forall f approxs
          (CF: c = f.(RTL.fn_code))
          (ANL: analyze f = Some approxs)
          (MATCH: regs_match_approx ge approxs!!pc rs),
-  exec_instrs tge (transf_code approxs c) sp pc rs m pc' rs' m'.
+  exec_instrs tge (transf_code approxs c) sp pc rs m t pc' rs' m'.
 
 Definition exec_function_prop
-        (f: RTL.function) (args: list val) (m: mem)
+        (f: RTL.fundef) (args: list val) (m: mem) (t: trace)
         (res: val) (m': mem) : Prop :=
-  exec_function tge (transf_function f) args m res m'.
+  exec_function tge (transf_fundef f) args m t res m'.
 
 Ltac TransfInstr :=
   match goal with
@@ -716,9 +734,9 @@ Ltac TransfInstr :=
   evaluation derivation of the original code. *)
 
 Lemma transf_funct_correct:
-  forall f args m res m',
-  exec_function ge f args m res m' ->
-  exec_function_prop f args m res m'.
+  forall f args m t res m',
+  exec_function ge f args m t res m' ->
+  exec_function_prop f args m t res m'.
 Proof.
   apply (exec_function_ind_3 ge
           exec_instr_prop exec_instrs_prop exec_function_prop);
@@ -773,13 +791,13 @@ Proof.
     rewrite ASR; simpl. congruence.
   intro. eapply exec_Istore; eauto. 
   (* Icall *)
-  assert (find_function tge ros rs = Some (transf_function f)).
+  assert (find_function tge ros rs = Some (transf_fundef f)).
   generalize H0; unfold find_function; destruct ros.
   apply functions_translated. 
   rewrite symbols_preserved. destruct (Genv.find_symbol ge i).
   apply function_ptr_translated. congruence.
-  assert (sig = fn_sig (transf_function f)).
-  rewrite H1. unfold transf_function. destruct (analyze f); reflexivity.
+  assert (funsig (transf_fundef f) = sig).
+    generalize (sig_translated f). congruence.
   split; [idtac| intros; TransfInstr].
   eapply exec_Icall; eauto.
   set (ros' :=
@@ -803,6 +821,11 @@ Proof.
   generalize H4. simpl. rewrite A. rewrite B. subst i0. 
   rewrite Genv.find_funct_find_funct_ptr. auto.
 
+  (* Ialloc *)
+  split; [idtac|intros; TransfInstr].
+  eapply exec_Ialloc; eauto. 
+  intros. eapply exec_Ialloc; eauto. 
+
   (* Icond, true *)
   split; [idtac| intros; TransfInstr].
   eapply exec_Icond_true; eauto.
@@ -844,37 +867,38 @@ Proof.
   (* trans *)
   elim H0; intros. elim H2; intros.
   split.
-  apply exec_trans with pc2 rs2 m2; auto.
-  intros; apply exec_trans with pc2 rs2 m2.
-  eapply H4; eauto. eapply H6; eauto.
-  eapply analyze_correct_2; eauto.
+  apply exec_trans with t1 pc2 rs2 m2 t2; auto.
+  intros; apply exec_trans with t1 pc2 rs2 m2 t2.
+  eapply H5; eauto. eapply H7; eauto.
+  eapply analyze_correct_2; eauto. auto.
 
-  (* function *)
+  (* internal function *)
   elim H1; intros.
-  unfold transf_function.
+  simpl. unfold transf_function. 
   caseEq (analyze f). 
   intros approxs ANL.
-  eapply exec_funct; simpl; eauto. 
+  eapply exec_funct_internal; simpl; eauto. 
   eapply H5. reflexivity. auto. 
   apply analyze_correct_3; auto.
   TransfInstr; auto.
-  intros. eapply exec_funct; eauto.
+  intros. eapply exec_funct_internal; eauto.
+  (* external function *)
+  unfold transf_function; simpl. apply exec_funct_external; auto.
 Qed.
 
 (** The preservation of the observable behavior of the program then
   follows. *)
 
 Theorem transf_program_correct:
-  forall (r: val),
-  exec_program prog r -> exec_program tprog r.
+  forall (t: trace) (r: val),
+  exec_program prog t r -> exec_program tprog t r.
 Proof.
-  intros r [b [f [m [SYMB [FIND [SIG EXEC]]]]]].
-  red. exists b. exists (transf_function f). exists m. 
+  intros t r [b [f [m [SYMB [FIND [SIG EXEC]]]]]].
+  red. exists b. exists (transf_fundef f). exists m. 
   split. change (prog_main tprog) with (prog_main prog).
   rewrite symbols_preserved. auto.
   split. apply function_ptr_translated; auto.
-  split. unfold transf_function. 
-  rewrite <- SIG. destruct (analyze f); reflexivity.
+  split. generalize (sig_translated f). congruence.
   apply transf_funct_correct. 
   unfold tprog, transf_program. rewrite Genv.init_mem_transf. 
   exact EXEC.
diff --git a/backend/Conventions.v b/backend/Conventions.v
index 99cc933..5b4222d 100644
--- a/backend/Conventions.v
+++ b/backend/Conventions.v
@@ -19,12 +19,11 @@ Require Import Locations.
   of callee- and caller-save registers.
 *)
 
-Definition destroyed_at_call_regs :=
-  R3 :: R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R10 ::
-  F1 :: F2 :: F3 :: F4 :: F5 :: F6 :: F7 :: F8 :: F9 :: F10 :: nil.
+Definition int_caller_save_regs :=
+  R3 :: R4 :: R5 :: R6 :: R7 :: R8 :: R9 :: R10 :: nil.
 
-Definition destroyed_at_call :=
-  List.map R destroyed_at_call_regs.
+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 :: 
@@ -34,6 +33,12 @@ 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 temporaries := 
   R IT1 :: R IT2 :: R IT3 :: R FT1 :: R FT2 :: R FT3 :: nil.
 
@@ -298,6 +303,18 @@ Proof.
   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_acceptable 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 ABI states the following convention for passing arguments
@@ -316,11 +333,6 @@ Qed.
 These conventions are somewhat baroque, but they are mandated by the ABI.
 *)
 
-Definition drop1 (x: list mreg) :=
-  match x with nil => nil | hd :: tl => tl end.
-Definition drop2 (x: list mreg) :=
-  match x with nil => nil | hd :: nil => nil | hd1 :: hd2 :: tl => tl end.
-
 Fixpoint loc_arguments_rec
     (tyl: list typ) (iregl: list mreg) (fregl: list mreg)
     (ofs: Z) {struct tyl} : list loc :=
@@ -331,13 +343,13 @@ Fixpoint loc_arguments_rec
       | nil => S (Outgoing ofs Tint)
       | ireg :: _ => R ireg
       end ::
-      loc_arguments_rec tys (drop1 iregl) fregl (ofs + 1)
+      loc_arguments_rec tys (list_drop1 iregl) fregl (ofs + 1)
   | Tfloat :: tys =>
       match fregl with
       | nil => S (Outgoing ofs Tfloat)
       | freg :: _ => R freg
       end ::
-      loc_arguments_rec tys (drop2 iregl) (drop1 fregl) (ofs + 2)
+      loc_arguments_rec tys (list_drop2 iregl) (list_drop1 fregl) (ofs + 2)
   end.
 
 Definition int_param_regs :=
@@ -374,18 +386,6 @@ Definition loc_argument_acceptable (l: loc) : Prop :=
   | _ => False
   end.
 
-Remark drop1_incl:
-  forall x l, In x (drop1 l) -> In x l.
-Proof.
-  intros. destruct l. elim H. simpl in H. auto with coqlib.
-Qed.
-Remark drop2_incl:
-  forall x l, In x (drop2 l) -> In x l.
-Proof.
-  intros. destruct l. elim H. destruct l. elim H.
-  simpl in H. auto with coqlib.
-Qed.
-
 Remark loc_arguments_rec_charact:
   forall tyl iregl fregl ofs l,
   In l (loc_arguments_rec tyl iregl fregl ofs) ->
@@ -400,12 +400,12 @@ Proof.
   destruct a; elim H; intros.
   destruct iregl; subst l. omega. left; auto with coqlib.
   generalize (IHtyl _ _ _ _ H0). 
-  destruct l. intros [A|B]. left; apply drop1_incl; auto. tauto.
+  destruct l. intros [A|B]. left; apply list_drop1_incl; auto. tauto.
   destruct s; try contradiction. omega.
   destruct fregl; subst l. omega. right; auto with coqlib.
   generalize (IHtyl _ _ _ _ H0). 
-  destruct l. intros [A|B]. left; apply drop2_incl; auto. 
-  right; apply drop1_incl; auto.
+  destruct l. intros [A|B]. left; apply list_drop2_incl; auto. 
+  right; apply list_drop1_incl; auto.
   destruct s; try contradiction. omega.
 Qed.
 
@@ -425,18 +425,6 @@ Hint Resolve loc_arguments_acceptable: locs.
 
 (** Arguments are parwise disjoint (in the sense of [Loc.norepet]). *)
 
-Remark drop1_norepet:
-  forall l, list_norepet l -> list_norepet (drop1 l).
-Proof.
-  intros. destruct l; simpl. constructor. inversion H. auto.
-Qed.
-Remark drop2_norepet:
-  forall l, list_norepet l -> list_norepet (drop2 l).
-Proof.
-  intros. destruct l; simpl. constructor.
-  destruct l; simpl. constructor. inversion H. inversion H3. auto.
-Qed.
-
 Remark loc_arguments_rec_notin_reg:
   forall tyl iregl fregl ofs r,
   ~(In r iregl) -> ~(In r fregl) ->
@@ -446,10 +434,10 @@ Proof.
   auto.
   destruct a; simpl; split.
   destruct iregl. auto. red; intro; subst m. apply H. auto with coqlib.
-  apply IHtyl. red; intro. apply H. apply drop1_incl; auto. auto.
+  apply IHtyl. red; intro. apply H. apply list_drop1_incl; auto. auto.
   destruct fregl. auto. red; intro; subst m. apply H0. auto with coqlib.
-  apply IHtyl. red; intro. apply H. apply drop2_incl; auto.
-  red; intro. apply H0. apply drop1_incl; auto.
+  apply IHtyl. red; intro. apply H. apply list_drop2_incl; auto.
+  red; intro. apply H0. apply list_drop1_incl; auto.
 Qed.
 
 Remark loc_arguments_rec_notin_local:
@@ -494,16 +482,16 @@ Proof.
   apply loc_arguments_rec_notin_outgoing. simpl; omega.
   apply loc_arguments_rec_notin_reg. simpl. inversion H. auto.
   apply list_disjoint_notin with (m :: iregl); auto with coqlib.
-  apply IHtyl. apply drop1_norepet; auto. auto. 
-  red; intros. apply H1. apply drop1_incl; auto. auto.
+  apply IHtyl. apply list_drop1_norepet; auto. auto. 
+  red; intros. apply H1. apply list_drop1_incl; auto. auto.
   destruct fregl. 
   apply loc_arguments_rec_notin_outgoing. simpl; omega.
   apply loc_arguments_rec_notin_reg. simpl. 
-  red; intro. apply (H1 m m). apply drop2_incl; auto. 
+  red; intro. apply (H1 m m). apply list_drop2_incl; auto. 
   auto with coqlib. auto.
   simpl. inversion H0. auto.
-  apply IHtyl. apply drop2_norepet; auto. apply drop1_norepet; auto.
-  red; intros. apply H1. apply drop2_incl; auto. apply drop1_incl; auto.
+  apply IHtyl. apply list_drop2_norepet; auto. apply list_drop1_norepet; auto.
+  red; intros. apply H1. apply list_drop2_incl; auto. apply list_drop1_incl; auto.
 
   intro. unfold loc_arguments. apply H.
   unfold int_param_regs. NoRepet.
@@ -601,11 +589,11 @@ Proof.
   destruct a; simpl; apply (f_equal2 (@cons typ)).
   destruct iregl.  reflexivity. simpl. apply H. auto with coqlib.
   apply IHtyl.
-  intros. apply H. apply drop1_incl. auto. auto.
+  intros. apply H. apply list_drop1_incl. auto. auto.
   destruct fregl.  reflexivity. simpl. apply H0. auto with coqlib.
   apply IHtyl.
-  intros. apply H. apply drop2_incl. auto. 
-  intros. apply H0. apply drop1_incl. auto.
+  intros. apply H. apply list_drop2_incl. auto. 
+  intros. apply H0. apply list_drop1_incl. auto.
 
   intros. unfold loc_arguments. apply H. 
   intro; simpl. ElimOrEq; reflexivity.
@@ -688,3 +676,30 @@ Proof.
   intros; simpl. tauto.
 Qed.
 
+(** ** Location of arguments to external functions *)
+
+Definition loc_external_arguments (s: signature) : list mreg :=
+  List.map
+    (fun l => match l with R r => r | S _ => IT1 end)
+    (loc_arguments s).
+
+Definition sig_external_ok (s: signature) : Prop :=
+  forall sl, ~In (S sl) (loc_arguments s).
+
+Lemma loc_external_arguments_loc_arguments:
+  forall s, 
+  sig_external_ok s ->
+  loc_arguments s = List.map R (loc_external_arguments s).
+Proof.
+  intros. unfold loc_external_arguments.
+  rewrite list_map_compose.
+  transitivity (List.map (fun x => x) (loc_arguments s)).
+  symmetry; apply list_map_identity.
+  apply list_map_exten; intros.
+  destruct x. auto. elim (H _ H0).
+Qed.
+
+(** ** Location of argument and result of dynamic allocation *)
+
+Definition loc_alloc_argument := R3.
+Definition loc_alloc_result := R3.
diff --git a/backend/Csharpminor.v b/backend/Csharpminor.v
index 49fd3df..246ebf5 100644
--- a/backend/Csharpminor.v
+++ b/backend/Csharpminor.v
@@ -7,13 +7,14 @@ Require Import Integers.
 Require Import Floats.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 
 (** Abstract syntax *)
 
-(** Cminor is a low-level imperative language structured in expressions,
+(** Csharpminor is a low-level imperative language structured in expressions,
   statements, functions and programs.  Expressions include
-  reading and writing local variables, reading and writing store locations,
+  reading global or local variables, reading store locations,
   arithmetic operations, function calls, and conditional expressions
   (similar to [e1 ? e2 : e3] in C).  The [Elet] and [Eletvar] constructs
   enable sharing the computations of subexpressions.  De Bruijn notation
@@ -67,20 +68,20 @@ Inductive operation : Set :=
 Inductive expr : Set :=
   | Evar : ident -> expr                (**r reading a scalar variable  *)
   | Eaddrof : ident -> expr             (**r taking the address of a variable *)
-  | Eassign : ident -> expr -> expr     (**r assignment to a scalar variable  *)
   | Eop : operation -> exprlist -> expr (**r arithmetic operation *)
   | Eload : memory_chunk -> expr -> expr (**r memory read *)
-  | Estore : memory_chunk -> expr -> expr -> expr (**r memory write *)
   | Ecall : signature -> expr -> exprlist -> expr (**r function call *)
   | Econdition : expr -> expr -> expr -> expr (**r conditional expression *)
   | Elet : expr -> expr -> expr         (**r let binding  *)
   | Eletvar : nat -> expr               (**r reference to a let-bound variable *)
+  | Ealloc : expr -> expr               (**r memory allocation *)
 
 with exprlist : Set :=
   | Enil: exprlist
   | Econs: expr -> exprlist -> exprlist.
 
-(** Statements include expression evaluation, an if/then/else conditional,
+(** Statements include expression evaluation, variable assignment,
+  memory stores, an if/then/else conditional,
   infinite loops, blocks and early block exits, and early function returns.
   [Sexit n] terminates prematurely the execution of the [n+1] enclosing
   [Sblock] statements. *)
@@ -88,6 +89,8 @@ with exprlist : Set :=
 Inductive stmt : Set :=
   | Sskip: stmt
   | Sexpr: expr -> stmt
+  | Sassign : ident -> expr -> stmt
+  | Sstore : memory_chunk -> expr -> expr -> stmt
   | Sseq: stmt -> stmt -> stmt
   | Sifthenelse: expr -> stmt -> stmt -> stmt
   | Sloop: stmt -> stmt
@@ -117,12 +120,20 @@ Record function : Set := mkfunction {
   fn_body: stmt
 }.
 
+Definition fundef := AST.fundef function.
+
 Record program : Set := mkprogram {
-  prog_funct: list (ident * function);
+  prog_funct: list (ident * fundef);
   prog_main: ident;
-  prog_vars: list (ident * var_kind)
+  prog_vars: list (ident * var_kind * list init_data)
 }.
 
+Definition funsig (fd: fundef) :=
+  match fd with
+  | Internal f => f.(fn_sig)
+  | External ef => ef.(ef_sig)
+  end.
+
 (** * Operational semantics *)
 
 (** The operational semantics for Csharpminor is given in big-step operational
@@ -164,7 +175,7 @@ Fixpoint switch_target (n: int) (dfl: nat) (cases: list (int * nat))
 - [env]: local environments, map local variables to memory blocks + var info;
 - [lenv]: let environments, map de Bruijn indices to values.
 *)
-Definition genv := Genv.t function.
+Definition genv := Genv.t fundef.
 Definition gvarenv := PTree.t var_kind.
 Definition env := PTree.t (block * var_kind).
 Definition empty_env : env := PTree.empty (block * var_kind).
@@ -176,11 +187,11 @@ Definition sizeof (lv: var_kind) : Z :=
   | Varray sz => Zmax 0 sz
   end.
 
-Definition program_of_program (p: program): AST.program function :=
+Definition program_of_program (p: program): AST.program fundef :=
   AST.mkprogram
     p.(prog_funct)
     p.(prog_main)
-    (List.map (fun id_vi => (fst id_vi, sizeof (snd id_vi))) p.(prog_vars)).
+    (List.map (fun x => match x with (id, k, init) => (id, init) end) p.(prog_vars)).
 
 Definition fn_variables (f: function) :=
   List.map
@@ -195,7 +206,7 @@ Definition fn_vars_names (f: function) :=
 
 Definition global_var_env (p: program): gvarenv :=
   List.fold_left
-    (fun gve id_vi => PTree.set (fst id_vi) (snd id_vi) gve)
+    (fun gve x => match x with (id, k, init) => PTree.set id k gve end)
     p.(prog_vars) (PTree.empty var_kind).
 
 (** Evaluation of operator applications. *)
@@ -270,22 +281,6 @@ Definition eval_operation (op: operation) (vl: list val) (m: mem): option val :=
   | _, _ => None
   end.
 
-(** ``Casting'' a value to a memory chunk.  The value is truncated and
-  zero- or sign-extended as dictated by the memory chunk. *)
-
-Definition cast (chunk: memory_chunk) (v: val) : option val :=
-  match chunk, v with
-  | Mint8signed, Vint n => Some (Vint (Int.cast8signed n))
-  | Mint8unsigned, Vint n => Some (Vint (Int.cast8unsigned n))
-  | Mint16signed, Vint n => Some (Vint (Int.cast16signed n))
-  | Mint16unsigned, Vint n => Some (Vint (Int.cast16unsigned n))
-  | Mint32, Vint n => Some(Vint n)
-  | Mint32, Vptr b ofs => Some(Vptr b ofs)
-  | Mfloat32, Vfloat f => Some(Vfloat(Float.singleoffloat f))
-  | Mfloat64, Vfloat f => Some(Vfloat f)
-  | _, _ => None
-  end.
-
 (** Allocation of local variables at function entry.  Each variable is
   bound to the reference to a fresh block of the appropriate size. *)
 
@@ -312,10 +307,9 @@ Inductive bind_parameters: env ->
       forall e m,
       bind_parameters e m nil nil m
   | bind_parameters_cons:
-      forall e m id chunk params v1 v2 vl b m1 m2,
+      forall e m id chunk params v1 vl b m1 m2,
       PTree.get id e = Some (b, Vscalar chunk) ->
-      cast chunk v1 = Some v2 ->
-      Mem.store chunk m b 0 v2 = Some m1 ->
+      Mem.store chunk m b 0 v1 = Some m1 ->
       bind_parameters e m1 params vl m2 ->
       bind_parameters e m ((id, chunk) :: params) (v1 :: vl) m2.
 
@@ -364,69 +358,64 @@ Inductive eval_var_ref: env -> ident -> block -> memory_chunk -> Prop :=
 
 Inductive eval_expr:
          letenv -> env ->
-         mem -> expr -> mem -> val -> Prop :=
+         mem -> expr -> trace -> mem -> val -> Prop :=
   | eval_Evar:
       forall le e m id b chunk v,
       eval_var_ref e id b chunk ->
       Mem.load chunk m b 0 = Some v ->
-      eval_expr le e m (Evar id) m v
-  | eval_Eassign:
-      forall le e m id a m1 b chunk v1 v2 m2,
-      eval_expr le e m a m1 v1 ->
-      eval_var_ref e id b chunk ->
-      cast chunk v1 = Some v2 ->
-      Mem.store chunk m1 b 0 v2 = Some m2 ->
-      eval_expr le e m (Eassign id a) m2 v2
+      eval_expr le e m (Evar id) E0 m v
   | eval_Eaddrof:
       forall le e m id b,
       eval_var_addr e id b ->
-      eval_expr le e m (Eaddrof id) m (Vptr b Int.zero)
+      eval_expr le e m (Eaddrof id) E0 m (Vptr b Int.zero)
   | eval_Eop:
-      forall le e m op al m1 vl v,
-      eval_exprlist le e m al m1 vl ->
+      forall le e m op al t m1 vl v,
+      eval_exprlist le e m al t m1 vl ->
       eval_operation op vl m1 = Some v ->
-      eval_expr le e m (Eop op al) m1 v
+      eval_expr le e m (Eop op al) t m1 v
   | eval_Eload:
-      forall le e m chunk a m1 v1 v,
-      eval_expr le e m a m1 v1 ->
+      forall le e m chunk a t m1 v1 v,
+      eval_expr le e m a t m1 v1 ->
       Mem.loadv chunk m1 v1 = Some v ->
-      eval_expr le e m (Eload chunk a) m1 v
-  | eval_Estore:
-      forall le e m chunk a b m1 v1 m2 v2 m3 v3,
-      eval_expr le e m a m1 v1 ->
-      eval_expr le e m1 b m2 v2 ->
-      cast chunk v2 = Some v3 ->
-      Mem.storev chunk m2 v1 v3 = Some m3 ->
-      eval_expr le e m (Estore chunk a b) m3 v3
+      eval_expr le e m (Eload chunk a) t m1 v
   | eval_Ecall:
-      forall le e m sig a bl m1 m2 m3 vf vargs vres f,
-      eval_expr le e m a m1 vf ->
-      eval_exprlist le e m1 bl m2 vargs ->
+      forall le e m sig a bl t1 m1 t2 m2 t3 m3 vf vargs vres f t,
+      eval_expr le e m a t1 m1 vf ->
+      eval_exprlist le e m1 bl t2 m2 vargs ->
       Genv.find_funct ge vf = Some f ->
-      f.(fn_sig) = sig ->
-      eval_funcall m2 f vargs m3 vres ->
-      eval_expr le e m (Ecall sig a bl) m3 vres
+      funsig f = sig ->
+      eval_funcall m2 f vargs t3 m3 vres ->
+      t = t1 ** t2 ** t3 ->
+      eval_expr le e m (Ecall sig a bl) t m3 vres
   | eval_Econdition_true:
-      forall le e m a b c m1 v1 m2 v2,
-      eval_expr le e m a m1 v1 ->
+      forall le e m a b c t1 m1 v1 t2 m2 v2 t,
+      eval_expr le e m a t1 m1 v1 ->
       Val.is_true v1 ->
-      eval_expr le e m1 b m2 v2 ->
-      eval_expr le e m (Econdition a b c) m2 v2
+      eval_expr le e m1 b t2 m2 v2 ->
+      t = t1 ** t2 ->
+      eval_expr le e m (Econdition a b c) t m2 v2
   | eval_Econdition_false:
-      forall le e m a b c m1 v1 m2 v2,
-      eval_expr le e m a m1 v1 ->
+      forall le e m a b c t1 m1 v1 t2 m2 v2 t,
+      eval_expr le e m a t1 m1 v1 ->
       Val.is_false v1 ->
-      eval_expr le e m1 c m2 v2 ->
-      eval_expr le e m (Econdition a b c) m2 v2
+      eval_expr le e m1 c t2 m2 v2 ->
+      t = t1 ** t2 ->
+      eval_expr le e m (Econdition a b c) t m2 v2
   | eval_Elet:
-      forall le e m a b m1 v1 m2 v2,
-      eval_expr le e m a m1 v1 ->
-      eval_expr (v1::le) e m1 b m2 v2 ->
-      eval_expr le e m (Elet a b) m2 v2
+      forall le e m a b t1 m1 v1 t2 m2 v2 t,
+      eval_expr le e m a t1 m1 v1 ->
+      eval_expr (v1::le) e m1 b t2 m2 v2 ->
+      t = t1 ** t2 ->
+      eval_expr le e m (Elet a b) t m2 v2
   | eval_Eletvar:
       forall le e m n v,
       nth_error le n = Some v ->
-      eval_expr le e m (Eletvar n) m v
+      eval_expr le e m (Eletvar n) E0 m v
+  | eval_Ealloc:
+      forall le e m a t m1 n m2 b,
+      eval_expr le e m a t m1 (Vint n) ->
+      Mem.alloc m1 0 (Int.signed n) = (m2, b) ->
+      eval_expr le e m (Ealloc a) t m2 (Vptr b Int.zero)
 
 (** Evaluation of a list of expressions:
   [eval_exprlist prg le al m a m' vl]
@@ -437,32 +426,37 @@ Inductive eval_expr:
 
 with eval_exprlist:
          letenv -> env ->
-         mem -> exprlist ->
+         mem -> exprlist -> trace ->
          mem -> list val -> Prop :=
   | eval_Enil:
       forall le e m,
-      eval_exprlist le e m Enil m nil
+      eval_exprlist le e m Enil E0 m nil
   | eval_Econs:
-      forall le e m a bl m1 v m2 vl,
-      eval_expr le e m a m1 v ->
-      eval_exprlist le e m1 bl m2 vl ->
-      eval_exprlist le e m (Econs a bl) m2 (v :: vl)
+      forall le e m a bl t1 m1 v t2 m2 vl t,
+      eval_expr le e m a t1 m1 v ->
+      eval_exprlist le e m1 bl t2 m2 vl ->
+      t = t1 ** t2 ->
+      eval_exprlist le e m (Econs a bl) t m2 (v :: vl)
 
 (** Evaluation of a function invocation: [eval_funcall prg m f args m' res]
   means that the function [f], applied to the arguments [args] in
   memory state [m], returns the value [res] in modified memory state [m'].
 *)
 with eval_funcall:
-        mem -> function -> list val ->
+        mem -> fundef -> list val -> trace ->
         mem -> val -> Prop :=
-  | eval_funcall_intro:
-      forall m f vargs e m1 lb m2 m3 out vres,
+  | eval_funcall_internal:
+      forall m f vargs e m1 lb m2 t m3 out vres,
       list_norepet (fn_params_names f ++ fn_vars_names f) ->
       alloc_variables empty_env m (fn_variables f) e m1 lb ->
       bind_parameters e m1 f.(fn_params) vargs m2 ->
-      exec_stmt e m2 f.(fn_body) m3 out ->
+      exec_stmt e m2 f.(fn_body) t m3 out ->
       outcome_result_value out f.(fn_sig).(sig_res) vres ->
-      eval_funcall m f vargs (Mem.free_list m3 lb) vres
+      eval_funcall m (Internal f) vargs t (Mem.free_list m3 lb) vres
+  | eval_funcall_external:
+      forall m ef vargs t vres,
+      event_match ef vargs t vres ->
+      eval_funcall m (External ef) vargs t m vres
 
 (** Execution of a statement: [exec_stmt prg e m s m' out]
   means that statement [s] executes with outcome [out].
@@ -470,66 +464,83 @@ with eval_funcall:
 
 with exec_stmt:
          env ->
-         mem -> stmt ->
+         mem -> stmt -> trace ->
          mem -> outcome -> Prop :=
   | exec_Sskip:
       forall e m,
-      exec_stmt e m Sskip m Out_normal
+      exec_stmt e m Sskip E0 m Out_normal
   | exec_Sexpr:
-      forall e m a m1 v,
-      eval_expr nil e m a m1 v ->
-      exec_stmt e m (Sexpr a) m1 Out_normal
+      forall e m a t m1 v,
+      eval_expr nil e m a t m1 v ->
+      exec_stmt e m (Sexpr a) t m1 Out_normal
+  | eval_Sassign:
+      forall e m id a t m1 b chunk v m2,
+      eval_expr nil e m a t m1 v ->
+      eval_var_ref e id b chunk ->
+      Mem.store chunk m1 b 0 v = Some m2 ->
+      exec_stmt e m (Sassign id a) t m2 Out_normal
+  | eval_Sstore:
+      forall e m chunk a b t1 m1 v1 t2 m2 v2 t3 m3,
+      eval_expr nil e m a t1 m1 v1 ->
+      eval_expr nil e m1 b t2 m2 v2 ->
+      Mem.storev chunk m2 v1 v2 = Some m3 ->
+      t3 = t1 ** t2 ->
+      exec_stmt e m (Sstore chunk a b) t3 m3 Out_normal
   | exec_Sseq_continue:
-      forall e m s1 s2 m1 m2 out,
-      exec_stmt e m s1 m1 Out_normal ->
-      exec_stmt e m1 s2 m2 out ->
-      exec_stmt e m (Sseq s1 s2) m2 out
+      forall e m s1 s2 t1 t2 m1 m2 t out,
+      exec_stmt e m s1 t1 m1 Out_normal ->
+      exec_stmt e m1 s2 t2 m2 out ->
+      t = t1 ** t2 ->
+      exec_stmt e m (Sseq s1 s2) t m2 out
   | exec_Sseq_stop:
-      forall e m s1 s2 m1 out,
-      exec_stmt e m s1 m1 out ->
+      forall e m s1 s2 t1 m1 out,
+      exec_stmt e m s1 t1 m1 out ->
       out <> Out_normal ->
-      exec_stmt e m (Sseq s1 s2) m1 out
+      exec_stmt e m (Sseq s1 s2) t1 m1 out
   | exec_Sifthenelse_true:
-      forall e m a sl1 sl2 m1 v1 m2 out,
-      eval_expr nil e m a m1 v1 ->
+      forall e m a sl1 sl2 t1 m1 v1 t2 m2 out t,
+      eval_expr nil e m a t1 m1 v1 ->
       Val.is_true v1 ->
-      exec_stmt e m1 sl1 m2 out ->
-      exec_stmt e m (Sifthenelse a sl1 sl2) m2 out
+      exec_stmt e m1 sl1 t2 m2 out ->
+      t = t1 ** t2 ->
+      exec_stmt e m (Sifthenelse a sl1 sl2) t m2 out
   | exec_Sifthenelse_false:
-      forall e m a sl1 sl2 m1 v1 m2 out,
-      eval_expr nil e m a m1 v1 ->
+      forall e m a sl1 sl2 t1 m1 v1 t2 m2 out t,
+      eval_expr nil e m a t1 m1 v1 ->
       Val.is_false v1 ->
-      exec_stmt e m1 sl2 m2 out ->
-      exec_stmt e m (Sifthenelse a sl1 sl2) m2 out
+      exec_stmt e m1 sl2 t2 m2 out ->
+      t = t1 ** t2 ->
+      exec_stmt e m (Sifthenelse a sl1 sl2) t m2 out
   | exec_Sloop_loop:
-      forall e m sl m1 m2 out,
-      exec_stmt e m sl m1 Out_normal ->
-      exec_stmt e m1 (Sloop sl) m2 out ->
-      exec_stmt e m (Sloop sl) m2 out
+      forall e m sl t1 m1 t2 m2 out t,
+      exec_stmt e m sl t1 m1 Out_normal ->
+      exec_stmt e m1 (Sloop sl) t2 m2 out ->
+      t = t1 ** t2 ->
+      exec_stmt e m (Sloop sl) t m2 out
   | exec_Sloop_stop:
-      forall e m sl m1 out,
-      exec_stmt e m sl m1 out ->
+      forall e m sl t1 m1 out,
+      exec_stmt e m sl t1 m1 out ->
       out <> Out_normal ->
-      exec_stmt e m (Sloop sl) m1 out
+      exec_stmt e m (Sloop sl) t1 m1 out
   | exec_Sblock:
-      forall e m sl m1 out,
-      exec_stmt e m sl m1 out ->
-      exec_stmt e m (Sblock sl) m1 (outcome_block out)
+      forall e m sl t1 m1 out,
+      exec_stmt e m sl t1 m1 out ->
+      exec_stmt e m (Sblock sl) t1 m1 (outcome_block out)
   | exec_Sexit:
       forall e m n,
-      exec_stmt e m (Sexit n) m (Out_exit n)
+      exec_stmt e m (Sexit n) E0 m (Out_exit n)
   | exec_Sswitch:
-      forall e m a cases default m1 n,
-      eval_expr nil e m a m1 (Vint n) ->
+      forall e m a cases default t1 m1 n,
+      eval_expr nil e m a t1 m1 (Vint n) ->
       exec_stmt e m (Sswitch a cases default)
-                  m1 (Out_exit (switch_target n default cases))
+               t1 m1 (Out_exit (switch_target n default cases))
   | exec_Sreturn_none:
       forall e m,
-      exec_stmt e m (Sreturn None) m (Out_return None)
+      exec_stmt e m (Sreturn None) E0 m (Out_return None)
   | exec_Sreturn_some:
-      forall e m a m1 v,
-      eval_expr nil e m a m1 v ->
-      exec_stmt e m (Sreturn (Some a)) m1 (Out_return (Some v)).
+      forall e m a t1 m1 v,
+      eval_expr nil e m a t1 m1 v ->
+      exec_stmt e m (Sreturn (Some a)) t1 m1 (Out_return (Some v)).
 
 Scheme eval_expr_ind4 := Minimality for eval_expr Sort Prop
   with eval_exprlist_ind4 := Minimality for eval_exprlist Sort Prop
@@ -542,12 +553,11 @@ End RELSEM.
   holds if the application of [p]'s main function to no arguments
   in the initial memory state for [p] eventually returns value [r]. *)
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv (program_of_program p) in
   let m0 := Genv.init_mem (program_of_program p) in
   exists b, exists f, exists m,
   Genv.find_symbol ge p.(prog_main) = Some b /\
   Genv.find_funct_ptr ge b = Some f /\
-  f.(fn_sig) = mksignature nil (Some Tint) /\
-  eval_funcall p m0 f nil m r.
-
+  funsig f = mksignature nil (Some Tint) /\
+  eval_funcall p m0 f nil t m r.
diff --git a/backend/Events.v b/backend/Events.v
new file mode 100644
index 0000000..a0559fd
--- /dev/null
+++ b/backend/Events.v
@@ -0,0 +1,103 @@
+(** Representation of (traces of) observable events. *)
+
+Require Import Coqlib.
+Require Import AST.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+
+Inductive eventval: Set :=
+  | EVint: int -> eventval
+  | EVfloat: float -> eventval.
+
+Parameter trace: Set.
+Parameter E0: trace.
+Parameter Eextcall: ident -> list eventval -> eventval -> trace.
+Parameter Eapp: trace -> trace -> trace.
+
+Infix "**" := Eapp (at level 60, right associativity).
+
+Axiom E0_left: forall t, E0 ** t = t.
+Axiom E0_right: forall t, t ** E0 = t.
+Axiom Eapp_assoc: forall t1 t2 t3, (t1 ** t2) ** t3 = t1 ** (t2 ** t3).
+
+Hint Rewrite E0_left E0_right Eapp_assoc: trace_rewrite.
+
+Ltac substTraceHyp :=
+  match goal with
+  | [ H: (@eq trace ?x ?y) |- _ ] =>
+       subst x || clear H
+  end.
+
+Ltac decomposeTraceEq :=
+  match goal with
+  | [ |- (_ ** _) = (_ ** _) ] =>
+      apply (f_equal2 Eapp); auto; decomposeTraceEq
+  | _ =>
+      auto
+  end.
+
+Ltac traceEq := 
+  repeat substTraceHyp; autorewrite with trace_rewrite; decomposeTraceEq.
+
+Inductive eventval_match: eventval -> typ -> val -> Prop :=
+  | ev_match_int:
+      forall i, eventval_match (EVint i) Tint (Vint i)
+  | ev_match_float:
+      forall f, eventval_match (EVfloat f) Tfloat (Vfloat f).
+
+Inductive eventval_list_match: list eventval -> list typ -> list val -> Prop :=
+  | evl_match_nil:
+      eventval_list_match nil nil nil
+  | evl_match_cons:
+      forall ev1 evl ty1 tyl v1 vl,
+      eventval_match ev1 ty1 v1 ->
+      eventval_list_match evl tyl vl ->
+      eventval_list_match (ev1::evl) (ty1::tyl) (v1::vl).
+
+Inductive event_match:
+         external_function -> list val -> trace -> val -> Prop :=
+  event_match_intro:
+    forall ef vargs vres eargs eres,
+    eventval_list_match eargs (sig_args ef.(ef_sig)) vargs ->
+    eventval_match eres (proj_sig_res ef.(ef_sig)) vres ->
+    event_match ef vargs (Eextcall ef.(ef_id) eargs eres) vres.
+
+Require Import Mem.
+
+Section EVENT_MATCH_INJECT.
+
+Variable f: meminj.
+
+Remark eventval_match_inject:
+  forall ev ty v1,  eventval_match ev ty v1 ->
+  forall v2, val_inject f v1 v2 ->
+  eventval_match ev ty v2.
+Proof.
+  induction 1; intros; inversion H; constructor.
+Qed.
+
+Remark eventval_list_match_inject:
+  forall evl tyl vl1,  eventval_list_match evl tyl vl1 ->
+  forall vl2, val_list_inject f vl1 vl2 ->
+  eventval_list_match evl tyl vl2.
+Proof.
+  induction 1; intros.
+  inversion H; constructor. 
+  inversion H1; constructor. 
+  eapply eventval_match_inject; eauto.
+  eauto.
+Qed.
+
+Lemma event_match_inject:
+  forall ef args1 t res args2,
+  event_match ef args1 t res ->
+  val_list_inject f args1 args2 ->
+  event_match ef args2 t res /\ val_inject f res res.
+Proof.
+  intros. inversion H; subst. 
+  split. constructor. eapply eventval_list_match_inject; eauto. auto.
+  inversion H2; constructor.
+Qed.
+
+End EVENT_MATCH_INJECT.
diff --git a/backend/Globalenvs.v b/backend/Globalenvs.v
index 55afc35..036fd8f 100644
--- a/backend/Globalenvs.v
+++ b/backend/Globalenvs.v
@@ -70,15 +70,20 @@ Module Type GENV.
     (forall id f, In (id, f) (prog_funct p) -> P f) ->
     find_funct (globalenv p) v = Some f ->
     P f.
+  Hypothesis find_funct_ptr_symbol_inversion:
+    forall (F: Set) (p: program F) (id: ident) (b: block) (f: F),
+    find_symbol (globalenv p) id = Some b ->
+    find_funct_ptr (globalenv p) b = Some f ->
+    In (id, f) p.(prog_funct).
+
   Hypothesis initmem_nullptr:
     forall (F: Set) (p: program F),
     let m := init_mem p in
     valid_block m nullptr /\
     m.(blocks) nullptr = empty_block 0 0.
-  Hypothesis initmem_undef:
+  Hypothesis initmem_block_init:
     forall (F: Set) (p: program F) (b: block),
-    exists lo, exists hi, 
-    (init_mem p).(blocks) b = empty_block lo hi.
+    exists id, (init_mem p).(blocks) b = block_init_data id.
   Hypothesis find_funct_ptr_inv:
     forall (F: Set) (p: program F) (b: block) (f: F),
     find_funct_ptr (globalenv p) b = Some f -> b < 0.
@@ -206,12 +211,12 @@ Definition add_functs (init: genv) (fns: list (ident * funct)) : genv :=
   List.fold_right add_funct init fns.
 
 Definition add_globals 
-        (init: genv * mem) (vars: list (ident * Z)) : genv * mem :=
+        (init: genv * mem) (vars: list (ident * list init_data)) : genv * mem :=
   List.fold_right
-    (fun (id_sz: ident * Z) (g_st: genv * mem) =>
-       let (id, sz) := id_sz in
+    (fun (id_init: ident * list init_data) (g_st: genv * mem) =>
+       let (id, init) := id_init in
        let (g, st) := g_st in
-       let (st', b) := Mem.alloc st 0 sz in
+       let (st', b) := Mem.alloc_init_data st init in
        (add_symbol id b g, st'))
     init vars.
 
@@ -229,7 +234,7 @@ Lemma functions_globalenv:
   forall (p: program funct),
   functions (globalenv p) = functions (add_functs empty p.(prog_funct)).
 Proof.
-  assert (forall (init: genv * mem) (vars: list (ident * Z)),
+  assert (forall init vars,
      functions (fst (add_globals init vars)) = functions (fst init)).
   induction vars; simpl.
   reflexivity.
@@ -248,11 +253,11 @@ Lemma initmem_nullptr:
   m.(blocks) nullptr = mkblock 0 0 (fun y => Undef) (undef_undef_outside 0 0).
 Proof.
   assert
-   (forall (init: genv * mem),
+   (forall init,
     let m1 := snd init in
     0 < m1.(nextblock) ->
     m1.(blocks) nullptr = mkblock 0 0 (fun y => Undef) (undef_undef_outside 0 0) ->
-    forall (vars: list (ident * Z)),
+    forall vars,
     let m2 := snd (add_globals init vars) in
     0 < m2.(nextblock) /\
     m2.(blocks) nullptr = mkblock 0 0 (fun y => Undef) (undef_undef_outside 0 0)).
@@ -268,23 +273,21 @@ Proof.
   unfold valid_block. apply H. simpl. omega. reflexivity.
 Qed. 
 
-Lemma initmem_undef:
+Lemma initmem_block_init:
   forall (p: program funct) (b: block),
-  exists lo, exists hi, 
-  (init_mem p).(blocks) b = empty_block lo hi.
+  exists id, (init_mem p).(blocks) b = block_init_data id.
 Proof.
   assert (forall g0 vars g1 m b,
       add_globals (g0, Mem.empty) vars = (g1, m) ->
-      exists lo, exists hi, 
-      m.(blocks) b = empty_block lo hi).
+      exists id, m.(blocks) b = block_init_data id).
   induction vars; simpl.
   intros. inversion H. unfold Mem.empty; simpl. 
-  exists 0; exists 0. auto.
+  exists (@nil init_data). symmetry. apply Mem.block_init_data_empty.
   destruct a. caseEq (add_globals (g0, Mem.empty) vars). intros g1 m1 EQ. 
   intros g m b EQ1. injection EQ1; intros EQ2 EQ3; clear EQ1.
   rewrite <- EQ2; simpl. unfold update.
   case (zeq b (nextblock m1)); intro.
-  exists 0; exists z; auto.
+  exists l; auto.
   eauto.
   intros. caseEq (globalenv_initmem p). 
   intros g m EQ. unfold init_mem; rewrite EQ; simpl. 
@@ -372,6 +375,59 @@ Proof.
   intros. eapply find_funct_ptr_prop; eauto.
 Qed.
 
+Lemma find_funct_ptr_symbol_inversion:
+  forall (F: Set) (p: program F) (id: ident) (b: block) (f: F),
+  find_symbol (globalenv p) id = Some b ->
+  find_funct_ptr (globalenv p) b = Some f ->
+  In (id, f) p.(prog_funct).
+Proof.
+  intros until f.
+  assert (forall fns,
+           let g := add_functs (empty F) fns in
+           PTree.get id g.(symbols) = Some b ->
+           b > g.(nextfunction)).
+    induction fns; simpl.
+    rewrite PTree.gempty. congruence.
+    rewrite PTree.gsspec. case (peq id (fst a)); intro.
+    intro EQ. inversion EQ. unfold Zpred. omega.
+    intros. generalize (IHfns H). unfold Zpred; omega.
+  assert (forall fns,
+           let g := add_functs (empty F) fns in
+           PTree.get id g.(symbols) = Some b ->
+           ZMap.get b g.(functions) = Some f ->
+           In (id, f) fns).
+    induction fns; simpl.
+    rewrite ZMap.gi. congruence.
+    set (g := add_functs (empty F) fns). 
+    rewrite PTree.gsspec. rewrite ZMap.gsspec. 
+    case (peq id (fst a)); intro.
+    intro EQ. inversion EQ. unfold ZIndexed.eq. rewrite zeq_true. 
+    intro EQ2. left. destruct a. simpl in *. congruence. 
+    intro. unfold ZIndexed.eq. rewrite zeq_false. intro. eauto.
+    generalize (H _ H0). fold g. unfold block. omega.
+  assert (forall g0 m0, b < 0 ->
+          forall vars g m,
+          @add_globals F (g0, m0) vars = (g, m) ->
+          PTree.get id g.(symbols) = Some b ->
+          PTree.get id g0.(symbols) = Some b).
+    induction vars; simpl.
+    intros. inversion H2. auto.
+    destruct a. caseEq (add_globals (g0, m0) vars). 
+    intros g1 m1 EQ g m EQ1. injection EQ1; simpl; clear EQ1.
+    unfold add_symbol; intros A B. rewrite <- B. simpl. 
+    rewrite PTree.gsspec. case (peq id i); intros.
+    assert (b > 0). injection H2; intros. rewrite <- H3. apply nextblock_pos. 
+    omegaContradiction.
+    eauto. 
+  intros. 
+  generalize (find_funct_ptr_inv _ _ H3). intro.
+  pose (g := add_functs (empty F) (prog_funct p)). 
+  apply H0.  
+  apply H1 with Mem.empty (prog_vars p) (globalenv p) (init_mem p).
+  auto. unfold globalenv, init_mem. rewrite <- surjective_pairing.
+  reflexivity. assumption. rewrite <- functions_globalenv. assumption.
+Qed.
+
 (* Global environments and program transformations. *)
 
 Section TRANSF_PROGRAM_PARTIAL.
@@ -420,7 +476,7 @@ Proof.
 Qed.
 
 Lemma mem_add_globals_transf:
-  forall (g1: genv A) (g2: genv B) (m: mem) (vars: list (ident * Z)),
+  forall (g1: genv A) (g2: genv B) (m: mem) (vars: list (ident * list init_data)),
   snd (add_globals (g1, m) vars) = snd (add_globals (g2, m) vars).
 Proof.
   induction vars; simpl.
@@ -433,7 +489,7 @@ Qed.
 Lemma symbols_add_globals_transf:
   forall (g1: genv A) (g2: genv B) (m: mem),
   symbols g1 = symbols g2 ->
-  forall (vars: list (ident * Z)),
+  forall (vars: list (ident * list init_data)),
   symbols (fst (add_globals (g1, m) vars)) =
   symbols (fst (add_globals (g2, m) vars)).
 Proof.
diff --git a/backend/InterfGraph.v b/backend/InterfGraph.v
index 37248f5..78112c3 100644
--- a/backend/InterfGraph.v
+++ b/backend/InterfGraph.v
@@ -1,7 +1,8 @@
 (** Representation of interference graphs for register allocation. *)
 
 Require Import Coqlib.
-Require Import FSet.
+Require Import FSets.
+Require Import FSetAVL.
 Require Import Maps.
 Require Import Ordered.
 Require Import Registers.
@@ -39,10 +40,14 @@ Module OrderedRegReg := OrderedPair(OrderedReg)(OrderedReg).
 Module OrderedMreg := OrderedIndexed(IndexedMreg).
 Module OrderedRegMreg := OrderedPair(OrderedReg)(OrderedMreg).
 
+(*
 Module SetDepRegReg := FSetAVL.Make(OrderedRegReg).
 Module SetRegReg := NodepOfDep(SetDepRegReg).
 Module SetDepRegMreg := FSetAVL.Make(OrderedRegMreg).
 Module SetRegMreg := NodepOfDep(SetDepRegMreg).
+*)
+Module SetRegReg := FSetAVL.Make(OrderedRegReg).
+Module SetRegMreg := FSetAVL.Make(OrderedRegMreg).
 
 Record graph: Set := mkgraph {
   interf_reg_reg: SetRegReg.t;
@@ -197,12 +202,15 @@ Qed.
 (** [all_interf_regs g] returns the set of pseudo-registers that
   are nodes of [g]. *)
 
+Definition add_intf2 (r1r2: reg * reg) (u: Regset.t) : Regset.t :=
+  Regset.add (fst r1r2) (Regset.add (snd r1r2) u).
+Definition add_intf1 (r1m2: reg * mreg) (u: Regset.t) : Regset.t :=
+  Regset.add (fst r1m2) u.
+
 Definition all_interf_regs (g: graph) : Regset.t :=
-  SetRegReg.fold
-    (fun r1r2 u => Regset.add (fst r1r2) (Regset.add (snd r1r2) u))
+  SetRegReg.fold _ add_intf2
     g.(interf_reg_reg)
-    (SetRegMreg.fold
-      (fun r1m2 u => Regset.add (fst r1m2) u)
+    (SetRegMreg.fold _ add_intf1
       g.(interf_reg_mreg)
       Regset.empty).
 
@@ -215,53 +223,63 @@ Proof.
   rewrite Regset.mem_add_other; auto.
 Qed.
 
-Lemma all_interf_regs_correct_aux_1:
-  forall l u r,
-  Regset.mem r u = true ->
-  Regset.mem r
-    (List.fold_right
-      (fun r1r2 u => Regset.add (fst r1r2) (Regset.add (snd r1r2) u))
-      u l) = true.
+Lemma in_setregreg_fold:
+  forall g r1 r2 u,
+  SetRegReg.In (r1, r2) g \/ Regset.mem r1 u = true /\ Regset.mem r2 u = true ->
+  Regset.mem r1 (SetRegReg.fold _ add_intf2 g u) = true /\
+  Regset.mem r2 (SetRegReg.fold _ add_intf2 g u) = true.
 Proof.
-  induction l; simpl; intros.
-  auto.
-  apply mem_add_tail. apply mem_add_tail. auto.
+  set (add_intf2' := fun u r1r2 => add_intf2 r1r2 u).
+  assert (forall l r1 r2 u,
+    InA OrderedRegReg.eq (r1,r2) l \/ Regset.mem r1 u = true /\ Regset.mem r2 u = true ->
+    Regset.mem r1 (List.fold_left add_intf2' l u) = true /\
+    Regset.mem r2 (List.fold_left add_intf2' l u) = true).
+  induction l; intros; simpl.
+  elim H; intro. inversion H0. auto.
+  apply IHl. destruct a as [a1 a2].
+  elim H; intro. inversion H0; subst. 
+  red in H2. simpl in H2. destruct H2. red in H1. red in H2. subst r1 r2.
+  right; unfold add_intf2', add_intf2; simpl; split. 
+  apply Regset.mem_add_same. apply mem_add_tail. apply Regset.mem_add_same.
+  tauto.
+  right; unfold add_intf2', add_intf2; simpl; split;
+  apply mem_add_tail; apply mem_add_tail; tauto.
+
+  intros. rewrite SetRegReg.fold_1. apply H. 
+  intuition. left. apply SetRegReg.elements_1. auto.
 Qed.
 
-Lemma all_interf_regs_correct_aux_2:
-  forall l u r1 r2,
-  InList OrderedRegReg.eq (r1, r2) l ->
-  let u' :=
-    List.fold_right
-      (fun r1r2 u => Regset.add (fst r1r2) (Regset.add (snd r1r2) u))
-      u l in
-  Regset.mem r1 u' = true /\ Regset.mem r2 u' = true.
+Lemma in_setregreg_fold':
+  forall g r u,
+  Regset.mem r u = true ->
+  Regset.mem r (SetRegReg.fold _ add_intf2 g u) = true.
 Proof.
-  induction l; simpl; intros.
-  inversion H.
-  inversion H. elim H1. simpl. unfold OrderedReg.eq. 
-  intros; subst r1; subst r2.
-  split. apply Regset.mem_add_same. 
-  apply mem_add_tail. apply Regset.mem_add_same.
-  generalize (IHl u r1 r2 H1). intros [A B].
-  split; repeat rewrite mem_add_tail; auto.
+  intros. exploit in_setregreg_fold. eauto. 
+  intros [A B]. eauto.
 Qed.
 
-Lemma all_interf_regs_correct_aux_3:
-  forall l u r1 r2,
-  InList OrderedRegMreg.eq (r1, r2) l ->
-  let u' :=
-    List.fold_right
-      (fun r1r2 u => Regset.add (fst r1r2) u)
-      u l in
-  Regset.mem r1 u' = true.
+Lemma in_setregmreg_fold:
+  forall g r1 mr2 u,
+  SetRegMreg.In (r1, mr2) g \/ Regset.mem r1 u = true ->
+  Regset.mem r1 (SetRegMreg.fold _ add_intf1 g u) = true.
 Proof.
-  induction l; simpl; intros.
-  inversion H.
-  inversion H. elim H1. simpl. unfold OrderedReg.eq. 
-  intros; subst r1.
+  set (add_intf1' := fun u r1mr2 => add_intf1 r1mr2 u).
+  assert (forall l r1 mr2 u,
+    InA OrderedRegMreg.eq (r1,mr2) l \/ Regset.mem r1 u = true ->
+    Regset.mem r1 (List.fold_left add_intf1' l u) = true).
+  induction l; intros; simpl.
+  elim H; intro. inversion H0. auto.
+  apply IHl with mr2. destruct a as [a1 a2].
+  elim H; intro. inversion H0; subst. 
+  red in H2. simpl in H2. destruct H2. red in H1. red in H2. subst r1 mr2.
+  right; unfold add_intf1', add_intf1; simpl.
   apply Regset.mem_add_same. 
-  apply mem_add_tail. apply IHl with r2. auto.
+  tauto.
+  right; unfold add_intf1', add_intf1; simpl.
+  apply mem_add_tail; auto.
+
+  intros. rewrite SetRegMreg.fold_1. apply H with mr2. 
+  intuition. left. apply SetRegMreg.elements_1. auto.
 Qed.
 
 Lemma all_interf_regs_correct_1:
@@ -271,16 +289,7 @@ Lemma all_interf_regs_correct_1:
   Regset.mem r2 (all_interf_regs g) = true.
 Proof.
   intros. unfold all_interf_regs. 
-  generalize (SetRegReg.fold_1
-    g.(interf_reg_reg)
-    (SetRegMreg.fold
-        (fun (r1m2 : SetDepRegMreg.elt) (u : Regset.t) =>
-         Regset.add (fst r1m2) u) (interf_reg_mreg g) Regset.empty)
-    (fun (r1r2 : SetDepRegReg.elt) (u : Regset.t) =>
-      Regset.add (fst r1r2) (Regset.add (snd r1r2) u))).
-  intros [l [UN [INEQ EQ]]].
-  rewrite EQ. apply all_interf_regs_correct_aux_2.
-  elim (INEQ (r1, r2)); intros. auto.
+  apply in_setregreg_fold. tauto.
 Qed.
 
 Lemma all_interf_regs_correct_2:
@@ -289,22 +298,6 @@ Lemma all_interf_regs_correct_2:
   Regset.mem r1 (all_interf_regs g) = true.
 Proof.
   intros. unfold all_interf_regs.
-  generalize (SetRegReg.fold_1
-    g.(interf_reg_reg)
-    (SetRegMreg.fold
-        (fun (r1m2 : SetDepRegMreg.elt) (u : Regset.t) =>
-         Regset.add (fst r1m2) u) (interf_reg_mreg g) Regset.empty)
-    (fun (r1r2 : SetDepRegReg.elt) (u : Regset.t) =>
-      Regset.add (fst r1r2) (Regset.add (snd r1r2) u))).
-  intros [l [UN [INEQ EQ]]].
-  rewrite EQ. apply all_interf_regs_correct_aux_1.
-  generalize (SetRegMreg.fold_1
-    g.(interf_reg_mreg)
-    Regset.empty
-    (fun (r1r2 : SetDepRegMreg.elt) (u : Regset.t) =>
-      Regset.add (fst r1r2) u)).
-  change (PTree.t unit) with Regset.t.
-  intros [l' [UN' [INEQ' EQ']]].
-  rewrite EQ'. apply all_interf_regs_correct_aux_3 with mr2.
-  elim (INEQ' (r1, mr2)); intros. auto.
+  apply in_setregreg_fold'. eapply in_setregmreg_fold. eauto.
 Qed.
+
diff --git a/backend/Kildall.v b/backend/Kildall.v
index 10b2e1d..0210b73 100644
--- a/backend/Kildall.v
+++ b/backend/Kildall.v
@@ -1,6 +1,7 @@
 (** Solvers for dataflow inequations. *)
 
 Require Import Coqlib.
+Require Import Iteration.
 Require Import Maps.
 Require Import Lattice.
 
@@ -40,128 +41,6 @@ sets [X(n) = top] for all merge points [n], that is, program points having
 several predecessors.  This solver is useful when least upper bounds of
 approximations do not exist or are too expensive to compute. *)
 
-(** * Bounded iteration *)
-
-(** The three solvers proceed iteratively, increasing the value of one of
-  the unknowns [X(n)] at each iteration until a solution is reached.
-  This section defines the general form of iteration used. *)
-
-Section BOUNDED_ITERATION.
-
-Variables A B: Set.
-Variable step: A -> B + A.
-
-(** The [step] parameter represents one step of the iteration.  From a 
-  current iteration state [a: A], it either returns a value of type [B],
-  meaning that iteration is over and that this [B] value is the final
-  result of the iteration, or a value [a' : A] which is the next state
-  of the iteration.
-
-  The naive way to define the iteration is:
-<<
-Fixpoint iterate (a: A) : B :=
-  match step a with
-  | inl b => b
-  | inr a' => iterate a'
-  end.
->>
-  However, this is a general recursion, not guaranteed to terminate,
-  and therefore not expressible in Coq.  The standard way to work around
-  this difficulty is to use Noetherian recursion (Coq module [Wf]).
-  This requires that we equip the type [A] with a well-founded ordering [<]
-  (no infinite ascending chains) and we demand that [step] satisfies
-  [step a = inr a' -> a < a'].  For the types [A] that are of interest to us
-  in this development, it is however very painful to define adequate
-  well-founded orderings, even though we know our iterations always
-  terminate.
-
-  Instead, we choose to bound the number of iterations by an arbitrary
-  constant.  [iterate] then becomes a function that can fail,
-  of type [A -> option B].  The [None] result denotes failure to reach
-  a result in the number of iterations prescribed, or, in other terms,
-  failure to find a solution to the dataflow problem.  The compiler
-  passes that exploit dataflow analysis (the [Constprop], [CSE] and
-  [Allocation] passes) will, in this case, either fail ([Allocation])
-  or turn off the optimization pass ([Constprop] and [CSE]).
-
-  Since we know (informally) that our computations terminate, we can
-  take a very large constant as the maximal number of iterations.
-  Failure will therefore never happen in practice, but of
-  course our proofs also cover the failure case and show that 
-  nothing bad happens in this hypothetical case either.  *)
-
-Definition num_iterations := 1000000000000%positive.
-
-(** The simple definition of bounded iteration is:
-<<
-Fixpoint iterate (niter: nat) (a: A) {struct niter} : option B :=
-  match niter with
-  | O => None
-  | S niter' =>
-      match step a with
-      | inl b => b
-      | inr a' => iterate niter' a'
-      end
-  end.
->>
-  This function is structural recursive over the parameter [niter]
-  (number of iterations), represented here as a Peano integer (type [nat]).
-  However, we want to use very large values of [niter].  As Peano integers,
-  these values would be much too large to fit in memory.  Therefore,
-  we must express iteration counts as a binary integer (type [positive]).
-  However, Peano induction over type [positive] is not structural recursion,
-  so we cannot define [iterate] as a Coq fixpoint and must use
-  Noetherian recursion instead. *)
-
-Definition iter_step (x: positive)
-                     (next: forall y, Plt y x -> A -> option B)
-                     (s: A) : option B :=
-  match peq x xH with
-  | left EQ => None
-  | right NOTEQ =>
-      match step s with
-      | inl res => Some res
-      | inr s'  => next (Ppred x) (Ppred_Plt x NOTEQ) s'
-      end
-  end.
-
-Definition iterate: positive -> A -> option B :=
-  Fix Plt_wf (fun _ => A -> option B) iter_step.
-
-(** We then prove the expected unrolling equations for [iterate]. *)
-
-Remark unroll_iterate:
-  forall x, iterate x = iter_step x (fun y _ => iterate y).
-Proof.
-  unfold iterate; apply (Fix_eq Plt_wf (fun _ => A -> option B) iter_step).
-  intros. unfold iter_step. apply extensionality. intro s. 
-  case (peq x xH); intro. auto. 
-  rewrite H. auto. 
-Qed.
-
-Lemma iterate_base:
-  forall s, iterate 1%positive s = None.
-Proof.
-  intro; rewrite unroll_iterate; unfold iter_step.
-  case (peq 1 1); congruence.
-Qed.
-
-Lemma iterate_step:
-  forall x s, 
-  iterate (Psucc x) s =
-    match step s with
-    | inl res => Some res
-    | inr s'  => iterate x s'
-    end.
-Proof.
-  intro; rewrite unroll_iterate; unfold iter_step; intros.
-  case (peq (Psucc x) 1); intro.
-  destruct x; simpl in e; discriminate.
-  rewrite Ppred_succ. auto.
-Qed.
-
-End BOUNDED_ITERATION.
-
 (** * Solving forward dataflow problems using Kildall's algorithm *)
 
 (** A forward dataflow solver has the following generic interface.
@@ -316,7 +195,7 @@ Definition step (s: state) : PMap.t L.t + state :=
   the start state. *)
 
 Definition fixpoint : option (PMap.t L.t) :=
-  iterate _ _ step num_iterations start_state.
+  PrimIter.iterate _ _ step start_state.
 
 (** ** Monotonicity properties *)
 
@@ -361,33 +240,24 @@ Proof.
   apply propagate_succ_incr. auto.
 Qed. 
 
-Lemma iterate_incr:
-  forall n st res,
-  iterate _ _ step n st = Some res ->
-  in_incr st.(st_in) res.
-Proof.
-  intro n; pattern n. apply positive_Peano_ind; intros until res.
-  rewrite iterate_base. congruence.
-  rewrite iterate_step. unfold step.
-  destruct st.(st_wrk); intros.
-  injection H0; intro; subst res. 
-  red; intros; apply L.ge_refl.
-  apply in_incr_trans with
-    (propagate_succ_list (mkstate (st_in st) l)
-                         (transf p (st_in st)!!p)
-                         (successors p)).(st_in).
-  change (st_in st) with (st_in (mkstate (st_in st) l)).
-  apply propagate_succ_list_incr.
-  apply H. auto.
-Qed.
-
 Lemma fixpoint_incr:
   forall res,
   fixpoint = Some res -> in_incr (start_state_in entrypoints) res.
 Proof.
   unfold fixpoint; intros.
   change (start_state_in entrypoints) with start_state.(st_in).
-  apply iterate_incr with num_iterations; auto.
+  eapply (PrimIter.iterate_prop _ _ step
+    (fun st => in_incr start_state.(st_in) st.(st_in))
+    (fun res => in_incr start_state.(st_in) res)).
+
+  intros st INCR. unfold step.
+  destruct st.(st_wrk) as [ | n rem ]. 
+  auto.
+  apply in_incr_trans with st.(st_in). auto. 
+  change st.(st_in) with (mkstate st.(st_in) rem).(st_in).
+  apply propagate_succ_list_incr.
+
+  eauto. apply in_incr_refl.
 Qed.
 
 (** ** Correctness invariant *)
@@ -563,30 +433,8 @@ Qed.
 (** ** Correctness of the solution returned by [iterate]. *)
 
 (** As a consequence of the [good_state] invariant, the result of
-  [iterate], if defined, is a solution of the dataflow inequations,
-  since [st_wrk] is empty when [iterate] terminates. *)
-
-Lemma iterate_solution:
-  forall niter st res n s,
-  good_state st ->
-  iterate _ _ step niter st = Some res ->
-  Plt n topnode -> In s (successors n) ->
-  L.ge res!!s (transf n res!!n).
-Proof.
-  intro niter; pattern niter; apply positive_Peano_ind; intros until s.
-  rewrite iterate_base. congruence.
-  intro GS. rewrite iterate_step. 
-  unfold step; caseEq (st.(st_wrk)).
-  intros. injection H1; intros; subst res. 
-  elim (GS n H2); intro.
-  rewrite H0 in H4. elim H4.
-  auto.
-  intros. apply H with 
-    (propagate_succ_list (mkstate st.(st_in) l)
-        (transf p st.(st_in)!!p) (successors p)). 
-  apply step_state_good; auto.
-  auto. auto. auto.
-Qed.
+  [fixpoint], if defined, is a solution of the dataflow inequations,
+  since [st_wrk] is empty when the iteration terminates. *)
 
 Theorem fixpoint_solution:
   forall res n s,
@@ -594,10 +442,20 @@ Theorem fixpoint_solution:
   Plt n topnode -> In s (successors n) ->
   L.ge res!!s (transf n res!!n).
 Proof.
-  unfold fixpoint. intros.
-  apply iterate_solution with num_iterations start_state.
-  apply start_state_good.
-  auto. auto. auto.
+  assert (forall res, fixpoint = Some res ->
+          forall n s, Plt n topnode -> In s (successors n) ->
+                      L.ge res!!s (transf n res!!n)).
+  unfold fixpoint. intros res PI. pattern res. 
+  eapply (PrimIter.iterate_prop _ _ step good_state).
+
+  intros st GOOD. unfold step. 
+  caseEq (st.(st_wrk)). 
+  intros. elim (GOOD n H0); intro. 
+  rewrite H in H2. contradiction.
+  auto.
+  intros n rem WRK. apply step_state_good; auto.
+
+  eauto. apply start_state_good. eauto.
 Qed.
 
 (** As a consequence of the monotonicity property, the result of
@@ -936,8 +794,7 @@ Definition basic_block_list (bb: bbmap) : list positive :=
 
 Definition fixpoint : option result :=
   let bb := basic_block_map in
-  iterate _ _ (step bb) num_iterations 
-              (mkstate (PMap.init L.top) (basic_block_list bb)).
+  PrimIter.iterate _ _ (step bb) (mkstate (PMap.init L.top) (basic_block_list bb)).
 
 (** ** Properties of predecessors and multiple-predecessors nodes *)
 
@@ -1121,23 +978,6 @@ Proof.
   right. assumption.
 Qed.
 
-Lemma analyze_invariant:
-  forall res count st,
-  iterate _ _ (step basic_block_map) count st = Some res ->
-  state_invariant st ->
-  state_invariant (mkstate res nil).
-Proof.
-  intros until count. pattern count. 
-  apply positive_Peano_ind; intros until st.
-  rewrite iterate_base. congruence.
-  rewrite iterate_step. unfold step at 1. case st; intros r w; simpl.
-  case w.
-  intros. replace res with r. auto. congruence.
-  intros pc wl. case (plt pc topnode); intros.
-  eapply H. eauto. apply propagate_successors_invariant; auto.
-  eapply H. eauto. eapply discard_top_worklist_invariant; eauto.
-Qed.
-
 Lemma initial_state_invariant:
   state_invariant (mkstate (PMap.init L.top) (basic_block_list basic_block_map)).
 Proof.
@@ -1146,6 +986,27 @@ Proof.
   right. intros. repeat rewrite PMap.gi. apply L.top_ge.
 Qed.
 
+Lemma analyze_invariant:
+  forall res,
+  fixpoint = Some res ->
+  state_invariant (mkstate res nil).
+Proof.
+  unfold fixpoint; intros. pattern res.
+  eapply (PrimIter.iterate_prop _ _ (step basic_block_map)
+           state_invariant).
+
+  intros st INV. destruct st as [stin stwrk]. 
+  unfold step. simpl. caseEq stwrk.
+  intro. congruence.
+
+  intros pc rem WRK. case (plt pc topnode); intro.
+  apply propagate_successors_invariant; auto. congruence. 
+  eapply discard_top_worklist_invariant; eauto. congruence.
+
+  eauto. apply initial_state_invariant.
+Qed.
+
+
 (** ** Correctness of the returned solution *)
 
 Theorem fixpoint_solution:
@@ -1154,10 +1015,9 @@ Theorem fixpoint_solution:
   Plt n topnode -> In s (successors n) ->
   L.ge res!!s (transf n res!!n).
 Proof.
-  unfold fixpoint. 
   intros. 
   assert (state_invariant (mkstate res nil)).
-  eapply analyze_invariant; eauto. apply initial_state_invariant.
+  eapply analyze_invariant; eauto. 
   elim H2; simpl; intros. 
   elim (H4 n H0); intros. 
   contradiction.
@@ -1169,10 +1029,9 @@ Theorem fixpoint_entry:
   fixpoint = Some res ->
   res!!entrypoint = L.top.
 Proof.
-  unfold fixpoint. 
   intros. 
   assert (state_invariant (mkstate res nil)).
-  eapply analyze_invariant; eauto. apply initial_state_invariant.
+  eapply analyze_invariant; eauto. 
   elim H0; simpl; intros. 
   apply H1. unfold basic_block_map, is_basic_block_head.
   fold predecessors. 
@@ -1201,28 +1060,21 @@ Proof.
   auto. apply H0.
 Qed.
 
-Lemma analyze_P:
-  forall bb res count st,
-  iterate _ _ (step bb) count st = Some res -> 
-  Pstate st ->
-  (forall pc,  P res!!pc).
-Proof.
-  intros until count; pattern count; apply positive_Peano_ind; intros until st.
-  rewrite iterate_base. congruence.
-  rewrite iterate_step; unfold step at 1; destruct st.(st_wrk).
-  intros. inversion H0. apply H1.
-  destruct (plt p topnode).
-  intros. eapply H. eauto. 
-  apply propagate_successors_P. apply Ptransf. apply H1. 
-  red; intro; simpl. apply H1. 
-  intros. eauto.
-Qed.
-
 Theorem fixpoint_invariant:
   forall res pc, fixpoint = Some res -> P res!!pc.
 Proof.
-  intros. unfold fixpoint in H. eapply analyze_P; eauto.
-  red; intro; simpl. rewrite PMap.gi. apply Ptop.
+  unfold fixpoint; intros. pattern res. 
+  eapply (PrimIter.iterate_prop _ _ (step basic_block_map) Pstate).
+
+  intros st PS. unfold step. destruct (st.(st_wrk)).
+  apply PS.
+  assert (PS2: Pstate (mkstate st.(st_in) l)).
+    red; intro; simpl. apply PS.
+  case (plt p topnode); intro.
+  apply propagate_successors_P. auto. auto. 
+  auto.
+
+  eauto. red; intro; simpl. rewrite PMap.gi. apply Ptop.
 Qed.
 
 End Solver.
diff --git a/backend/LTL.v b/backend/LTL.v
index 2c36cba..f20ba3f 100644
--- a/backend/LTL.v
+++ b/backend/LTL.v
@@ -9,6 +9,7 @@ Require Import Maps.
 Require Import AST.
 Require Import Integers.
 Require Import Values.
+Require Import Events.
 Require Import Mem.
 Require Import Globalenvs.
 Require Import Op.
@@ -39,6 +40,7 @@ Inductive block: Set :=
   | Bload: memory_chunk -> addressing -> list mreg -> mreg -> block -> block
   | Bstore: memory_chunk -> addressing -> list mreg -> mreg -> block -> block
   | Bcall: signature -> mreg + ident -> block -> block
+  | Balloc: block -> block
   | Bgoto: node -> block
   | Bcond: condition -> list mreg -> node -> node -> block
   | Breturn: block.
@@ -60,11 +62,19 @@ Record function: Set := mkfunction {
     forall (pc: node), Plt pc (Psucc fn_entrypoint) \/ fn_code!pc = None
 }.
 
-Definition program := AST.program function.
+Definition fundef := AST.fundef function.
+
+Definition program := AST.program fundef.
+
+Definition funsig (fd: fundef) :=
+  match fd with
+  | Internal f => f.(fn_sig)
+  | External ef => ef.(ef_sig)
+  end.
 
 (** * Operational semantics *)
 
-Definition genv := Genv.t function.
+Definition genv := Genv.t fundef.
 Definition locset := Locmap.t.
 
 Section RELSEM.
@@ -117,7 +127,7 @@ Definition return_regs (caller callee: locset) : locset :=
 
 Variable ge: genv.
 
-Definition find_function (ros: mreg + ident) (rs: locset) : option function :=
+Definition find_function (ros: mreg + ident) (rs: locset) : option fundef :=
   match ros with
   | inl r => Genv.find_funct ge (rs (R r))
   | inr symb =>
@@ -166,104 +176,119 @@ Inductive outcome: Set :=
   | Return: outcome.
 
 Inductive exec_instr: val ->
-                      block -> locset -> mem ->
+                      block -> locset -> mem -> trace ->
                       block -> locset -> mem -> Prop :=
   | exec_Bgetstack:
       forall sp sl r b rs m,
       exec_instr sp (Bgetstack sl r b) rs m
-                    b (Locmap.set (R r) (rs (S sl)) rs) m
+                 E0 b (Locmap.set (R r) (rs (S sl)) rs) m
   | exec_Bsetstack:
       forall sp r sl b rs m,
       exec_instr sp (Bsetstack r sl b) rs m
-                    b (Locmap.set (S sl) (rs (R r)) rs) m
+                 E0 b (Locmap.set (S sl) (rs (R r)) rs) m
   | exec_Bop:
       forall sp op args res b rs m v,
       eval_operation ge sp op (reglist args rs) = Some v ->
       exec_instr sp (Bop op args res b) rs m
-                    b (Locmap.set (R res) v rs) m
+                 E0 b (Locmap.set (R res) v rs) m
   | exec_Bload:
       forall sp chunk addr args dst b rs m a v,
       eval_addressing ge sp addr (reglist args rs) = Some a ->
       loadv chunk m a = Some v ->
       exec_instr sp (Bload chunk addr args dst b) rs m
-                    b (Locmap.set (R dst) v rs) m
+                 E0 b (Locmap.set (R dst) v rs) m
   | exec_Bstore:
       forall sp chunk addr args src b rs m m' a,
       eval_addressing ge sp addr (reglist args rs) = Some a ->
       storev chunk m a (rs (R src)) = Some m' ->
       exec_instr sp (Bstore chunk addr args src b) rs m
-                    b rs m'
+                 E0 b rs m'
   | exec_Bcall:
-      forall sp sig ros b rs m f rs' m',
+      forall sp sig ros b rs m t f rs' m',
       find_function ros rs = Some f ->
-      sig = f.(fn_sig) ->
-      exec_function f rs m rs' m' ->
+      sig = funsig f ->
+      exec_function f rs m t rs' m' ->
       exec_instr sp (Bcall sig ros b) rs m
-                    b (return_regs rs rs') m'
+                  t b (return_regs rs rs') m'
+  | exec_Balloc:
+      forall sp b rs m sz m' blk,
+      rs (R Conventions.loc_alloc_argument) = Vint sz ->
+      Mem.alloc m 0 (Int.signed sz) = (m', blk) ->
+      exec_instr sp (Balloc b) rs m E0 b
+                 (Locmap.set (R Conventions.loc_alloc_result) 
+                             (Vptr blk Int.zero) rs) m'
 
 with exec_instrs: val ->
-                  block -> locset -> mem ->
+                  block -> locset -> mem -> trace ->
                   block -> locset -> mem -> Prop :=
   | exec_refl:
       forall sp b rs m,
-      exec_instrs sp b rs m b rs m
+      exec_instrs sp b rs m E0 b rs m
   | exec_one:
-      forall sp b1 rs1 m1 b2 rs2 m2,
-      exec_instr sp b1 rs1 m1 b2 rs2 m2 ->
-      exec_instrs sp b1 rs1 m1 b2 rs2 m2
+      forall sp b1 rs1 m1 t b2 rs2 m2,
+      exec_instr sp b1 rs1 m1 t b2 rs2 m2 ->
+      exec_instrs sp b1 rs1 m1 t b2 rs2 m2
   | exec_trans:
-      forall sp b1 rs1 m1 b2 rs2 m2 b3 rs3 m3,
-      exec_instrs sp b1 rs1 m1 b2 rs2 m2 ->
-      exec_instrs sp b2 rs2 m2 b3 rs3 m3 ->
-      exec_instrs sp b1 rs1 m1 b3 rs3 m3
+      forall sp b1 rs1 m1 t t1 b2 rs2 m2 t2 b3 rs3 m3,
+      exec_instrs sp b1 rs1 m1 t1 b2 rs2 m2 ->
+      exec_instrs sp b2 rs2 m2 t2 b3 rs3 m3 ->
+      t = t1 ** t2 ->
+      exec_instrs sp b1 rs1 m1 t b3 rs3 m3
 
 with exec_block: val ->
-                 block -> locset -> mem ->
+                 block -> locset -> mem -> trace ->
                  outcome -> locset -> mem -> Prop :=
   | exec_Bgoto:
-      forall sp b rs m s rs' m',
-      exec_instrs sp b rs m (Bgoto s) rs' m' ->
-      exec_block sp b rs m (Cont s) rs' m'
+      forall sp b rs m t s rs' m',
+      exec_instrs sp b rs m t (Bgoto s) rs' m' ->
+      exec_block sp b rs m t (Cont s) rs' m'
   | exec_Bcond_true:
-      forall sp b rs m cond args ifso ifnot rs' m',
-      exec_instrs sp b rs m (Bcond cond args ifso ifnot) rs' m' ->
+      forall sp b rs m t cond args ifso ifnot rs' m',
+      exec_instrs sp b rs m t (Bcond cond args ifso ifnot) rs' m' ->
       eval_condition cond (reglist args rs') = Some true ->
-      exec_block sp b rs m (Cont ifso) rs' m'
+      exec_block sp b rs m t (Cont ifso) rs' m'
   | exec_Bcond_false:
-      forall sp b rs m cond args ifso ifnot rs' m',
-      exec_instrs sp b rs m (Bcond cond args ifso ifnot) rs' m' ->
+      forall sp b rs m t cond args ifso ifnot rs' m',
+      exec_instrs sp b rs m t (Bcond cond args ifso ifnot) rs' m' ->
       eval_condition cond (reglist args rs') = Some false ->
-      exec_block sp b rs m (Cont ifnot) rs' m'
+      exec_block sp b rs m t (Cont ifnot) rs' m'
   | exec_Breturn:
-      forall sp b rs m rs' m',
-      exec_instrs sp b rs m Breturn rs' m' ->
-      exec_block sp b rs m Return rs' m'
+      forall sp b rs m t rs' m',
+      exec_instrs sp b rs m t Breturn rs' m' ->
+      exec_block sp b rs m t Return rs' m'
 
 with exec_blocks: code -> val ->
-                  node -> locset -> mem ->
+                  node -> locset -> mem -> trace ->
                   outcome -> locset -> mem -> Prop :=
   | exec_blocks_refl:
       forall c sp pc rs m,
-      exec_blocks c sp pc rs m (Cont pc) rs m
+      exec_blocks c sp pc rs m E0 (Cont pc) rs m
   | exec_blocks_one:
-      forall c sp pc b m rs out rs' m',
+      forall c sp pc b m rs t out rs' m',
       c!pc = Some b ->
-      exec_block sp b rs m out rs' m' ->
-      exec_blocks c sp pc rs m out rs' m'
+      exec_block sp b rs m t out rs' m' ->
+      exec_blocks c sp pc rs m t out rs' m'
   | exec_blocks_trans:
-      forall c sp pc1 rs1 m1 pc2 rs2 m2 out rs3 m3,
-      exec_blocks c sp pc1 rs1 m1 (Cont pc2) rs2 m2 ->
-      exec_blocks c sp pc2 rs2 m2 out rs3 m3 ->
-      exec_blocks c sp pc1 rs1 m1 out rs3 m3
+      forall c sp pc1 rs1 m1 t t1 pc2 rs2 m2 t2 out rs3 m3,
+      exec_blocks c sp pc1 rs1 m1 t1 (Cont pc2) rs2 m2 ->
+      exec_blocks c sp pc2 rs2 m2 t2 out rs3 m3 ->
+      t = t1 ** t2 ->
+      exec_blocks c sp pc1 rs1 m1 t out rs3 m3
 
-with exec_function: function -> locset -> mem ->
+with exec_function: fundef -> locset -> mem -> trace ->
                                 locset -> mem -> Prop :=
-  | exec_funct:
-      forall f rs m m1 stk rs2 m2,
+  | exec_funct_internal:
+      forall f rs m m1 stk t rs2 m2,
       alloc m 0 f.(fn_stacksize) = (m1, stk) ->
       exec_blocks f.(fn_code) (Vptr stk Int.zero)
-                  f.(fn_entrypoint) (call_regs rs) m1 Return rs2 m2 ->
-      exec_function f rs m rs2 (free m2 stk).
+                  f.(fn_entrypoint) (call_regs rs) m1 t Return rs2 m2 ->
+      exec_function (Internal f) rs m t rs2 (free m2 stk)
+  | exec_funct_external:
+      forall ef args res rs1 rs2 m t,
+      event_match ef args t res ->
+      args = List.map rs1 (Conventions.loc_arguments ef.(ef_sig)) ->
+      rs2 = Locmap.set (R (Conventions.loc_result ef.(ef_sig))) res rs1 ->
+      exec_function (External ef) rs1 m t rs2 m.
 
 End RELSEM.
 
@@ -272,15 +297,15 @@ End RELSEM.
   main function, to be found in the machine register dictated
   by the calling conventions. *)
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv p in
   let m0 := Genv.init_mem p in
   exists b, exists f, exists rs, exists m,
   Genv.find_symbol ge p.(prog_main) = Some b /\
   Genv.find_funct_ptr ge b  = Some f /\
-  f.(fn_sig) = mksignature nil (Some Tint) /\
-  exec_function ge f (Locmap.init Vundef) m0 rs m /\
-  rs (R (Conventions.loc_result f.(fn_sig))) = r.
+  funsig f = mksignature nil (Some Tint) /\
+  exec_function ge f (Locmap.init Vundef) m0 t rs m /\
+  rs (R (Conventions.loc_result (funsig f))) = r.
 
 (** We remark that the [exec_blocks] relation is stable if
   the control-flow graph is extended by adding new basic blocks
@@ -293,9 +318,9 @@ Variable c1 c2: code.
 Hypothesis EXT: forall pc, c2!pc = c1!pc \/ c1!pc = None.
 
 Lemma exec_blocks_extends:
-  forall sp pc1 rs1 m1 out rs2 m2,
-  exec_blocks ge c1 sp pc1 rs1 m1 out rs2 m2 ->
-  exec_blocks ge c2 sp pc1 rs1 m1 out rs2 m2.
+  forall sp pc1 rs1 m1 t out rs2 m2,
+  exec_blocks ge c1 sp pc1 rs1 m1 t out rs2 m2 ->
+  exec_blocks ge c2 sp pc1 rs1 m1 t out rs2 m2.
 Proof.
   induction 1. 
   apply exec_blocks_refl.
@@ -319,6 +344,7 @@ Fixpoint successors_aux (b: block) : list node :=
   | Bload chunk addr args dst b => successors_aux b
   | Bstore chunk addr args src b => successors_aux b
   | Bcall sig ros b => successors_aux b
+  | Balloc b => successors_aux b
   | Bgoto n => n :: nil
   | Bcond cond args ifso ifnot => ifso :: ifnot :: nil
   | Breturn => nil
@@ -331,8 +357,8 @@ Definition successors (f: function) (pc: node) : list node :=
   end.
 
 Lemma successors_aux_invariant:
-  forall ge sp b rs m b' rs' m',
-  exec_instrs ge sp b rs m b' rs' m' ->
+  forall ge sp b rs m t b' rs' m',
+  exec_instrs ge sp b rs m t b' rs' m' ->
   successors_aux b = successors_aux b'.
 Proof.
   induction 1; simpl; intros.
@@ -342,16 +368,16 @@ Proof.
 Qed.
 
 Lemma successors_correct:
-  forall ge f sp pc rs m pc' rs' m' b,
+  forall ge f sp pc rs m t pc' rs' m' b,
   f.(fn_code)!pc = Some b ->
-  exec_block ge sp b rs m (Cont pc') rs' m' ->
+  exec_block ge sp b rs m t (Cont pc') rs' m' ->
   In pc' (successors f pc).
 Proof.
   intros. unfold successors. rewrite H. inversion H0.
-  rewrite (successors_aux_invariant _ _ _ _ _ _ _ _ H6); simpl.
+  rewrite (successors_aux_invariant _ _ _ _ _ _ _ _ _ H7); simpl.
   tauto.
-  rewrite (successors_aux_invariant _ _ _ _ _ _ _ _ H2); simpl.
+  rewrite (successors_aux_invariant _ _ _ _ _ _ _ _ _ H2); simpl.
   tauto.
-  rewrite (successors_aux_invariant _ _ _ _ _ _ _ _ H2); simpl.
+  rewrite (successors_aux_invariant _ _ _ _ _ _ _ _ _ H2); simpl.
   tauto.
 Qed.
diff --git a/backend/LTLtyping.v b/backend/LTLtyping.v
index 3f13ac3..3450814 100644
--- a/backend/LTLtyping.v
+++ b/backend/LTLtyping.v
@@ -73,6 +73,10 @@ Inductive wt_block : block -> Prop :=
       match ros with inl r => mreg_type r = Tint | _ => True end ->
       wt_block b ->
       wt_block (Bcall sig ros b)
+  | wt_Balloc:
+      forall b,
+      wt_block b ->
+      wt_block (Balloc b)
   | wt_Bgoto:
       forall lbl,
       wt_block (Bgoto lbl)
@@ -88,6 +92,14 @@ End WT_BLOCK.
 Definition wt_function (f: function) : Prop :=
   forall pc b, f.(fn_code)!pc = Some b -> wt_block f b.
 
+Inductive wt_fundef: fundef -> Prop :=
+  | wt_fundef_external: forall ef,
+      Conventions.sig_external_ok ef.(ef_sig) ->
+      wt_fundef (External ef)
+  | wt_function_internal: forall f,
+      wt_function f ->
+      wt_fundef (Internal f).
+
 Definition wt_program (p: program) : Prop :=
-  forall i f, In (i, f) (prog_funct p) -> wt_function f.
+  forall i f, In (i, f) (prog_funct p) -> wt_fundef f.
 
diff --git a/backend/Linear.v b/backend/Linear.v
index f4ed045..2520f5b 100644
--- a/backend/Linear.v
+++ b/backend/Linear.v
@@ -11,6 +11,7 @@ Require Import AST.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
@@ -37,6 +38,7 @@ Inductive instruction: Set :=
   | Lload: memory_chunk -> addressing -> list mreg -> mreg -> instruction
   | Lstore: memory_chunk -> addressing -> list mreg -> mreg -> instruction
   | Lcall: signature -> mreg + ident -> instruction
+  | Lalloc: instruction
   | Llabel: label -> instruction
   | Lgoto: label -> instruction
   | Lcond: condition -> list mreg -> label -> instruction
@@ -50,9 +52,17 @@ Record function: Set := mkfunction {
   fn_code: code
 }.
 
-Definition program := AST.program function.
+Definition fundef := AST.fundef function.
 
-Definition genv := Genv.t function.
+Definition program := AST.program fundef.
+
+Definition funsig (fd: fundef) :=
+  match fd with
+  | Internal f => f.(fn_sig)
+  | External ef => ef.(ef_sig)
+  end.
+
+Definition genv := Genv.t fundef.
 Definition locset := Locmap.t.
 
 (** * Operational semantics *)
@@ -88,7 +98,7 @@ Section RELSEM.
 
 Variable ge: genv.
 
-Definition find_function (ros: mreg + ident) (rs: locset) : option function :=
+Definition find_function (ros: mreg + ident) (rs: locset) : option fundef :=
   match ros with
   | inl r => Genv.find_funct ge (rs (R r))
   | inr symb =>
@@ -106,84 +116,99 @@ Definition find_function (ros: mreg + ident) (rs: locset) : option function :=
   [ls'] and [m'] are the final location state and memory state. *)
 
 Inductive exec_instr: function -> val ->
-                      code -> locset -> mem ->
+                      code -> locset -> mem -> trace ->
                       code -> locset -> mem -> Prop :=
   | exec_Lgetstack:
       forall f sp sl r b rs m,
       exec_instr f sp (Lgetstack sl r :: b) rs m
-                       b (Locmap.set (R r) (rs (S sl)) rs) m
+                   E0 b (Locmap.set (R r) (rs (S sl)) rs) m
   | exec_Lsetstack:
       forall f sp r sl b rs m,
       exec_instr f sp (Lsetstack r sl :: b) rs m
-                      b (Locmap.set (S sl) (rs (R r)) rs) m
+                   E0 b (Locmap.set (S sl) (rs (R r)) rs) m
   | exec_Lop:
       forall f sp op args res b rs m v,
       eval_operation ge sp op (reglist args rs) = Some v ->
       exec_instr f sp (Lop op args res :: b) rs m
-                      b (Locmap.set (R res) v rs) m
+                   E0 b (Locmap.set (R res) v rs) m
   | exec_Lload:
       forall f sp chunk addr args dst b rs m a v,
       eval_addressing ge sp addr (reglist args rs) = Some a ->
       loadv chunk m a = Some v ->
       exec_instr f sp (Lload chunk addr args dst :: b) rs m
-                      b (Locmap.set (R dst) v rs) m
+                   E0 b (Locmap.set (R dst) v rs) m
   | exec_Lstore:
       forall f sp chunk addr args src b rs m m' a,
       eval_addressing ge sp addr (reglist args rs) = Some a ->
       storev chunk m a (rs (R src)) = Some m' ->
       exec_instr f sp (Lstore chunk addr args src :: b) rs m
-                      b rs m'
+                   E0 b rs m'
   | exec_Lcall:
-      forall f sp sig ros b rs m f' rs' m',
+      forall f sp sig ros b rs m t f' rs' m',
       find_function ros rs = Some f' ->
-      sig = f'.(fn_sig) ->
-      exec_function f' rs m rs' m' ->
+      sig = funsig f' ->
+      exec_function f' rs m t rs' m' ->
       exec_instr f sp (Lcall sig ros :: b) rs m
-                      b (return_regs rs rs') m'
+                    t b (return_regs rs rs') m'
+  | exec_Lalloc:
+      forall f sp b rs m sz m' blk,
+      rs (R Conventions.loc_alloc_argument) = Vint sz ->
+      Mem.alloc m 0 (Int.signed sz) = (m', blk) ->
+      exec_instr f sp (Lalloc :: b) rs m
+                   E0 b (Locmap.set (R Conventions.loc_alloc_result) 
+                                    (Vptr blk Int.zero) rs) m'
   | exec_Llabel:
       forall f sp lbl b rs m,
       exec_instr f sp (Llabel lbl :: b) rs m
-                      b rs m
+                   E0 b rs m
   | exec_Lgoto:
       forall f sp lbl b rs m b',
       find_label lbl f.(fn_code) = Some b' ->
       exec_instr f sp (Lgoto lbl :: b) rs m
-                      b' rs m
+                   E0 b' rs m
   | exec_Lcond_true:
       forall f sp cond args lbl b rs m b',
       eval_condition cond (reglist args rs) = Some true ->
       find_label lbl f.(fn_code) = Some b' ->
       exec_instr f sp (Lcond cond args lbl :: b) rs m
-                      b' rs m
+                   E0 b' rs m
   | exec_Lcond_false:
       forall f sp cond args lbl b rs m,
       eval_condition cond (reglist args rs) = Some false ->
       exec_instr f sp (Lcond cond args lbl :: b) rs m
-                      b rs m
+                   E0 b rs m
 
 with exec_instrs: function -> val ->
-                  code -> locset -> mem ->
+                  code -> locset -> mem -> trace ->
                   code -> locset -> mem -> Prop :=
   | exec_refl:
       forall f sp b rs m,
-      exec_instrs f sp b rs m b rs m
+      exec_instrs f sp b rs m E0 b rs m
   | exec_one:
-      forall f sp b1 rs1 m1 b2 rs2 m2,
-      exec_instr f sp b1 rs1 m1 b2 rs2 m2 ->
-      exec_instrs f sp b1 rs1 m1 b2 rs2 m2
+      forall f sp b1 rs1 m1 t b2 rs2 m2,
+      exec_instr f sp b1 rs1 m1 t b2 rs2 m2 ->
+      exec_instrs f sp b1 rs1 m1 t b2 rs2 m2
   | exec_trans:
-      forall f sp b1 rs1 m1 b2 rs2 m2 b3 rs3 m3,
-      exec_instrs f sp b1 rs1 m1 b2 rs2 m2 ->
-      exec_instrs f sp b2 rs2 m2 b3 rs3 m3 ->
-      exec_instrs f sp b1 rs1 m1 b3 rs3 m3
-
-with exec_function: function -> locset -> mem -> locset -> mem -> Prop :=
-  | exec_funct:
-      forall f rs m m1 stk rs2 m2 b,
+      forall f sp b1 rs1 m1 t1 b2 rs2 m2 t2 b3 rs3 m3 t,
+      exec_instrs f sp b1 rs1 m1 t1 b2 rs2 m2 ->
+      exec_instrs f sp b2 rs2 m2 t2 b3 rs3 m3 ->
+      t = t1 ** t2 ->
+      exec_instrs f sp b1 rs1 m1 t b3 rs3 m3
+
+with exec_function: fundef -> locset -> mem -> trace -> locset -> mem -> Prop :=
+  | exec_funct_internal:
+      forall f rs m t m1 stk rs2 m2 b,
       alloc m 0 f.(fn_stacksize) = (m1, stk) ->
       exec_instrs f (Vptr stk Int.zero)
-                  f.(fn_code) (call_regs rs) m1 (Lreturn :: b) rs2 m2 ->
-      exec_function f rs m rs2 (free m2 stk).
+                  f.(fn_code) (call_regs rs) m1
+                t (Lreturn :: b) rs2 m2 ->
+      exec_function (Internal f) rs m t rs2 (free m2 stk)
+  | exec_funct_external:
+      forall ef args res rs1 rs2 m t,
+      event_match ef args t res ->
+      args = List.map rs1 (Conventions.loc_arguments ef.(ef_sig)) ->
+      rs2 = Locmap.set (R (Conventions.loc_result ef.(ef_sig))) res rs1 ->
+      exec_function (External ef) rs1 m t rs2 m.
 
 Scheme exec_instr_ind3 := Minimality for exec_instr Sort Prop
   with exec_instrs_ind3 := Minimality for exec_instrs Sort Prop
@@ -191,13 +216,13 @@ Scheme exec_instr_ind3 := Minimality for exec_instr Sort Prop
 
 End RELSEM.
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv p in
   let m0 := Genv.init_mem p in
   exists b, exists f, exists rs, exists m,
   Genv.find_symbol ge p.(prog_main) = Some b /\
   Genv.find_funct_ptr ge b = Some f /\
-  f.(fn_sig) = mksignature nil (Some Tint) /\
-  exec_function ge f (Locmap.init Vundef) m0 rs m /\
-  rs (R (Conventions.loc_result f.(fn_sig))) = r.
+  funsig f = mksignature nil (Some Tint) /\
+  exec_function ge f (Locmap.init Vundef) m0 t rs m /\
+  rs (R (Conventions.loc_result (funsig f))) = r.
 
diff --git a/backend/Linearize.v b/backend/Linearize.v
index af70b0f..f5b2a9e 100644
--- a/backend/Linearize.v
+++ b/backend/Linearize.v
@@ -148,6 +148,8 @@ Fixpoint linearize_block (b: block) (k: code) {struct b} : code :=
       Lstore chunk addr args src :: linearize_block b k
   | Bcall sig ros b =>
       Lcall sig ros :: linearize_block b k
+  | Balloc b =>
+      Lalloc :: linearize_block b k
   | Bgoto s =>
       Lgoto s :: k
   | Bcond cond args s1 s2 =>
@@ -208,5 +210,8 @@ Definition cleanup_function (f: Linear.function) : Linear.function :=
 Definition transf_function (f: LTL.function) : Linear.function :=
   cleanup_function (linearize_function f).
 
+Definition transf_fundef (f: LTL.fundef) : Linear.fundef :=
+  AST.transf_fundef transf_function f.
+
 Definition transf_program (p: LTL.program) : Linear.program :=
-  transform_program transf_function p.
+  transform_program transf_fundef p.
diff --git a/backend/Linearizeproof.v b/backend/Linearizeproof.v
index b80acb4..22bf19c 100644
--- a/backend/Linearizeproof.v
+++ b/backend/Linearizeproof.v
@@ -6,6 +6,7 @@ Require Import AST.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
@@ -25,19 +26,25 @@ Let tge := Genv.globalenv tprog.
 Lemma functions_translated:
   forall v f,
   Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (transf_function f).
-Proof (@Genv.find_funct_transf _ _ transf_function prog).
+  Genv.find_funct tge v = Some (transf_fundef f).
+Proof (@Genv.find_funct_transf _ _ transf_fundef prog).
 
 Lemma function_ptr_translated:
   forall v f,
   Genv.find_funct_ptr ge v = Some f ->
-  Genv.find_funct_ptr tge v = Some (transf_function f).
-Proof (@Genv.find_funct_ptr_transf _ _ transf_function prog).
+  Genv.find_funct_ptr tge v = Some (transf_fundef f).
+Proof (@Genv.find_funct_ptr_transf _ _ transf_fundef prog).
 
 Lemma symbols_preserved:
   forall id,
   Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof (@Genv.find_symbol_transf _ _ transf_function prog).
+Proof (@Genv.find_symbol_transf _ _ transf_fundef prog).
+
+Lemma sig_preserved:
+  forall f, funsig (transf_fundef f) = LTL.funsig f.
+Proof.
+  destruct f; reflexivity.
+Qed.
 
 (** * Correctness of reachability analysis *)
 
@@ -80,9 +87,9 @@ Qed.
   [pc] is reachable, then [pc'] is reachable. *)
 
 Lemma reachable_correct_1:
-  forall f sp pc rs m pc' rs' m' b,
+  forall f sp pc rs m t pc' rs' m' b,
   f.(LTL.fn_code)!pc = Some b ->
-  exec_block ge sp b rs m (Cont pc') rs' m' ->
+  exec_block ge sp b rs m t (Cont pc') rs' m' ->
   (reachable f)!!pc = true ->
   (reachable f)!!pc' = true.
 Proof.
@@ -92,8 +99,8 @@ Proof.
 Qed.
 
 Lemma reachable_correct_2:
-  forall c sp pc rs m out rs' m',
-  exec_blocks ge c sp pc rs m out rs' m' ->  
+  forall c sp pc rs m t out rs' m',
+  exec_blocks ge c sp pc rs m t out rs' m' ->  
   forall f pc',
   c = f.(LTL.fn_code) ->
   out = Cont pc' ->
@@ -236,18 +243,19 @@ Lemma starts_with_correct:
   starts_with lbl c1 = true ->
   find_label lbl c2 = Some c3 ->
   exec_instrs tge f sp (cleanup_code c1) ls m 
-                       (cleanup_code c3) ls m.
+                    E0 (cleanup_code c3) ls m.
 Proof.
   induction c1.
   simpl; intros; discriminate.
   simpl starts_with. destruct a; try (intros; discriminate).
-  intros. apply exec_trans with (cleanup_code c1) ls m.
+  intros. apply exec_trans with E0 (cleanup_code c1) ls m E0.
   simpl. 
   constructor. constructor. 
   destruct (peq lbl l).
   subst l. replace c3 with c1. constructor.
   apply find_label_unique with lbl c2; auto.
   apply IHc1 with c2; auto. eapply is_tail_cons_left; eauto.
+  traceEq.
 Qed.
 
 (** Code cleanup preserves the labeling of the code. *)
@@ -273,13 +281,13 @@ Qed.
   or one transitions in the cleaned-up code. *)
 
 Lemma cleanup_code_correct_1:
-  forall f sp c1 ls1 m1 c2 ls2 m2,
-  exec_instr tge f sp c1 ls1 m1 c2 ls2 m2 ->
+  forall f sp c1 ls1 m1 t c2 ls2 m2,
+  exec_instr tge f sp c1 ls1 m1 t c2 ls2 m2 ->
   is_tail c1 f.(fn_code) ->
   unique_labels f.(fn_code) ->
   exec_instrs tge (cleanup_function f) sp 
                        (cleanup_code c1) ls1 m1
-                       (cleanup_code c2) ls2 m2.
+                     t (cleanup_code c2) ls2 m2.
 Proof.
   induction 1; simpl; intros;
   try (apply exec_one; econstructor; eauto; fail).
@@ -310,8 +318,8 @@ Proof.
 Qed.
 
 Lemma is_tail_exec_instr:
-  forall f sp c1 ls1 m1 c2 ls2 m2,
-  exec_instr tge f sp c1 ls1 m1 c2 ls2 m2 ->
+  forall f sp c1 ls1 m1 t c2 ls2 m2,
+  exec_instr tge f sp c1 ls1 m1 t c2 ls2 m2 ->
   is_tail c1 f.(fn_code) -> is_tail c2 f.(fn_code).
 Proof.
   induction 1; intros;
@@ -321,8 +329,8 @@ Proof.
 Qed.
 
 Lemma is_tail_exec_instrs:
-  forall f sp c1 ls1 m1 c2 ls2 m2,
-  exec_instrs tge f sp c1 ls1 m1 c2 ls2 m2 ->
+  forall f sp c1 ls1 m1 t c2 ls2 m2,
+  exec_instrs tge f sp c1 ls1 m1 t c2 ls2 m2 ->
   is_tail c1 f.(fn_code) -> is_tail c2 f.(fn_code).
 Proof.
   induction 1; intros.
@@ -335,31 +343,32 @@ Qed.
   to zero, one or several transitions in the cleaned-up code. *)
 
 Lemma cleanup_code_correct_2:
-  forall f sp c1 ls1 m1 c2 ls2 m2,
-  exec_instrs tge f sp c1 ls1 m1 c2 ls2 m2 ->
+  forall f sp c1 ls1 m1 t c2 ls2 m2,
+  exec_instrs tge f sp c1 ls1 m1 t c2 ls2 m2 ->
   is_tail c1 f.(fn_code) ->
   unique_labels f.(fn_code) ->
   exec_instrs tge (cleanup_function f) sp 
                        (cleanup_code c1) ls1 m1
-                       (cleanup_code c2) ls2 m2.
+                     t (cleanup_code c2) ls2 m2.
 Proof.
   induction 1; simpl; intros.
   apply exec_refl.
   eapply cleanup_code_correct_1; eauto.
-  apply exec_trans with (cleanup_code b2) rs2 m2.
+  apply exec_trans with t1 (cleanup_code b2) rs2 m2 t2.
   auto. 
   apply IHexec_instrs2; auto.
   eapply is_tail_exec_instrs; eauto.
+  auto.
 Qed.
 
 Lemma cleanup_function_correct:
-  forall f ls1 m1 ls2 m2,
-  exec_function tge f ls1 m1 ls2 m2 ->
+  forall f ls1 m1 t ls2 m2,
+  exec_function tge (Internal f) ls1 m1 t ls2 m2 ->
   unique_labels f.(fn_code) ->
-  exec_function tge (cleanup_function f) ls1 m1 ls2 m2. 
+  exec_function tge (Internal (cleanup_function f)) ls1 m1 t ls2 m2. 
 Proof.
-  induction 1; intro.
-  generalize (cleanup_code_correct_2 _ _ _ _ _ _ _ _ H0 (is_tail_refl _) H1).
+  intros. inversion H; subst.
+  generalize (cleanup_code_correct_2 _ _ _ _ _ _ _ _ _ H3 (is_tail_refl _) H0).
   simpl. intro.
   econstructor; eauto.
 Qed.
@@ -479,8 +488,8 @@ Definition valid_outcome (f: LTL.function) (out: outcome) :=
 (** Auxiliary lemma used to establish the [valid_outcome] property. *)
 
 Lemma exec_blocks_valid_outcome:
-  forall c sp pc ls1 m1 out ls2 m2,
-  exec_blocks ge c sp pc ls1 m1 out ls2 m2 ->
+  forall c sp pc ls1 m1 t out ls2 m2,
+  exec_blocks ge c sp pc ls1 m1 t out ls2 m2 ->
   forall f,
   c = f.(LTL.fn_code) ->
   (reachable f)!!pc = true ->
@@ -514,34 +523,34 @@ Inductive cont_for_outcome: LTL.function -> outcome -> code -> Prop :=
 
 Definition exec_instr_prop 
   (sp: val) (b1: block) (ls1: locset) (m1: mem)
-            (b2: block) (ls2: locset) (m2: mem) : Prop :=
+  (t: trace) (b2: block) (ls2: locset) (m2: mem) : Prop :=
   forall f k,
   exec_instr tge (linearize_function f) sp
                  (linearize_block b1 k) ls1 m1
-                 (linearize_block b2 k) ls2 m2.
+               t (linearize_block b2 k) ls2 m2.
 
 Definition exec_instrs_prop
   (sp: val) (b1: block) (ls1: locset) (m1: mem)
-            (b2: block) (ls2: locset) (m2: mem) : Prop :=
+  (t: trace) (b2: block) (ls2: locset) (m2: mem) : Prop :=
   forall f k,
   exec_instrs tge (linearize_function f) sp
                   (linearize_block b1 k) ls1 m1
-                  (linearize_block b2 k) ls2 m2.
+                t (linearize_block b2 k) ls2 m2.
 
 Definition exec_block_prop
   (sp: val) (b: block) (ls1: locset) (m1: mem) 
-            (out: outcome) (ls2: locset) (m2: mem): Prop :=
+  (t: trace) (out: outcome) (ls2: locset) (m2: mem): Prop :=
   forall f k,
   valid_outcome f out ->
   exists k',
   exec_instrs tge (linearize_function f) sp
                   (linearize_block b k) ls1 m1
-                  k' ls2 m2
+                t k' ls2 m2
   /\ cont_for_outcome f out k'.
 
 Definition exec_blocks_prop
   (c: LTL.code) (sp: val) (pc: node) (ls1: locset) (m1: mem) 
-                      (out: outcome) (ls2: locset) (m2: mem): Prop :=
+         (t: trace) (out: outcome) (ls2: locset) (m2: mem): Prop :=
   forall f k,
   c = f.(LTL.fn_code) ->
   (reachable f)!!pc = true ->
@@ -550,12 +559,13 @@ Definition exec_blocks_prop
   exists k',
   exec_instrs tge (linearize_function f) sp
                   k ls1 m1
-                  k' ls2 m2
+                t k' ls2 m2
   /\ cont_for_outcome f out k'.
 
 Definition exec_function_prop
-  (f: LTL.function) (ls1: locset) (m1: mem) (ls2: locset) (m2: mem): Prop :=
-  exec_function tge (transf_function f) ls1 m1 ls2 m2.
+  (f: LTL.fundef) (ls1: locset) (m1: mem) (t: trace)
+  (ls2: locset) (m2: mem): Prop :=
+  exec_function tge (transf_fundef f) ls1 m1 t ls2 m2.
 
 Scheme exec_instr_ind5 := Minimality for LTL.exec_instr Sort Prop
   with exec_instrs_ind5 := Minimality for LTL.exec_instrs Sort Prop
@@ -567,9 +577,9 @@ Scheme exec_instr_ind5 := Minimality for LTL.exec_instr Sort Prop
   derivation. *)
 
 Lemma transf_function_correct:
-  forall f ls1 m1 ls2 m2,
-  LTL.exec_function ge f ls1 m1 ls2 m2 ->
-  exec_function_prop f ls1 m1 ls2 m2.
+  forall f ls1 m1 t ls2 m2,
+  LTL.exec_function ge f ls1 m1 t ls2 m2 ->
+  exec_function_prop f ls1 m1 t ls2 m2.
 Proof.
   apply (exec_function_ind5 ge
            exec_instr_prop
@@ -596,27 +606,29 @@ Proof.
   exact symbols_preserved.
   auto.
   (* call *)
-  apply exec_Lcall with (transf_function f).
+  apply exec_Lcall with (transf_fundef f).
   generalize H. destruct ros; simpl.
   intro; apply functions_translated; auto.
   rewrite symbols_preserved. destruct (Genv.find_symbol ge i).
   intro; apply function_ptr_translated; auto. congruence.
-  rewrite H0; reflexivity.
+  generalize (sig_preserved f). congruence.
   apply H2. 
+  (* alloc *)
+  eapply exec_Lalloc; eauto. 
   (* instr_refl *)
   apply exec_refl.
   (* instr_one *)
   apply exec_one. apply H0. 
   (* instr_trans *)
-  apply exec_trans with (linearize_block b2 k) rs2 m2.
-  apply H0. apply H2.
+  apply exec_trans with t1 (linearize_block b2 k) rs2 m2 t2.
+  apply H0. apply H2. auto.
   (* goto *)
   elim H1. intros REACH [b2 AT2]. 
   generalize (H0 f k). simpl. intro.
   elim (find_label_lin f s b2 AT2 REACH). intros k2 FIND.
   exists (linearize_block b2 k2).
   split. 
-  eapply exec_trans. eexact H2. constructor. constructor. auto.
+  eapply exec_trans. eexact H2. constructor. constructor. auto. traceEq.
   constructor. auto. 
   (* cond, true *)
   elim H2. intros REACH [b2 AT2]. 
@@ -628,10 +640,10 @@ Proof.
   eapply exec_trans. eexact H3. 
   eapply exec_trans. apply exec_one. apply exec_Lcond_false.
   change false with (negb true). apply eval_negate_condition. auto.
-  apply exec_one. apply exec_Lgoto. auto. 
+  apply exec_one. apply exec_Lgoto. auto. reflexivity. traceEq.
   eapply exec_trans. eexact H3. 
   apply exec_one. apply exec_Lcond_true.
-  auto. auto. 
+  auto. auto. traceEq.
   constructor; auto.
   (* cond, false *)
   elim H2. intros REACH [b2 AT2]. 
@@ -643,10 +655,10 @@ Proof.
   eapply exec_trans. eexact H3. 
   apply exec_one. apply exec_Lcond_true. 
   change true with (negb false). apply eval_negate_condition. auto.
-  auto. 
+  auto. traceEq.
   eapply exec_trans. eexact H3.
   eapply exec_trans. apply exec_one. apply exec_Lcond_false. auto.
-  apply exec_one. apply exec_Lgoto. auto. 
+  apply exec_one. apply exec_Lgoto. auto. reflexivity. traceEq.
   constructor; auto.
   (* return *)
   exists (Lreturn :: k). split. 
@@ -663,11 +675,11 @@ Proof.
     eapply reachable_correct_2. eexact H. auto. auto. auto.
   assert (valid_outcome f (Cont pc2)).
     eapply exec_blocks_valid_outcome; eauto.
-  generalize (H0 f k H3 H4 H5 H8). intros [k1 [EX1 CFO2]].
+  generalize (H0 f k H4 H5 H6 H9). intros [k1 [EX1 CFO2]].
   inversion CFO2. 
-  generalize (H2 f k1 H3 H7 H11 H6). intros [k2 [EX2 CFO3]].
+  generalize (H2 f k1 H4 H8 H12 H7). intros [k2 [EX2 CFO3]].
   exists k2. split. eapply exec_trans; eauto. auto.
-  (* function -- TA-DA! *)
+  (* internal function -- TA-DA! *)
   assert (REACH0: (reachable f)!!(fn_entrypoint f) = true).
     apply reachable_entrypoint.
   assert (VO2: valid_outcome f Return). simpl; auto.
@@ -687,25 +699,27 @@ Proof.
   inversion CO. subst k'. 
   unfold transf_function. apply cleanup_function_correct.
   econstructor. eauto. rewrite EQ. eapply exec_trans.
-  apply exec_one. constructor. eauto.
+  apply exec_one. constructor. eauto. traceEq.
   apply unique_labels_lin_function.
+  (* external function *)
+  econstructor; eauto.
 Qed.
 
 End LINEARIZATION.
 
 Theorem transf_program_correct:
-  forall (p: LTL.program) (r: val),
-  LTL.exec_program p r ->
-  Linear.exec_program (transf_program p) r.
+  forall (p: LTL.program) (t: trace) (r: val),
+  LTL.exec_program p t r ->
+  Linear.exec_program (transf_program p) t r.
 Proof.
-  intros p r [b [f [ls [m [FIND1 [FIND2 [SIG [EX RES]]]]]]]].
-  red. exists b; exists (transf_function f); exists ls; exists m.
+  intros p t r [b [f [ls [m [FIND1 [FIND2 [SIG [EX RES]]]]]]]].
+  red. exists b; exists (transf_fundef f); exists ls; exists m.
   split. change (prog_main (transf_program p)) with (prog_main p).
   rewrite symbols_preserved; auto.
   split. apply function_ptr_translated. auto.
-  split. auto.
+  split. generalize (sig_preserved f); congruence.
   split. apply transf_function_correct. 
   unfold transf_program. rewrite Genv.init_mem_transf. auto.
-  exact RES.
+  rewrite sig_preserved. exact RES.
 Qed.
 
diff --git a/backend/Linearizetyping.v b/backend/Linearizetyping.v
index 6cebca8..66926e9 100644
--- a/backend/Linearizetyping.v
+++ b/backend/Linearizetyping.v
@@ -274,6 +274,8 @@ Proof.
   (* call *)
   constructor; auto. 
   eapply size_arguments_bound; eauto.
+  (* alloc *)
+  constructor.
   (* goto *)
   constructor. 
   (* cond *)
@@ -327,14 +329,24 @@ Proof.
   apply cleanup_function_conservation_2; auto.
 Qed.
 
+Lemma wt_transf_fundef:
+  forall f,
+  LTLtyping.wt_fundef f ->
+  wt_fundef (transf_fundef f). 
+Proof.
+  induction 1; simpl.
+  constructor; assumption.
+  constructor; apply wt_transf_function; assumption.
+Qed.
+
 Lemma program_typing_preserved:
   forall (p: LTL.program),
   LTLtyping.wt_program p ->
   Lineartyping.wt_program (transf_program p).
 Proof.
   intros; red; intros.
-  generalize (transform_program_function transf_function p i f H0).
+  generalize (transform_program_function transf_fundef p i f H0).
   intros [f0 [IN TR]].
-  subst f. apply wt_transf_function; auto. 
+  subst f. apply wt_transf_fundef; auto. 
   apply (H i f0 IN).
 Qed.
diff --git a/backend/Lineartyping.v b/backend/Lineartyping.v
index 0b13b40..bf41908 100644
--- a/backend/Lineartyping.v
+++ b/backend/Lineartyping.v
@@ -38,6 +38,7 @@ Definition regs_of_instr (i: instruction) : list mreg :=
   | Lstore chunk addr args src => src :: args
   | Lcall sig (inl fn) => fn :: nil
   | Lcall sig (inr _) => nil
+  | Lalloc => nil
   | Llabel lbl => nil
   | Lgoto lbl => nil
   | Lcond cond args lbl => args
@@ -231,6 +232,8 @@ Inductive wt_instr : instruction -> Prop :=
       size_arguments sig <= bound_outgoing b ->
       match ros with inl r => mreg_type r = Tint | _ => True end ->
       wt_instr (Lcall sig ros)
+  | wt_Lalloc:
+      wt_instr Lalloc
   | wt_Llabel:
       forall lbl,
       wt_instr (Llabel lbl)
@@ -249,6 +252,14 @@ End WT_INSTR.
 Definition wt_function (f: function) : Prop :=
   forall instr, In instr f.(fn_code) -> wt_instr f instr.
 
+Inductive wt_fundef: fundef -> Prop :=
+  | wt_fundef_external: forall ef,
+      Conventions.sig_external_ok ef.(ef_sig) ->
+      wt_fundef (External ef)
+  | wt_function_internal: forall f,
+      wt_function f ->
+      wt_fundef (Internal f).
+
 Definition wt_program (p: program) : Prop :=
-  forall i f, In (i, f) (prog_funct p) -> wt_function f.
+  forall i f, In (i, f) (prog_funct p) -> wt_fundef f.
 
diff --git a/backend/Mach.v b/backend/Mach.v
index f953798..1a9a94a 100644
--- a/backend/Mach.v
+++ b/backend/Mach.v
@@ -10,9 +10,11 @@ Require Import AST.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
+Require Conventions.
 
 (** * Abstract syntax *)
 
@@ -43,6 +45,7 @@ Inductive instruction: Set :=
   | Mload: memory_chunk -> addressing -> list mreg -> mreg -> instruction
   | Mstore: memory_chunk -> addressing -> list mreg -> mreg -> instruction
   | Mcall: signature -> mreg + ident -> instruction
+  | Malloc: instruction
   | Mlabel: label -> instruction
   | Mgoto: label -> instruction
   | Mcond: condition -> list mreg -> label -> instruction
@@ -56,9 +59,17 @@ Record function: Set := mkfunction
     fn_stacksize: Z;
     fn_framesize: Z }.
 
-Definition program := AST.program function.
+Definition fundef := AST.fundef function.
 
-Definition genv := Genv.t function.
+Definition program := AST.program fundef.
+
+Definition funsig (fd: fundef) :=
+  match fd with
+  | Internal f => f.(fn_sig)
+  | External ef => ef.(ef_sig)
+  end.
+
+Definition genv := Genv.t fundef.
 
 (** * Dynamic semantics *)
 
@@ -122,7 +133,7 @@ Section RELSEM.
 
 Variable ge: genv.
 
-Definition find_function (ros: mreg + ident) (rs: regset) : option function :=
+Definition find_function (ros: mreg + ident) (rs: regset) : option fundef :=
   match ros with
   | inl r => Genv.find_funct ge (rs r)
   | inr symb =>
@@ -141,95 +152,104 @@ Definition find_function (ros: mreg + ident) (rs: regset) : option function :=
 
 Inductive exec_instr:
       function -> val ->
-      code -> regset -> mem ->
+      code -> regset -> mem -> trace ->
       code -> regset -> mem -> Prop :=
   | exec_Mlabel:
       forall f sp lbl c rs m,
       exec_instr f sp
                  (Mlabel lbl :: c) rs m
-                 c rs m
+              E0 c rs m
   | exec_Mgetstack:
       forall f sp ofs ty dst c rs m v,
       load_stack m sp ty ofs = Some v ->
       exec_instr f sp
                  (Mgetstack ofs ty dst :: c) rs m
-                 c (rs#dst <- v) m
+              E0 c (rs#dst <- v) m
   | exec_Msetstack:
       forall f sp src ofs ty c rs m m',
       store_stack m sp ty ofs (rs src) = Some m' ->
       exec_instr f sp
                  (Msetstack src ofs ty :: c) rs m
-                 c rs m'
+              E0 c rs m'
   | exec_Mgetparam:
       forall f sp parent ofs ty dst c rs m v,
       load_stack m sp Tint (Int.repr 0) = Some parent ->
       load_stack m parent ty ofs = Some v ->
       exec_instr f sp
                  (Mgetparam ofs ty dst :: c) rs m
-                 c (rs#dst <- v) m
+              E0 c (rs#dst <- v) m
   | exec_Mop:
       forall f sp op args res c rs m v,
       eval_operation ge sp op rs##args = Some v ->
       exec_instr f sp
                  (Mop op args res :: c) rs m
-                 c (rs#res <- v) m
+              E0 c (rs#res <- v) m
   | exec_Mload:
       forall f sp chunk addr args dst c rs m a v,
       eval_addressing ge sp addr rs##args = Some a ->
       Mem.loadv chunk m a = Some v ->
       exec_instr f sp 
                  (Mload chunk addr args dst :: c) rs m
-                 c (rs#dst <- v) m
+              E0 c (rs#dst <- v) m
   | exec_Mstore:
       forall f sp chunk addr args src c rs m m' a,
       eval_addressing ge sp addr rs##args = Some a ->
       Mem.storev chunk m a (rs src) = Some m' ->
       exec_instr f sp
                  (Mstore chunk addr args src :: c) rs m
-                 c rs m'
+              E0 c rs m'
   | exec_Mcall:
-      forall f sp sig ros c rs m f' rs' m',
+      forall f sp sig ros c rs m f' t rs' m',
       find_function ros rs = Some f' ->
-      exec_function f' sp rs m rs' m' ->
+      exec_function f' sp rs m t rs' m' ->
       exec_instr f sp
                  (Mcall sig ros :: c) rs m
-                 c rs' m'
+               t c rs' m'
+  | exec_Malloc:
+      forall f sp c rs m sz m' blk,
+      rs (Conventions.loc_alloc_argument) = Vint sz ->
+      Mem.alloc m 0 (Int.signed sz) = (m', blk) ->
+      exec_instr f sp 
+                 (Malloc :: c) rs m
+              E0 c (rs#Conventions.loc_alloc_result <- 
+                                              (Vptr blk Int.zero)) m'
   | exec_Mgoto:
       forall f sp lbl c rs m c',
       find_label lbl f.(fn_code) = Some c' ->
       exec_instr f sp
                  (Mgoto lbl :: c) rs m
-                 c' rs m
+              E0 c' rs m
   | exec_Mcond_true:
       forall f sp cond args lbl c rs m c',
       eval_condition cond rs##args = Some true ->
       find_label lbl f.(fn_code) = Some c' ->
       exec_instr f sp
                  (Mcond cond args lbl :: c) rs m
-                 c' rs m
+              E0 c' rs m
   | exec_Mcond_false:
       forall f sp cond args lbl c rs m,
       eval_condition cond rs##args = Some false ->
       exec_instr f sp
                  (Mcond cond args lbl :: c) rs m
-                 c rs m
+              E0 c rs m
 
 with exec_instrs:
       function -> val ->
-      code -> regset -> mem ->
+      code -> regset -> mem -> trace ->
       code -> regset -> mem -> Prop :=
   | exec_refl:
       forall f sp c rs m,
-      exec_instrs f sp  c rs m  c rs m
+      exec_instrs f sp  c rs m E0 c rs m
   | exec_one:
-      forall f sp c rs m c' rs' m',
-      exec_instr f sp c rs m  c' rs' m' ->
-      exec_instrs f sp c rs m  c' rs' m'
+      forall f sp c rs m t c' rs' m',
+      exec_instr f sp c rs m t c' rs' m' ->
+      exec_instrs f sp c rs m t c' rs' m'
   | exec_trans:
-      forall f sp c1 rs1 m1 c2 rs2 m2 c3 rs3 m3,
-      exec_instrs f sp  c1 rs1 m1  c2 rs2 m2 ->
-      exec_instrs f sp  c2 rs2 m2  c3 rs3 m3 ->
-      exec_instrs f sp  c1 rs1 m1  c3 rs3 m3
+      forall f sp c1 rs1 m1 t1 c2 rs2 m2 t2 c3 rs3 m3 t3,
+      exec_instrs f sp  c1 rs1 m1 t1 c2 rs2 m2 ->
+      exec_instrs f sp  c2 rs2 m2 t2 c3 rs3 m3 ->
+      t3 = t1 ** t2 ->
+      exec_instrs f sp  c1 rs1 m1 t3 c3 rs3 m3
 
 (** In addition to reserving the word at offset 0 in the activation 
   record for maintaining the linking of activation records,
@@ -252,9 +272,9 @@ with exec_instrs:
 
 with exec_function_body:
       function -> val -> val ->
-      regset -> mem -> regset -> mem -> Prop :=
+      regset -> mem -> trace -> regset -> mem -> Prop :=
   | exec_funct_body:
-      forall f parent ra rs m rs' m1 m2 m3 m4 stk c,
+      forall f parent ra rs m t rs' m1 m2 m3 m4 stk c,
       Mem.alloc m (- f.(fn_framesize))
                   (align_16_top (- f.(fn_framesize)) f.(fn_stacksize))
                                                         = (m1, stk) ->
@@ -263,19 +283,25 @@ with exec_function_body:
       store_stack m2 sp Tint (Int.repr 4) ra = Some m3 ->
       exec_instrs f sp
                   f.(fn_code) rs m3
-                 (Mreturn :: c) rs' m4 ->
+                t (Mreturn :: c) rs' m4 ->
       load_stack m4 sp Tint (Int.repr 0) = Some parent ->
       load_stack m4 sp Tint (Int.repr 4) = Some ra ->
-      exec_function_body f parent ra rs m rs' (Mem.free m4 stk)
+      exec_function_body f parent ra rs m t rs' (Mem.free m4 stk)
 
 with exec_function:
-      function -> val -> regset -> mem -> regset -> mem -> Prop :=
-  | exec_funct:
-      forall f parent rs m rs' m',
+      fundef -> val -> regset -> mem -> trace -> regset -> mem -> Prop :=
+  | exec_funct_internal:
+      forall f parent rs m t rs' m',
       (forall ra,
          Val.has_type ra Tint ->
-         exec_function_body f parent ra rs m rs' m') ->
-      exec_function f parent rs m rs' m'.
+         exec_function_body f parent ra rs m t rs' m') ->
+      exec_function (Internal f) parent rs m t rs' m'
+  | exec_funct_external:
+      forall ef parent args res rs1 rs2 m t,
+      event_match ef args t res ->
+      args = rs1##(Conventions.loc_external_arguments ef.(ef_sig)) ->
+      rs2 = (rs1#(Conventions.loc_result ef.(ef_sig)) <- res) ->
+      exec_function (External ef) parent rs1 m t rs2 m.
 
 Scheme exec_instr_ind4 := Minimality for exec_instr Sort Prop
   with exec_instrs_ind4 := Minimality for exec_instrs Sort Prop
@@ -284,12 +310,13 @@ Scheme exec_instr_ind4 := Minimality for exec_instr Sort Prop
 
 End RELSEM.
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv p in
   let m0 := Genv.init_mem p in
   exists b, exists f, exists rs, exists m,
   Genv.find_symbol ge p.(prog_main) = Some b /\
   Genv.find_funct_ptr ge b = Some f /\
-  exec_function ge f (Vptr Mem.nullptr Int.zero) (Regmap.init Vundef) m0 rs m /\
+  exec_function ge f (Vptr Mem.nullptr Int.zero) (Regmap.init Vundef) m0
+                     t rs m /\
   rs R3 = r.
 
diff --git a/backend/Machabstr.v b/backend/Machabstr.v
index 25458dc..8d5d72a 100644
--- a/backend/Machabstr.v
+++ b/backend/Machabstr.v
@@ -7,6 +7,7 @@ Require Import Mem.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
@@ -99,117 +100,132 @@ Variable ge: genv.
 
 Inductive exec_instr:
       function -> val -> frame ->
-      code -> regset -> frame -> mem ->
+      code -> regset -> frame -> mem -> trace ->
       code -> regset -> frame -> mem -> Prop :=
   | exec_Mlabel:
       forall f sp parent lbl c rs fr m,
       exec_instr f sp parent
                  (Mlabel lbl :: c) rs fr m
-                 c rs fr m
+              E0 c rs fr m
   | exec_Mgetstack:
       forall f sp parent ofs ty dst c rs fr m v,
       get_slot fr ty (Int.signed ofs) v ->
       exec_instr f sp parent
                  (Mgetstack ofs ty dst :: c) rs fr m
-                 c (rs#dst <- v) fr m
+              E0 c (rs#dst <- v) fr m
   | exec_Msetstack:
      forall f sp parent src ofs ty c rs fr m fr',
       set_slot fr ty (Int.signed ofs) (rs src) fr' ->
       exec_instr f sp parent
                  (Msetstack src ofs ty :: c) rs fr m
-                 c rs fr' m
+              E0 c rs fr' m
   | exec_Mgetparam:
       forall f sp parent ofs ty dst c rs fr m v,
       get_slot parent ty (Int.signed ofs) v ->
       exec_instr f sp parent
                  (Mgetparam ofs ty dst :: c) rs fr m
-                 c (rs#dst <- v) fr m
+              E0 c (rs#dst <- v) fr m
   | exec_Mop:
       forall f sp parent op args res c rs fr m v,
       eval_operation ge sp op rs##args = Some v ->
       exec_instr f sp parent
                  (Mop op args res :: c) rs fr m
-                 c (rs#res <- v) fr m
+              E0 c (rs#res <- v) fr m
   | exec_Mload:
       forall f sp parent chunk addr args dst c rs fr m a v,
       eval_addressing ge sp addr rs##args = Some a ->
       Mem.loadv chunk m a = Some v ->
       exec_instr f sp parent
                  (Mload chunk addr args dst :: c) rs fr m
-                 c (rs#dst <- v) fr m
+              E0 c (rs#dst <- v) fr m
   | exec_Mstore:
       forall f sp parent chunk addr args src c rs fr m m' a,
       eval_addressing ge sp addr rs##args = Some a ->
       Mem.storev chunk m a (rs src) = Some m' ->
       exec_instr f sp parent
                  (Mstore chunk addr args src :: c) rs fr m
-                 c rs fr m'
+              E0 c rs fr m'
   | exec_Mcall:
-      forall f sp parent sig ros c rs fr m f' rs' m',
+      forall f sp parent sig ros c rs fr m t f' rs' m',
       find_function ge ros rs = Some f' ->
-      exec_function f' fr rs m rs' m' ->
+      exec_function f' fr rs m t rs' m' ->
       exec_instr f sp parent
                  (Mcall sig ros :: c) rs fr m
-                 c rs' fr m'
+               t c rs' fr m'
+  | exec_Malloc:
+      forall f sp parent c rs fr m sz m' blk,
+      rs (Conventions.loc_alloc_argument) = Vint sz ->
+      Mem.alloc m 0 (Int.signed sz) = (m', blk) ->
+      exec_instr f sp parent
+                 (Malloc :: c) rs fr m
+              E0 c (rs#Conventions.loc_alloc_result <- 
+                                              (Vptr blk Int.zero)) fr m'
   | exec_Mgoto:
       forall f sp parent lbl c rs fr m c',
       find_label lbl f.(fn_code) = Some c' ->
       exec_instr f sp parent
                  (Mgoto lbl :: c) rs fr m
-                 c' rs fr m
+              E0 c' rs fr m
   | exec_Mcond_true:
       forall f sp parent cond args lbl c rs fr m c',
       eval_condition cond rs##args = Some true ->
       find_label lbl f.(fn_code) = Some c' ->
       exec_instr f sp parent
                  (Mcond cond args lbl :: c) rs fr m
-                 c' rs fr m
+              E0 c' rs fr m
   | exec_Mcond_false:
       forall f sp parent cond args lbl c rs fr m,
       eval_condition cond rs##args = Some false ->
       exec_instr f sp parent
                  (Mcond cond args lbl :: c) rs fr m
-                 c rs fr m
+              E0 c rs fr m
 
 with exec_instrs:
       function -> val -> frame ->
-      code -> regset -> frame -> mem ->
+      code -> regset -> frame -> mem -> trace ->
       code -> regset -> frame -> mem -> Prop :=
   | exec_refl:
       forall f sp parent c rs fr m,
-      exec_instrs f sp parent  c rs fr m  c rs fr m
+      exec_instrs f sp parent  c rs fr m E0 c rs fr m
   | exec_one:
-      forall f sp parent c rs fr m c' rs' fr' m',
-      exec_instr f sp parent  c rs fr m  c' rs' fr' m' ->
-      exec_instrs f sp parent  c rs fr m  c' rs' fr' m'
+      forall f sp parent c rs fr m t c' rs' fr' m',
+      exec_instr f sp parent  c rs fr m t c' rs' fr' m' ->
+      exec_instrs f sp parent  c rs fr m t c' rs' fr' m'
   | exec_trans:
-      forall f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 c3 rs3 fr3 m3,
-      exec_instrs f sp parent  c1 rs1 fr1 m1  c2 rs2 fr2 m2 ->
-      exec_instrs f sp parent  c2 rs2 fr2 m2  c3 rs3 fr3 m3 ->
-      exec_instrs f sp parent  c1 rs1 fr1 m1  c3 rs3 fr3 m3
+      forall f sp parent c1 rs1 fr1 m1 t1 c2 rs2 fr2 m2 t2 c3 rs3 fr3 m3 t3,
+      exec_instrs f sp parent  c1 rs1 fr1 m1 t1 c2 rs2 fr2 m2 ->
+      exec_instrs f sp parent  c2 rs2 fr2 m2 t2 c3 rs3 fr3 m3 ->
+      t3 = t1 ** t2 ->
+      exec_instrs f sp parent  c1 rs1 fr1 m1 t3 c3 rs3 fr3 m3
 
 with exec_function_body:
       function -> frame -> val -> val ->
-      regset -> mem -> regset -> mem -> Prop :=
+      regset -> mem -> trace -> regset -> mem -> Prop :=
   | exec_funct_body:
-      forall f parent link ra rs m rs' m1 m2 stk fr1 fr2 fr3 c,
+      forall f parent link ra rs m t rs' m1 m2 stk fr1 fr2 fr3 c,
       Mem.alloc m 0 f.(fn_stacksize) = (m1, stk) ->
       set_slot (init_frame f) Tint 0 link fr1 ->
       set_slot fr1 Tint 4 ra fr2 ->
       exec_instrs f (Vptr stk (Int.repr (-f.(fn_framesize)))) parent
                   f.(fn_code) rs fr2 m1
-                  (Mreturn :: c) rs' fr3 m2 ->
-      exec_function_body f parent link ra rs m rs' (Mem.free m2 stk)
+                t (Mreturn :: c) rs' fr3 m2 ->
+      exec_function_body f parent link ra rs m t rs' (Mem.free m2 stk)
 
 with exec_function:
-      function -> frame -> regset -> mem -> regset -> mem -> Prop :=
-  | exec_funct:
-      forall f parent rs m rs' m',
+      fundef -> frame -> regset -> mem -> trace -> regset -> mem -> Prop :=
+  | exec_funct_internal:
+      forall f parent rs m t rs' m',
       (forall link ra, 
          Val.has_type link Tint ->
          Val.has_type ra Tint ->
-         exec_function_body f parent link ra rs m rs' m') ->
-      exec_function f parent rs m rs' m'.
+         exec_function_body f parent link ra rs m t rs' m') ->
+      exec_function (Internal f) parent rs m t rs' m'
+  | exec_funct_external:
+      forall ef parent args res rs1 rs2 m t,
+      event_match ef args t res ->
+      args = rs1##(Conventions.loc_external_arguments ef.(ef_sig)) ->
+      rs2 = (rs1#(Conventions.loc_result ef.(ef_sig)) <- res) ->
+      exec_function (External ef) parent rs1 m t rs2 m.
 
 Scheme exec_instr_ind4 := Minimality for exec_instr Sort Prop
   with exec_instrs_ind4 := Minimality for exec_instrs Sort Prop
@@ -222,134 +238,155 @@ Scheme exec_instr_ind4 := Minimality for exec_instr Sort Prop
   by the [Scheme] command above. *)
 
 Lemma exec_mutual_induction:
-  forall (P
+ forall
+         (P
           P0 : function ->
                val ->
                frame ->
                code ->
                regset ->
-               frame -> mem -> code -> regset -> frame -> mem -> Prop)
+               frame ->
+               mem -> trace -> code -> regset -> frame -> mem -> Prop)
          (P1 : function ->
-               frame -> val -> val -> regset -> mem -> regset -> mem -> Prop)
-         (P2 : function -> frame -> regset -> mem -> regset -> mem -> Prop),
+               frame ->
+               val -> val -> regset -> mem -> trace -> regset -> mem -> Prop)
+         (P2 : fundef ->
+               frame -> regset -> mem -> trace -> regset -> mem -> Prop),
        (forall (f : function) (sp : val) (parent : frame) (lbl : label)
           (c : list instruction) (rs : regset) (fr : frame) (m : mem),
-        P f sp parent (Mlabel lbl :: c) rs fr m c rs fr m) ->
-       (forall (f : function) (sp : val) (parent : frame) (ofs : int)
+        P f sp parent (Mlabel lbl :: c) rs fr m E0 c rs fr m) ->
+       (forall (f0 : function) (sp : val) (parent : frame) (ofs : int)
           (ty : typ) (dst : mreg) (c : list instruction) (rs : regset)
           (fr : frame) (m : mem) (v : val),
         get_slot fr ty (Int.signed ofs) v ->
-        P f sp parent (Mgetstack ofs ty dst :: c) rs fr m c rs # dst <- v fr
-          m) ->
-       (forall (f : function) (sp : val) (parent : frame) (src : mreg)
+        P f0 sp parent (Mgetstack ofs ty dst :: c) rs fr m E0 c rs # dst <- v
+          fr m) ->
+       (forall (f1 : function) (sp : val) (parent : frame) (src : mreg)
           (ofs : int) (ty : typ) (c : list instruction) (rs : mreg -> val)
           (fr : frame) (m : mem) (fr' : frame),
         set_slot fr ty (Int.signed ofs) (rs src) fr' ->
-        P f sp parent (Msetstack src ofs ty :: c) rs fr m c rs fr' m) ->
-       (forall (f : function) (sp : val) (parent : frame) (ofs : int)
+        P f1 sp parent (Msetstack src ofs ty :: c) rs fr m E0 c rs fr' m) ->
+       (forall (f2 : function) (sp : val) (parent : frame) (ofs : int)
           (ty : typ) (dst : mreg) (c : list instruction) (rs : regset)
           (fr : frame) (m : mem) (v : val),
         get_slot parent ty (Int.signed ofs) v ->
-        P f sp parent (Mgetparam ofs ty dst :: c) rs fr m c rs # dst <- v fr
-          m) ->
-       (forall (f : function) (sp : val) (parent : frame) (op : operation)
+        P f2 sp parent (Mgetparam ofs ty dst :: c) rs fr m E0 c rs # dst <- v
+          fr m) ->
+       (forall (f3 : function) (sp : val) (parent : frame) (op : operation)
           (args : list mreg) (res : mreg) (c : list instruction)
           (rs : mreg -> val) (fr : frame) (m : mem) (v : val),
         eval_operation ge sp op rs ## args = Some v ->
-        P f sp parent (Mop op args res :: c) rs fr m c rs # res <- v fr m) ->
-       (forall (f : function) (sp : val) (parent : frame)
+        P f3 sp parent (Mop op args res :: c) rs fr m E0 c rs # res <- v fr m) ->
+       (forall (f4 : function) (sp : val) (parent : frame)
           (chunk : memory_chunk) (addr : addressing) (args : list mreg)
           (dst : mreg) (c : list instruction) (rs : mreg -> val) (fr : frame)
           (m : mem) (a v : val),
         eval_addressing ge sp addr rs ## args = Some a ->
         loadv chunk m a = Some v ->
-        P f sp parent (Mload chunk addr args dst :: c) rs fr m c
+        P f4 sp parent (Mload chunk addr args dst :: c) rs fr m E0 c
           rs # dst <- v fr m) ->
-       (forall (f : function) (sp : val) (parent : frame)
+       (forall (f5 : function) (sp : val) (parent : frame)
           (chunk : memory_chunk) (addr : addressing) (args : list mreg)
           (src : mreg) (c : list instruction) (rs : mreg -> val) (fr : frame)
           (m m' : mem) (a : val),
         eval_addressing ge sp addr rs ## args = Some a ->
         storev chunk m a (rs src) = Some m' ->
-        P f sp parent (Mstore chunk addr args src :: c) rs fr m c rs fr m') ->
-       (forall (f : function) (sp : val) (parent : frame) (sig : signature)
+        P f5 sp parent (Mstore chunk addr args src :: c) rs fr m E0 c rs fr
+          m') ->
+       (forall (f6 : function) (sp : val) (parent : frame) (sig : signature)
           (ros : mreg + ident) (c : list instruction) (rs : regset)
-          (fr : frame) (m : mem) (f' : function) (rs' : regset) (m' : mem),
+          (fr : frame) (m : mem) (t : trace) (f' : fundef) (rs' : regset)
+          (m' : mem),
         find_function ge ros rs = Some f' ->
-        exec_function f' fr rs m rs' m' ->
-        P2 f' fr rs m rs' m' ->
-        P f sp parent (Mcall sig ros :: c) rs fr m c rs' fr m') ->
-       (forall (f : function) (sp : val) (parent : frame) (lbl : label)
-          (c : list instruction) (rs : regset) (fr : frame) (m : mem)
-          (c' : code),
-        find_label lbl (fn_code f) = Some c' ->
-        P f sp parent (Mgoto lbl :: c) rs fr m c' rs fr m) ->
-       (forall (f : function) (sp : val) (parent : frame)
-          (cond : condition) (args : list mreg) (lbl : label)
+        exec_function f' fr rs m t rs' m' ->
+        P2 f' fr rs m t rs' m' ->
+        P f6 sp parent (Mcall sig ros :: c) rs fr m t c rs' fr m') ->
+       (forall (f7 : function) (sp : val) (parent : frame)
           (c : list instruction) (rs : mreg -> val) (fr : frame) (m : mem)
+          (sz : int) (m' : mem) (blk : block),
+        rs Conventions.loc_alloc_argument = Vint sz ->
+        alloc m 0 (Int.signed sz) = (m', blk) ->
+        P f7 sp parent (Malloc :: c) rs fr m E0 c
+          rs # Conventions.loc_alloc_result <- (Vptr blk Int.zero) fr m') ->
+       (forall (f7 : function) (sp : val) (parent : frame) (lbl : label)
+          (c : list instruction) (rs : regset) (fr : frame) (m : mem)
           (c' : code),
+        find_label lbl (fn_code f7) = Some c' ->
+        P f7 sp parent (Mgoto lbl :: c) rs fr m E0 c' rs fr m) ->
+       (forall (f8 : function) (sp : val) (parent : frame) (cond : condition)
+          (args : list mreg) (lbl : label) (c : list instruction)
+          (rs : mreg -> val) (fr : frame) (m : mem) (c' : code),
         eval_condition cond rs ## args = Some true ->
-        find_label lbl (fn_code f) = Some c' ->
-        P f sp parent (Mcond cond args lbl :: c) rs fr m c' rs fr m) ->
-       (forall (f : function) (sp : val) (parent : frame)
-          (cond : condition) (args : list mreg) (lbl : label)
-          (c : list instruction) (rs : mreg -> val) (fr : frame) (m : mem),
+        find_label lbl (fn_code f8) = Some c' ->
+        P f8 sp parent (Mcond cond args lbl :: c) rs fr m E0 c' rs fr m) ->
+       (forall (f9 : function) (sp : val) (parent : frame) (cond : condition)
+          (args : list mreg) (lbl : label) (c : list instruction)
+          (rs : mreg -> val) (fr : frame) (m : mem),
         eval_condition cond rs ## args = Some false ->
-        P f sp parent (Mcond cond args lbl :: c) rs fr m c rs fr m) ->
-       (forall (f : function) (sp : val) (parent : frame) (c : code)
+        P f9 sp parent (Mcond cond args lbl :: c) rs fr m E0 c rs fr m) ->
+       (forall (f10 : function) (sp : val) (parent : frame) (c : code)
           (rs : regset) (fr : frame) (m : mem),
-        P0 f sp parent c rs fr m c rs fr m) ->
-       (forall (f : function) (sp : val) (parent : frame) (c : code)
-          (rs : regset) (fr : frame) (m : mem) (c' : code) (rs' : regset)
-          (fr' : frame) (m' : mem),
-        exec_instr f sp parent c rs fr m c' rs' fr' m' ->
-        P f sp parent c rs fr m c' rs' fr' m' ->
-        P0 f sp parent c rs fr m c' rs' fr' m') ->
-       (forall (f : function) (sp : val) (parent : frame) (c1 : code)
-          (rs1 : regset) (fr1 : frame) (m1 : mem) (c2 : code) (rs2 : regset)
-          (fr2 : frame) (m2 : mem) (c3 : code) (rs3 : regset) (fr3 : frame)
-          (m3 : mem),
-        exec_instrs f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
-        P0 f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
-        exec_instrs f sp parent c2 rs2 fr2 m2 c3 rs3 fr3 m3 ->
-        P0 f sp parent c2 rs2 fr2 m2 c3 rs3 fr3 m3 ->
-        P0 f sp parent c1 rs1 fr1 m1 c3 rs3 fr3 m3) ->
-       (forall (f : function) (parent : frame) (link ra : val) (rs : regset)
-          (m : mem) (rs' : regset) (m1 m2 : mem) (stk : block)
-          (fr1 fr2 fr3 : frame) (c : list instruction),
-        alloc m 0 (fn_stacksize f) = (m1, stk) ->
-        set_slot (init_frame f) Tint 0 link fr1 ->
+        P0 f10 sp parent c rs fr m E0 c rs fr m) ->
+       (forall (f11 : function) (sp : val) (parent : frame) (c : code)
+          (rs : regset) (fr : frame) (m : mem) (t : trace) (c' : code)
+          (rs' : regset) (fr' : frame) (m' : mem),
+        exec_instr f11 sp parent c rs fr m t c' rs' fr' m' ->
+        P f11 sp parent c rs fr m t c' rs' fr' m' ->
+        P0 f11 sp parent c rs fr m t c' rs' fr' m') ->
+       (forall (f12 : function) (sp : val) (parent : frame) (c1 : code)
+          (rs1 : regset) (fr1 : frame) (m1 : mem) (t1 : trace) (c2 : code)
+          (rs2 : regset) (fr2 : frame) (m2 : mem) (t2 : trace) (c3 : code)
+          (rs3 : regset) (fr3 : frame) (m3 : mem) (t3 : trace),
+        exec_instrs f12 sp parent c1 rs1 fr1 m1 t1 c2 rs2 fr2 m2 ->
+        P0 f12 sp parent c1 rs1 fr1 m1 t1 c2 rs2 fr2 m2 ->
+        exec_instrs f12 sp parent c2 rs2 fr2 m2 t2 c3 rs3 fr3 m3 ->
+        P0 f12 sp parent c2 rs2 fr2 m2 t2 c3 rs3 fr3 m3 ->
+        t3 = t1 ** t2 -> P0 f12 sp parent c1 rs1 fr1 m1 t3 c3 rs3 fr3 m3) ->
+       (forall (f13 : function) (parent : frame) (link ra : val)
+          (rs : regset) (m : mem) (t : trace) (rs' : regset) (m1 m2 : mem)
+          (stk : block) (fr1 fr2 fr3 : frame) (c : list instruction),
+        alloc m 0 (fn_stacksize f13) = (m1, stk) ->
+        set_slot (init_frame f13) Tint 0 link fr1 ->
         set_slot fr1 Tint 4 ra fr2 ->
-        exec_instrs f (Vptr stk (Int.repr (-f.(fn_framesize)))) parent (fn_code f) rs fr2 m1 (Mreturn :: c) rs' fr3
-          m2 ->
-        P0 f (Vptr stk (Int.repr (-f.(fn_framesize)))) parent (fn_code f) rs fr2 m1 (Mreturn :: c) rs' fr3 m2 ->
-        P1 f parent link ra rs m rs' (free m2 stk)) ->
-       (forall (f : function) (parent : frame) (rs : regset) (m : mem)
-          (rs' : regset) (m' : mem),
+        exec_instrs f13 (Vptr stk (Int.repr (- fn_framesize f13))) parent
+          (fn_code f13) rs fr2 m1 t (Mreturn :: c) rs' fr3 m2 ->
+        P0 f13 (Vptr stk (Int.repr (- fn_framesize f13))) parent
+          (fn_code f13) rs fr2 m1 t (Mreturn :: c) rs' fr3 m2 ->
+        P1 f13 parent link ra rs m t rs' (free m2 stk)) ->
+       (forall (f14 : function) (parent : frame) (rs : regset) (m : mem)
+          (t : trace) (rs' : regset) (m' : mem),
         (forall link ra : val,
          Val.has_type link Tint ->
          Val.has_type ra Tint ->
-         exec_function_body f parent link ra rs m rs' m') ->
+         exec_function_body f14 parent link ra rs m t rs' m') ->
         (forall link ra : val,
          Val.has_type link Tint ->
-         Val.has_type ra Tint -> P1 f parent link ra rs m rs' m') ->
-        P2 f parent rs m rs' m') ->
-       (forall (f15 : function) (sp : val) (f16 : frame) (c : code)
-         (r : regset) (f17 : frame) (m : mem) (c0 : code) (r0 : regset)
-         (f18 : frame) (m0 : mem),
-       exec_instr f15 sp f16 c r f17 m c0 r0 f18 m0 ->
-       P f15 sp f16 c r f17 m c0 r0 f18 m0)
-   /\  (forall (f15 : function) (sp : val) (f16 : frame) (c : code)
-         (r : regset) (f17 : frame) (m : mem) (c0 : code) (r0 : regset)
-         (f18 : frame) (m0 : mem),
-       exec_instrs f15 sp f16 c r f17 m c0 r0 f18 m0 ->
-       P0 f15 sp f16 c r f17 m c0 r0 f18 m0)
-   /\  (forall (f15 : function) (f16 : frame) (v1 v2 : val) (r : regset) (m : mem)
-         (r0 : regset) (m0 : mem),
-       exec_function_body f15 f16 v1 v2 r m r0 m0 -> P1 f15 f16 v1 v2 r m r0 m0)
-   /\  (forall (f15 : function) (f16 : frame) (r : regset) (m : mem)
+         Val.has_type ra Tint -> P1 f14 parent link ra rs m t rs' m') ->
+        P2 (Internal f14) parent rs m t rs' m') ->
+       (forall (ef : external_function) (parent : frame) (args : list val)
+          (res : val) (rs1 : mreg -> val) (rs2 : RegEq.t -> val) (m : mem)
+          (t0 : trace),
+        event_match ef args t0 res ->
+        args = rs1 ## (Conventions.loc_external_arguments (ef_sig ef)) ->
+        rs2 = rs1 # (Conventions.loc_result (ef_sig ef)) <- res ->
+        P2 (External ef) parent rs1 m t0 rs2 m) ->
+      (forall (f16 : function) (v : val) (f17 : frame) (c : code)
+         (r : regset) (f18 : frame) (m : mem) (t : trace) (c0 : code)
+         (r0 : regset) (f19 : frame) (m0 : mem),
+       exec_instr f16 v f17 c r f18 m t c0 r0 f19 m0 ->
+       P f16 v f17 c r f18 m t c0 r0 f19 m0)
+   /\ (forall (f16 : function) (v : val) (f17 : frame) (c : code)
+         (r : regset) (f18 : frame) (m : mem) (t : trace) (c0 : code)
+         (r0 : regset) (f19 : frame) (m0 : mem),
+       exec_instrs f16 v f17 c r f18 m t c0 r0 f19 m0 ->
+       P0 f16 v f17 c r f18 m t c0 r0 f19 m0)
+   /\ (forall (f16 : function) (f17 : frame) (v v0 : val) (r : regset)
+         (m : mem) (t : trace) (r0 : regset) (m0 : mem),
+       exec_function_body f16 f17 v v0 r m t r0 m0 ->
+       P1 f16 f17 v v0 r m t r0 m0)
+   /\ (forall (f16 : fundef) (f17 : frame) (r : regset) (m : mem) (t : trace)
          (r0 : regset) (m0 : mem),
-       exec_function f15 f16 r m r0 m0 -> P2 f15 f16 r m r0 m0).
+       exec_function f16 f17 r m t r0 m0 -> P2 f16 f17 r m t r0 m0).
 Proof.
   intros. split. apply (exec_instr_ind4 P P0 P1 P2); assumption.
   split. apply (exec_instrs_ind4 P P0 P1 P2); assumption.
@@ -359,13 +396,12 @@ Qed.
 
 End RELSEM.
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv p in
   let m0 := Genv.init_mem p in
   exists b, exists f, exists rs, exists m,
   Genv.find_symbol ge p.(prog_main) = Some b /\
   Genv.find_funct_ptr ge b = Some f /\
-  f.(fn_sig) = mksignature nil (Some Tint) /\
-  exec_function ge f empty_frame (Regmap.init Vundef) m0 rs m /\
-  rs (Conventions.loc_result f.(fn_sig)) = r.
+  exec_function ge f empty_frame (Regmap.init Vundef) m0 t rs m /\
+  rs R3 = r.
 
diff --git a/backend/Machabstr2mach.v b/backend/Machabstr2mach.v
index 8549cef..0513cbe 100644
--- a/backend/Machabstr2mach.v
+++ b/backend/Machabstr2mach.v
@@ -6,6 +6,7 @@ Require Import AST.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
@@ -757,6 +758,36 @@ Proof.
   exists ms'. split. auto. eapply callstack_store_aux; eauto.
 Qed.
 
+(** Allocations of heap blocks can be performed in parallel in
+    both semantics, preserving [callstack_invariant]. *)
+
+Lemma callstack_alloc:
+  forall cs mm ms lo hi mm' blk,
+  callstack_invariant cs mm ms ->
+  Mem.alloc mm lo hi = (mm', blk) ->
+  exists ms',
+    Mem.alloc ms lo hi = (ms', blk) /\
+    callstack_invariant cs mm' ms'.
+Proof.
+  intros. inversion H. 
+  caseEq (alloc ms lo hi). intros ms' blk' ALLOC'.
+  injection H0; intros. injection ALLOC'; intros.
+  assert (blk' = blk). congruence. rewrite H5 in H3. rewrite H5. 
+  exists ms'; split. auto.
+  constructor. 
+  (* frame *)
+  intros; eapply frame_match_alloc; eauto.
+  (* linked *)
+  auto.
+  (* others *)
+  intros. rewrite <- H2; rewrite <- H4; simpl.
+  rewrite H1; rewrite H3. unfold update. case (zeq b blk); auto.
+  (* next *)
+  rewrite <- H2; rewrite <- H4; simpl; congruence.
+  (* dom *)
+  eapply callstack_dom_incr; eauto. rewrite <- H4; simpl. omega.
+Qed.
+
 (** At function entry, a new frame is pushed on the call stack,
   and memory blocks are allocated in both semantics.  Moreover,
   the back link to the caller's activation record is set up
@@ -905,7 +936,7 @@ Let ge := Genv.globalenv p.
 
 Definition exec_instr_prop
     (f: function) (sp: val) (parent: frame)
-    (c: code) (rs: regset) (fr: frame) (mm: mem)
+    (c: code) (rs: regset) (fr: frame) (mm: mem) (t: trace)
     (c': code) (rs': regset) (fr': frame) (mm': mem) : Prop :=
   forall ms stk base pstk pbase cs
          (WTF: wt_function f)
@@ -916,12 +947,12 @@ Definition exec_instr_prop
          (CSI: callstack_invariant ((fr, stk, base) :: (parent, pstk, pbase) :: cs) mm ms)
          (SP: sp = Vptr stk base),
   exists ms',
-    exec_instr ge f sp c rs ms c' rs' ms' /\
+    exec_instr ge f sp c rs ms t c' rs' ms' /\
     callstack_invariant ((fr', stk, base) :: (parent, pstk, pbase) :: cs) mm' ms'.
 
 Definition exec_instrs_prop
     (f: function) (sp: val) (parent: frame)
-    (c: code) (rs: regset) (fr: frame) (mm: mem)
+    (c: code) (rs: regset) (fr: frame) (mm: mem) (t: trace)
     (c': code) (rs': regset) (fr': frame) (mm': mem) : Prop :=
   forall ms stk base pstk pbase cs
          (WTF: wt_function f)
@@ -932,12 +963,12 @@ Definition exec_instrs_prop
          (CSI: callstack_invariant ((fr, stk, base) :: (parent, pstk, pbase) :: cs) mm ms)
          (SP: sp = Vptr stk base),
   exists ms',
-    exec_instrs ge f sp c rs ms c' rs' ms' /\
+    exec_instrs ge f sp c rs ms t c' rs' ms' /\
     callstack_invariant ((fr', stk, base) :: (parent, pstk, pbase) :: cs) mm' ms'.
 
 Definition exec_function_body_prop
     (f: function) (parent: frame) (link ra: val)
-    (rs: regset) (mm: mem)
+    (rs: regset) (mm: mem) (t: trace)
     (rs': regset) (mm': mem) : Prop :=
   forall ms pstk pbase cs
          (WTF: wt_function f)
@@ -947,26 +978,26 @@ Definition exec_function_body_prop
          (LINK: link = Vptr pstk pbase)
          (CSI: callstack_invariant ((parent, pstk, pbase) :: cs) mm ms),
   exists ms',
-    exec_function_body ge f (Vptr pstk pbase) ra rs ms rs' ms' /\
+    exec_function_body ge f (Vptr pstk pbase) ra rs ms t rs' ms' /\
     callstack_invariant ((parent, pstk, pbase) :: cs) mm' ms'.
 
 Definition exec_function_prop
-    (f: function) (parent: frame)
-    (rs: regset) (mm: mem)
+    (f: fundef) (parent: frame)
+    (rs: regset) (mm: mem) (t: trace)
     (rs': regset) (mm': mem) : Prop :=
   forall ms pstk pbase cs
-         (WTF: wt_function f)
+         (WTF: wt_fundef f)
          (WTRS: wt_regset rs)
          (WTPA: wt_frame parent)
          (CSI: callstack_invariant ((parent, pstk, pbase) :: cs) mm ms),
   exists ms',
-    exec_function ge f (Vptr pstk pbase) rs ms rs' ms' /\
+    exec_function ge f (Vptr pstk pbase) rs ms t rs' ms' /\
     callstack_invariant ((parent, pstk, pbase) :: cs) mm' ms'.
 
 Lemma exec_function_equiv:
-  forall f parent rs mm rs' mm',
-  Machabstr.exec_function ge f parent rs mm rs' mm' ->
-  exec_function_prop f parent rs mm rs' mm'.
+  forall f parent rs mm t rs' mm',
+  Machabstr.exec_function ge f parent rs mm t rs' mm' ->
+  exec_function_prop f parent rs mm t rs' mm'.
 Proof.
   apply (Machabstr.exec_function_ind4 ge
            exec_instr_prop
@@ -1009,16 +1040,22 @@ Proof.
   auto. 
   (* Mcall *)
   red in H1. 
-  assert (WTF': wt_function f').
+  assert (WTF': wt_fundef f').
     destruct ros; simpl in H.
-    apply (Genv.find_funct_prop wt_function wt_p H).
+    apply (Genv.find_funct_prop wt_fundef wt_p H).
     destruct (Genv.find_symbol ge i); try discriminate.
-    apply (Genv.find_funct_ptr_prop wt_function wt_p H).
+    apply (Genv.find_funct_ptr_prop wt_fundef wt_p H).
   generalize (H1 _ _ _ _ WTF' WTRS WTFR CSI). 
   intros [ms' [EXF CSI']].
   exists ms'. split. apply exec_Mcall with f'; auto. 
   rewrite SP. auto.
   auto.
+  (* Malloc *)
+  generalize (callstack_alloc _ _ _ _ _ _ _ CSI H0). 
+  intros [ms' [ALLOC' CSI']].
+  exists ms'; split.
+  eapply exec_Malloc; eauto.
+  auto.
   (* Mgoto *)
   exists ms. split. constructor; auto. auto.
   (* Mcond *)
@@ -1033,7 +1070,7 @@ Proof.
   exists ms'. split. apply exec_one; auto. auto.
   (* trans *)
   generalize (subject_reduction_instrs p wt_p 
-               _ _ _ _ _ _ _ _ _ _ _ H WTF INCL WTRS WTFR WTPA).
+               _ _ _ _ _ _ _ _ _ _ _ _ H WTF INCL WTRS WTFR WTPA).
   intros [INCL2 [WTRS2 WTFR2]].
   generalize (H0 _ _ _ _ _ _ WTF INCL WTRS WTFR WTPA CSI SP).
   intros [ms1 [EX1 CSI1]].
@@ -1069,7 +1106,7 @@ Proof.
   generalize (H3 _ _ _ _ _ _ WTF (incl_refl _) WTRS WTFR2 WTPA
                 CSI3 (refl_equal _)).
   intros [ms4 [EXEC CSI4]].
-  generalize (exec_instrs_link_invariant _ _ _ _ _ _ _ _ _ _ _ _
+  generalize (exec_instrs_link_invariant _ _ _ _ _ _ _ _ _ _ _ _ _
                 H2 WTF (incl_refl _)).
   intros [INCL LINKINV].
   exists (free ms4 stk). split.
@@ -1082,39 +1119,42 @@ Proof.
   apply LINKINV. rewrite FOUR. omega. eapply slot_gss; eauto. auto.
   eapply callstack_function_return; eauto.
 
-  (* function *)
+  (* internal function *)
+  inversion WTF. subst f0. 
   generalize (H0 (Vptr pstk pbase) Vzero I I
-                 ms pstk pbase cs WTF WTRS WTPA I (refl_equal _) CSI).
+                 ms pstk pbase cs H2 WTRS WTPA I (refl_equal _) CSI).
   intros [ms' [EXEC CSI']].
   exists ms'. split. constructor. intros.
   generalize (H0 (Vptr pstk pbase) ra I H1 
-                ms pstk pbase cs WTF WTRS WTPA H1 (refl_equal _) CSI).
+                ms pstk pbase cs H2 WTRS WTPA H1 (refl_equal _) CSI).
   intros [ms1 [EXEC1 CSI1]].
   rewrite (callstack_exten _ _ _ _ CSI' CSI1). auto.
   auto.
+
+  (* external function *)
+  exists ms; split. econstructor; eauto. auto.
 Qed.  
 
 End SIMULATION.
 
 Theorem exec_program_equiv:
-  forall p r, 
+  forall p t r, 
   wt_program p ->
-  Machabstr.exec_program p r -> 
-  Mach.exec_program p r.
+  Machabstr.exec_program p t r -> 
+  Mach.exec_program p t r.
 Proof.
-  intros p r WTP [fptr [f [rs [mm [FINDPTR [FINDF [SIG [EXEC RES]]]]]]]].
-  assert (WTF: wt_function f).
-    apply (Genv.find_funct_ptr_prop wt_function WTP FINDF).
+  intros p t r WTP [fptr [f [rs [mm [FINDPTR [FINDF [EXEC RES]]]]]]].
+  assert (WTF: wt_fundef f).
+    apply (Genv.find_funct_ptr_prop wt_fundef WTP FINDF).
   assert (WTRS: wt_regset (Regmap.init Vundef)).
     red; intros. rewrite Regmap.gi; simpl; auto.
   assert (WTFR: wt_frame empty_frame).
     red; intros. simpl. auto.
   generalize (exec_function_equiv p WTP
                 f empty_frame
-                (Regmap.init Vundef) (Genv.init_mem p) rs mm
+                (Regmap.init Vundef) (Genv.init_mem p) t rs mm
                 EXEC (Genv.init_mem p) nullptr Int.zero nil
                 WTF WTRS WTFR (callstack_init p)).
   intros [ms' [EXEC' CSI]].
-  red. exists fptr; exists f; exists rs; exists ms'. 
-  intuition. rewrite SIG in RES. exact RES.
+  red. exists fptr; exists f; exists rs; exists ms'. tauto.
 Qed.
diff --git a/backend/Machtyping.v b/backend/Machtyping.v
index 987269b..92f283b 100644
--- a/backend/Machtyping.v
+++ b/backend/Machtyping.v
@@ -7,6 +7,7 @@ Require Import Mem.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
@@ -57,6 +58,8 @@ Inductive wt_instr : instruction -> Prop :=
       forall sig ros,
       match ros with inl r => mreg_type r = Tint | inr s => True end ->
       wt_instr (Mcall sig ros)
+  | wt_Malloc:
+      wt_instr Malloc
   | wt_Mgoto:
       forall lbl,
       wt_instr (Mgoto lbl)
@@ -78,8 +81,16 @@ Record wt_function (f: function) : Prop := mk_wt_function {
     f.(fn_framesize) <= -Int.min_signed
 }.
 
+Inductive wt_fundef: fundef -> Prop :=
+  | wt_fundef_external: forall ef,
+      Conventions.sig_external_ok ef.(ef_sig) ->
+      wt_fundef (External ef)
+  | wt_function_internal: forall f,
+      wt_function f ->
+      wt_fundef (Internal f).
+
 Definition wt_program (p: program) : Prop :=
-  forall i f, In (i, f) (prog_funct p) -> wt_function f.
+  forall i f, In (i, f) (prog_funct p) -> wt_fundef f.
 
 (** * Type soundness *)
 
@@ -89,8 +100,8 @@ Require Import Machabstr.
     of Mach: for a well-typed Mach program, if a transition is taken
     from a state where registers hold values of their static types,
     registers in the final state hold values of their static types
-    as well.  This is a progress theorem for our type system.
-    It is used in the proof of implcation from the abstract Mach
+    as well.  This is a subject reduction theorem for our type system.
+    It is used in the proof of implication from the abstract Mach
     semantics to the concrete Mach semantics (file [Machabstr2mach]).
 *)
 
@@ -183,6 +194,14 @@ Proof.
   apply incl_tl; auto.
 Qed.
 
+Lemma wt_event_match:
+  forall ef args t res,
+  event_match ef args t res ->
+  Val.has_type res (proj_sig_res ef.(ef_sig)).
+Proof.
+  induction 1. inversion H0; exact I.
+Qed.
+
 Section SUBJECT_REDUCTION.
 
 Variable p: program.
@@ -191,7 +210,7 @@ Let ge := Genv.globalenv p.
 
 Definition exec_instr_prop 
   (f: function) (sp: val) (parent: frame)
-  (c1: code) (rs1: regset) (fr1: frame) (m1: mem)
+  (c1: code) (rs1: regset) (fr1: frame) (m1: mem) (t: trace)
   (c2: code) (rs2: regset) (fr2: frame) (m2: mem) :=
     forall (WTF: wt_function f)
            (INCL: incl c1 f.(fn_code))
@@ -201,7 +220,7 @@ Definition exec_instr_prop
     incl c2 f.(fn_code) /\ wt_regset rs2 /\ wt_frame fr2.
 Definition exec_function_body_prop
   (f: function) (parent: frame) (link ra: val)
-  (rs1: regset) (m1: mem) (rs2: regset) (m2: mem) :=
+  (rs1: regset) (m1: mem) (t: trace) (rs2: regset) (m2: mem) :=
     forall (WTF: wt_function f)
            (WTRS: wt_regset rs1)
            (WTPA: wt_frame parent)
@@ -209,26 +228,26 @@ Definition exec_function_body_prop
            (WTRA: Val.has_type ra Tint),
     wt_regset rs2.
 Definition exec_function_prop
-  (f: function) (parent: frame)
-  (rs1: regset) (m1: mem) (rs2: regset) (m2: mem) :=
-    forall (WTF: wt_function f)
+  (f: fundef) (parent: frame)
+  (rs1: regset) (m1: mem) (t: trace) (rs2: regset) (m2: mem) :=
+    forall (WTF: wt_fundef f)
            (WTRS: wt_regset rs1)
            (WTPA: wt_frame parent),
     wt_regset rs2.
 
 Lemma subject_reduction:
-   (forall f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2,
-      exec_instr ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
-      exec_instr_prop f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2)
-/\ (forall f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2,
-      exec_instrs ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
-      exec_instr_prop f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2)
-/\ (forall f parent link ra rs1 m1 rs2 m2,
-      exec_function_body ge f parent link ra rs1 m1 rs2 m2 ->
-      exec_function_body_prop f parent link ra rs1 m1 rs2 m2)
-/\ (forall f parent rs1 m1 rs2 m2,
-      exec_function ge f parent rs1 m1 rs2 m2 ->
-      exec_function_prop f parent rs1 m1 rs2 m2).
+   (forall f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2,
+      exec_instr ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2 ->
+      exec_instr_prop f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2)
+/\ (forall f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2,
+      exec_instrs ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2 ->
+      exec_instr_prop f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2)
+/\ (forall f parent link ra rs1 m1 t rs2 m2,
+      exec_function_body ge f parent link ra rs1 m1 t rs2 m2 ->
+      exec_function_body_prop f parent link ra rs1 m1 t rs2 m2)
+/\ (forall f parent rs1 m1 t rs2 m2,
+      exec_function ge f parent rs1 m1 t rs2 m2 ->
+      exec_function_prop f parent rs1 m1 t rs2 m2).
 Proof.
   apply exec_mutual_induction; red; intros; 
   try (generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))); intro;
@@ -249,7 +268,7 @@ Proof.
     subst args; subst op. simpl in H. 
     replace v with Vundef. simpl; auto. congruence.
     replace (mreg_type res) with (snd (type_of_operation op)).
-    apply type_of_operation_sound with function ge rs##args sp; auto.
+    apply type_of_operation_sound with fundef ge rs##args sp; auto.
     rewrite <- H6; reflexivity.
 
   apply wt_setreg; auto. inversion H1. rewrite H7.
@@ -257,11 +276,13 @@ Proof.
 
   apply H1; auto.
   destruct ros; simpl in H. 
-  apply (Genv.find_funct_prop wt_function wt_p H).
+  apply (Genv.find_funct_prop wt_fundef wt_p H).
   destruct (Genv.find_symbol ge i). 
-  apply (Genv.find_funct_ptr_prop wt_function wt_p H).
+  apply (Genv.find_funct_ptr_prop wt_fundef wt_p H).
   discriminate.
 
+  apply wt_setreg; auto. exact I. 
+
   apply incl_find_label with lbl; auto. 
   apply incl_find_label with lbl; auto. 
 
@@ -277,26 +298,34 @@ Proof.
   generalize (H3 WTF (incl_refl _) WTRS WTFR2 WTPA).
   tauto.
 
-  apply (H0 Vzero Vzero). exact I. exact I. auto. auto. auto. 
+  apply (H0 Vzero Vzero). exact I. exact I. 
+  inversion WTF; auto. auto. auto. 
   exact I. exact I.
+
+  rewrite H1. apply wt_setreg; auto. 
+  generalize (wt_event_match _ _ _ _ H). 
+  unfold proj_sig_res, Conventions.loc_result.
+  destruct (sig_res (ef_sig ef)).
+  destruct t; simpl; auto.
+  simpl; auto.
 Qed.
 
 Lemma subject_reduction_instr:
-   forall f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2,
-      exec_instr ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
-      exec_instr_prop f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2.
+   forall f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2,
+      exec_instr ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2 ->
+      exec_instr_prop f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2.
 Proof (proj1 subject_reduction).
 
 Lemma subject_reduction_instrs:
-   forall f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2,
-      exec_instrs ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
-      exec_instr_prop f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2.
+   forall f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2,
+      exec_instrs ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2 ->
+      exec_instr_prop f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2.
 Proof (proj1 (proj2 subject_reduction)).
 
 Lemma subject_reduction_function:
-  forall f parent rs1 m1 rs2 m2,
-      exec_function ge f parent rs1 m1 rs2 m2 ->
-      exec_function_prop f parent rs1 m1 rs2 m2.
+  forall f parent rs1 m1 t rs2 m2,
+      exec_function ge f parent rs1 m1 t rs2 m2 ->
+      exec_function_prop f parent rs1 m1 t rs2 m2.
 Proof (proj2 (proj2 (proj2 subject_reduction))).
 
 End SUBJECT_REDUCTION.
@@ -335,8 +364,8 @@ Proof.
 Qed.
 
 Lemma exec_instr_link_invariant:
-  forall ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2,
-  exec_instr ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
+  forall ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2,
+  exec_instr ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2 ->
   wt_function f ->
   incl c1 f.(fn_code) ->
   incl c2 f.(fn_code) /\ link_invariant fr1 fr2.
@@ -351,8 +380,8 @@ Proof.
 Qed.
 
 Lemma exec_instrs_link_invariant:
-  forall ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2,
-  exec_instrs ge f sp parent c1 rs1 fr1 m1 c2 rs2 fr2 m2 ->
+  forall ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2,
+  exec_instrs ge f sp parent c1 rs1 fr1 m1 t c2 rs2 fr2 m2 ->
   wt_function f ->
   incl c1 f.(fn_code) ->
   incl c2 f.(fn_code) /\ link_invariant fr1 fr2.
@@ -360,8 +389,8 @@ Proof.
   induction 1; intros.
   split. auto. apply link_invariant_refl.
   eapply exec_instr_link_invariant; eauto.
-  generalize (IHexec_instrs1 H1 H2); intros [A B].
-  generalize (IHexec_instrs2 H1 A); intros [C D].
+  generalize (IHexec_instrs1 H2 H3); intros [A B].
+  generalize (IHexec_instrs2 H2 A); intros [C D].
   split. auto. red; auto.
 Qed.
 
diff --git a/backend/Main.v b/backend/Main.v
index 80a0577..95dc4e6 100644
--- a/backend/Main.v
+++ b/backend/Main.v
@@ -78,34 +78,34 @@ Notation "a @@ b" :=
   
   The translation of a Cminor function to a PPC function is as follows. *)
 
-Definition transf_cminor_function (f: Cminor.function) : option PPC.code :=
+Definition transf_cminor_fundef (f: Cminor.fundef) : option PPC.fundef :=
   Some f
-  @@@ RTLgen.transl_function
-   @@ Constprop.transf_function
-   @@ CSE.transf_function
-  @@@ Allocation.transf_function
-   @@ Tunneling.tunnel_function
-   @@ Linearize.transf_function
-  @@@ Stacking.transf_function
-  @@@ PPCgen.transf_function.
+  @@@ RTLgen.transl_fundef
+   @@ Constprop.transf_fundef
+   @@ CSE.transf_fundef
+  @@@ Allocation.transf_fundef
+   @@ Tunneling.tunnel_fundef
+   @@ Linearize.transf_fundef
+  @@@ Stacking.transf_fundef
+  @@@ PPCgen.transf_fundef.
 
 (** And here is the translation for Csharpminor functions. *)
 
-Definition transf_csharpminor_function 
-     (gce: Cminorgen.compilenv) (f: Csharpminor.function) : option PPC.code :=
+Definition transf_csharpminor_fundef
+     (gce: Cminorgen.compilenv) (f: Csharpminor.fundef) : option PPC.fundef :=
   Some f 
-  @@@ Cminorgen.transl_function gce
-  @@@ transf_cminor_function.
+  @@@ Cminorgen.transl_fundef gce
+  @@@ transf_cminor_fundef.
 
 (** The corresponding translations for whole program follow. *)
 
 Definition transf_cminor_program (p: Cminor.program) : option PPC.program :=
-  transform_partial_program transf_cminor_function p.
+  transform_partial_program transf_cminor_fundef p.
 
 Definition transf_csharpminor_program (p: Csharpminor.program) : option PPC.program :=
   let gce := Cminorgen.build_global_compilenv p in
   transform_partial_program 
-    (transf_csharpminor_function gce)
+    (transf_csharpminor_fundef gce)
     (Csharpminor.program_of_program p).
 
 (** * Equivalence with whole program transformations *)
@@ -194,7 +194,7 @@ Qed.
 Lemma transf_cminor_program_equiv:
   forall p, transf_cminor_program2 p = transf_cminor_program p.
 Proof.
-  intro. unfold transf_cminor_program, transf_cminor_program2, transf_cminor_function.
+  intro. unfold transf_cminor_program, transf_cminor_program2, transf_cminor_fundef.
   simpl. 
   unfold RTLgen.transl_program,
          Constprop.transf_program, RTL.program.
@@ -223,7 +223,7 @@ Lemma transf_csharpminor_program_equiv:
   forall p, transf_csharpminor_program2 p = transf_csharpminor_program p.
 Proof.
   intros. 
-  unfold transf_csharpminor_program2, transf_csharpminor_program, transf_csharpminor_function.
+  unfold transf_csharpminor_program2, transf_csharpminor_program, transf_csharpminor_fundef.
   simpl. 
   replace transf_cminor_program2 with transf_cminor_program.
   unfold transf_cminor_program, Cminorgen.transl_program, Cminor.program, PPC.program.
@@ -237,10 +237,10 @@ Qed.
   composes the semantic preservation results for each pass. *)
 
 Lemma transf_cminor_program2_correct:
-  forall p tp n,
+  forall p tp t n,
   transf_cminor_program2 p = Some tp ->
-  Cminor.exec_program p (Vint n) ->
-  PPC.exec_program tp (Vint n).
+  Cminor.exec_program p t (Vint n) ->
+  PPC.exec_program tp t (Vint n).
 Proof.
   intros until n.
   unfold transf_cminor_program2.
@@ -274,10 +274,10 @@ Proof.
 Qed.
 
 Lemma transf_csharpminor_program2_correct:
-  forall p tp n,
+  forall p tp t n,
   transf_csharpminor_program2 p = Some tp ->
-  Csharpminor.exec_program p (Vint n) ->
-  PPC.exec_program tp (Vint n).
+  Csharpminor.exec_program p t (Vint n) ->
+  PPC.exec_program tp t (Vint n).
 Proof.
   intros until n; unfold transf_csharpminor_program2; simpl.
   caseEq (Cminorgen.transl_program p).
@@ -291,20 +291,20 @@ Qed.
 (** It follows that the whole compiler is semantic-preserving. *)
 
 Theorem transf_cminor_program_correct:
-  forall p tp n,
+  forall p tp t n,
   transf_cminor_program p = Some tp ->
-  Cminor.exec_program p (Vint n) ->
-  PPC.exec_program tp (Vint n).
+  Cminor.exec_program p t (Vint n) ->
+  PPC.exec_program tp t (Vint n).
 Proof.
   intros. apply transf_cminor_program2_correct with p. 
   rewrite transf_cminor_program_equiv. assumption. assumption.
 Qed.
 
 Theorem transf_csharpminor_program_correct:
-  forall p tp n,
+  forall p tp t n,
   transf_csharpminor_program p = Some tp ->
-  Csharpminor.exec_program p (Vint n) ->
-  PPC.exec_program tp (Vint n).
+  Csharpminor.exec_program p t (Vint n) ->
+  PPC.exec_program tp t (Vint n).
 Proof.
   intros. apply transf_csharpminor_program2_correct with p. 
   rewrite transf_csharpminor_program_equiv. assumption. assumption.
diff --git a/backend/Mem.v b/backend/Mem.v
index 26d4c49..7af696e 100644
--- a/backend/Mem.v
+++ b/backend/Mem.v
@@ -619,6 +619,88 @@ Qed.
 
 Hint Resolve store_in_bounds store_inv.
 
+(** Build a block filled with the given initialization data. *)
+
+Fixpoint contents_init_data (pos: Z) (id: list init_data) {struct id}: contentmap :=
+  match id with
+  | nil => (fun y => Undef)
+  | Init_int8 n :: id' =>
+      store_contents Size8 (contents_init_data (pos + 1) id') pos (Vint n)
+  | Init_int16 n :: id' =>
+      store_contents Size16 (contents_init_data (pos + 2) id') pos (Vint n)
+  | Init_int32 n :: id' =>
+      store_contents Size32 (contents_init_data (pos + 4) id') pos (Vint n)
+  | Init_float32 f :: id' =>
+      store_contents Size32 (contents_init_data (pos + 4) id') pos (Vfloat f)
+  | Init_float64 f :: id' =>
+      store_contents Size64 (contents_init_data (pos + 8) id') pos (Vfloat f)
+  | Init_space n :: id' =>
+      contents_init_data (pos + Zmax n 0) id'
+  end.
+
+Definition size_init_data (id: init_data) : Z :=
+  match id with
+  | Init_int8 _ => 1
+  | Init_int16 _ => 2
+  | Init_int32 _ => 4
+  | Init_float32 _ => 4
+  | Init_float64 _ => 8
+  | Init_space n => Zmax n 0
+  end.
+
+Definition size_init_data_list (id: list init_data): Z :=
+  List.fold_right (fun id sz => size_init_data id + sz) 0 id.
+
+Remark size_init_data_list_pos:
+  forall id, size_init_data_list id >= 0.
+Proof.
+  induction id; simpl.
+  omega.
+  assert (size_init_data a >= 0). destruct a; simpl; try omega. 
+  generalize (Zmax2 z 0). omega. omega.
+Qed.
+
+Remark contents_init_data_undef_outside:
+  forall id pos x,
+  x < pos \/ x >= pos + size_init_data_list id ->
+  contents_init_data pos id x = Undef.
+Proof.
+  induction id; simpl; intros.
+  auto.
+  generalize (size_init_data_list_pos id); intro.
+  assert (forall n delta dt,
+    delta = 1 + Z_of_nat n ->
+    x < pos \/ x >= pos + (delta + size_init_data_list id) ->
+    setN n pos dt (contents_init_data (pos + delta) id) x = Undef).
+  intros. unfold setN. rewrite update_o. 
+  transitivity (contents_init_data (pos + delta) id x).
+  apply set_cont_outside.  omega. 
+  apply IHid. omega. omega.
+  unfold size_init_data in H; destruct a;
+  try (apply H1; [reflexivity|assumption]).
+  apply IHid. generalize (Zmax2 z 0). omega. 
+Qed.
+
+Definition block_init_data (id: list init_data) : block_contents :=
+  mkblock 0 (size_init_data_list id) 
+          (contents_init_data 0 id)
+          (contents_init_data_undef_outside id 0).
+
+Definition alloc_init_data (m: mem) (id: list init_data) : mem * block :=
+  (mkmem (update m.(nextblock)
+                 (block_init_data id)
+                 m.(blocks))
+         (Zsucc m.(nextblock))
+         (succ_nextblock_pos m),
+   m.(nextblock)).
+
+Remark block_init_data_empty:
+  block_init_data nil = empty_block 0 0.
+Proof.
+  unfold block_init_data, empty_block. simpl. 
+  decEq. apply proof_irrelevance. 
+Qed.
+
 (** * Properties of the memory operations *)
 
 (** ** Properties related to block validity *)
@@ -2032,6 +2114,32 @@ Proof.
    apply free_first_list_inject. auto.
 Qed. 
 
+Lemma contents_init_data_inject:
+  forall id, contentmap_inject (contents_init_data 0 id) (contents_init_data 0 id) 0 (size_init_data_list id) 0.
+Proof.
+  intro id0. 
+  set (sz0 := size_init_data_list id0).
+  assert (forall id pos,
+    0 <= pos -> pos + size_init_data_list id <= sz0 ->
+    contentmap_inject (contents_init_data pos id) (contents_init_data pos id) 0 sz0 0).
+  induction id; simpl; intros.
+  red; intros; constructor.
+  assert (forall n dt,
+    size_init_data a = 1 + Z_of_nat n ->
+    content_inject dt dt ->
+    contentmap_inject (setN n pos dt (contents_init_data (pos + size_init_data a) id))
+                      (setN n pos dt (contents_init_data (pos + size_init_data a) id))
+                      0 sz0 0).
+  intros. set (pos' := pos) in |- * at 3. replace pos' with (pos + 0).
+  apply setN_inject. apply IHid. omega. omega. auto. auto. 
+  generalize (size_init_data_list_pos id). omega. unfold pos'; omega.
+  destruct a;
+  try (apply H1; [reflexivity|repeat constructor]).
+  apply IHid. generalize (Zmax2 z 0). omega. simpl in H0; omega.
+
+  apply H. omega. unfold sz0. omega.
+Qed.
+
 End MEM_INJECT.
 
 Hint Resolve val_inject_int val_inject_float val_inject_ptr val_inject_undef.
@@ -2251,3 +2359,27 @@ Proof.
   right. intros. omega. left. auto.
   apply mi_no_overlap0; auto.
 Qed.
+
+Lemma alloc_parallel_inject:
+  forall f m1 m2 lo hi m1' m2' b1 b2,
+  mem_inject f m1 m2 ->
+  alloc m1 lo hi = (m1', b1) ->
+  alloc m2 lo hi = (m2', b2) ->
+  Int.min_signed <= lo -> hi <= Int.max_signed ->
+  mem_inject (extend_inject b1 (Some(b2,0)) f) m1' m2' /\
+  inject_incr f (extend_inject b1 (Some(b2,0)) f).
+Proof.
+  intros. 
+  generalize (low_bound_alloc _ _ b2 _ _ _ H1). rewrite zeq_true; intro LOW.
+  generalize (high_bound_alloc _ _ b2 _ _ _ H1). rewrite zeq_true; intro HIGH.
+  eapply alloc_mapped_inject; eauto.
+  eapply alloc_right_inject; eauto.
+  eapply valid_new_block; eauto.
+  compute. intuition congruence.
+  rewrite LOW; auto.
+  rewrite HIGH; auto.
+  rewrite LOW; omega.
+  rewrite HIGH; omega.
+  intros. elim (mi_mappedblocks _ _ _ H _ _ _ H4); intros.
+  injection H1; intros. rewrite H7 in H5. omegaContradiction.
+Qed.
diff --git a/backend/Op.v b/backend/Op.v
index e0dcfa4..efd0d9c 100644
--- a/backend/Op.v
+++ b/backend/Op.v
@@ -46,7 +46,9 @@ Inductive operation : Set :=
   | Oundef: operation                   (**r set [rd] to undefined value *)
 (*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] *)
   | Oaddimm: int -> operation           (**r [rd = r1 + n] *)
   | Osub: operation                     (**r [rd = r1 - r2] *)
@@ -166,8 +168,10 @@ Definition eval_operation
       end
   | Oaddrstack ofs, nil => offset_sp sp ofs
   | Oundef, nil => Some Vundef
-  | Ocast8signed, Vint n1 :: nil => Some (Vint (Int.cast8signed n1))
-  | Ocast16signed, Vint n1 :: nil => Some (Vint (Int.cast16signed n1))
+  | Ocast8signed, v1 :: nil => Some (Val.cast8signed v1)
+  | Ocast8unsigned, v1 :: nil => Some (Val.cast8unsigned v1)
+  | Ocast16signed, v1 :: nil => Some (Val.cast16signed v1)
+  | Ocast16unsigned, v1 :: nil => Some (Val.cast16unsigned 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))
@@ -215,8 +219,8 @@ Definition eval_operation
       Some (Vfloat (Float.add (Float.mul f1 f2) f3))
   | Omulsubf, Vfloat f1 :: Vfloat f2 :: Vfloat f3 :: nil =>
       Some (Vfloat (Float.sub (Float.mul f1 f2) f3))
-  | Osingleoffloat, Vfloat f1 :: nil =>
-      Some (Vfloat (Float.singleoffloat f1))
+  | Osingleoffloat, v1 :: nil =>
+      Some (Val.singleoffloat v1)
   | Ointoffloat, Vfloat f1 :: nil => 
       Some (Vint (Float.intoffloat f1))
   | Ofloatofint, Vint n1 :: nil => 
@@ -396,7 +400,9 @@ Definition type_of_operation (op: operation) : list typ * typ :=
   | Oaddrstack _ => (nil, Tint)
   | Oundef => (nil, Tint)  (* treated specially *)
   | Ocast8signed => (Tint :: nil, Tint)
+  | Ocast8unsigned => (Tint :: nil, Tint)
   | Ocast16signed => (Tint :: nil, Tint)
+  | Ocast16unsigned => (Tint :: nil, Tint)
   | Oadd => (Tint :: Tint :: nil, Tint)
   | Oaddimm _ => (Tint :: nil, Tint)
   | Osub => (Tint :: Tint :: nil, Tint)
@@ -476,6 +482,10 @@ Proof.
   destruct (Genv.find_symbol genv i); simplify_eq H1; intro; subst v; exact I.
   simpl. unfold offset_sp in H1. destruct sp; try discriminate.
   inversion H1. exact I.
+  destruct v0; exact I. 
+  destruct v0; exact I. 
+  destruct v0; exact I. 
+  destruct v0; exact I. 
   destruct (eq_block b b0). injection H1; intro; subst v; exact I.
   discriminate.
   destruct (Int.eq i0 Int.zero). discriminate. 
@@ -492,6 +502,7 @@ Proof.
   injection H1; intro; subst v; exact I. discriminate.
   destruct (Int.ltu i0 (Int.repr 32)).
   injection H1; intro; subst v; exact I. discriminate.
+  destruct v0; exact I.
   destruct (eval_condition c vl). 
   destruct b; injection H1; intro; subst v; exact I.
   discriminate.
@@ -550,7 +561,9 @@ Definition eval_operation_total (sp: val) (op: operation) (vl: list val) : val :
   | Oaddrstack ofs, nil => Val.add sp (Vint ofs)
   | Oundef, nil => Vundef
   | Ocast8signed, v1::nil => Val.cast8signed v1
+  | Ocast8unsigned, v1::nil => Val.cast8unsigned v1
   | Ocast16signed, v1::nil => Val.cast16signed v1
+  | Ocast16unsigned, v1::nil => Val.cast16unsigned v1
   | Oadd, v1::v2::nil => Val.add v1 v2
   | Oaddimm n, v1::nil => Val.add v1 (Vint n)
   | Osub, v1::v2::nil => Val.sub v1 v2
diff --git a/backend/PPC.v b/backend/PPC.v
index 64bd90a..37f882b 100644
--- a/backend/PPC.v
+++ b/backend/PPC.v
@@ -7,6 +7,7 @@ Require Import Integers.
 Require Import Floats.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 
 (** * Abstract syntax *)
@@ -85,6 +86,7 @@ Inductive instruction : Set :=
   | Paddi: ireg -> ireg -> constant -> instruction            (**r add immediate *)
   | Paddis: ireg -> ireg -> constant -> instruction           (**r add immediate high *)
   | Paddze: ireg -> ireg -> instruction                       (**r add Carry bit *)
+  | Pallocblock: instruction                                  (**r allocate new heap block *)
   | Pallocframe: Z -> Z -> instruction                        (**r allocate new stack frame *)
   | Pand_: ireg -> ireg -> ireg -> instruction                (**r bitwise and *)
   | Pandc: ireg -> ireg -> ireg -> instruction                (**r bitwise and-complement *)
@@ -260,6 +262,12 @@ lbl:    .long   0x43300000, 0x00000000
   Again, our memory model cannot comprehend that this operation
   frees (logically) the current stack frame.
 
+- [Pallocheap]: in the formal semantics, this pseudo-instruction
+  allocates a heap block of size the contents of [GPR3], and leaves
+  a pointer to this block in [GPR3].  In the generated assembly code,
+  it is turned into a call to the allocation function of the run-time
+  system.
+
 - [Piundef] and [Pfundef]: set an integer or float register (respectively)
   to the [Vundef] value.  Expand to nothing, as the PowerPC processor has
   no notion of ``undefined value''.  These two pseudo-instructions are used
@@ -277,7 +285,8 @@ lbl:    .long   0x43300000, 0x00000000
 *)
 
 Definition code := list instruction.
-Definition program := AST.program code.
+Definition fundef := AST.fundef code.
+Definition program := AST.program fundef.
 
 (** * Operational semantics *)
 
@@ -317,7 +326,7 @@ Module Pregmap := EMap(PregEq).
   [Vzero] or [Vone]. *)
   
 Definition regset := Pregmap.t val.
-Definition genv := Genv.t code.
+Definition genv := Genv.t fundef.
 
 Notation "a # b" := (a b) (at level 1, only parsing).
 Notation "a # b <- c" := (Pregmap.set b c a) (at level 1, b at next level).
@@ -540,6 +549,14 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome
       OK (nextinstr (rs#rd <- (Val.add (gpr_or_zero rs r1) (const_high cst)))) m
   | Paddze rd r1 =>
       OK (nextinstr (rs#rd <- (Val.add rs#r1 rs#CARRY))) m
+  | Pallocblock =>
+      match rs#GPR3 with
+      | Vint n =>
+          let (m', b) := Mem.alloc m 0 (Int.signed n) in
+          OK (nextinstr (rs#GPR3 <- (Vptr b Int.zero)
+                           #LR <- (Val.add rs#PC Vone))) m'
+      | _ => Error
+      end
   | Pallocframe lo hi =>
       let (m1, stk) := Mem.alloc m lo hi in
       let sp := Vptr stk (Int.repr lo) in
@@ -735,36 +752,84 @@ 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
+    we use PPC registers instead of locations. *)
+
+Fixpoint loc_external_arguments_rec
+    (tyl: list typ) (iregl: list ireg) (fregl: list freg)
+    {struct tyl} : list preg :=
+  match tyl with
+  | nil => nil
+  | Tint :: tys =>
+      match iregl with
+      | nil => IR GPR11 (* should not happen *)
+      | ireg :: _ => IR ireg
+      end ::
+      loc_external_arguments_rec tys (list_drop1 iregl) fregl
+  | Tfloat :: tys =>
+      match fregl with
+      | nil => IR GPR11 (* should not happen *)
+      | freg :: _ => FR freg
+      end ::
+      loc_external_arguments_rec tys (list_drop2 iregl) (list_drop1 fregl)
+  end.
+
+Definition int_param_regs :=
+  GPR3 :: GPR4 :: GPR5 :: GPR6 :: GPR7 :: GPR8 :: GPR9 :: GPR10 :: nil.
+Definition float_param_regs :=
+  FPR1 :: FPR2 :: FPR3 :: FPR4 :: FPR5 :: FPR6 :: FPR7 :: FPR8 :: FPR9 :: FPR10 :: nil.
+
+Definition loc_external_arguments (s: signature) : list preg :=
+  loc_external_arguments_rec s.(sig_args) int_param_regs float_param_regs.
+
+Definition loc_external_result (s: signature) : preg :=
+  match s.(sig_res) with
+  | None => GPR3
+  | Some Tint => GPR3
+  | Some Tfloat => FPR1
+  end.
+
 (** Execution of the instruction at [rs#PC]. *)
 
-Inductive exec_step: regset -> mem -> regset -> mem -> Prop :=
-  | exec_step_intro:
+Inductive exec_step: regset -> mem -> trace -> regset -> mem -> Prop :=
+  | exec_step_internal:
       forall b ofs c i rs m rs' m',
       rs PC = Vptr b ofs ->
-      Genv.find_funct_ptr ge b = Some c ->
+      Genv.find_funct_ptr ge b = Some (Internal c) ->
       find_instr (Int.unsigned ofs) c = Some i ->
       exec_instr c i rs m = OK rs' m' ->
-      exec_step rs m rs' m'.
+      exec_step rs m E0 rs' m'
+  | exec_step_external:
+      forall b ef args res rs m t rs',
+      rs PC = Vptr b Int.zero ->
+      Genv.find_funct_ptr ge b = Some (External ef) ->
+      event_match ef args t res ->
+      args = List.map (fun r => rs#r) (loc_external_arguments ef.(ef_sig)) ->
+      rs' = (rs#(loc_external_result ef.(ef_sig)) <- res
+               #PC <- (rs LR)) ->
+      exec_step rs m t rs' m.
 
 (** Execution of zero, one or several instructions starting at [rs#PC]. *)
 
-Inductive exec_steps: regset -> mem -> regset -> mem -> Prop :=
+Inductive exec_steps: regset -> mem -> trace -> regset -> mem -> Prop :=
   | exec_refl:
       forall rs m,
-      exec_steps rs m rs m
+      exec_steps rs m E0 rs m
   | exec_one:
-      forall rs m rs' m',
-      exec_step rs m rs' m' ->
-      exec_steps rs m rs' m'
+      forall rs m t rs' m',
+      exec_step rs m t rs' m' ->
+      exec_steps rs m t rs' m'
   | exec_trans:
-      forall rs1 m1 rs2 m2 rs3 m3,
-      exec_steps rs1 m1 rs2 m2 ->
-      exec_steps rs2 m2 rs3 m3 ->
-      exec_steps rs1 m1 rs3 m3.
+      forall rs1 m1 t1 rs2 m2 t2 rs3 m3 t3,
+      exec_steps rs1 m1 t1 rs2 m2 ->
+      exec_steps rs2 m2 t2 rs3 m3 ->
+      t3 = t1 ** t2 ->
+      exec_steps rs1 m1 t3 rs3 m3.
 
 End RELSEM.
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv p in
   let m0 := Genv.init_mem p in
   let rs0 :=
@@ -772,4 +837,4 @@ Definition exec_program (p: program) (r: val) : Prop :=
                           # LR <- Vzero
                           # GPR1 <- (Vptr Mem.nullptr Int.zero) in
   exists rs, exists m,
-  exec_steps ge rs0 m0 rs m /\ rs#PC = Vzero /\ rs#GPR3 = r.
+  exec_steps ge rs0 m0 t rs m /\ rs#PC = Vzero /\ rs#GPR3 = r.
diff --git a/backend/PPCgen.v b/backend/PPCgen.v
index dc8ed40..6cf0699 100644
--- a/backend/PPCgen.v
+++ b/backend/PPCgen.v
@@ -275,8 +275,12 @@ Definition transl_op
       end
   | Ocast8signed, a1 :: nil =>
       Pextsb (ireg_of r) (ireg_of a1) :: k
+  | Ocast8unsigned, a1 :: nil =>
+      Prlwinm (ireg_of r) (ireg_of a1) Int.zero (Int.repr 255) :: k
   | Ocast16signed, a1 :: nil =>
       Pextsh (ireg_of r) (ireg_of a1) :: k
+  | Ocast16unsigned, a1 :: nil =>
+      Prlwinm (ireg_of r) (ireg_of a1) Int.zero (Int.repr 65535) :: k
   | Oadd, a1 :: a2 :: nil =>
       Padd (ireg_of r) (ireg_of a1) (ireg_of a2) :: k
   | Oaddimm n, a1 :: nil =>
@@ -470,6 +474,8 @@ Definition transl_instr (i: Mach.instruction) (k: code) :=
       Pmtctr (ireg_of r) :: Pbctrl :: k
   | Mcall sig (inr symb) =>
       Pbl symb :: k
+  | Malloc =>
+      Pallocblock :: k
   | Mlabel lbl =>
       Plabel lbl :: k
   | Mgoto lbl =>
@@ -504,11 +510,14 @@ Fixpoint code_size (c: code) : Z :=
   | instr :: c' => code_size c' + 1
   end.
 
-Definition transf_function (f: Mach.function) :=
+Definition transf_function (f: Mach.function) : option PPC.code :=
   let c := transl_function f in
   if zlt Int.max_unsigned (code_size c)
   then None
   else Some c.
 
+Definition transf_fundef (f: Mach.fundef) : option PPC.fundef :=
+  transf_partial_fundef transf_function f.
+
 Definition transf_program (p: Mach.program) : option PPC.program :=
-  transform_partial_program transf_function p.
+  transform_partial_program transf_fundef p.
diff --git a/backend/PPCgenproof.v b/backend/PPCgenproof.v
index 99aa4c8..3264999 100644
--- a/backend/PPCgenproof.v
+++ b/backend/PPCgenproof.v
@@ -7,6 +7,7 @@ Require Import Integers.
 Require Import Floats.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
@@ -29,53 +30,44 @@ 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_function.
+  apply Genv.find_symbol_transf_partial with transf_fundef.
   exact TRANSF. 
 Qed.
 
 Lemma functions_translated:
   forall f b,
   Genv.find_funct_ptr ge b = Some f ->
-  Genv.find_funct_ptr tge b = Some (transl_function f).
+  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = Some tf.
 Proof.
   intros. 
-  generalize (Genv.find_funct_ptr_transf_partial
-                transf_function TRANSF H).
-  intros [A B].
-  unfold tge. change code with (list instruction). rewrite A. 
-  generalize B. unfold transf_function. 
-  case (zlt Int.max_unsigned (code_size (transl_function f))); intro.
-  tauto. auto.
+  generalize (Genv.find_funct_ptr_transf_partial transf_fundef TRANSF H).
+  case (transf_fundef f). 
+  intros f' [A B]. exists f'; split. assumption. auto.
+  tauto.
 Qed.
 
-Lemma functions_translated_2:
-  forall f v,
-  Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (transl_function f).
+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. 
-  generalize (Genv.find_funct_transf_partial
-                transf_function TRANSF H).
-  intros [A B].
-  unfold tge. change code with (list instruction). rewrite A. 
-  generalize B. unfold transf_function. 
+  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))); intro.
-  tauto. auto.
+  congruence. auto.
 Qed.
 
-Lemma functions_translated_no_overflow:
+Lemma functions_transl_no_overflow:
   forall b f,
-  Genv.find_funct_ptr ge b = Some f ->
+  Genv.find_funct_ptr ge b = Some (Internal f) ->
   code_size (transl_function f) <= Int.max_unsigned.
 Proof.
-  intros.
-  generalize (Genv.find_funct_ptr_transf_partial
-                transf_function TRANSF H).
-  intros [A B].
-  generalize B.
-  unfold transf_function.
+  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))); intro.
-  tauto. intro. omega. 
+  congruence. intro; omega.
 Qed.
 
 (** * Properties of control flow *)
@@ -180,7 +172,7 @@ Qed.
 Inductive transl_code_at_pc: val -> Mach.function -> Mach.code -> Prop :=
   transl_code_at_pc_intro:
     forall b ofs f c,
-    Genv.find_funct_ptr ge b = Some f ->
+    Genv.find_funct_ptr ge b = Some (Internal f) ->
     code_tail (Int.unsigned ofs) (transl_function f) = transl_code c ->
     transl_code_at_pc (Vptr b ofs) f c.
 
@@ -194,19 +186,20 @@ Lemma exec_straight_steps_1:
   code_size fn <= Int.max_unsigned ->
   forall b ofs,
   rs#PC = Vptr b ofs ->
-  Genv.find_funct_ptr tge b = Some fn ->
+  Genv.find_funct_ptr tge b = Some (Internal fn) ->
   code_tail (Int.unsigned ofs) fn = c ->
-  exec_steps tge rs m rs' m'.
+  exec_steps tge rs m E0 rs' m'.
 Proof.
   induction 1.
   intros. apply exec_refl. 
-  intros. apply exec_trans with rs2 m2.
+  intros. apply exec_trans with E0 rs2 m2 E0.
   apply exec_one; econstructor; eauto. 
   rewrite find_instr_tail. rewrite H5. auto.
   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:
@@ -215,7 +208,7 @@ Lemma exec_straight_steps_2:
   code_size fn <= Int.max_unsigned ->
   forall b ofs,
   rs#PC = Vptr b ofs ->
-  Genv.find_funct_ptr tge b = Some fn ->
+  Genv.find_funct_ptr tge b = Some (Internal fn) ->
   code_tail (Int.unsigned ofs) fn = c ->
   exists ofs',
      rs'#PC = Vptr b ofs'
@@ -233,11 +226,11 @@ Lemma exec_straight_steps:
   transl_code_at_pc (rs PC) f c ->
   exec_straight tge (transl_function f)
                 (transl_code c) rs m (transl_code c') rs' m' ->
-  exec_steps tge rs m rs' m' /\ transl_code_at_pc (rs' PC) f c'.
+  exec_steps tge rs m E0 rs' m' /\ transl_code_at_pc (rs' PC) f c'.
 Proof.
   intros. inversion H.
-  generalize (functions_translated_no_overflow _ _ H2). intro.
-  generalize (functions_translated _ _ H2). intro.
+  generalize (functions_transl_no_overflow _ _ H2). intro.
+  generalize (functions_transl _ _ H2). intro.
   split. eapply exec_straight_steps_1; eauto. 
   generalize (exec_straight_steps_2 _ _ _ _ _ _ _
                 H0 H6 _ _ (sym_equal H1) H7 H3).
@@ -490,7 +483,7 @@ End TRANSL_LABEL.
 
 Lemma find_label_goto_label:
   forall f lbl rs m c' b ofs,
-  Genv.find_funct_ptr ge b = Some f ->
+  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',
@@ -509,7 +502,7 @@ Proof.
   split. rewrite Pregmap.gss. constructor. auto. 
   rewrite Int.unsigned_repr. replace (pos' - 0) with pos' in B.
   auto. omega. 
-  generalize (functions_translated_no_overflow _ _ H). 
+  generalize (functions_transl_no_overflow _ _ H). 
   omega.
   intros. apply Pregmap.gso; auto.
 Qed.  
@@ -575,7 +568,7 @@ Qed.
 
 Definition exec_instr_prop
             (f: Mach.function) (sp: val) 
-            (c1: Mach.code) (ms1: Mach.regset) (m1: mem)
+            (c1: Mach.code) (ms1: Mach.regset) (m1: mem) (t: trace)
             (c2: Mach.code) (ms2: Mach.regset) (m2: mem) :=
   forall rs1
     (WTF: wt_function f)
@@ -584,36 +577,36 @@ Definition exec_instr_prop
     (AG: agree ms1 sp rs1),
   exists rs2,
     agree ms2 sp rs2
-  /\ exec_steps tge rs1 m1 rs2 m2
+  /\ exec_steps tge rs1 m1 t rs2 m2
   /\ transl_code_at_pc (rs2 PC) f c2.
 
 Definition exec_function_body_prop
             (f: Mach.function) (parent: val) (ra: val)
-            (ms1: Mach.regset) (m1: mem)
+            (ms1: Mach.regset) (m1: mem) (t: trace)
             (ms2: Mach.regset) (m2: mem) :=
   forall rs1
     (WTRA: Val.has_type ra Tint)
     (RALR: rs1 LR = ra)
     (WTF: wt_function f)
-    (AT: Genv.find_funct ge (rs1 PC) = Some f)
+    (AT: Genv.find_funct ge (rs1 PC) = Some (Internal f))
     (AG: agree ms1 parent rs1),
   exists rs2,
      agree ms2 parent rs2
-  /\ exec_steps tge rs1 m1 rs2 m2
+  /\ exec_steps tge rs1 m1 t rs2 m2
   /\ rs2 PC = rs1 LR.
 
 Definition exec_function_prop
-            (f: Mach.function) (parent: val) 
-            (ms1: Mach.regset) (m1: mem)
+            (f: Mach.fundef) (parent: val) 
+            (ms1: Mach.regset) (m1: mem) (t: trace)
             (ms2: Mach.regset) (m2: mem) :=
   forall rs1
-    (WTF: wt_function f)
+    (WTF: wt_fundef f)
     (AT: Genv.find_funct ge (rs1 PC) = Some f)
     (AG: agree ms1 parent rs1)
     (WTRA: Val.has_type (rs1 LR) Tint),
   exists rs2,
      agree ms2 parent rs2
-  /\ exec_steps tge rs1 m1 rs2 m2
+  /\ exec_steps tge rs1 m1 t rs2 m2
   /\ rs2 PC = rs1 LR.
            
 (** We show each case of the inductive proof of simulation as a separate
@@ -622,7 +615,7 @@ Definition exec_function_prop
 Lemma exec_Mlabel_prop:
   forall (f : function) (sp : val) (lbl : Mach.label)
      (c : list Mach.instruction) (rs : Mach.regset) (m : mem),
-   exec_instr_prop f sp (Mlabel lbl :: c) rs m c rs m.
+   exec_instr_prop f sp (Mlabel lbl :: c) rs m E0 c rs m.
 Proof.
   intros; red; intros.
   assert (exec_straight tge (transl_function f)
@@ -637,7 +630,7 @@ Lemma exec_Mgetstack_prop:
   forall (f : function) (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 f sp (Mgetstack ofs ty dst :: c) ms m c (Regmap.set dst v ms) m.
+   exec_instr_prop f sp (Mgetstack ofs ty dst :: c) ms m E0 c (Regmap.set dst v ms) m.
 Proof.
   intros; red; intros.
   unfold load_stack in H. 
@@ -661,7 +654,7 @@ Lemma exec_Msetstack_prop:
   forall (f : function) (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 f sp (Msetstack src ofs ty :: c) ms m c ms m'.
+   exec_instr_prop f sp (Msetstack src ofs ty :: c) ms m E0 c ms m'.
 Proof.
   intros; red; intros.
   unfold store_stack in H. 
@@ -684,7 +677,7 @@ Lemma exec_Mgetparam_prop:
      (m : mem) (v : val),
    load_stack m sp Tint (Int.repr 0) = Some parent ->
    load_stack m parent ty ofs = Some v ->
-   exec_instr_prop f sp (Mgetparam ofs ty dst :: c) ms m c (Regmap.set dst v ms) m.
+   exec_instr_prop f sp (Mgetparam ofs ty dst :: c) ms m E0 c (Regmap.set dst v ms) m.
 Proof.
   intros; red; intros.
   set (rs2 := nextinstr (rs1#GPR2 <- parent)).
@@ -723,7 +716,7 @@ Lemma exec_straight_exec_prop:
    /\ agree ms' sp rs2) ->
   (exists rs2,
       agree ms' sp rs2
-   /\ exec_steps tge rs1 m1 rs2 m2
+   /\ exec_steps tge rs1 m1 E0 rs2 m2
   /\ transl_code_at_pc (rs2 PC) f c2).
 Proof.
   intros until ms'. intros TRANS1 [rs2 [EX AG]].
@@ -736,7 +729,7 @@ Lemma exec_Mop_prop:
      (res : mreg) (c : list Mach.instruction) (ms: Mach.regset)
      (m : mem) (v: val),
    eval_operation ge sp op ms ## args = Some v ->
-   exec_instr_prop f sp (Mop op args res :: c) ms m c (Regmap.set res v ms) m.
+   exec_instr_prop f sp (Mop op args res :: c) ms m E0 c (Regmap.set res v ms) m.
 Proof.
   intros; red; intros.
   generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
@@ -753,7 +746,7 @@ Lemma exec_Mload_prop:
      (a v : val),
    eval_addressing ge sp addr ms ## args = Some a ->
    loadv chunk m a = Some v ->
-   exec_instr_prop f sp (Mload chunk addr args dst :: c) ms m c (Regmap.set dst v ms) m.
+   exec_instr_prop f sp (Mload chunk addr args dst :: c) ms m E0 c (Regmap.set dst v ms) m.
 Proof.
   intros; red; intros.
   generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
@@ -801,7 +794,7 @@ Lemma exec_Mstore_prop:
      (a : val),
    eval_addressing ge sp addr ms ## args = Some a ->
    storev chunk m a (ms src) = Some m' ->
-   exec_instr_prop f sp (Mstore chunk addr args src :: c) ms m c ms m'.
+   exec_instr_prop f sp (Mstore chunk addr args src :: c) ms m E0 c ms m'.
 Proof.
   intros; red; intros.
   generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
@@ -820,23 +813,23 @@ Hypothesis wt_prog: wt_program prog.
 Lemma exec_Mcall_prop:
    forall (f : function) (sp : val) (sig : signature)
      (mos : mreg + ident) (c : list Mach.instruction) (ms : Mach.regset)
-     (m : mem) (f' : function) (ms' : Mach.regset) (m' : mem),
+     (m : mem) (f' : Mach.fundef) (t: trace) (ms' : Mach.regset) (m' : mem),
    find_function ge mos ms = Some f' ->
-   exec_function ge f' sp ms m ms' m' ->
-   exec_function_prop f' sp ms m ms' m' ->
-   exec_instr_prop f sp (Mcall sig mos :: c) ms m c ms' m'.
+   exec_function ge f' sp ms m t ms' m' ->
+   exec_function_prop f' sp ms m t ms' m' ->
+   exec_instr_prop f sp (Mcall sig mos :: c) ms m t c ms' m'.
 Proof.
   intros; red; intros.
   generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
   intro WTI. inversion WTI.
   inversion AT.
-  assert (WTF': wt_function f').
+  assert (WTF': wt_fundef f').
     destruct mos; simpl in H.
-    apply (Genv.find_funct_prop wt_function wt_prog H).
+    apply (Genv.find_funct_prop wt_fundef wt_prog H).
     destruct (Genv.find_symbol ge i); try discriminate.
-    apply (Genv.find_funct_ptr_prop wt_function wt_prog H).
+    apply (Genv.find_funct_ptr_prop wt_fundef wt_prog H).
   assert (NOOV: code_size (transl_function f) <= Int.max_unsigned).
-    eapply functions_translated_no_overflow; eauto.
+    eapply functions_transl_no_overflow; eauto.
   destruct mos; simpl in H; simpl transl_code in H7.
   (* Indirect call *)
   generalize (code_tail_next_int _ _ _ _ NOOV H7). intro CT1.
@@ -853,19 +846,19 @@ Proof.
   generalize (H1 rs3 WTF' TFIND AG3 WTRA).
   intros [rs4 [AG4 [EXF' PC4]]].
   exists rs4. split. auto. split.
-  apply exec_trans with rs2 m. apply exec_one. econstructor. 
-    eauto. apply functions_translated. eexact H6. 
+  apply exec_trans with E0 rs2 m t. apply exec_one. econstructor. 
+    eauto. apply functions_transl. eexact H6. 
     rewrite find_instr_tail. rewrite H7. reflexivity.
     simpl. rewrite <- (ireg_val ms sp rs1); auto. 
-  apply exec_trans with rs3 m. apply exec_one. econstructor.
+  apply exec_trans with E0 rs3 m t. apply exec_one. econstructor.
     unfold rs2, nextinstr. rewrite Pregmap.gss. 
     rewrite Pregmap.gso. rewrite <- H5. simpl. reflexivity.
-    discriminate. apply functions_translated. eexact H6.
+    discriminate. apply functions_transl. eexact H6.
     rewrite find_instr_tail. rewrite CT1. reflexivity.
     simpl. replace (rs2 CTR) with (ms m0). reflexivity.
     unfold rs2. rewrite nextinstr_inv. rewrite Pregmap.gss. 
     auto. discriminate.
-  exact EXF'.
+  exact EXF'. traceEq. traceEq. 
   rewrite PC4. unfold rs3. rewrite Pregmap.gso. rewrite Pregmap.gss.
   unfold rs2, nextinstr. rewrite Pregmap.gss. rewrite Pregmap.gso. 
   rewrite <- H5. simpl. constructor. auto. auto. 
@@ -888,23 +881,36 @@ Proof.
   generalize (H1 rs2 WTF' TFIND AG2 WTRA).
   intros [rs3 [AG3 [EXF' PC3]]].
   exists rs3. split. auto. split.
-  apply exec_trans with rs2 m. apply exec_one. econstructor. 
-    eauto. apply functions_translated. eexact H6. 
+  apply exec_trans with E0 rs2 m t. apply exec_one. econstructor. 
+    eauto. apply functions_transl. eexact H6. 
     rewrite find_instr_tail. rewrite H7. reflexivity.
-    simpl. reflexivity.
-  exact EXF'.
+    simpl. reflexivity. 
+  exact EXF'. traceEq.
   rewrite PC3. unfold rs2. rewrite Pregmap.gso. rewrite Pregmap.gss.
   rewrite <- H5. simpl. constructor. auto. auto. 
   discriminate. 
   intro FINDS. rewrite FINDS in H. discriminate.
 Qed.
 
+Lemma exec_Malloc_prop:
+  forall (f : function) (sp : val) (c : list Mach.instruction)
+         (ms : Mach.regset) (m : mem) (sz : int) (m' : mem) (blk : block),
+  ms Conventions.loc_alloc_argument = Vint sz ->
+  Mem.alloc m 0 (Int.signed sz) = (m', blk) ->
+  exec_instr_prop f sp (Malloc :: c) ms m E0 c
+    (Regmap.set Conventions.loc_alloc_result (Vptr blk Int.zero) ms) m'.
+Proof.
+  intros; red; intros.
+  eapply exec_straight_exec_prop; eauto.
+  simpl. eapply transl_alloc_correct; eauto. 
+Qed.
+
 Lemma exec_Mgoto_prop:
    forall (f : function) (sp : val) (lbl : Mach.label)
      (c : list Mach.instruction) (ms : Mach.regset) (m : mem)
      (c' : Mach.code),
    Mach.find_label lbl (fn_code f) = Some c' ->
-   exec_instr_prop f sp (Mgoto lbl :: c) ms m c' ms m.
+   exec_instr_prop f sp (Mgoto lbl :: c) ms m E0 c' ms m.
 Proof.
   intros; red; intros.
   inversion AT.
@@ -912,7 +918,7 @@ Proof.
   intros [rs2 [GOTO [AT2 INV]]].
   exists rs2. split. apply agree_exten_2 with rs1; auto. 
   split. inversion AT. apply exec_one. econstructor; eauto.
-  apply functions_translated; eauto. 
+  apply functions_transl; eauto. 
   rewrite find_instr_tail. rewrite H7. simpl. reflexivity.
   simpl. rewrite GOTO. auto. auto.
 Qed.
@@ -923,7 +929,7 @@ Lemma exec_Mcond_true_prop:
      (ms: Mach.regset) (m : mem) (c' : Mach.code),
    eval_condition cond ms ## args = Some true ->
    Mach.find_label lbl (fn_code f) = Some c' ->
-   exec_instr_prop f sp (Mcond cond args lbl :: c) ms m c' ms m.
+   exec_instr_prop f sp (Mcond cond args lbl :: c) ms m E0 c' ms m.
 Proof.
   intros; red; intros.
   generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
@@ -936,8 +942,8 @@ Proof.
                 cond args k1 ms sp rs1 m true H2 AG H).
   simpl. intros [rs2 [EX [RES AG2]]].
   inversion AT.
-  generalize (functions_translated _ _ H6); intro FN.
-  generalize (functions_translated_no_overflow _ _ H6); intro NOOV.
+  generalize (functions_transl _ _ H6); intro FN.
+  generalize (functions_transl_no_overflow _ _ H6); intro NOOV.
   simpl in H7.
   generalize (exec_straight_steps_2 _ _ _ _ _ _ _ EX 
                NOOV _ _ (sym_equal H5) FN H7).
@@ -955,7 +961,7 @@ Proof.
   apply exec_one. econstructor; eauto.
   rewrite find_instr_tail. rewrite CT2. unfold k1. rewrite ISSET. reflexivity.
   simpl. rewrite RES. simpl. auto.
-  auto. 
+  traceEq. auto. 
 Qed.
 
 Lemma exec_Mcond_false_prop:
@@ -963,7 +969,7 @@ Lemma exec_Mcond_false_prop:
      (args : list mreg) (lbl : Mach.label) (c : list Mach.instruction)
      (ms : Mach.regset) (m : mem),
    eval_condition cond ms ## args = Some false ->
-   exec_instr_prop f sp (Mcond cond args lbl :: c) ms m c ms m.
+   exec_instr_prop f sp (Mcond cond args lbl :: c) ms m E0 c ms m.
 Proof.
   intros; red; intros.
   generalize (wt_function_instrs _ WTF _ (INCL _ (in_eq _ _))).
@@ -989,8 +995,8 @@ Proof.
 Qed.
 
 Lemma exec_instr_incl:
-  forall f sp c rs m c' rs' m',
-  Mach.exec_instr ge f sp c rs m c' rs' m' ->
+  forall f sp c rs m t c' rs' m',
+  Mach.exec_instr ge f sp c rs m t c' rs' m' ->
   incl c f.(fn_code) -> incl c' f.(fn_code).
 Proof.
   induction 1; intros; eauto with coqlib.
@@ -999,8 +1005,8 @@ Proof.
 Qed.
 
 Lemma exec_instrs_incl:
-  forall f sp c rs m c' rs' m',
-  Mach.exec_instrs ge f sp c rs m c' rs' m' ->
+  forall f sp c rs m t c' rs' m',
+  Mach.exec_instrs ge f sp c rs m t c' rs' m' ->
   incl c f.(fn_code) -> incl c' f.(fn_code).
 Proof.
   induction 1; intros. 
@@ -1011,7 +1017,7 @@ Qed.
 
 Lemma exec_refl_prop:
    forall (f : function) (sp : val) (c : Mach.code) (ms : Mach.regset)
-     (m : mem), exec_instr_prop f sp c ms m c ms m.
+     (m : mem), exec_instr_prop f sp c ms m E0 c ms m.
 Proof.
   intros; red; intros.
   exists rs1. split. auto. split. apply exec_refl. auto.
@@ -1019,28 +1025,29 @@ Qed.
 
 Lemma exec_one_prop:
    forall (f : function) (sp : val) (c : Mach.code) (ms : Mach.regset)
-     (m : mem) (c' : Mach.code) (ms' : Mach.regset) (m' : mem),
-   Mach.exec_instr ge f sp c ms m c' ms' m' ->
-   exec_instr_prop f sp c ms m c' ms' m' ->
-   exec_instr_prop f sp c ms m c' ms' m'.
+     (m : mem) (t: trace) (c' : Mach.code) (ms' : Mach.regset) (m' : mem),
+   Mach.exec_instr ge f sp c ms m t c' ms' m' ->
+   exec_instr_prop f sp c ms m t c' ms' m' ->
+   exec_instr_prop f sp c ms m t c' ms' m'.
 Proof.
   auto.
 Qed.
 
 Lemma exec_trans_prop:
    forall (f : function) (sp : val) (c1 : Mach.code) (ms1 : Mach.regset)
-     (m1 : mem) (c2 : Mach.code) (ms2 : Mach.regset) (m2 : mem)
-     (c3 : Mach.code) (ms3 : Mach.regset) (m3 : mem),
-   exec_instrs ge f sp c1 ms1 m1 c2 ms2 m2 ->
-   exec_instr_prop f sp c1 ms1 m1 c2 ms2 m2 ->
-   exec_instrs ge f sp c2 ms2 m2 c3 ms3 m3 ->
-   exec_instr_prop f sp c2 ms2 m2 c3 ms3 m3 -> 
-   exec_instr_prop f sp c1 ms1 m1 c3 ms3 m3.
+     (m1 : mem) (t1: trace) (c2 : Mach.code) (ms2 : Mach.regset) (m2 : mem)
+     (t2: trace) (c3 : Mach.code) (ms3 : Mach.regset) (m3 : mem) (t3: trace),
+   exec_instrs ge f sp c1 ms1 m1 t1 c2 ms2 m2 ->
+   exec_instr_prop f sp c1 ms1 m1 t1 c2 ms2 m2 ->
+   exec_instrs ge f sp c2 ms2 m2 t2 c3 ms3 m3 ->
+   exec_instr_prop f sp c2 ms2 m2 t2 c3 ms3 m3 -> 
+   t3 = t1 ** t2 ->
+   exec_instr_prop f sp c1 ms1 m1 t3 c3 ms3 m3.
 Proof.
   intros; red; intros.
   generalize (H0 rs1 WTF INCL AT AG).
   intros [rs2 [AG2 [EX2 AT2]]].
-  generalize (exec_instrs_incl _ _ _ _ _ _ _ _ H INCL). intro INCL2.
+  generalize (exec_instrs_incl _ _ _ _ _ _ _ _ _ H INCL). intro INCL2.
   generalize (H2 rs2 WTF INCL2 AT2 AG2).
   intros [rs3 [AG3 [EX3 AT3]]].
   exists rs3. split. auto. split. eapply exec_trans; eauto. auto.
@@ -1048,23 +1055,23 @@ Qed.
 
 Lemma exec_function_body_prop_:
    forall (f : function) (parent ra : val) (ms : Mach.regset) (m : mem)
-     (ms' : Mach.regset) (m1 m2 m3 m4 : mem) (stk : block)
+     (t: trace) (ms' : Mach.regset) (m1 m2 m3 m4 : mem) (stk : block)
      (c : list Mach.instruction),
    alloc m (- fn_framesize f)
       (align_16_top (- fn_framesize f) (fn_stacksize f)) = (m1, stk) ->
    let sp := Vptr stk (Int.repr (- fn_framesize f)) in
    store_stack m1 sp Tint (Int.repr 0) parent = Some m2 ->
    store_stack m2 sp Tint (Int.repr 4) ra = Some m3 ->
-   exec_instrs ge f sp (fn_code f) ms m3 (Mreturn :: c) ms' m4 ->
-   exec_instr_prop f sp (fn_code f) ms m3 (Mreturn :: c) ms' m4 ->
+   exec_instrs ge f sp (fn_code f) ms m3 t (Mreturn :: c) ms' m4 ->
+   exec_instr_prop f sp (fn_code f) ms m3 t (Mreturn :: c) ms' m4 ->
    load_stack m4 sp Tint (Int.repr 0) = Some parent ->
    load_stack m4 sp Tint (Int.repr 4) = Some ra ->
-   exec_function_body_prop f parent ra ms m ms' (free m4 stk).
+   exec_function_body_prop f parent ra ms m t ms' (free m4 stk).
 Proof.
   intros; red; intros.
   generalize (Genv.find_funct_inv AT). intros [b EQPC].
   generalize AT. rewrite EQPC. rewrite Genv.find_funct_find_funct_ptr. intro FN.
-  generalize (functions_translated_no_overflow _ _ FN); intro NOOV.
+  generalize (functions_transl_no_overflow _ _ FN); intro NOOV.
   set (rs2 := nextinstr (rs1#GPR1 <- sp #GPR2 <- Vundef)).
   set (rs3 := nextinstr (rs2#GPR2 <- ra)).
   set (rs4 := nextinstr rs3).
@@ -1132,18 +1139,18 @@ Proof.
     elim AG7; auto. auto with ppcgen. auto with ppcgen.
   unfold rs9; auto with ppcgen.
   (* execution *)
-  split. apply exec_trans with rs4 m3.
+  split. apply exec_trans with E0 rs4 m3 t.
   eapply exec_straight_steps_1; eauto. 
-  apply functions_translated; auto. 
-  apply exec_trans with rs5 m4. assumption.
+  apply functions_transl; auto. 
+  apply exec_trans with t rs5 m4 E0. assumption.
   inversion AT5.
-  apply exec_trans with rs8 (free m4 stk).
+  apply exec_trans with E0 rs8 (free m4 stk) E0.
   eapply exec_straight_steps_1; eauto.
-  apply functions_translated; auto.
+  apply functions_transl; auto.
   apply exec_one. econstructor. 
   change rs8#PC with (Val.add (Val.add (Val.add rs5#PC Vone) Vone) Vone).
   rewrite <- H8. simpl. reflexivity.
-  apply functions_translated; eauto.
+  apply functions_transl; eauto.
   assert (code_tail (Int.unsigned (Int.add (Int.add (Int.add ofs Int.one) Int.one) Int.one))
                     (transl_function f) = Pblr :: transl_code c).
   eapply code_tail_next_int; auto.
@@ -1153,35 +1160,62 @@ Proof.
   rewrite find_instr_tail. rewrite H13.
   reflexivity.
   reflexivity.
+  traceEq. traceEq. traceEq. 
   (* LR preservation *)
   change rs9#PC with ra. auto.
 Qed.
 
-Lemma exec_function_prop_:
+Lemma exec_function_internal_prop:
    forall (f : function) (parent : val) (ms : Mach.regset) (m : mem)
-          (ms' : Mach.regset) (m' : mem),
+          (t: trace) (ms' : Mach.regset) (m' : mem),
    (forall ra : val,
       Val.has_type ra Tint ->
-      exec_function_body ge f parent ra ms m ms' m') ->
+      exec_function_body ge f parent ra ms m t ms' m') ->
    (forall ra : val, Val.has_type ra Tint -> 
-      exec_function_body_prop f parent ra ms m ms' m') ->
-   exec_function_prop f parent ms m ms' m'.
+      exec_function_body_prop f parent ra ms m t ms' m') ->
+   exec_function_prop (Internal f) parent ms m t ms' m'.
 Proof.
   intros; red; intros.
-  apply (H0 rs1#LR WTRA rs1 WTRA (refl_equal _) WTF AT AG).
+  inversion WTF. subst f0. 
+  apply (H0 rs1#LR WTRA rs1 WTRA (refl_equal _) H2 AT AG).
+Qed.
+
+Lemma exec_function_external_prop:
+  forall (ef : external_function) (parent : val) (args : list val)
+         (res : val) (ms1 ms2: Mach.regset) (m : mem)
+         (t : trace),
+  event_match ef args t res ->
+  args = ms1 ## (Conventions.loc_external_arguments (ef_sig ef)) ->
+  ms2 = Regmap.set (Conventions.loc_result (ef_sig ef)) res ms1 ->
+  exec_function_prop (External ef) parent ms1 m t ms2 m.
+Proof.
+  intros; red; intros.
+  destruct (Genv.find_funct_inv AT) as [b EQ].
+  rewrite EQ in AT. rewrite Genv.find_funct_find_funct_ptr in AT.
+  exists (rs1#(loc_external_result (ef_sig ef)) <- res #PC <- (rs1 LR)).
+  split. rewrite loc_external_result_match. rewrite H1. auto with ppcgen.
+  split. apply exec_one. eapply exec_step_external; eauto.
+  destruct (functions_translated _ _ AT) as [tf [A B]].
+  simpl in B. congruence.
+  rewrite H0. rewrite loc_external_arguments_match. 
+  rewrite list_map_compose. apply list_map_exten; intros.
+  symmetry; eapply preg_val; eauto. 
+  reflexivity.
 Qed.
 
 (** We then conclude by induction on the structure of the Mach
 execution derivation. *)
 
 Theorem transf_function_correct:
-  forall f parent ms m ms' m',
-  Mach.exec_function ge f parent ms m ms' m' ->
-  exec_function_prop f parent ms m ms' m'.
+  forall f parent ms m t ms' m',
+  Mach.exec_function ge f parent ms m t ms' m' ->
+  exec_function_prop f parent ms m t ms' m'.
 Proof 
   (Mach.exec_function_ind4 ge
-           exec_instr_prop exec_instr_prop
-           exec_function_body_prop exec_function_prop
+           exec_instr_prop
+           exec_instr_prop
+           exec_function_body_prop
+           exec_function_prop
 
            exec_Mlabel_prop
            exec_Mgetstack_prop
@@ -1191,6 +1225,7 @@ Proof
            exec_Mload_prop
            exec_Mstore_prop
            exec_Mcall_prop
+           exec_Malloc_prop
            exec_Mgoto_prop
            exec_Mcond_true_prop
            exec_Mcond_false_prop
@@ -1198,21 +1233,22 @@ Proof
            exec_one_prop
            exec_trans_prop
            exec_function_body_prop_
-           exec_function_prop_).
+           exec_function_internal_prop
+           exec_function_external_prop).
 
 End PRESERVATION.
 
 Theorem transf_program_correct:
-  forall (p: Mach.program) (tp: PPC.program) (r: val),
+  forall (p: Mach.program) (tp: PPC.program) (t: trace) (r: val),
   wt_program p ->
   transf_program p = Some tp ->
-  Mach.exec_program p r ->
-  PPC.exec_program tp r.
+  Mach.exec_program p t r ->
+  PPC.exec_program tp t r.
 Proof.
   intros. 
   destruct H1 as [fptr [f [ms [m [FINDS [FINDF [EX RES]]]]]]].
-  assert (WTF: wt_function f).
-    apply (Genv.find_funct_ptr_prop wt_function H FINDF).
+  assert (WTF: wt_fundef f).
+    apply (Genv.find_funct_ptr_prop wt_fundef H FINDF).
   set (ge := Genv.globalenv p) in *.
   set (ms0 := Regmap.init Vundef) in *.
   set (tge := Genv.globalenv tp).
@@ -1232,7 +1268,7 @@ Proof.
   assert (WTRA: Val.has_type (rs0 LR) Tint).
     exact I.
   generalize (transf_function_correct p tp H0 H
-                 _ _ _ _ _ _ EX rs0 WTF AT AG WTRA).
+                 _ _ _ _ _ _ _ EX rs0 WTF AT AG WTRA).
   intros [rs [AG' [EX' RPC]]].
   red. exists rs; exists m.
   split. rewrite (Genv.init_mem_transf_partial _ _ H0). exact EX'.
diff --git a/backend/PPCgenproof1.v b/backend/PPCgenproof1.v
index 30eb336..4a9ac94 100644
--- a/backend/PPCgenproof1.v
+++ b/backend/PPCgenproof1.v
@@ -14,6 +14,7 @@ Require Import Mach.
 Require Import Machtyping.
 Require Import PPC.
 Require Import PPCgen.
+Require Conventions.
 
 (** * Properties of low half/high half decomposition *)
 
@@ -430,6 +431,75 @@ Proof.
 Qed.
 Hint Resolve gpr_or_zero_not_zero gpr_or_zero_zero: ppcgen.
 
+(** Connection between Mach and PPC calling conventions for external
+    functions. *)
+
+Lemma loc_external_result_match:
+  forall sg,
+  PPC.loc_external_result sg = preg_of (Conventions.loc_result sg).
+Proof.
+  intros. destruct sg as [sargs sres]. 
+  destruct sres. destruct t; reflexivity. reflexivity.
+Qed.
+
+Remark list_map_drop1:
+  forall (A B: Set) (f: A -> B) (l: list A), list_drop1 (map f l) = map f (list_drop1 l).
+Proof.
+  intros; destruct l; reflexivity.
+Qed.
+
+Remark list_map_drop2:
+  forall (A B: Set) (f: A -> B) (l: list A), list_drop2 (map f l) = map f (list_drop2 l).
+Proof.
+  intros; destruct l. reflexivity. destruct l; reflexivity.
+Qed.
+
+Lemma loc_external_arguments_rec_match:
+  forall tyl iregl fregl ofs,
+  (forall r, In r iregl -> mreg_type r = Tint) ->
+  (forall r, In r fregl -> mreg_type r = Tfloat) ->
+  PPC.loc_external_arguments_rec tyl (map ireg_of iregl) (map freg_of fregl) =
+  List.map
+    (fun l => preg_of (match l with R r => r | S _ => IT1 end))
+    (Conventions.loc_arguments_rec tyl iregl fregl ofs).
+Proof.
+  induction tyl; intros; simpl.
+  auto.
+  destruct a; simpl; apply (f_equal2 (@cons preg)). 
+  destruct iregl; simpl. 
+  reflexivity. unfold preg_of; rewrite (H m); auto with coqlib.
+  rewrite list_map_drop1. apply IHtyl. 
+  intros; apply H; apply list_drop1_incl; auto. 
+  assumption.
+  destruct fregl; simpl. 
+  reflexivity. unfold preg_of; rewrite (H0 m); auto with coqlib.
+  rewrite list_map_drop1. rewrite list_map_drop2. apply IHtyl. 
+  intros; apply H; apply list_drop2_incl; auto. 
+  intros; apply H0; apply list_drop1_incl; auto. 
+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 loc_external_arguments_match:
+  forall sg,
+  PPC.loc_external_arguments sg = List.map preg_of (Conventions.loc_external_arguments sg).
+Proof.
+  intros. destruct sg as [sgargs sgres]; unfold loc_external_arguments, Conventions.loc_external_arguments.
+  rewrite list_map_compose. unfold Conventions.loc_arguments.
+  rewrite <- loc_external_arguments_rec_match.
+  reflexivity.
+  intro; simpl; ElimOrEq; reflexivity.  
+  intro; simpl; ElimOrEq; reflexivity.  
+Qed.
+
 (** * Execution of straight-line code *)
 
 Section STRAIGHTLINE.
@@ -1198,6 +1268,22 @@ Proof.
   rewrite (sp_val ms sp rs). auto. auto. 
   (* Oundef again *)
   congruence.
+  (* Ocast8unsigned *)
+  exists (nextinstr (rs#(ireg_of res) <- (Val.rolm (ms m0) Int.zero (Int.repr 255)))).
+  split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs)); auto. reflexivity.
+  replace (Val.cast8unsigned (ms m0))
+      with (Val.rolm (ms m0) Int.zero (Int.repr 255)).
+  auto with ppcgen. 
+  unfold Val.rolm, Val.cast8unsigned. destruct (ms m0); auto. 
+  rewrite Int.rolm_zero. rewrite Int.cast8unsigned_and. auto.
+  (* Ocast16unsigned *)
+  exists (nextinstr (rs#(ireg_of res) <- (Val.rolm (ms m0) Int.zero (Int.repr 65535)))).
+  split. apply exec_straight_one. repeat (rewrite (ireg_val ms sp rs)); auto. reflexivity.
+  replace (Val.cast16unsigned (ms m0))
+      with (Val.rolm (ms m0) Int.zero (Int.repr 65535)).
+  auto with ppcgen. 
+  unfold Val.rolm, Val.cast16unsigned. destruct (ms m0); auto. 
+  rewrite Int.rolm_zero. rewrite Int.cast16unsigned_and. auto.
   (* Oaddimm *)
   generalize (addimm_correct (ireg_of res) (ireg_of m0) i k rs m
                             (ireg_of_not_GPR2 m0)).
@@ -1562,5 +1648,31 @@ Proof.
   auto. auto.
 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#GPR3 <- (Vptr blk Int.zero) #LR <- (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 GPR3) with (preg_of Conventions.loc_alloc_result).
+  apply agree_set_mreg. auto.
+  simpl. tauto.
+Qed.
+
 End STRAIGHTLINE.
 
diff --git a/backend/Parallelmove.v b/backend/Parallelmove.v
index f95416e..b2ec930 100644
--- a/backend/Parallelmove.v
+++ b/backend/Parallelmove.v
@@ -1,2529 +1,290 @@
-(** Translation of parallel moves into sequences of individual moves *)
+Require Import Coqlib.
+Require Parmov.
+Require Import Values.
+Require Import Events.
+Require Import AST.
+Require Import Locations.
+Require Import Conventions.
 
-(** The ``parallel move'' problem, also known as ``parallel assignment'',
-  is the following.  We are given a list of (source, destination) pairs
-  of locations.  The goal is to find a sequence of elementary
-  moves ([loc <- loc] assignments) such that, at the end of the sequence,
-  location [dst] contains the value of location [src] at the beginning of
-  the sequence, for each ([src], [dst]) pairs in the given problem.
-  Moreover, other locations should keep their values, except one register
-  of each type, which can be used as temporaries in the generated sequences.
+Definition temp_for (l: loc) : loc :=
+  match Loc.type l with Tint => R IT2 | Tfloat => R FT2 end.
 
-  The parallel move problem is trivial if the sources and destinations do
-  not overlap.  For instance,
-<<
-  (R1, R2) <- (R3, R4)     becomes    R1 <- R3; R2 <- R4
->>
-  However, arbitrary overlap is allowed between sources and destinations.
-  This requires some care in ordering the individual moves, as in
-<<
-  (R1, R2) <- (R3, R1)     becomes    R2 <- R1; R1 <- R3
->>
-  Worse, cycles (permutations) can require the use of temporaries, as in
-<<
-  (R1, R2, R3) <- (R2, R3, R1)   becomes   T <- R1; R1 <- R2; R2 <- R3; R3 <- T;
->>
-  An amazing fact is that for any parallel move problem, at most one temporary
-  (or in our case one integer temporary and one float temporary) is needed.
+Definition parmove (srcs dsts: list loc) :=
+  Parmov.parmove2 loc temp_for Loc.eq srcs dsts.
 
-  The development in this section was contributed by Laurence Rideau and
-  Bernard Serpette.  It is described in their paper
-  ``Coq à la conquête des moulins'', JFLA 2005, 
-  #<A HREF="http://www-sop.inria.fr/lemme/Laurence.Rideau/RideauSerpetteJFLA05.ps">#
-  http://www-sop.inria.fr/lemme/Laurence.Rideau/RideauSerpetteJFLA05.ps
-  #</A>#
-*)
+Definition moves := (list (loc * loc))%type.
 
-Require Omega.
-Require Import Wf_nat.
-Require Import Conventions.
-Require Import Coqlib.
-Require Import Bool_nat.
-Require Import TheoryList.
-Require Import Bool.
-Require Import Arith.
-Require Import Peano_dec.
-Require Import EqNat.
-Require Import Values.
-Require Import LTL.
-Require Import EqNat.
-Require Import Locations.
-Require Import AST.
- 
-Section pmov.
- 
-Ltac caseEq name := generalize (refl_equal name); pattern name at -1; case name.
-Hint Resolve beq_nat_eq .
- 
-Lemma neq_is_neq: forall (x y : nat), x <> y ->  beq_nat x y = false.
-Proof.
-unfold not; intros.
-caseEq (beq_nat x y); auto.
-intro.
-elim H; auto.
-Qed.
-Hint Resolve neq_is_neq .
- 
-Lemma app_nil: forall (A : Set) (l : list A),  l ++ nil = l.
-Proof.
-intros A l; induction l as [|a l Hrecl]; auto; simpl; rewrite Hrecl; auto.
-Qed.
- 
-Lemma app_cons:
- forall (A : Set) (l1 l2 : list A) (a : A),  (a :: l1) ++ l2 = a :: (l1 ++ l2).
-Proof.
-auto.
-Qed.
- 
-Lemma app_app:
- forall (A : Set) (l1 l2 l3 : list A),  l1 ++ (l2 ++ l3) = (l1 ++ l2) ++ l3.
-Proof.
-intros A l1; induction l1 as [|a l1 Hrecl1]; simpl; auto; intros;
- rewrite Hrecl1; auto.
-Qed.
- 
-Lemma app_rewrite:
- forall (A : Set) (l : list A) (x : A),
-  (exists y : A , exists r : list A , l ++ (x :: nil) = y :: r  ).
-Proof.
-intros A l x; induction l as [|a l Hrecl].
-exists x; exists (nil (A:=A)); auto.
-inversion Hrecl; inversion H.
-exists a; exists (l ++ (x :: nil)); auto.
-Qed.
- 
-Lemma app_rewrite2:
- forall (A : Set) (l l2 : list A) (x : A),
-  (exists y : A , exists r : list A , l ++ (x :: l2) = y :: r  ).
-Proof.
-intros A l l2 x; induction l as [|a l Hrecl].
-exists x; exists l2; auto.
-inversion Hrecl; inversion H.
-exists a; exists (l ++ (x :: l2)); auto.
-Qed.
- 
-Lemma app_rewriter:
- forall (A : Set) (l : list A) (x : A),
-  (exists y : A , exists r : list A , x :: l = r ++ (y :: nil)  ).
-Proof.
-intros A l x; induction l as [|a l Hrecl].
-exists x; exists (nil (A:=A)); auto.
-inversion Hrecl; inversion H.
-generalize H0; case x1; simpl; intros; inversion H1.
-exists a; exists (x0 :: nil); simpl; auto.
-exists x0; exists (a0 :: (a :: l0)); simpl; auto.
-Qed.
-Hint Resolve app_rewriter .
- 
-Definition Reg := loc.
- 
-Definition T :=
-   fun (r : loc) =>
-      match Loc.type r with Tint => R IT2 | Tfloat => R FT2 end.
- 
-Definition notemporary := fun (r : loc) => forall x,  Loc.diff r (T x).
- 
-Definition Move := (Reg * Reg)%type.
- 
-Definition Moves := list Move.
- 
-Definition State := ((Moves * Moves) * Moves)%type.
- 
-Definition StateToMove (r : State) : Moves :=
-   match r with ((t, b), l) => t end.
- 
-Definition StateBeing (r : State) : Moves :=
-   match r with ((t, b), l) => b end.
- 
-Definition StateDone (r : State) : Moves :=
-   match r with ((t, b), l) => l end.
- 
-Fixpoint noRead (p : Moves) (r : Reg) {struct p} : Prop :=
- match p with
-   nil => True
-  | (s, d) :: l => Loc.diff s r /\ noRead l r
- end.
- 
-Lemma noRead_app:
- forall (l1 l2 : Moves) (r : Reg),
- noRead l1 r -> noRead l2 r ->  noRead (l1 ++ l2) r.
-Proof.
-intros; induction l1 as [|a l1 Hrecl1]; simpl; auto.
-destruct a.
-elim H; intros; split; auto.
-Qed.
- 
-Inductive step : State -> State ->  Prop :=
-  step_nop:
-    forall (r : Reg) (t1 t2 l : Moves),
-     step (t1 ++ ((r, r) :: t2), nil, l) (t1 ++ t2, nil, l)
- | step_start:
-     forall (t1 t2 l : Moves) (m : Move),
-      step (t1 ++ (m :: t2), nil, l) (t1 ++ t2, m :: nil, l)
- | step_push:
-     forall (t1 t2 b l : Moves) (s d r : Reg),
-      step
-       (t1 ++ ((d, r) :: t2), (s, d) :: b, l)
-       (t1 ++ t2, (d, r) :: ((s, d) :: b), l)
- | step_loop:
-     forall (t b l : Moves) (s d r0 r0ounon : Reg),
-      step
-       (t, (s, r0ounon) :: (b ++ ((r0, d) :: nil)), l)
-       (t, (s, r0ounon) :: (b ++ ((T r0, d) :: nil)), (r0, T r0) :: l)
- | step_pop:
-     forall (t b l : Moves) (s0 d0 sn dn : Reg),
-     noRead t dn ->
-     Loc.diff dn s0 ->
-      step
-       (t, (sn, dn) :: (b ++ ((s0, d0) :: nil)), l)
-       (t, b ++ ((s0, d0) :: nil), (sn, dn) :: l)
- | step_last:
-     forall (t l : Moves) (s d : Reg),
-     noRead t d ->  step (t, (s, d) :: nil, l) (t, nil, (s, d) :: l) .
-Hint Resolve step_nop step_start step_push step_loop step_pop step_last .
- 
-Fixpoint path (l : Moves) : Prop :=
- match l with
-   nil => True
-  | (s, d) :: l =>
-      match l with
-        nil => True
-       | (ss, dd) :: l2 => s = dd /\ path l
-      end
- end.
- 
-Lemma path_pop: forall (m : Move) (l : Moves), path (m :: l) ->  path l.
-Proof.
-simpl; intros m l; destruct m as [ms md]; case l; auto.
-intros m0; destruct m0; intros; inversion H; auto.
-Qed.
- 
-Fixpoint noWrite (p : Moves) (r : Reg) {struct p} : Prop :=
- match p with
-   nil => True
-  | (s, d) :: l => Loc.diff d r /\ noWrite l r
- end.
- 
-Lemma noWrite_pop:
- forall (p1 p2 : Moves) (m : Move) (r : Reg),
- noWrite (p1 ++ (m :: p2)) r ->  noWrite (p1 ++ p2) r.
-Proof.
-intros; induction p1 as [|a p1 Hrecp1].
-generalize H; simpl; case m; intros; inversion H0; auto.
-generalize H; rewrite app_cons; rewrite app_cons.
-simpl; case a; intros.
-inversion H0; split; auto.
-Qed.
- 
-Lemma noWrite_in:
- forall (p1 p2 : Moves) (r0 r1 r2 : Reg),
- noWrite (p1 ++ ((r1, r2) :: p2)) r0 ->  Loc.diff r0 r2.
-Proof.
-intros; induction p1 as [|a p1 Hrecp1]; simpl; auto.
-generalize H; simpl; intros; inversion H0; auto.
-apply Loc.diff_sym; auto.
-generalize H; rewrite app_cons; simpl; case a; intros.
-apply Hrecp1; inversion H0; auto.
-Qed.
- 
-Lemma noWrite_swap:
- forall (p : Moves) (m1 m2 : Move) (r : Reg),
- noWrite (m1 :: (m2 :: p)) r ->  noWrite (m2 :: (m1 :: p)) r.
-Proof.
-intros p m1 m2 r; simpl; case m1; case m2.
-intros; inversion H; inversion H1; split; auto.
-Qed.
- 
-Lemma noWrite_movFront:
- forall (p1 p2 : Moves) (m : Move) (r0 : Reg),
- noWrite (p1 ++ (m :: p2)) r0 ->  noWrite (m :: (p1 ++ p2)) r0.
-Proof.
-intros p1 p2 m r0; induction p1 as [|a p1 Hrecp1]; auto.
-case a; intros r1 r2; rewrite app_cons; rewrite app_cons.
-intros; apply noWrite_swap; rewrite <- app_cons.
-simpl in H |-; inversion H; unfold noWrite; fold noWrite; auto.
-Qed.
- 
-Lemma noWrite_insert:
- forall (p1 p2 : Moves) (m : Move) (r0 : Reg),
- noWrite (m :: (p1 ++ p2)) r0 ->  noWrite (p1 ++ (m :: p2)) r0.
-Proof.
-intros p1 p2 m r0; induction p1 as [|a p1 Hrecp1].
-simpl; auto.
-destruct a; simpl.
-destruct m.
-intros [H1 [H2 H3]]; split; auto.
-apply Hrecp1.
-simpl; auto.
-Qed.
- 
-Lemma noWrite_tmpLast:
- forall (t : Moves) (r s d : Reg),
- noWrite (t ++ ((s, d) :: nil)) r ->
- forall (x : Reg),  noWrite (t ++ ((x, d) :: nil)) r.
-Proof.
-intros; induction t as [|a t Hrect].
-simpl; auto.
-generalize H; simpl; case a; intros; inversion H0; split; auto.
-Qed.
- 
-Fixpoint simpleDest (p : Moves) : Prop :=
- match p with
-   nil => True
-  | (s, d) :: l => noWrite l d /\ simpleDest l
- end.
- 
-Lemma simpleDest_Pop:
- forall (m : Move) (l1 l2 : Moves),
- simpleDest (l1 ++ (m :: l2)) ->  simpleDest (l1 ++ l2).
-Proof.
-intros; induction l1 as [|a l1 Hrecl1].
-generalize H; simpl; case m; intros; inversion H0; auto.
-generalize H; rewrite app_cons; rewrite app_cons.
-simpl; case a; intros; inversion H0; split; auto.
-apply (noWrite_pop l1 l2 m); auto.
-Qed.
- 
-Lemma simpleDest_pop:
- forall (m : Move) (l : Moves), simpleDest (m :: l) ->  simpleDest l.
-Proof.
-intros m l; simpl; case m; intros _ r [X Y]; auto.
-Qed.
- 
-Lemma simpleDest_right:
- forall (l1 l2 : Moves), simpleDest (l1 ++ l2) ->  simpleDest l2.
-Proof.
-intros l1; induction l1 as [|a l1 Hrecl1]; auto.
-intros l2; rewrite app_cons; intros; apply Hrecl1.
-apply (simpleDest_pop a); auto.
-Qed.
- 
-Lemma simpleDest_swap:
- forall (m1 m2 : Move) (l : Moves),
- simpleDest (m1 :: (m2 :: l)) ->  simpleDest (m2 :: (m1 :: l)).
-Proof.
-intros m1 m2 l; simpl; case m1; case m2.
-intros _ r0 _ r2 [[X Y] [Z U]]; auto.
-(repeat split); auto.
-apply Loc.diff_sym; auto.
-Qed.
- 
-Lemma simpleDest_pop2:
- forall (m1 m2 : Move) (l : Moves),
- simpleDest (m1 :: (m2 :: l)) ->  simpleDest (m1 :: l).
-Proof.
-intros; apply (simpleDest_pop m2); apply simpleDest_swap; auto.
-Qed.
- 
-Lemma simpleDest_movFront:
- forall (p1 p2 : Moves) (m : Move),
- simpleDest (p1 ++ (m :: p2)) ->  simpleDest (m :: (p1 ++ p2)).
-Proof.
-intros p1 p2 m; induction p1 as [|a p1 Hrecp1].
-simpl; auto.
-rewrite app_cons; rewrite app_cons.
-case a; intros; simpl in H |-; inversion H.
-apply simpleDest_swap; simpl; auto.
-destruct m.
-cut (noWrite ((r1, r2) :: (p1 ++ p2)) r0).
-cut (simpleDest ((r1, r2) :: (p1 ++ p2))).
-intro; (repeat split); elim H3; elim H2; intros; auto.
-apply Hrecp1; auto.
-apply noWrite_movFront; auto.
-Qed.
- 
-Lemma simpleDest_insert:
- forall (p1 p2 : Moves) (m : Move),
- simpleDest (m :: (p1 ++ p2)) ->  simpleDest (p1 ++ (m :: p2)).
-Proof.
-intros p1 p2 m; induction p1 as [|a p1 Hrecp1].
-simpl; auto.
-rewrite app_cons; intros.
-simpl.
-destruct a as [a1 a2].
-split.
-destruct m; simpl in H |-.
-apply noWrite_insert.
-simpl; split; elim H; intros [H1 H2] [H3 H4]; auto.
-apply Loc.diff_sym; auto.
-apply Hrecp1.
-apply simpleDest_pop2 with (a1, a2); auto.
-Qed.
- 
-Lemma simpleDest_movBack:
- forall (p1 p2 : Moves) (m : Move),
- simpleDest (p1 ++ (m :: p2)) ->  simpleDest ((p1 ++ p2) ++ (m :: nil)).
-Proof.
-intros.
-apply (simpleDest_insert (p1 ++ p2) nil m).
-rewrite app_nil; apply simpleDest_movFront; auto.
-Qed.
- 
-Lemma simpleDest_swap_app:
- forall (t1 t2 t3 : Moves) (m : Move),
- simpleDest (t1 ++ (m :: (t2 ++ t3))) ->  simpleDest ((t1 ++ t2) ++ (m :: t3)).
-Proof.
-intros.
-apply (simpleDest_insert (t1 ++ t2) t3 m).
-rewrite <- app_app.
-apply simpleDest_movFront; auto.
-Qed.
- 
-Lemma simpleDest_tmpLast:
- forall (t : Moves) (s d : Reg),
- simpleDest (t ++ ((s, d) :: nil)) ->
- forall (r : Reg),  simpleDest (t ++ ((r, d) :: nil)).
-Proof.
-intros t s d; induction t as [|a t Hrect].
-simpl; auto.
-simpl; case a; intros; inversion H; split; auto.
-apply (noWrite_tmpLast t r0 s); auto.
-Qed.
- 
-Fixpoint noTmp (b : Moves) : Prop :=
- match b with
-   nil => True
-  | (s, d) :: l =>
-      (forall r,  Loc.diff s (T r)) /\
-      ((forall r,  Loc.diff d (T r)) /\ noTmp l)
- end.
- 
-Fixpoint noTmpLast (b : Moves) : Prop :=
- match b with
-   nil => True
-  | (s, d) :: nil => forall r,  Loc.diff d (T r)
-  | (s, d) :: l =>
-      (forall r,  Loc.diff s (T r)) /\
-      ((forall r,  Loc.diff d (T r)) /\ noTmpLast l)
- end.
- 
-Lemma noTmp_app:
- forall (l1 l2 : Moves) (m : Move),
- noTmp l1 -> noTmpLast (m :: l2) ->  noTmpLast (l1 ++ (m :: l2)).
-Proof.
-intros.
-induction l1 as [|a l1 Hrecl1].
-simpl; auto.
-simpl.
-caseEq (l1 ++ (m :: l2)); intro.
-destruct a.
-elim H; intros; auto.
-inversion H; auto.
-elim H3; auto.
-intros; destruct a as [a1 a2].
-elim H; intros H2 [H3 H4]; auto.
-(repeat split); auto.
-rewrite H1 in Hrecl1; apply Hrecl1; auto.
-Qed.
- 
-Lemma noTmpLast_popBack:
- forall (t : Moves) (m : Move), noTmpLast (t ++ (m :: nil)) ->  noTmp t.
-Proof.
-intros.
-induction t as [|a t Hrect].
-simpl; auto.
-destruct a as [a1 a2].
-rewrite app_cons in H.
-simpl.
-simpl in H |-.
-generalize H; caseEq (t ++ (m :: nil)); intros.
-destruct t; inversion H0.
-elim H1.
-intros H2 [H3 H4]; (repeat split); auto.
-rewrite <- H0 in H4.
-apply Hrect; auto.
-Qed.
- 
-Fixpoint getsrc (p : Moves) : list Reg :=
- match p with
-   nil => nil
-  | (s, d) :: l => s :: getsrc l
- end.
- 
-Fixpoint getdst (p : Moves) : list Reg :=
- match p with
-   nil => nil
-  | (s, d) :: l => d :: getdst l
- end.
- 
-Fixpoint noOverlap_aux (r : Reg) (l : list Reg) {struct l} : Prop :=
- match l with
-   nil => True
-  | b :: m => (b = r \/ Loc.diff b r) /\ noOverlap_aux r m
- end.
- 
-Definition noOverlap (p : Moves) : Prop :=
-   forall l, In l (getsrc p) ->  noOverlap_aux l (getdst p).
- 
-Definition stepInv (r : State) : Prop :=
-   path (StateBeing r) /\
-   (simpleDest (StateToMove r ++ StateBeing r) /\
-    (noOverlap (StateToMove r ++ StateBeing r) /\
-     (noTmp (StateToMove r) /\ noTmpLast (StateBeing r)))).
- 
-Definition Value := val.
- 
-Definition Env := locset.
- 
-Definition get (e : Env) (r : Reg) := Locmap.get r e.
- 
-Definition update (e : Env) (r : Reg) (v : Value) : Env := Locmap.set r v e.
- 
-Fixpoint sexec (p : Moves) (e : Env) {struct p} : Env :=
- match p with
-   nil => e
-  | (s, d) :: l => let e' := sexec l e in
-                     update e' d (get e' s)
- end.
- 
-Fixpoint pexec (p : Moves) (e : Env) {struct p} : Env :=
- match p with
-   nil => e
-  | (s, d) :: l => update (pexec l e) d (get e s)
- end.
- 
-Lemma get_update:
- forall (e : Env) (r1 r2 : Reg) (v : Value),
-  get (update e r1 v) r2 =
-  (if Loc.eq r1 r2 then v else if Loc.overlap r1 r2 then Vundef else get e r2).
-Proof.
-intros.
-unfold update, get, Locmap.get, Locmap.set; trivial.
-Qed.
- 
-Lemma get_update_id:
- forall (e : Env) (r1 : Reg) (v : Value),  get (update e r1 v) r1 = v.
-Proof.
-intros e r1 v; rewrite (get_update e r1 r1); auto.
-case (Loc.eq r1 r1); auto.
-intros H; elim H; trivial.
-Qed.
- 
-Lemma get_update_diff:
- forall (e : Env) (r1 r2 : Reg) (v : Value),
- Loc.diff r1 r2 ->  get (update e r1 v) r2 = get e r2.
-Proof.
-intros; unfold update, get, Locmap.get, Locmap.set.
-case (Loc.eq r1 r2); intro.
-absurd (r1 = r2); [apply Loc.diff_not_eq; trivial | trivial].
-caseEq (Loc.overlap r1 r2); intro; trivial.
-absurd (Loc.diff r1 r2); [apply Loc.overlap_not_diff; assumption | assumption].
-Qed.
- 
-Lemma get_update_ndiff:
- forall (e : Env) (r1 r2 : Reg) (v : Value),
- r1 <> r2 -> not (Loc.diff r1 r2) ->  get (update e r1 v) r2 = Vundef.
-Proof.
-intros; unfold update, get, Locmap.get, Locmap.set.
-case (Loc.eq r1 r2); intro.
-absurd (r1 = r2); assumption.
-caseEq (Loc.overlap r1 r2); intro; trivial.
-absurd (Loc.diff r1 r2); (try assumption).
-apply Loc.non_overlap_diff; assumption.
-Qed.
- 
-Lemma pexec_swap:
- forall (m1 m2 : Move) (t : Moves),
- simpleDest (m1 :: (m2 :: t)) ->
- forall (e : Env) (r : Reg),
-  get (pexec (m1 :: (m2 :: t)) e) r = get (pexec (m2 :: (m1 :: t)) e) r.
-Proof.
-intros; destruct m1 as [m1s m1d]; destruct m2 as [m2s m2d].
-generalize H; simpl; intros [[NEQ NW] [NW2 HSD]]; clear H.
-case (Loc.eq m1d r); case (Loc.eq m2d r); intros.
-absurd (m1d = m2d);
- [apply Loc.diff_not_eq; apply Loc.diff_sym; assumption |
-  rewrite e0; rewrite e1; trivial].
-caseEq (Loc.overlap m2d r); intro.
-absurd (Loc.diff m2d m1d); [apply Loc.overlap_not_diff; rewrite e0 | idtac];
- (try assumption).
-subst m1d; rewrite get_update_id; rewrite get_update_diff;
- (try rewrite get_update_id); auto.
-caseEq (Loc.overlap m1d r); intro.
-absurd (Loc.diff m1d m2d);
- [apply Loc.overlap_not_diff; rewrite e0 | apply Loc.diff_sym]; assumption.
-subst m2d; (repeat rewrite get_update_id); rewrite get_update_diff;
- [rewrite get_update_id; trivial | apply Loc.diff_sym; trivial].
-caseEq (Loc.overlap m1d r); caseEq (Loc.overlap m2d r); intros.
-(repeat rewrite get_update_ndiff);
- (try (apply Loc.overlap_not_diff; assumption)); trivial.
-assert (~ Loc.diff m1d r);
- [apply Loc.overlap_not_diff; assumption |
-  intros; rewrite get_update_ndiff; auto].
-rewrite get_update_diff;
- [rewrite get_update_ndiff; auto | apply Loc.non_overlap_diff; auto].
-cut (~ Loc.diff m2d r); [idtac | apply Loc.overlap_not_diff; auto].
-cut (Loc.diff m1d r); [idtac | apply Loc.non_overlap_diff; auto].
-intros; rewrite get_update_diff; auto.
-(repeat rewrite get_update_ndiff); auto.
-cut (Loc.diff m1d r); [idtac | apply Loc.non_overlap_diff; auto].
-cut (Loc.diff m2d r); [idtac | apply Loc.non_overlap_diff; auto].
-intros; (repeat rewrite get_update_diff); auto.
-Qed.
- 
-Lemma pexec_add:
- forall (t1 t2 : Moves) (r : Reg) (e : Env),
- get (pexec t1 e) r = get (pexec t2 e) r ->
- forall (a : Move),  get (pexec (a :: t1) e) r = get (pexec (a :: t2) e) r.
-Proof.
-intros.
-case a.
-simpl.
-intros a1 a2.
-unfold get, update, Locmap.set, Locmap.get.
-case (Loc.eq a2 r); case (Loc.overlap a2 r); auto.
-Qed.
- 
-Lemma pexec_movBack:
- forall (t1 t2 : Moves) (m : Move),
- simpleDest (m :: (t1 ++ t2)) ->
- forall (e : Env) (r : Reg),
-  get (pexec (m :: (t1 ++ t2)) e) r = get (pexec (t1 ++ (m :: t2)) e) r.
-Proof.
-intros t1 t2 m; induction t1 as [|a t1 Hrect1].
-simpl; auto.
-rewrite app_cons.
-intros; rewrite pexec_swap; auto; rewrite app_cons; auto.
-apply pexec_add.
-apply Hrect1.
-apply (simpleDest_pop2 m a); auto.
-Qed.
- 
-Lemma pexec_movFront:
- forall (t1 t2 : Moves) (m : Move),
- simpleDest (t1 ++ (m :: t2)) ->
- forall (e : Env) (r : Reg),
-  get (pexec (t1 ++ (m :: t2)) e) r = get (pexec (m :: (t1 ++ t2)) e) r.
-Proof.
-intros; rewrite <- pexec_movBack; eauto.
-apply simpleDest_movFront; auto.
-Qed.
- 
-Lemma pexec_mov:
- forall (t1 t2 t3 : Moves) (m : Move),
- simpleDest ((t1 ++ (m :: t2)) ++ t3) ->
- forall (e : Env) (r : Reg),
-  get (pexec ((t1 ++ (m :: t2)) ++ t3) e) r =
-  get (pexec ((t1 ++ t2) ++ (m :: t3)) e) r.
-Proof.
-intros t1 t2 t3 m.
-rewrite <- app_app.
-rewrite app_cons.
-intros.
-rewrite pexec_movFront; auto.
-cut (simpleDest (m :: (t1 ++ (t2 ++ t3)))).
-rewrite app_app.
-rewrite <- pexec_movFront; auto.
-apply simpleDest_swap_app; auto.
-apply simpleDest_movFront; auto.
-Qed.
- 
-Definition diff_dec:
- forall (x y : Reg),  ({ Loc.diff x y }) + ({ not (Loc.diff x y) }).
-intros.
-case (Loc.eq x y).
-intros heq; right.
-red; intro; absurd (x = y); auto.
-apply Loc.diff_not_eq; auto.
-intro; caseEq (Loc.overlap x y).
-intro; right.
-apply Loc.overlap_not_diff; auto.
-intro; left; apply Loc.non_overlap_diff; auto.
-Defined.
- 
-Lemma get_pexec_id_noWrite:
- forall (t : Moves) (d : Reg),
- noWrite t d ->
- forall (e : Env) (v : Value),  v = get (pexec t (update e d v)) d.
-Proof.
-intros.
-induction t as [|a t Hrect].
-simpl.
-rewrite get_update_id; auto.
-generalize H; destruct a as [a1 a2]; simpl; intros [NEQ R].
-rewrite get_update_diff; auto.
-Qed.
- 
-Lemma pexec_nop:
- forall (t : Moves) (r : Reg) (e : Env) (x : Reg),
- Loc.diff r x ->  get (pexec ((r, r) :: t) e) x = get (pexec t e) x.
-Proof.
-intros.
-simpl.
-rewrite get_update_diff; auto.
-Qed.
- 
-Lemma sD_nW: forall t r s, simpleDest ((s, r) :: t) ->  noWrite t r.
-Proof.
-induction t.
-simpl; auto.
-simpl.
-destruct a.
-intros r1 r2 H; split; [try assumption | idtac].
-elim H;
- [intros H0 H1; elim H0; [intros H2 H3; (try clear H0 H); (try exact H2)]].
-elim H;
- [intros H0 H1; elim H0; [intros H2 H3; (try clear H0 H); (try exact H3)]].
-Qed.
- 
-Lemma sD_pexec:
- forall (t : Moves) (s d : Reg),
- simpleDest ((s, d) :: t) -> forall (e : Env),  get (pexec t e) d = get e d.
-Proof.
-intros.
-induction t as [|a t Hrect]; simpl; auto.
-destruct a as [a1 a2].
-simpl in H |-; elim H; intros [H0 H1] [H2 H3]; clear H.
-case (Loc.eq a2 d); intro.
-absurd (a2 = d); [apply Loc.diff_not_eq | trivial]; assumption.
-rewrite get_update_diff; (try assumption).
-apply Hrect.
-simpl; (split; assumption).
-Qed.
- 
-Lemma noOverlap_nil: noOverlap nil.
-Proof.
-unfold noOverlap, noOverlap_aux, getsrc, getdst; trivial.
-Qed.
- 
-Lemma getsrc_add:
- forall (m : Move) (l1 l2 : Moves) (l : Reg),
- In l (getsrc (l1 ++ l2)) ->  In l (getsrc (l1 ++ (m :: l2))).
-Proof.
-intros m l1 l2 l; destruct m; induction l1; simpl; auto.
-destruct a; simpl; intros.
-elim H; intros H0; [left | right]; auto.
-Qed.
- 
-Lemma getdst_add:
- forall (r1 r2 : Reg) (l1 l2 : Moves),
-  getdst (l1 ++ ((r1, r2) :: l2)) = getdst l1 ++ (r2 :: getdst l2).
-Proof.
-intros r1 r2 l1 l2; induction l1; simpl; auto.
-destruct a; simpl; rewrite IHl1; auto.
-Qed.
- 
-Lemma getdst_app:
- forall (l1 l2 : Moves),  getdst (l1 ++ l2) = getdst l1 ++ getdst l2.
-Proof.
-intros; induction l1; simpl; auto.
-destruct a; simpl; rewrite IHl1; auto.
-Qed.
- 
-Lemma noOverlap_auxpop:
- forall (x r : Reg) (l : list Reg),
- noOverlap_aux x (r :: l) ->  noOverlap_aux x l.
-Proof.
-induction l; simpl; auto.
-intros [H1 [H2 H3]]; split; auto.
-Qed.
- 
-Lemma noOverlap_auxPop:
- forall (x r : Reg) (l1 l2 : list Reg),
- noOverlap_aux x (l1 ++ (r :: l2)) ->  noOverlap_aux x (l1 ++ l2).
-Proof.
-intros x r l1 l2; (try assumption).
-induction l1 as [|a l1 Hrecl1]; simpl app.
-intro; apply (noOverlap_auxpop x r); auto.
-(repeat rewrite app_cons); simpl.
-intros [H1 H2]; split; auto.
-Qed.
- 
-Lemma noOverlap_pop:
- forall (m : Move) (l : Moves), noOverlap (m :: l) ->  noOverlap l.
-Proof.
-induction l.
-intro; apply noOverlap_nil.
-unfold noOverlap; simpl; destruct m; destruct a; simpl; intros.
-elim (H l0); intros; (try assumption).
-elim H0; intros H1; right; [left | right]; assumption.
-Qed.
- 
-Lemma noOverlap_Pop:
- forall (m : Move) (l1 l2 : Moves),
- noOverlap (l1 ++ (m :: l2)) ->  noOverlap (l1 ++ l2).
-Proof.
-intros m l1 l2; induction l1 as [|a l1 Hrecl1]; simpl.
-simpl; apply noOverlap_pop.
-(repeat rewrite app_cons); unfold noOverlap; destruct a; simpl.
-intros H l H0; split.
-elim (H l); [intros H1 H2 | idtac]; auto.
-elim H0; [intros H3; left | intros H3; right; apply getsrc_add]; auto.
-unfold noOverlap in Hrecl1 |-.
-elim H0; intros H1; clear H0.
-destruct m; rewrite getdst_app; apply noOverlap_auxPop with ( r := r2 ).
-rewrite getdst_add in H.
-elim H with ( l := l ); [intros H0 H2; (try clear H); (try exact H2) | idtac].
-left; (try assumption).
-apply Hrecl1 with ( l := l ); auto.
-intros l0 H0; (try assumption).
-elim H with ( l := l0 ); [intros H2 H3; (try clear H); (try exact H3) | idtac];
- auto.
-Qed.
- 
-Lemma noOverlap_right:
- forall (l1 l2 : Moves), noOverlap (l1 ++ l2) ->  noOverlap l2.
-Proof.
-intros l1; induction l1 as [|a l1 Hrecl1]; auto.
-intros l2; rewrite app_cons; intros; apply Hrecl1.
-apply (noOverlap_pop a); auto.
-Qed.
- 
-Lemma pexec_update:
- forall t e d r v,
- Loc.diff d r ->
- noRead t d ->  get (pexec t (update e d v)) r = get (pexec t e) r.
-Proof.
-induction t; simpl.
-intros; rewrite get_update_diff; auto.
-destruct a as [a1 a2]; intros; case (Loc.eq a2 r); intro.
-subst a2; (repeat rewrite get_update_id).
-rewrite get_update_diff; auto; apply Loc.diff_sym; elim H0; auto.
-case (diff_dec a2 r); intro.
-(repeat rewrite get_update_diff); auto.
-apply IHt; auto.
-elim H0; auto.
-(repeat rewrite get_update_ndiff); auto.
-Qed.
- 
-Lemma pexec_push:
- forall (t l : Moves) (s d : Reg),
- noRead t d ->
- simpleDest ((s, d) :: t) ->
- forall (e : Env) (r : Reg),
- r = d \/ Loc.diff d r ->
-  get (pexec ((s, d) :: t) (sexec l e)) r =
-  get (pexec t (sexec ((s, d) :: l) e)) r.
-Proof.
-intros; simpl.
-elim H1; intros e1.
-rewrite e1; rewrite get_update_id; auto.
-rewrite (sD_pexec t s d); auto; rewrite get_update_id; auto.
-rewrite pexec_update; auto.
-rewrite get_update_diff; auto.
-Qed.
- 
-Definition exec (s : State) (e : Env) :=
-   pexec (StateToMove s ++ StateBeing s) (sexec (StateDone s) e).
- 
-Definition sameEnv (e1 e2 : Env) :=
-   forall (r : Reg), notemporary r ->  get e1 r = get e2 r.
- 
-Definition NoOverlap (r : Reg) (s : State) :=
-   noOverlap ((r, r) :: (StateToMove s ++ StateBeing s)).
- 
-Lemma noOverlapaux_swap2:
- forall (l1 l2 : list Reg) (m l : Reg),
- noOverlap_aux l (l1 ++ (m :: l2)) ->  noOverlap_aux l (m :: (l1 ++ l2)).
-Proof.
-intros l1 l2 m l; induction l1; simpl noOverlap_aux; auto.
-intros; elim H; intros H0 H1; (repeat split); auto.
-simpl in IHl1 |-.
-elim IHl1; [intros H2 H3; (try exact H2) | idtac]; auto.
-apply (noOverlap_auxpop l m).
-apply IHl1; auto.
-Qed.
- 
-Lemma noTmp_noReadTmp: forall t, noTmp t -> forall s,  noRead t (T s).
-Proof.
-induction t; simpl; auto.
-destruct a as [a1 a2]; intros.
-split; [idtac | apply IHt]; elim H; intros H1 [H2 H3]; auto.
-Qed.
- 
-Lemma noRead_by_path:
- forall (b t : Moves) (r0 r1 r7 r8 : Reg),
- simpleDest ((r7, r8) :: (b ++ ((r0, r1) :: nil))) ->
- path (b ++ ((r0, r1) :: nil)) -> Loc.diff r8 r0 ->  noRead b r8.
-Proof.
-intros; induction b as [|a b Hrecb]; simpl; auto.
-destruct a as [a1 a2]; generalize H H0; rewrite app_cons; intros; split.
-simpl in H3 |-; caseEq (b ++ ((r0, r1) :: nil)); intro.
-destruct b; inversion H4.
-intros l H4.
-rewrite H4 in H3.
-destruct m.
-rewrite H4 in H2; simpl in H2 |-.
-elim H3; [intros H5 H6; (try clear H3); (try exact H5)].
-rewrite H5.
-elim H2; intros [H3 [H7 H8]] [H9 [H10 H11]]; (try assumption).
-apply Hrecb.
-apply (simpleDest_pop (a1, a2)); apply simpleDest_swap; auto.
-apply (path_pop (a1, a2)); auto.
-Qed.
- 
-Lemma noOverlap_swap:
- forall (m1 m2 : Move) (l : Moves),
- noOverlap (m1 :: (m2 :: l)) ->  noOverlap (m2 :: (m1 :: l)).
-Proof.
-intros m1 m2 l; simpl; destruct m1 as [m1s m1d]; destruct m2 as [m2s m2d].
-unfold noOverlap; simpl; intros.
-assert (m1s = l0 \/ (m2s = l0 \/ In l0 (getsrc l))).
-elim H0; [intros H1 | intros [H1|H2]].
-right; left; (try assumption).
-left; (try assumption).
-right; right; (try assumption).
-(repeat split);
- (elim (H l0); [intros H2 H3; elim H3; [intros H4 H5] | idtac]; auto).
-Qed.
- 
-Lemma getsrc_add1:
- forall (r1 r2 : Reg) (l1 l2 : Moves),
-  getsrc (l1 ++ ((r1, r2) :: l2)) = getsrc l1 ++ (r1 :: getsrc l2).
-Proof.
-intros r1 r2 l1 l2; induction l1; simpl; auto.
-destruct a; simpl; rewrite IHl1; auto.
-Qed.
- 
-Lemma getsrc_app:
- forall (l1 l2 : Moves),  getsrc (l1 ++ l2) = getsrc l1 ++ getsrc l2.
-Proof.
-intros; induction l1; simpl; auto.
-destruct a; simpl; rewrite IHl1; auto.
-Qed.
- 
-Lemma Ingetsrc_swap:
- forall (m : Move) (l1 l2 : Moves) (l : Reg),
- In l (getsrc (m :: (l1 ++ l2))) ->  In l (getsrc (l1 ++ (m :: l2))).
-Proof.
-intros; destruct m as [m1 m2]; simpl; auto.
-simpl in H |-.
-elim H; intros H0; auto.
-rewrite H0; rewrite getsrc_add1; auto.
-apply (in_or_app (getsrc l1) (l :: getsrc l2)); auto.
-right; apply in_eq; auto.
-apply getsrc_add; auto.
-Qed.
- 
-Lemma noOverlap_movFront:
- forall (p1 p2 : Moves) (m : Move),
- noOverlap (p1 ++ (m :: p2)) ->  noOverlap (m :: (p1 ++ p2)).
-Proof.
-intros p1 p2 m; unfold noOverlap.
-destruct m; rewrite getdst_add; simpl getdst; rewrite getdst_app; intros.
-apply noOverlapaux_swap2.
-apply (H l); apply Ingetsrc_swap; auto.
-Qed.
- 
-Lemma step_inv_loop_aux:
- forall (t l : Moves) (s d : Reg),
- simpleDest (t ++ ((s, d) :: nil)) ->
- noTmp t ->
- forall (e : Env) (r : Reg),
- notemporary r ->
- d = r \/ Loc.diff d r ->
-  get (pexec (t ++ ((s, d) :: nil)) (sexec l e)) r =
-  get (pexec (t ++ ((T s, d) :: nil)) (sexec ((s, T s) :: l) e)) r.
-Proof.
-intros; (repeat rewrite pexec_movFront); auto.
-(repeat rewrite app_nil); simpl; elim H2; intros e1.
-subst d; (repeat rewrite get_update_id); auto.
-(repeat rewrite get_update_diff); auto.
-rewrite pexec_update; auto.
-apply Loc.diff_sym; unfold notemporary in H1 |-; auto.
-apply noTmp_noReadTmp; auto.
-apply (simpleDest_tmpLast t s); auto.
-Qed.
- 
-Lemma step_inv_loop:
- forall (t l : Moves) (s d : Reg),
- simpleDest (t ++ ((s, d) :: nil)) ->
- noTmpLast (t ++ ((s, d) :: nil)) ->
- forall (e : Env) (r : Reg),
- notemporary r ->
- d = r \/ Loc.diff d r ->
-  get (pexec (t ++ ((s, d) :: nil)) (sexec l e)) r =
-  get (pexec (t ++ ((T s, d) :: nil)) (sexec ((s, T s) :: l) e)) r.
-Proof.
-intros; apply step_inv_loop_aux; auto.
-apply (noTmpLast_popBack t (s, d)); auto.
-Qed.
- 
-Definition sameExec (s1 s2 : State) :=
-   forall (e : Env) (r : Reg),
-    (let A :=
-      getdst
-       ((StateToMove s1 ++ StateBeing s1) ++ (StateToMove s2 ++ StateBeing s2))
-      in
-       notemporary r ->
-       (forall x, In x A ->  r = x \/ Loc.diff r x) ->
-        get (exec s1 e) r = get (exec s2 e) r).
- 
-Lemma get_noWrite:
- forall (t : Moves) (d : Reg),
- noWrite t d -> forall (e : Env),  get e d = get (pexec t e) d.
-Proof.
-intros; induction t as [|a t Hrect]; simpl; auto.
-generalize H; destruct a as [a1 a2]; simpl; intros [NEQ R].
-unfold get, Locmap.get, update, Locmap.set.
-case (Loc.eq a2 d); intro; auto.
-absurd (a2 = d); auto; apply Loc.diff_not_eq; (try assumption).
-caseEq (Loc.overlap a2 d); intro.
-absurd (Loc.diff a2 d); auto; apply Loc.overlap_not_diff; auto.
-unfold get, Locmap.get in Hrect |-; apply Hrect; auto.
-Qed.
- 
-Lemma step_sameExec:
- forall (r1 r2 : State), step r1 r2 -> stepInv r1 ->  sameExec r1 r2.
-Proof.
-intros r1 r2 STEP; inversion STEP;
- unfold stepInv, sameExec, NoOverlap, exec, StateToMove, StateBeing, StateDone;
- (repeat rewrite app_nil); intros [P [SD [NO [TT TB]]]]; intros.
-rewrite pexec_movFront; simpl; auto.
-case (Loc.eq r r0); intros e0.
-subst r0; rewrite get_update_id; apply get_noWrite; apply sD_nW with r;
- apply simpleDest_movFront; auto.
-elim H2 with ( x := r );
- [intros H3; absurd (r = r0); auto |
-  intros H3; rewrite get_update_diff; auto; apply Loc.diff_sym; auto | idtac].
-(repeat (rewrite getdst_app; simpl)); apply in_or_app; left; apply in_or_app;
- right; simpl; auto.
-(repeat rewrite pexec_movFront); auto.
-rewrite app_nil; auto.
-apply simpleDest_movBack; auto.
-apply pexec_mov; auto.
-repeat (rewrite <- app_cons; rewrite app_app).
-apply step_inv_loop; auto.
-repeat (rewrite <- app_app; rewrite app_cons; auto).
-repeat (rewrite <- app_app; rewrite app_cons; auto).
-apply noTmp_app; auto.
-elim H2 with ( x := d );
- [intros H3; left; auto | intros H3; right; apply Loc.diff_sym; auto
-  | try clear H2].
-repeat (rewrite getdst_app; simpl).
-apply in_or_app; left; apply in_or_app; right; simpl; right; apply in_or_app;
- right; simpl; left; trivial.
-rewrite pexec_movFront; auto; apply pexec_push; auto.
-apply noRead_app; auto.
-apply noRead_app.
-apply (noRead_by_path b b s0 d0 sn dn); auto.
-apply (simpleDest_right t); auto.
-apply (path_pop (sn, dn)); auto.
-simpl; split; [apply Loc.diff_sym | idtac]; auto.
-apply simpleDest_movFront; auto.
-elim H4 with ( x := dn ); [intros H5 | intros H5 | try clear H4].
-left; (try assumption).
-right; apply Loc.diff_sym; (try assumption).
-repeat (rewrite getdst_app; simpl).
-apply in_or_app; left; apply in_or_app; right; simpl; left; trivial.
-rewrite pexec_movFront; auto.
-rewrite app_nil; auto.
-apply pexec_push; auto.
-rewrite <- (app_nil _ t).
-apply simpleDest_movFront; auto.
-elim (H3 d); (try intros H4).
-left; (try assumption).
-right; apply Loc.diff_sym; (try assumption).
-(repeat rewrite getdst_app); simpl; apply in_or_app; left; apply in_or_app;
- right; simpl; left; trivial.
-Qed.
- 
-Lemma path_tmpLast:
- forall (s d : Reg) (l : Moves),
- path (l ++ ((s, d) :: nil)) ->  path (l ++ ((T s, d) :: nil)).
-Proof.
-intros; induction l as [|a l Hrecl].
-simpl; auto.
-generalize H; (repeat rewrite app_cons).
-case a; generalize Hrecl; case l; intros; auto.
-destruct m; intros.
-inversion H0; split; auto.
-Qed.
- 
-Lemma step_inv_path:
- forall (r1 r2 : State), step r1 r2 -> stepInv r1 ->  path (StateBeing r2).
-Proof.
-intros r1 r2 STEP; inversion_clear STEP; unfold stepInv;
- unfold stepInv, sameExec, sameEnv, exec, StateToMove, StateBeing, StateDone;
- intros [P [SD [TT TB]]]; (try (simpl; auto; fail)).
-simpl; case m; auto.
-generalize P; rewrite <- app_cons; rewrite <- app_cons.
-apply (path_tmpLast r0).
-generalize P; apply path_pop.
-Qed.
- 
-Lemma step_inv_simpleDest:
- forall (r1 r2 : State),
- step r1 r2 -> stepInv r1 ->  simpleDest (StateToMove r2 ++ StateBeing r2).
-Proof.
-intros r1 r2 STEP; inversion_clear STEP; unfold stepInv;
- unfold stepInv, sameExec, sameEnv, exec, StateToMove, StateBeing, StateDone;
- (repeat rewrite app_nil); intros [P [SD [TT TB]]].
-apply (simpleDest_Pop (r, r)); assumption.
-apply simpleDest_movBack; assumption.
-apply simpleDest_insert; rewrite <- app_app; apply simpleDest_movFront.
-rewrite <- app_cons; rewrite app_app; auto.
-generalize SD; (repeat rewrite <- app_cons); (repeat rewrite app_app).
-generalize (simpleDest_tmpLast (t ++ ((s, r0ounon) :: b)) r0 d); auto.
-generalize SD; apply simpleDest_Pop.
-rewrite <- (app_nil _ t); generalize SD; apply simpleDest_Pop.
-Qed.
- 
-Lemma noTmp_pop:
- forall (m : Move) (l1 l2 : Moves), noTmp (l1 ++ (m :: l2)) ->  noTmp (l1 ++ l2).
-Proof.
-intros; induction l1 as [|a l1 Hrecl1]; generalize H.
-simpl; case m; intros; inversion H0; inversion H2; auto.
-rewrite app_cons; rewrite app_cons; simpl; case a.
-intros; inversion H0; inversion H2; auto.
-Qed.
- 
-Lemma step_inv_noTmp:
- forall (r1 r2 : State), step r1 r2 -> stepInv r1 ->  noTmp (StateToMove r2).
-Proof.
-intros r1 r2 STEP; inversion_clear STEP; unfold stepInv;
- unfold stepInv, sameExec, sameEnv, exec, StateToMove, StateBeing, StateDone;
- intros [P [SD [NO [TT TB]]]]; generalize TT; (try apply noTmp_pop); auto.
-Qed.
- 
-Lemma noTmp_noTmpLast: forall (l : Moves), noTmp l ->  noTmpLast l.
-Proof.
-intros; induction l as [|a l Hrecl]; (try (simpl; auto; fail)).
-generalize H; simpl; case a; generalize Hrecl; case l;
- (intros; inversion H0; inversion H2; auto).
-Qed.
- 
-Lemma noTmpLast_pop:
- forall (m : Move) (l : Moves), noTmpLast (m :: l) ->  noTmpLast l.
-Proof.
-intros m l; simpl; case m; case l.
-simpl; auto.
-intros; inversion H; inversion H1; auto.
-Qed.
- 
-Lemma noTmpLast_Pop:
- forall (m : Move) (l1 l2 : Moves),
- noTmpLast (l1 ++ (m :: l2)) ->  noTmpLast (l1 ++ l2).
-Proof.
-intros; induction l1 as [|a l1 Hrecl1]; generalize H.
-simpl; case m; case l2.
-simpl; auto.
-intros.
-elim H0; [intros H1 H2; elim H2; [intros H3 H4; (try exact H4)]].
-(repeat rewrite app_cons); simpl; case a.
-generalize Hrecl1; case l1.
-simpl; case m; case l2; intros; inversion H0; inversion H2; auto.
-intros m0 l R r r0; rewrite app_cons; rewrite app_cons.
-intros; inversion H0; inversion H2; auto.
-Qed.
- 
-Lemma noTmpLast_push:
- forall (m : Move) (t1 t2 t3 : Moves),
- noTmp (t1 ++ (m :: t2)) -> noTmpLast t3 ->  noTmpLast (m :: t3).
-Proof.
-intros; induction t1 as [|a t1 Hrect1]; generalize H.
-simpl; case m; intros r r0 [N1 [N2 NT]]; generalize H0; case t3; auto.
-rewrite app_cons; intros; apply Hrect1.
-generalize H1.
-simpl; case m; case a; intros; inversion H2; inversion H4; auto.
-Qed.
- 
-Lemma noTmpLast_tmpLast:
- forall (s d : Reg) (l : Moves),
- noTmpLast (l ++ ((s, d) :: nil)) ->  noTmpLast (l ++ ((T s, d) :: nil)).
+Definition exec_seq (m: moves) (e: Locmap.t) : Locmap.t :=
+  Parmov.exec_seq loc val Loc.eq m e.
+  
+Lemma temp_for_charact:
+  forall l, temp_for l = R IT2 \/ temp_for l = R FT2.
 Proof.
-intros; induction l as [|a l Hrecl].
-simpl; auto.
-generalize H; rewrite app_cons; rewrite app_cons; simpl.
-case a; generalize Hrecl; case l.
-simpl; auto.
-intros m l0 REC r r0; generalize REC; rewrite app_cons; rewrite app_cons.
-case m; intros; inversion H0; inversion H2; split; auto.
+  intro; unfold temp_for. destruct (Loc.type l); tauto.
 Qed.
- 
-Lemma step_inv_noTmpLast:
- forall (r1 r2 : State), step r1 r2 -> stepInv r1 ->  noTmpLast (StateBeing r2).
-Proof.
-intros r1 r2 STEP; inversion_clear STEP; unfold stepInv;
- unfold stepInv, sameExec, sameEnv, exec, StateToMove, StateBeing, StateDone;
- intros [P [SD [NO [TT TB]]]]; auto.
-apply (noTmpLast_push m t1 t2); auto.
-apply (noTmpLast_push (d, r) t1 t2); auto.
-generalize TB; rewrite <- app_cons; rewrite <- app_cons; apply noTmpLast_tmpLast.
-apply (noTmpLast_pop (sn, dn)); auto.
-Qed.
- 
-Lemma noOverlapaux_insert:
- forall (l1 l2 : list Reg) (r x : Reg),
- noOverlap_aux x (r :: (l1 ++ l2)) ->  noOverlap_aux x (l1 ++ (r :: l2)).
-Proof.
-simpl; intros; induction l1; simpl; split.
-elim H; [intros H0 H1; (try exact H0)].
-elim H; [intros H0 H1; (try exact H1)].
-simpl in H |-.
-elim H;
- [intros H0 H1; elim H1; [intros H2 H3; (try clear H1 H); (try exact H2)]].
-apply IHl1.
-split.
-elim H; [intros H0 H1; (try exact H0)].
-rewrite app_cons in H.
-apply noOverlap_auxpop with ( r := a ).
-elim H; [intros H0 H1; (try exact H1)].
-Qed.
- 
-Lemma Ingetsrc_swap2:
- forall (m : Move) (l1 l2 : Moves) (l : Reg),
- In l (getsrc (l1 ++ (m :: l2))) ->  In l (getsrc (m :: (l1 ++ l2))).
-Proof.
-intros; destruct m as [m1 m2]; simpl; auto.
-induction l1; simpl.
-simpl in H |-; auto.
-destruct a; simpl.
-simpl in H |-.
-elim H; [intros H0 | intros H0; (try exact H0)].
-right; left; (try assumption).
-elim IHl1; intros; auto.
-Qed.
- 
-Lemma noOverlap_insert:
- forall (p1 p2 : Moves) (m : Move),
- noOverlap (m :: (p1 ++ p2)) ->  noOverlap (p1 ++ (m :: p2)).
-Proof.
-unfold noOverlap; destruct m; rewrite getdst_add; simpl getdst;
- rewrite getdst_app.
-intros.
-apply noOverlapaux_insert.
-generalize (H l); intros H1; lapply H1;
- [intros H2; (try clear H1); (try exact H2) | idtac].
-simpl getsrc.
-generalize (Ingetsrc_swap2 (r, r0)); simpl; (intros; auto).
-Qed.
- 
-Lemma noOverlap_movBack:
- forall (p1 p2 : Moves) (m : Move),
- noOverlap (p1 ++ (m :: p2)) ->  noOverlap ((p1 ++ p2) ++ (m :: nil)).
-Proof.
-intros.
-apply (noOverlap_insert (p1 ++ p2) nil m).
-rewrite app_nil; apply noOverlap_movFront; auto.
-Qed.
- 
-Lemma noOverlap_movBack0:
- forall (t : Moves) (s d : Reg),
- noOverlap ((s, d) :: t) ->  noOverlap (t ++ ((s, d) :: nil)).
-Proof.
-intros t s d H; (try assumption).
-apply noOverlap_insert.
-rewrite app_nil; auto.
-Qed.
- 
-Lemma noOverlap_Front0:
- forall (t : Moves) (s d : Reg),
- noOverlap (t ++ ((s, d) :: nil)) ->  noOverlap ((s, d) :: t).
-Proof.
-intros t s d H; (try assumption).
-cut ((s, d) :: t = (s, d) :: (t ++ nil)).
-intros e; rewrite e.
-apply noOverlap_movFront; auto.
-rewrite app_nil; auto.
-Qed.
- 
-Lemma noTmpL_diff:
- forall (t : Moves) (s d : Reg),
- noTmpLast (t ++ ((s, d) :: nil)) ->  notemporary d.
-Proof.
-intros t s d; unfold notemporary; induction t; (try (simpl; intros; auto; fail)).
-rewrite app_cons.
-intros; apply IHt.
-apply (noTmpLast_pop a); auto.
-Qed.
- 
-Lemma noOverlap_aux_app:
- forall l1 l2 (r : Reg),
- noOverlap_aux r l1 -> noOverlap_aux r l2 ->  noOverlap_aux r (l1 ++ l2).
-Proof.
-induction l1; simpl; auto.
-intros; split.
-elim H; [intros H1 H2; (try clear H); (try exact H1)].
-apply IHl1; auto.
-elim H; [intros H1 H2; (try clear H); (try exact H2)].
-Qed.
- 
-Lemma noTmP_noOverlap_aux:
- forall t (r : Reg), noTmp t ->  noOverlap_aux (T r) (getdst t).
-Proof.
-induction t; simpl; auto.
-destruct a; simpl; (intros; split).
-elim H; intros; elim H1; intros.
-right; apply H2.
-apply IHt; auto.
-elim H;
- [intros H0 H1; elim H1; [intros H2 H3; (try clear H1 H); (try exact H3)]].
-Qed.
- 
-Lemma noTmp_append: forall l1 l2, noTmp l1 -> noTmp l2 ->  noTmp (l1 ++ l2).
-Proof.
-induction l1; simpl; auto.
-destruct a.
-intros l2 [H1 [H2 H3]] H4.
-(repeat split); auto.
-Qed.
- 
-Lemma step_inv_noOverlap:
- forall (r1 r2 : State),
- step r1 r2 -> stepInv r1 ->  noOverlap (StateToMove r2 ++ StateBeing r2).
-Proof.
-intros r1 r2 STEP; inversion_clear STEP; unfold stepInv;
- unfold stepInv, sameExec, sameEnv, exec, StateToMove, StateBeing, StateDone;
- (repeat rewrite app_nil); intros [P [SD [NO [TT TB]]]];
- (try (generalize NO; apply noOverlap_Pop; auto; fail)).
-apply noOverlap_movBack; auto.
-apply noOverlap_insert; rewrite <- app_app; apply noOverlap_movFront;
- rewrite <- app_cons; rewrite app_app; auto.
-generalize NO; (repeat rewrite <- app_cons); (repeat rewrite app_app);
- (clear NO; intros NO); apply noOverlap_movBack0.
-assert (noOverlap ((r0, d) :: (t ++ ((s, r0ounon) :: b))));
- [apply noOverlap_Front0; auto | idtac].
-generalize H; unfold noOverlap; simpl; clear H; intros.
-elim H0; intros; [idtac | apply (H l0); (right; (try assumption))].
-split; [right; (try assumption) | idtac].
-generalize TB; simpl; caseEq (b ++ ((r0, d) :: nil)); intro.
-elim (app_eq_nil b ((r0, d) :: nil)); intros; auto; inversion H4.
-subst l0; intros; rewrite <- H1 in TB0.
-elim TB0; [intros H2 H3; elim H3; [intros H4 H5; (try clear H3 TB0)]].
-generalize (noTmpL_diff b r0 d); unfold notemporary; intro; apply H3; auto.
-rewrite <- H1; apply noTmP_noOverlap_aux; apply noTmp_append; auto;
- rewrite <- app_cons in TB; apply noTmpLast_popBack with (r0, d); auto.
-rewrite <- (app_nil _ t); apply (noOverlap_Pop (s, d)); assumption.
-Qed.
- 
-Lemma step_inv: forall (r1 r2 : State), step r1 r2 -> stepInv r1 ->  stepInv r2.
-Proof.
-intros; unfold stepInv; (repeat split).
-apply (step_inv_path r1 r2); auto.
-apply (step_inv_simpleDest r1 r2); auto.
-apply (step_inv_noOverlap r1 r2); auto.
-apply (step_inv_noTmp r1 r2); auto.
-apply (step_inv_noTmpLast r1 r2); auto.
-Qed.
- 
-Definition step_NF (r : State) : Prop := ~ (exists s : State , step r s ).
- 
-Inductive stepp : State -> State ->  Prop :=
-  stepp_refl: forall (r : State),  stepp r r
- | stepp_trans:
-     forall (r1 r2 r3 : State), step r1 r2 -> stepp r2 r3 ->  stepp r1 r3 .
-Hint Resolve stepp_refl stepp_trans .
- 
-Lemma stepp_transitive:
- forall (r1 r2 r3 : State), stepp r1 r2 -> stepp r2 r3 ->  stepp r1 r3.
-Proof.
-intros; induction H as [r|r1 r2 r0 H H1 HrecH]; eauto.
-Qed.
- 
-Lemma step_stepp: forall (s1 s2 : State), step s1 s2 ->  stepp s1 s2.
-Proof.
-eauto.
-Qed.
- 
-Lemma stepp_inv:
- forall (r1 r2 : State), stepp r1 r2 -> stepInv r1 ->  stepInv r2.
-Proof.
-intros; induction H as [r|r1 r2 r3 H H1 HrecH]; auto.
-apply HrecH; auto.
-apply (step_inv r1 r2); auto.
-Qed.
- 
-Lemma noTmpLast_lastnoTmp:
- forall l s d, noTmpLast (l ++ ((s, d) :: nil)) ->  notemporary d.
-Proof.
-induction l.
-simpl.
-intros; unfold notemporary; auto.
-destruct a as [a1 a2]; intros.
-change (noTmpLast ((a1, a2) :: (l ++ ((s, d) :: nil)))) in H |-.
-apply IHl with s.
-apply noTmpLast_pop with (a1, a2); auto.
+
+Lemma is_not_temp_charact:
+  forall l,
+  Parmov.is_not_temp loc temp_for l <-> l <> R IT2 /\ l <> R FT2.
+Proof.
+  intros. unfold Parmov.is_not_temp. 
+  destruct (Loc.eq l (R IT2)). 
+  subst l. intuition. apply (H (R IT2)). reflexivity. discriminate.
+  destruct (Loc.eq l (R FT2)).
+  subst l. intuition. apply (H (R FT2)). reflexivity. 
+  assert (forall d, l <> temp_for d). 
+    intro. elim (temp_for_charact d); congruence.
+  intuition. 
 Qed.
- 
-Lemma step_inv_NoOverlap:
- forall (s1 s2 : State) r,
- step s1 s2 -> notemporary r -> stepInv s1 -> NoOverlap r s1 ->  NoOverlap r s2.
+
+Lemma disjoint_temp_not_temp:
+  forall l, Loc.notin l temporaries -> Parmov.is_not_temp loc temp_for l.
 Proof.
-intros s1 s2 r STEP notempr; inversion_clear STEP; unfold stepInv;
- unfold stepInv, sameExec, sameEnv, exec, StateToMove, StateBeing, StateDone;
- intros [P [SD [NO [TT TB]]]]; unfold NoOverlap; simpl.
-simpl; (repeat rewrite app_nil); simpl; (repeat rewrite <- app_cons); intro;
- apply noOverlap_Pop with ( m := (r0, r0) ); auto.
-(repeat rewrite app_nil); simpl; rewrite app_ass; (repeat rewrite <- app_cons);
- intro; rewrite ass_app; apply noOverlap_movBack; auto.
-simpl; (repeat (rewrite app_ass; simpl)); (repeat rewrite <- app_cons); intro.
-rewrite ass_app; apply noOverlap_insert; rewrite app_ass;
- apply noOverlap_movFront; auto.
-simpl; (repeat rewrite <- app_cons); intro; rewrite ass_app;
- apply noOverlap_movBack0; auto.
-generalize H; (repeat (rewrite app_ass; simpl)); intro.
-assert (noOverlap ((r0, d) :: (((r, r) :: t) ++ ((s, r0ounon) :: b))));
- [apply noOverlap_Front0 | idtac]; auto.
-generalize H0; (repeat (rewrite app_ass; simpl)); auto.
-generalize H1; unfold noOverlap; simpl; intros.
-elim H3; intros H4; clear H3.
-split.
-right; assert (notemporary d).
-change (noTmpLast (((s, r0ounon) :: b) ++ ((r0, d) :: nil))) in TB |-;
- apply (noTmpLast_lastnoTmp ((s, r0ounon) :: b) r0); auto.
-rewrite <- H4; unfold notemporary in H3 |-; apply H3.
-split.
-right; rewrite <- H4; unfold notemporary in notempr |-; apply notempr.
-rewrite <- H4; apply noTmP_noOverlap_aux; auto.
-apply noTmp_append; auto.
-change (noTmpLast (((s, r0ounon) :: b) ++ ((r0, d) :: nil))) in TB |-;
- apply noTmpLast_popBack with ( m := (r0, d) ); auto.
-apply (H2 l0).
-elim H4; intros H3; right; [left | right]; assumption.
-intro;
- change (noOverlap (((r, r) :: t) ++ ((sn, dn) :: (b ++ ((s0, d0) :: nil))))) in
- H1 |-.
-change (noOverlap (((r, r) :: t) ++ (b ++ ((s0, d0) :: nil))));
- apply (noOverlap_Pop (sn, dn)); auto.
-(repeat rewrite <- app_cons); apply noOverlap_Pop.
+  intros. rewrite is_not_temp_charact. 
+  unfold temporaries in H; simpl in H. 
+  split; apply Loc.diff_not_eq; tauto.
 Qed.
- 
-Lemma step_inv_getdst:
- forall (s1 s2 : State) r,
- step s1 s2 ->
- In r (getdst (StateToMove s2 ++ StateBeing s2)) ->
-  In r (getdst (StateToMove s1 ++ StateBeing s1)).
+
+Lemma loc_norepet_norepet:
+  forall l, Loc.norepet l -> list_norepet l.
 Proof.
-intros s1 s2 r STEP; inversion_clear STEP;
- unfold StateToMove, StateBeing, StateDone.
-(repeat rewrite getdst_app); simpl; (repeat rewrite app_nil); intro;
- apply in_or_app.
-elim (in_app_or (getdst t1) (getdst t2) r); auto.
-intro; right; simpl; right; assumption.
-(repeat rewrite getdst_app); destruct m as [m1 m2]; simpl;
- (repeat rewrite app_nil); intro; apply in_or_app.
-elim (in_app_or (getdst t1 ++ getdst t2) (m2 :: nil) r); auto; intro.
-elim (in_app_or (getdst t1) (getdst t2) r); auto; intro.
-right; simpl; right; assumption.
-elim H0; intros H1; [right; simpl; left; (try assumption) | inversion H1].
-(repeat rewrite getdst_app); simpl; (repeat rewrite app_nil); intro;
- apply in_or_app.
-elim (in_app_or (getdst t1 ++ getdst t2) (r0 :: (d :: getdst b)) r); auto;
- intro.
-elim (in_app_or (getdst t1) (getdst t2) r); auto; intro.
-left; apply in_or_app; left; assumption.
-left; apply in_or_app; right; simpl; right; assumption.
-elim H0; intro.
-left; apply in_or_app; right; simpl; left; trivial.
-elim H1; intro.
-right; (simpl; left; trivial).
-right; simpl; right; assumption.
-(repeat (rewrite getdst_app; simpl)); trivial.
-(repeat (rewrite getdst_app; simpl)); intro.
-elim (in_app_or (getdst t) (getdst b ++ (d0 :: nil)) r); auto; intro;
- apply in_or_app; auto.
-elim (in_app_or (getdst b) (d0 :: nil) r); auto; intro.
-right; simpl; right; apply in_or_app; auto.
-elim H3; intro.
-right; simpl; right; apply in_or_app; right; simpl; auto.
-inversion H4.
-rewrite app_nil; (repeat (rewrite getdst_app; simpl)); intro.
-apply in_or_app; left; assumption.
+  induction 1; constructor. 
+  apply Loc.notin_not_in; auto. auto.
 Qed.
- 
-Lemma stepp_sameExec:
- forall (r1 r2 : State), stepp r1 r2 -> stepInv r1 ->  sameExec r1 r2.
-Proof.
-intros; induction H as [r|r1 r2 r3 H H1 HrecH].
-unfold sameExec; intros; auto.
-cut (sameExec r1 r2); [idtac | apply (step_sameExec r1); auto].
-unfold sameExec; unfold sameExec in HrecH |-; intros.
-rewrite H2; auto.
-rewrite HrecH; auto.
-apply (step_inv r1); auto.
-intros x H5; apply H4.
-generalize H5; (repeat rewrite getdst_app); intros; apply in_or_app.
-elim
- (in_app_or
-   (getdst (StateToMove r2) ++ getdst (StateBeing r2))
-   (getdst (StateToMove r3) ++ getdst (StateBeing r3)) x); auto; intro.
-generalize (step_inv_getdst r1 r2 x); (repeat rewrite getdst_app); intro.
-left; apply H8; auto.
-intros x H5; apply H4.
-generalize H5; (repeat rewrite getdst_app); intros; apply in_or_app.
-elim
- (in_app_or
-   (getdst (StateToMove r1) ++ getdst (StateBeing r1))
-   (getdst (StateToMove r2) ++ getdst (StateBeing r2)) x); auto; intro.
-generalize (step_inv_getdst r1 r2 x); (repeat rewrite getdst_app); intro.
-left; apply H8; auto.
+
+Lemma parmove_prop_1:
+  forall srcs dsts,
+  List.length srcs = List.length dsts ->
+  Loc.norepet dsts ->
+  Loc.disjoint srcs temporaries ->
+  Loc.disjoint dsts temporaries ->
+  forall e,
+  let e' := exec_seq (parmove srcs dsts) e in
+  List.map e' dsts = List.map e srcs /\
+  forall l, ~In l dsts -> l <> R IT2 -> l <> R FT2 -> e' l = e l.
+Proof.
+  intros. 
+  assert (NR: list_norepet dsts) by (apply loc_norepet_norepet; auto).
+  assert (NTS: forall r, In r srcs -> Parmov.is_not_temp loc temp_for r).
+    intros. apply disjoint_temp_not_temp. apply Loc.disjoint_notin with srcs; auto.
+  assert (NTD: forall r, In r dsts -> Parmov.is_not_temp loc temp_for r).
+    intros. apply disjoint_temp_not_temp. apply Loc.disjoint_notin with dsts; auto.
+  generalize (Parmov.parmove2_correctness loc temp_for val Loc.eq srcs dsts H NR NTS NTD e).
+  change (Parmov.exec_seq loc val Loc.eq (Parmov.parmove2 loc temp_for Loc.eq srcs dsts) e) with e'.
+  intros [A B].
+  split. auto. intros. apply B. auto. rewrite is_not_temp_charact; auto.
 Qed.
- 
-Inductive dstep : State -> State ->  Prop :=
-  dstep_nop:
-    forall (r : Reg) (t l : Moves),  dstep ((r, r) :: t, nil, l) (t, nil, l)
- | dstep_start:
-     forall (t l : Moves) (s d : Reg),
-     s <> d ->  dstep ((s, d) :: t, nil, l) (t, (s, d) :: nil, l)
- | dstep_push:
-     forall (t1 t2 b l : Moves) (s d r : Reg),
-     noRead t1 d ->
-      dstep
-       (t1 ++ ((d, r) :: t2), (s, d) :: b, l)
-       (t1 ++ t2, (d, r) :: ((s, d) :: b), l)
- | dstep_pop_loop:
-     forall (t b l : Moves) (s d r0 : Reg),
-     noRead t r0 ->
-      dstep
-       (t, (s, r0) :: (b ++ ((r0, d) :: nil)), l)
-       (t, b ++ ((T r0, d) :: nil), (s, r0) :: ((r0, T r0) :: l))
- | dstep_pop:
-     forall (t b l : Moves) (s0 d0 sn dn : Reg),
-     noRead t dn ->
-     Loc.diff dn s0 ->
-      dstep
-       (t, (sn, dn) :: (b ++ ((s0, d0) :: nil)), l)
-       (t, b ++ ((s0, d0) :: nil), (sn, dn) :: l)
- | dstep_last:
-     forall (t l : Moves) (s d : Reg),
-     noRead t d ->  dstep (t, (s, d) :: nil, l) (t, nil, (s, d) :: l) .
-Hint Resolve dstep_nop dstep_start dstep_push .
-Hint Resolve dstep_pop_loop dstep_pop dstep_last .
- 
-Lemma dstep_step:
- forall (r1 r2 : State), dstep r1 r2 -> stepInv r1 ->  stepp r1 r2.
-Proof.
-intros r1 r2 DS; inversion_clear DS; intros SI; eauto.
-change (stepp (nil ++ ((r, r) :: t), nil, l) (t, nil, l)); apply step_stepp;
- apply (step_nop r nil t).
-change (stepp (nil ++ ((s, d) :: t), nil, l) (t, (s, d) :: nil, l));
- apply step_stepp; apply (step_start nil t l).
-apply
- (stepp_trans
-   (t, (s, r0) :: (b ++ ((r0, d) :: nil)), l)
-   (t, (s, r0) :: (b ++ ((T r0, d) :: nil)), (r0, T r0) :: l)
-   (t, b ++ ((T r0, d) :: nil), (s, r0) :: ((r0, T r0) :: l))); auto.
-apply step_stepp; apply step_pop; auto.
-unfold stepInv in SI |-; generalize SI; intros [X [Y [Z [U V]]]].
-generalize V; unfold StateBeing, noTmpLast.
-case (b ++ ((r0, d) :: nil)); auto.
-intros m l0 [R1 [OK PP]]; auto.
+
+Lemma parmove_prop_2:
+  forall srcs dsts s d,
+  In (s, d) (parmove srcs dsts) ->
+     (In s srcs \/ s = R IT2 \/ s = R FT2)
+  /\ (In d dsts \/ d = R IT2 \/ d = R FT2).
+Proof.
+  intros srcs dsts.
+  set (mu := List.combine srcs dsts).
+  assert (forall s d, Parmov.wf_move loc temp_for mu s d ->
+            (In s srcs \/ s = R IT2 \/ s = R FT2)
+         /\ (In d dsts \/ d = R IT2 \/ d = R FT2)).
+  unfold mu; induction 1. 
+  split. 
+    left. eapply List.in_combine_l; eauto.
+    left. eapply List.in_combine_r; eauto.
+  split. 
+    right. apply temp_for_charact. 
+    tauto.
+  split.
+    tauto.
+    right. apply temp_for_charact.
+  intros. apply H. 
+  apply (Parmov.parmove2_wf_moves loc temp_for Loc.eq srcs dsts s d H0). 
 Qed.
- 
-Lemma dstep_inv:
- forall (r1 r2 : State), dstep r1 r2 -> stepInv r1 ->  stepInv r2.
+
+Lemma loc_type_temp_for:
+  forall l, Loc.type (temp_for l) = Loc.type l.
 Proof.
-intros.
-apply (stepp_inv r1 r2); auto.
-apply dstep_step; auto.
+  intros; unfold temp_for. destruct (Loc.type l); reflexivity. 
 Qed.
- 
-Inductive dstepp : State -> State ->  Prop :=
-  dstepp_refl: forall (r : State),  dstepp r r
- | dstepp_trans:
-     forall (r1 r2 r3 : State), dstep r1 r2 -> dstepp r2 r3 ->  dstepp r1 r3 .
-Hint Resolve dstepp_refl dstepp_trans .
- 
-Lemma dstepp_stepp:
- forall (s1 s2 : State), stepInv s1 -> dstepp s1 s2 ->  stepp s1 s2.
-Proof.
-intros; induction H0 as [r|r1 r2 r3 H0 H1 HrecH0]; auto.
-apply (stepp_transitive r1 r2 r3); auto.
-apply dstep_step; auto.
-apply HrecH0; auto.
-apply (dstep_inv r1 r2); auto.
+
+Lemma loc_type_combine:
+  forall srcs dsts,
+  List.map Loc.type srcs = List.map Loc.type dsts ->
+  forall s d,
+  In (s, d) (List.combine srcs dsts) ->
+  Loc.type s = Loc.type d.
+Proof.
+  induction srcs; destruct dsts; simpl; intros; try discriminate.
+  elim H0.
+  elim H0; intros. inversion H1; subst. congruence.
+  apply IHsrcs with dsts. congruence. auto.
 Qed.
- 
-Lemma dstepp_sameExec:
- forall (r1 r2 : State), dstepp r1 r2 -> stepInv r1 ->  sameExec r1 r2.
-Proof.
-intros; apply stepp_sameExec; auto.
-apply dstepp_stepp; auto.
+
+Lemma parmove_prop_3:
+  forall srcs dsts,
+  List.map Loc.type srcs = List.map Loc.type dsts ->
+  forall s d,
+  In (s, d) (parmove srcs dsts) -> Loc.type s = Loc.type d.
+Proof.
+  intros srcs dsts TYP.
+  set (mu := List.combine srcs dsts).
+  assert (forall s d, Parmov.wf_move loc temp_for mu s d ->
+            Loc.type s = Loc.type d).
+  unfold mu; induction 1. 
+  eapply loc_type_combine; eauto.
+  rewrite loc_type_temp_for; auto.
+  rewrite loc_type_temp_for; auto.
+  intros. apply H. 
+  apply (Parmov.parmove2_wf_moves loc temp_for Loc.eq srcs dsts s d H0). 
 Qed.
- 
-End pmov.
 
-Fixpoint split_move' (m : Moves) (r : Reg) {struct m} :
- option ((Moves * Reg) * Moves) :=
- match m with
-   (s, d) :: tail =>
-     match diff_dec s r with
-       right _ => Some (nil, d, tail)
-      | left _ =>
-          match split_move' tail r with
-            Some ((t1, r2, t2)) => Some ((s, d) :: t1, r2, t2)
-           | None => None
-          end
-     end
-  | nil => None
- end.
- 
-Fixpoint split_move (m : Moves) (r : Reg) {struct m} :
- option ((Moves * Reg) * Moves) :=
- match m with
-   (s, d) :: tail =>
-     match Loc.eq s r with
-       left _ => Some (nil, d, tail)
-      | right _ =>
-          match split_move tail r with
-            Some ((t1, r2, t2)) => Some ((s, d) :: t1, r2, t2)
-           | None => None
-          end
-     end
-  | nil => None
- end.
+Section EQUIVALENCE.
 
-Definition def : Move := (R IT1, R IT1).
- 
-Fixpoint last (M : Moves) : Move :=
- match M with   nil => def
-               | m :: nil => m
-               | m :: tail => last tail end.
- 
-Fixpoint head_but_last (M : Moves) : Moves :=
- match M with
-   nil => nil
-  | m' :: nil => nil
-  | m' :: tail => m' :: head_but_last tail
- end.
- 
-Fixpoint replace_last_s (M : Moves) : Moves :=
- match M with
-   nil => nil
-  | m :: nil =>
-      match m with   (s, d) => (T s, d) :: nil end
-  | m :: tail => m :: replace_last_s tail
- end.
- 
-Ltac CaseEq name := generalize (refl_equal name); pattern name at -1; case name.
- 
-Definition stepf' (S1 : State) : State :=
-   match S1 with
-     (nil, nil, _) => S1
-    | ((s, d) :: tl, nil, l) =>
-        match diff_dec s d with
-          right _ => (tl, nil, l)
-         | left _ => (tl, (s, d) :: nil, l)
-        end
-    | (t, (s, d) :: b, l) =>
-        match split_move t d with
-          Some ((t1, r, t2)) =>
-            (t1 ++ t2, (d, r) :: ((s, d) :: b), l)
-         | None =>
-             match b with
-               nil => (t, nil, (s, d) :: l)
-              | _ =>
-                  match diff_dec d (fst (last b)) with
-                    right _ =>
-                      (t, replace_last_s b, (s, d) :: ((d, T d) :: l))
-                   | left _ => (t, b, (s, d) :: l)
-                  end
-             end
-        end
-   end.
- 
-Definition stepf (S1 : State) : State :=
-   match S1 with
-     (nil, nil, _) => S1
-    | ((s, d) :: tl, nil, l) =>
-        match Loc.eq s d with
-          left _ => (tl, nil, l)
-         | right _ => (tl, (s, d) :: nil, l)
-        end
-    | (t, (s, d) :: b, l) =>
-        match split_move t d with
-          Some ((t1, r, t2)) =>
-            (t1 ++ t2, (d, r) :: ((s, d) :: b), l)
-         | None =>
-             match b with
-               nil => (t, nil, (s, d) :: l)
-              | _ =>
-                  match Loc.eq d (fst (last b)) with
-                    left _ =>
-                      (t, replace_last_s b, (s, d) :: ((d, T d) :: l))
-                   | right _ => (t, b, (s, d) :: l)
-                  end
-             end
-        end
-   end.
- 
-Lemma rebuild_l:
- forall (l : Moves) (m : Move),
-  m :: l = head_but_last (m :: l) ++ (last (m :: l) :: nil).
-Proof.
-induction l; simpl; auto.
-intros m; rewrite (IHl a); auto.
-Qed.
- 
-Lemma splitSome:
- forall (l t1 t2 : Moves) (s d r : Reg),
- noOverlap (l ++ ((r, s) :: nil)) ->
- split_move l s = Some (t1, d, t2) ->  noRead t1 s.
-Proof.
-induction l; simpl.
-intros; discriminate.
-destruct a as [a1 a2].
-intros t1 t2 s d r Hno; case (Loc.eq a1 s).
-intros e H1; inversion H1.
-simpl; auto.
-CaseEq (split_move l s).
-intros; (repeat destruct p).
-inversion H0; auto.
-simpl; split; auto.
-change (noOverlap (((a1, a2) :: l) ++ ((r, s) :: nil))) in Hno |-.
-assert (noOverlap ((r, s) :: ((a1, a2) :: l))).
-apply noOverlap_Front0; auto.
-unfold noOverlap in H1 |-; simpl in H1 |-.
-elim H1 with ( l0 := a1 );
- [intros H5 H6; (try clear H1); (try exact H5) | idtac].
-elim H5; [intros H1; (try clear H5); (try exact H1) | intros H1; (try clear H5)].
-absurd (a1 = s); auto.
-apply Loc.diff_sym; auto.
-right; left; trivial.
-apply (IHl m0 m s r0 r); auto.
-apply (noOverlap_pop (a1, a2)); auto.
-intros; discriminate.
-Qed.
- 
-Lemma unsplit_move:
- forall (l t1 t2 : Moves) (s d r : Reg),
- noOverlap (l ++ ((r, s) :: nil)) ->
- split_move l s = Some (t1, d, t2) ->  l = t1 ++ ((s, d) :: t2).
-Proof.
-induction l.
-simpl; intros; discriminate.
-intros t1 t2 s d r HnoO; destruct a as [a1 a2]; simpl; case (diff_dec a1 s);
- intro.
-case (Loc.eq a1 s); intro.
-absurd (Loc.diff a1 s); auto.
-rewrite e; apply Loc.same_not_diff.
-CaseEq (split_move l s); intros; (try discriminate).
-(repeat destruct p); inversion H0.
-rewrite app_cons; subst t2; subst d; rewrite (IHl m0 m s r0 r); auto.
-apply (noOverlap_pop (a1, a2)); auto.
-case (Loc.eq a1 s); intros e H; inversion H; simpl.
-rewrite e; auto.
-cut (noOverlap_aux a1 (getdst ((r, s) :: nil))).
-intros [[H5|H4] H0]; [try exact H5 | idtac].
-absurd (s = a1); auto.
-absurd (Loc.diff a1 s); auto; apply Loc.diff_sym; auto.
-generalize HnoO; rewrite app_cons; intro.
-assert (noOverlap (l ++ ((a1, a2) :: ((r, s) :: nil))));
- (try (apply noOverlap_insert; assumption)).
-assert (noOverlap ((a1, a2) :: ((r, s) :: nil))).
-apply (noOverlap_right l); auto.
-generalize H2; unfold noOverlap; simpl.
-intros H5; elim (H5 a1); [idtac | left; trivial].
-intros H6 [[H7|H8] H9].
-absurd (s = a1); auto.
-split; [right; (try assumption) | auto].
-Qed.
- 
-Lemma cons_replace:
- forall (a : Move) (l : Moves),
- l <> nil ->  replace_last_s (a :: l) = a :: replace_last_s l.
-Proof.
-intros; simpl.
-CaseEq l.
-intro; contradiction.
-intros m l0 H0; auto.
-Qed.
- 
-Lemma last_replace:
- forall (l : Moves) (s d : Reg),
-  replace_last_s (l ++ ((s, d) :: nil)) = l ++ ((T s, d) :: nil).
-Proof.
-induction l; (try (simpl; auto; fail)).
-intros; (repeat rewrite <- app_comm_cons).
-rewrite cons_replace.
-rewrite IHl; auto.
-red; intro.
-elim (app_eq_nil l ((s, d) :: nil)); auto; intros; discriminate.
-Qed.
- 
-Lemma last_app: forall (l : Moves) (m : Move),  last (l ++ (m :: nil)) = m.
-Proof.
-induction l; simpl; auto.
-intros m; CaseEq (l ++ (m :: nil)).
-intro; elim (app_eq_nil l (m :: nil)); auto; intros; discriminate.
-intros m0 l0 H; (rewrite <- H; apply IHl).
-Qed.
- 
-Lemma last_cons:
- forall (l : Moves) (m m0 : Move),  last (m0 :: (m :: l)) = last (m :: l).
-Proof.
-intros; simpl; auto.
-Qed.
- 
-Lemma stepf_popLoop:
- forall (t b l : Moves) (s d r0 : Reg),
- split_move t d = None ->
-  stepf (t, (s, d) :: (b ++ ((d, r0) :: nil)), l) =
-  (t, b ++ ((T d, r0) :: nil), (s, d) :: ((d, T d) :: l)).
-Proof.
-intros; simpl; rewrite H; CaseEq (b ++ ((d, r0) :: nil)); intros.
-destruct b; discriminate.
-rewrite <- H0; rewrite last_app; simpl; rewrite last_replace.
-case (Loc.eq d d); intro; intuition.
-destruct t; (try destruct m0); simpl; auto.
-Qed.
- 
-Lemma stepf_pop:
- forall (t b l : Moves) (s d r r0 : Reg),
- split_move t d = None ->
- d <> r ->
-  stepf (t, (s, d) :: (b ++ ((r, r0) :: nil)), l) =
-  (t, b ++ ((r, r0) :: nil), (s, d) :: l).
-Proof.
-intros; simpl; rewrite H; CaseEq (b ++ ((r, r0) :: nil)); intros.
-destruct b; discriminate.
-rewrite <- H1; rewrite last_app; simpl.
-case (Loc.eq d r); intro.
-absurd (d = r); auto.
-destruct t; (try destruct m0); simpl; auto.
-Qed.
- 
-Lemma noOverlap_head:
- forall l1 l2 m, noOverlap (l1 ++ (m :: l2)) ->  noOverlap (l1 ++ (m :: nil)).
-Proof.
-induction l2; simpl; auto.
-intros; apply IHl2.
-cut (l1 ++ (m :: (a :: l2)) = (l1 ++ (m :: nil)) ++ (a :: l2));
- [idtac | rewrite app_ass; auto].
-intros e; rewrite e in H.
-cut (l1 ++ (m :: l2) = (l1 ++ (m :: nil)) ++ l2);
- [idtac | rewrite app_ass; auto].
-intros e'; rewrite e'; auto.
-apply noOverlap_Pop with a; auto.
-Qed.
- 
-Lemma splitNone:
- forall (l : Moves) (s d : Reg),
- split_move l d = None -> noOverlap (l ++ ((s, d) :: nil)) ->  noRead l d.
-Proof.
-induction l; intros s d; simpl; auto.
-destruct a as [a1 a2]; case (Loc.eq a1 d); intro; (try (intro; discriminate)).
-CaseEq (split_move l d); intros.
-(repeat destruct p); discriminate.
-split; (try assumption).
-change (noOverlap (((a1, a2) :: l) ++ ((s, d) :: nil))) in H1 |-.
-assert (noOverlap ((s, d) :: ((a1, a2) :: l))).
-apply noOverlap_Front0; auto.
-assert (noOverlap ((a1, a2) :: ((s, d) :: l))).
-apply noOverlap_swap; auto.
-unfold noOverlap in H3 |-; simpl in H3 |-.
-elim H3 with ( l0 := a1 );
- [intros H5 H6; (try clear H1); (try exact H5) | idtac].
-elim H6;
- [intros H1 H4; elim H1;
-   [intros H7; (try clear H1 H6); (try exact H7) | intros H7; (try clear H1 H6)]].
-absurd (a1 = d); auto.
-apply Loc.diff_sym; auto.
-left; trivial.
-apply IHl with s; auto.
-apply noOverlap_pop with (a1, a2); auto.
-Qed.
- 
-Lemma noO_diff:
- forall l1 l2 s d r r0,
- noOverlap (l1 ++ ((s, d) :: (l2 ++ ((r, r0) :: nil)))) ->
-  r = d \/ Loc.diff d r.
-Proof.
-intros.
-assert (noOverlap ((s, d) :: (l2 ++ ((r, r0) :: nil)))); auto.
-apply (noOverlap_right l1); auto.
-assert (noOverlap ((l2 ++ ((r, r0) :: nil)) ++ ((s, d) :: nil))); auto.
-apply (noOverlap_movBack0 (l2 ++ ((r, r0) :: nil))); auto.
-assert
- ((l2 ++ ((r, r0) :: nil)) ++ ((s, d) :: nil) =
-  l2 ++ (((r, r0) :: nil) ++ ((s, d) :: nil))); auto.
-rewrite app_ass; auto.
-rewrite H2 in H1.
-simpl in H1 |-.
-assert (noOverlap ((r, r0) :: ((s, d) :: nil))); auto.
-apply (noOverlap_right l2); auto.
-unfold noOverlap in H3 |-.
-generalize (H3 r); simpl.
-intros H4; elim H4; intros; [idtac | left; trivial].
-elim H6; intros [H9|H9] H10; [left | right]; auto.
-Qed.
- 
-Lemma f2ind:
- forall (S1 S2 : State),
- (forall (l : Moves),  (S1 <> (nil, nil, l))) ->
- noOverlap (StateToMove S1 ++ StateBeing S1) -> stepf S1 = S2 ->  dstep S1 S2.
-Proof.
-intros S1 S2 Hneq HnoO; destruct S1 as [[t b] l]; destruct b.
-destruct t.
-elim (Hneq l); auto.
-destruct m; simpl; case (Loc.eq r r0).
-intros.
-rewrite e; rewrite <- H; apply dstep_nop.
-intros n H; rewrite <- H; generalize (dstep_start t l r r0); auto.
-intros H; rewrite <- H; destruct m as [s d].
-CaseEq (split_move t d).
-intros p H0; destruct p as [[t1 s0] t2]; simpl; rewrite H0; destruct t; simpl.
-simpl in H0 |-; discriminate.
-rewrite (unsplit_move (m :: t) t1 t2 d s0 s); auto.
-destruct m; generalize dstep_push; intros H1; apply H1.
-unfold StateToMove, StateBeing in HnoO |-.
-apply (splitSome ((r, r0) :: t) t1 t2 d s0 s); auto.
-apply noOverlap_head with b; auto.
-unfold StateToMove, StateBeing in HnoO |-.
-apply noOverlap_head with b; auto.
-intros H0; destruct b.
-simpl.
-rewrite H0.
-destruct t; (try destruct m); generalize dstep_last; intros H1; apply H1.
-simpl; auto.
-unfold StateToMove, StateBeing in HnoO |-.
-apply splitNone with s; auto.
-unfold StateToMove, StateBeing in HnoO |-.
-generalize HnoO; clear HnoO; rewrite (rebuild_l b m); intros HnoO.
-destruct (last (m :: b)).
-case (Loc.eq d r).
-intros e; rewrite <- e.
-CaseEq (head_but_last (m :: b)); intros; [simpl | idtac];
- (try
-   (destruct t; (try destruct m0); rewrite H0;
-     (case (Loc.eq d d); intros h; (try (elim h; auto))))).
-generalize (dstep_pop_loop nil nil); simpl; intros H3; apply H3; auto.
-generalize (dstep_pop_loop ((r1, r2) :: t) nil); unfold T; simpl app;
- intros H3; apply H3; clear H3; apply splitNone with s; (try assumption).
-apply noOverlap_head with (head_but_last (m :: b) ++ ((r, r0) :: nil)); auto.
-rewrite stepf_popLoop; auto.
-generalize (dstep_pop_loop t (m0 :: l0)); simpl; intros H3; apply H3; clear H3;
- apply splitNone with s; (try assumption).
-apply noOverlap_head with (head_but_last (m :: b) ++ ((r, r0) :: nil)); auto.
-intro; assert (Loc.diff d r).
-assert (r = d \/ Loc.diff d r).
-apply (noO_diff t (head_but_last (m :: b)) s d r r0); auto.
-elim H1; [intros H2; absurd (d = r); auto | intros H2; auto].
-rewrite stepf_pop; auto.
-generalize (dstep_pop t (head_but_last (m :: b))); intros H3; apply H3; auto.
-clear H3; apply splitNone with s; (try assumption).
-apply noOverlap_head with (head_but_last (m :: b) ++ ((r, r0) :: nil)); auto.
-Qed.
- 
-Lemma f2ind':
- forall (S1 : State),
- (forall (l : Moves),  (S1 <> (nil, nil, l))) ->
- noOverlap (StateToMove S1 ++ StateBeing S1) ->  dstep S1 (stepf S1).
-Proof.
-intros S1 H noO; apply f2ind; auto.
-Qed.
- 
-Lemma appcons_length:
- forall (l1 l2 : Moves) (m : Move),
-  length (l1 ++ (m :: l2)) = (length (l1 ++ l2) + 1%nat)%nat.
-Proof.
-induction l1; simpl; intros; [omega | idtac].
-rewrite IHl1; omega.
-Qed.
- 
-Definition mesure (S0 : State) : nat :=
-   let (p, _) := S0 in let (t, b) := p in (2 * length t + length b)%nat.
- 
-Lemma step_dec0:
- forall (t1 t2 b1 b2 : Moves) (l1 l2 : Moves),
- dstep (t1, b1, l1) (t2, b2, l2) ->
-  (2 * length t2 + length b2 < 2 * length t1 + length b1)%nat.
-Proof.
-intros t1 t2 b1 b2 l1 l2 H; inversion H; simpl; (try omega).
-rewrite appcons_length; omega.
-cut (length (b ++ ((T r0, d) :: nil)) = length (b ++ ((r0, d) :: nil)));
- (try omega).
-induction b; simpl; auto.
-(repeat rewrite appcons_length); auto.
-Qed.
- 
-Lemma step_dec:
- forall (S1 S2 : State), dstep S1 S2 ->  (mesure S2 < mesure S1)%nat.
-Proof.
-unfold mesure; destruct S1 as [[t1 b1] l1]; destruct S2 as [[t2 b2] l2].
-intro; apply (step_dec0 t1 t2 b1 b2 l1 l2); trivial.
-Qed.
- 
-Lemma stepf_dec0:
- forall (S1 S2 : State),
- (forall (l : Moves),  (S1 <> (nil, nil, l))) /\
- (S2 = stepf S1 /\ noOverlap (StateToMove S1 ++ StateBeing S1)) ->
-  (mesure S2 < mesure S1)%nat.
-Proof.
-intros S1 S2 [H1 [H2 H3]]; apply step_dec.
-apply f2ind; trivial.
-rewrite H2; reflexivity.
-Qed.
- 
-Lemma stepf_dec:
- forall (S1 S2 : State),
- S2 = stepf S1 /\
- ((forall (l : Moves),  (S1 <> (nil, nil, l))) /\
-  noOverlap (StateToMove S1 ++ StateBeing S1)) ->  ltof _ mesure S2 S1.
-Proof.
-unfold ltof.
-intros S1 S2 [H1 [H2 H3]]; apply step_dec.
-apply f2ind; trivial.
-rewrite H1; reflexivity.
-Qed.
- 
-Lemma replace_last_id:
- forall l m m0,  replace_last_s (m :: (m0 :: l)) = m :: replace_last_s (m0 :: l).
-Proof.
-intros; case l; simpl.
-destruct m0; simpl; auto.
-intros; case l0; auto.
-Qed.
- 
-Lemma length_replace: forall l,  length (replace_last_s l) = length l.
-Proof.
-induction l; simpl; auto.
-destruct l; destruct a; simpl; auto.
-Qed.
- 
-Lemma length_app:
- forall (A : Set) (l1 l2 : list A),
-  (length (l1 ++ l2) = length l1 + length l2)%nat.
-Proof.
-intros A l1 l2; (try assumption).
-induction l1; simpl; auto.
-Qed.
- 
-Lemma split_length:
- forall (l t1 t2 : Moves) (s d : Reg),
- split_move l s = Some (t1, d, t2) ->
-  (length l = (length t1 + length t2) + 1)%nat.
-Proof.
-induction l.
-intros; discriminate.
-intros t1 t2 s d; destruct a as [r r0]; simpl; case (Loc.eq r s); intro.
-intros H; inversion H.
-simpl; omega.
-CaseEq (split_move l s); (try (intros; discriminate)).
-(repeat destruct p); intros H H0; inversion H0.
-rewrite H2; rewrite (IHl m0 m s r1); auto.
-rewrite H4; rewrite <- H2; simpl; omega.
-Qed.
- 
-Lemma stepf_dec0':
- forall (S1 : State),
- (forall (l : Moves),  (S1 <> (nil, nil, l))) ->
-  (mesure (stepf S1) < mesure S1)%nat.
-Proof.
-intros S1 H.
-unfold mesure; destruct S1 as [[t1 b1] l1].
-destruct t1.
-destruct b1.
-generalize (H l1); intros H1; elim H1; auto.
-destruct m; simpl.
-destruct b1.
-simpl; auto.
-case (Loc.eq r0 (fst (last (m :: b1)))).
-intros; rewrite length_replace; simpl; omega.
-simpl; case b1; intros; simpl; omega.
-destruct m.
-destruct b1.
-simpl.
-case (Loc.eq r r0); intros; simpl; omega.
-destruct m; simpl; case (Loc.eq r r2).
-intros; simpl; omega.
-CaseEq (split_move t1 r2); intros.
-destruct p; destruct p; simpl.
-rewrite (split_length t1 m0 m r2 r3); auto.
-rewrite length_app; auto.
-omega.
-destruct b1.
-simpl; omega.
-case (Loc.eq r2 (fst (last (m :: b1)))); intros.
-rewrite length_replace; simpl; omega.
-simpl; omega.
-Qed.
- 
-Lemma stepf1_dec:
- forall (S1 S2 : State),
- (forall (l : Moves),  (S1 <> (nil, nil, l))) ->
- S2 = stepf S1 ->  ltof _ mesure S2 S1.
-Proof.
-unfold ltof; intros S1 S2 H H0; rewrite H0.
-apply stepf_dec0'; (try assumption).
-Qed.
- 
-Lemma disc1:
- forall (a : Move) (l1 l2 l3 l4 : list Move),
-  ((a :: l1, l2, l3) <> (nil, nil, l4)).
-Proof.
-intros; discriminate.
-Qed.
- 
-Lemma disc2:
- forall (a : Move) (l1 l2 l3 l4 : list Move),
-  ((l1, a :: l2, l3) <> (nil, nil, l4)).
-Proof.
-intros; discriminate.
-Qed.
-Hint Resolve disc1 disc2 .
- 
-Lemma sameExec_reflexive: forall (r : State),  sameExec r r.
-Proof.
-intros r; unfold sameExec, sameEnv, exec.
-destruct r as [[t b] d]; trivial.
-Qed.
- 
-Definition base_case_Pmov_dec:
- forall (s : State),
-  ({ exists l : list Move , s = (nil, nil, l)  }) +
-  ({ forall l,  (s <> (nil, nil, l)) }).
-Proof.
-destruct s as [[[|x tl] [|y tl']] l]; (try (right; intro; discriminate)).
-left; exists l; auto.
-Defined.
- 
-Definition Pmov :=
-   Fix
-    (well_founded_ltof _ mesure) (fun _ => State)
-    (fun (S1 : State) =>
-     fun (Pmov : forall x, ltof _ mesure x S1 ->  State) =>
-        match base_case_Pmov_dec S1 with
-          left h => S1
-         | right h => Pmov (stepf S1) (stepf_dec0' S1 h) end).
- 
-Theorem Pmov_equation: forall S1,  Pmov S1 = match S1 with
-                                               ((nil, nil), _) => S1
-                                              | _ => Pmov (stepf S1)
-                                             end.
-Proof.
-intros S1; unfold Pmov at 1;
- rewrite (Fix_eq
-           (well_founded_ltof _ mesure) (fun _ => State)
-           (fun (S1 : State) =>
-            fun (Pmov : forall x, ltof _ mesure x S1 ->  State) =>
-               match base_case_Pmov_dec S1 with
-                 left h => S1
-                | right h => Pmov (stepf S1) (stepf_dec0' S1 h) end)).
-fold Pmov.
-destruct S1 as [[[|x tl] [|y tl']] l];
- match goal with
- | |- match ?a with left _ => _ | right _ => _ end = _ => case a end;
- (try (intros [l0 Heq]; discriminate Heq)); auto.
-intros H; elim (H l); auto.
-intros x f g Hfg_ext.
-match goal with
-| |- match ?a with left _ => _ | right _ => _ end = _ => case a end; auto.
-Qed.
- 
-Lemma sameExec_transitive:
- forall (r1 r2 r3 : State),
- (forall r,
-  In r (getdst (StateToMove r2 ++ StateBeing r2)) ->
-   In r (getdst (StateToMove r1 ++ StateBeing r1))) ->
- (forall r,
-  In r (getdst (StateToMove r3 ++ StateBeing r3)) ->
-   In r (getdst (StateToMove r2 ++ StateBeing r2))) ->
- sameExec r1 r2 -> sameExec r2 r3 ->  sameExec r1 r3.
-Proof.
-intros r1 r2 r3; unfold sameExec, exec; (repeat rewrite getdst_app).
-destruct r1 as [[t1 b1] d1]; destruct r2 as [[t2 b2] d2];
- destruct r3 as [[t3 b3] d3]; simpl.
-intros Hin; intros.
-rewrite H0; auto.
-rewrite H1; auto.
-intros.
-apply (H3 x).
-apply in_or_app; auto.
-elim (in_app_or (getdst t2 ++ getdst b2) (getdst t3 ++ getdst b3) x); auto.
-intros.
-apply (H3 x).
-apply in_or_app; auto.
-elim (in_app_or (getdst t1 ++ getdst b1) (getdst t2 ++ getdst b2) x); auto.
-Qed.
- 
-Lemma dstep_inv_getdst:
- forall (s1 s2 : State) r,
- dstep s1 s2 ->
- In r (getdst (StateToMove s2 ++ StateBeing s2)) ->
-  In r (getdst (StateToMove s1 ++ StateBeing s1)).
-intros s1 s2 r STEP; inversion_clear STEP;
- unfold StateToMove, StateBeing, StateDone; (repeat rewrite app_nil);
- (repeat (rewrite getdst_app; simpl)); intro; auto.
-Proof.
-right; (try assumption).
-elim (in_app_or (getdst t) (d :: nil) r); auto; (simpl; intros [H1|H1]);
- [left; assumption | inversion H1].
-elim (in_app_or (getdst t1 ++ getdst t2) (r0 :: (d :: getdst b)) r); auto;
- (simpl; intros).
-elim (in_app_or (getdst t1) (getdst t2) r); auto; (simpl; intros).
-apply in_or_app; left; apply in_or_app; left; assumption.
-apply in_or_app; left; apply in_or_app; right; simpl; right; assumption.
-elim H1; [intros H2 | intros [H2|H2]].
-apply in_or_app; left; apply in_or_app; right; simpl; left; auto.
-apply in_or_app; right; simpl; left; auto.
-apply in_or_app; right; simpl; right; assumption.
-elim (in_app_or (getdst t) (getdst b ++ (d :: nil)) r); auto; (simpl; intros).
-apply in_or_app; left; assumption.
-elim (in_app_or (getdst b) (d :: nil) r); auto; (simpl; intros).
-apply in_or_app; right; simpl; right; apply in_or_app; left; assumption.
-elim H2; [intros H3 | intros H3; inversion H3].
-apply in_or_app; right; simpl; right; apply in_or_app; right; simpl; auto.
-elim (in_app_or (getdst t) (getdst b ++ (d0 :: nil)) r); auto; (simpl; intros).
-apply in_or_app; left; assumption.
-elim (in_app_or (getdst b) (d0 :: nil) r); auto; simpl;
- [intros H3 | intros [H3|H3]; [idtac | inversion H3]].
-apply in_or_app; right; simpl; right; apply in_or_app; left; assumption.
-apply in_or_app; right; simpl; right; apply in_or_app; right; simpl; auto.
-apply in_or_app; left; assumption.
-Qed.
- 
-Theorem STM_Pmov: forall (S1 : State),  StateToMove (Pmov S1) = nil.
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1; intros Hrec; destruct S1 as [[t b] d];
- rewrite Pmov_equation; destruct t.
-destruct b; auto.
-apply Hrec; apply stepf1_dec; auto.
-apply Hrec; apply stepf1_dec; auto.
-Qed.
- 
-Theorem SB_Pmov: forall (S1 : State),  StateBeing (Pmov S1) = nil.
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1; intros Hrec; destruct S1 as [[t b] d];
- rewrite Pmov_equation; destruct t.
-destruct b; auto.
-apply Hrec; apply stepf1_dec; auto.
-apply Hrec; apply stepf1_dec; auto.
-Qed.
- 
-Theorem Fpmov_correct:
- forall (S1 : State), stepInv S1 ->  sameExec S1 (Pmov S1).
-Proof.
-intros S1; elim S1  using (well_founded_ind (Wf_nat.well_founded_ltof _ mesure)).
-clear S1; intros S1; intros Hrec Hinv; rewrite Pmov_equation;
- destruct S1 as [[t b] d].
-assert
- (forall (r : Reg) S1,
-  In r (getdst (StateToMove (Pmov (stepf S1)) ++ StateBeing (Pmov (stepf S1)))) ->
-   In r (getdst (StateToMove (stepf S1) ++ StateBeing (stepf S1)))).
-intros r S1; rewrite (STM_Pmov (stepf S1)); rewrite SB_Pmov; simpl; intros.
-inversion H.
-destruct t.
-destruct b.
-apply sameExec_reflexive.
-set (S1:=(nil (A:=Move), m :: b, d)).
-assert (dstep S1 (stepf S1)); (try apply f2ind); unfold S1; auto.
-elim Hinv; intros Hpath [SD [NO NT]]; assumption.
-apply sameExec_transitive with (stepf S1); auto.
-intros r; apply dstep_inv_getdst; auto.
-apply dstepp_sameExec; auto; apply dstepp_trans with (stepf S1); auto.
-apply dstepp_refl; auto.
-apply Hrec; auto.
-unfold ltof; apply step_dec; assumption.
-apply (dstep_inv S1); assumption.
-set (S1:=(m :: t, b, d)).
-assert (dstep S1 (stepf S1)); (try apply f2ind); unfold S1; auto.
-elim Hinv; intros Hpath [SD [NO NT]]; assumption.
-apply sameExec_transitive with (stepf S1); auto.
-intros r; apply dstep_inv_getdst; auto.
-apply dstepp_sameExec; auto; apply dstepp_trans with (stepf S1); auto.
-apply dstepp_refl; auto.
-apply Hrec; auto.
-unfold ltof; apply step_dec; assumption.
-apply (dstep_inv S1); assumption.
-Qed.
- 
-Definition P_move := fun (p : Moves) => StateDone (Pmov (p, nil, nil)).
- 
-Definition Sexec := sexec.
- 
-Definition Get := get.
- 
-Fixpoint listsLoc2Moves (src dst : list loc) {struct src} : Moves :=
- match src with
-   nil => nil
-  | s :: srcs =>
-      match dst with
-        nil => nil
-       | d :: dsts => (s, d) :: listsLoc2Moves srcs dsts
-      end
- end.
- 
-Definition no_overlap (l1 l2 : list loc) :=
-   forall r, In r l1 -> forall s, In s l2 ->  r = s \/ Loc.diff r s.
- 
-Definition no_overlap_state (S : State) :=
-   no_overlap
-    (getsrc (StateToMove S ++ StateBeing S))
-    (getdst (StateToMove S ++ StateBeing S)).
- 
-Definition no_overlap_list := fun l => no_overlap (getsrc l) (getdst l).
- 
-Lemma Indst_noOverlap_aux:
- forall l1 l,
- (forall (s : Reg), In s (getdst l1) ->  l = s \/ Loc.diff l s) ->
-  noOverlap_aux l (getdst l1).
-Proof.
-intros; induction l1; simpl; auto.
-destruct a as [a1 a2]; simpl; split.
-elim (H a2); (try intros H0).
-left; auto.
-right; apply Loc.diff_sym; auto.
-simpl; left; trivial.
-apply IHl1; intros.
-apply H; simpl; right; (try assumption).
-Qed.
- 
-Lemma no_overlap_noOverlap:
- forall r, no_overlap_state r ->  noOverlap (StateToMove r ++ StateBeing r).
-Proof.
-intros r; unfold noOverlap, no_overlap_state.
-set (l1:=StateToMove r ++ StateBeing r).
-unfold no_overlap; intros H l H0.
-apply Indst_noOverlap_aux; intros; apply H; auto.
-Qed.
- 
-Theorem Fpmov_correctMoves:
- forall p e r,
- simpleDest p ->
- no_overlap_list p ->
- noTmp p ->
- notemporary r ->
- (forall (x : Reg), In x (getdst p) ->  r = x \/ Loc.diff r x) ->
-  get (pexec p e) r = get (sexec (StateDone (Pmov (p, nil, nil))) e) r.
-Proof.
-intros p e r SD no_O notmp notempo.
-generalize (Fpmov_correct (p, nil, nil)); unfold sameExec, exec; simpl;
- rewrite SB_Pmov; rewrite STM_Pmov; simpl.
-(repeat rewrite app_nil); intro.
-apply H; auto.
-unfold stepInv; simpl; (repeat split); (try (rewrite app_nil; assumption)); auto.
-generalize (no_overlap_noOverlap (p, nil, nil)); simpl; intros; auto.
-apply H0; auto; unfold no_overlap_list in H0 |-.
-unfold no_overlap_state; simpl; (repeat rewrite app_nil); auto.
-Qed.
- 
-Theorem Fpmov_correct1:
- forall (p : Moves) (e : Env) (r : Reg),
- simpleDest p ->
- no_overlap_list p ->
- noTmp p ->
- notemporary r ->
- (forall (x : Reg), In x (getdst p) ->  r = x \/ Loc.diff r x) ->
- noWrite p r ->  get e r = get (sexec (StateDone (Pmov (p, nil, nil))) e) r.
-Proof.
-intros p e r Hsd Hno_O HnoTmp Hrnotempo Hrno_Overlap Hnw.
-rewrite <- (Fpmov_correctMoves p e); (try assumption).
-destruct p; auto.
-destruct m as [m1 m2]; simpl; case (Loc.eq m2 r); intros.
-elim Hnw; intros; absurd (Loc.diff m2 r); auto.
-rewrite e0; apply Loc.same_not_diff.
-elim Hnw; intros H1 H2.
-rewrite get_update_diff; (try assumption).
-apply get_noWrite; (try assumption).
-Qed.
- 
-Lemma In_SD_diff:
- forall (s d a1 a2 : Reg) (p : Moves),
- In (s, d) p -> simpleDest ((a1, a2) :: p) ->  Loc.diff a2 d.
-Proof.
-intros; induction p.
-inversion H.
-elim H; auto.
-intro; subst a; elim H0; intros H1 H2; elim H1; intros; apply Loc.diff_sym;
- assumption.
-intro; apply IHp; auto.
-apply simpleDest_pop2 with a; (try assumption).
-Qed.
- 
-Theorem pexec_correct:
- forall (e : Env) (m : Move) (p : Moves),
- In m p -> simpleDest p ->  (let (s, d) := m in get (pexec p e) d = get e s).
-Proof.
-induction p; intros.
-elim H.
-destruct m.
-elim (in_inv H); intro.
-rewrite H1; simpl; rewrite get_update_id; auto.
-destruct a as [a1 a2]; simpl.
-rewrite get_update_diff.
-apply IHp; auto.
-apply (simpleDest_pop (a1, a2)); (try assumption).
-apply (In_SD_diff r) with ( p := p ) ( a1 := a1 ); auto.
-Qed.
- 
-Lemma In_noTmp_notempo:
- forall (s d : Reg) (p : Moves), In (s, d) p -> noTmp p ->  notemporary d.
-Proof.
-intros; unfold notemporary; induction p.
-inversion H.
-elim H; intro.
-subst a; elim H0; intros H1 [H3 H2]; (try assumption).
-intro; apply IHp; auto.
-destruct a; elim H0; intros _ [H2 H3]; (try assumption).
-Qed.
- 
-Lemma In_Indst: forall s d p, In (s, d) p ->  In d (getdst p).
-Proof.
-intros; induction p; auto.
-destruct a; simpl.
-elim H; intro.
-left; inversion H0; trivial.
-right; apply IHp; auto.
-Qed.
- 
-Lemma In_SD_diff':
- forall (d a1 a2 : Reg) (p : Moves),
- In d (getdst p) -> simpleDest ((a1, a2) :: p) ->  Loc.diff a2 d.
-Proof.
-intros d a1 a2 p H H0; induction p.
-inversion H.
-destruct a; elim H.
-elim H0; simpl; intros.
-subst r0.
-elim H1; intros H3 H4; apply Loc.diff_sym; assumption.
-intro; apply IHp; (try assumption).
-apply simpleDest_pop2 with (r, r0); (try assumption).
-Qed.
- 
-Lemma In_SD_no_o:
- forall (s d : Reg) (p : Moves),
- In (s, d) p ->
- simpleDest p -> forall (x : Reg), In x (getdst p) ->  d = x \/ Loc.diff d x.
-Proof.
-intros s d p Hin Hsd; induction p.
-inversion Hin.
-destruct a as [a1 a2]; elim Hin; intros.
-inversion H; subst d; subst s.
-elim H0; intros H1; [left | right]; (try assumption).
-apply (In_SD_diff' x a1 a2 p); auto.
-elim H0.
-intro; subst x.
-right; apply Loc.diff_sym; apply (In_SD_diff s d a1 a2 p); auto.
-intro; apply IHp; auto.
-apply (simpleDest_pop (a1, a2)); assumption.
-Qed.
- 
-Lemma getdst_map: forall p,  getdst p = map (fun x => snd x) p.
-Proof.
-induction p.
-simpl; auto.
-destruct a; simpl.
-rewrite IHp; auto.
+Variables srcs dsts: list loc.
+Hypothesis LENGTH: List.length srcs = List.length dsts.
+Hypothesis NOREPET: Loc.norepet dsts.
+Hypothesis NO_OVERLAP: Loc.no_overlap srcs dsts.
+Hypothesis NO_SRCS_TEMP: Loc.disjoint srcs temporaries.
+Hypothesis NO_DSTS_TEMP: Loc.disjoint dsts temporaries.
+
+Definition no_overlap_dests (l: loc) : Prop :=
+  forall d, In d dsts -> l = d \/ Loc.diff l d.
+
+Lemma dests_no_overlap_dests:
+  forall l, In l dsts -> no_overlap_dests l.
+Proof.
+  assert (forall d, Loc.norepet d ->
+          forall l1 l2, In l1 d -> In l2 d -> l1 = l2 \/ Loc.diff l1 l2).
+  induction 1; simpl; intros.
+  contradiction.
+  elim H1; intro; elim H2; intro.
+  left; congruence.
+  right. subst l1. eapply Loc.in_notin_diff; eauto.
+  right. subst l2. apply Loc.diff_sym. eapply Loc.in_notin_diff; eauto.
+  eauto.
+  intros; red; intros. eauto. 
 Qed.
- 
-Lemma getsrc_map: forall p,  getsrc p = map (fun x => fst x) p.
+
+Lemma notin_dests_no_overlap_dests:
+  forall l, Loc.notin l dsts -> no_overlap_dests l.
 Proof.
-induction p.
-simpl; auto.
-destruct a; simpl.
-rewrite IHp; auto.
+  intros; red; intros.
+  right. eapply Loc.in_notin_diff; eauto.
 Qed.
- 
-Theorem Fpmov_correct2:
- forall (p : Moves) (e : Env) (m : Move),
- In m p ->
- simpleDest p ->
- no_overlap_list p ->
- noTmp p ->
-  (let (s, d) := m in get (sexec (StateDone (Pmov (p, nil, nil))) e) d = get e s).
+
+Lemma source_no_overlap_dests:
+  forall s, In s srcs \/ s = R IT2 \/ s = R FT2 -> no_overlap_dests s.
 Proof.
-intros p e m Hin Hsd Hno_O HnoTmp; destruct m as [s d];
- generalize (Fpmov_correctMoves p e); intros.
-rewrite <- H; auto.
-apply pexec_correct with ( m := (s, d) ); auto.
-apply (In_noTmp_notempo s d p); auto.
-apply (In_SD_no_o s d p Hin Hsd).
+  intros. elim H; intro. exact (NO_OVERLAP s H0). 
+  elim H0; intro; subst s; red; intros;
+  right; apply Loc.diff_sym; apply NO_DSTS_TEMP; auto; simpl; tauto.
 Qed.
- 
-Lemma notindst_nW: forall a p, Loc.notin a (getdst p) ->  noWrite p a.
+
+Lemma source_not_temp1:
+  forall s, In s srcs \/ s = R IT2 \/ s = R FT2 -> Loc.diff s (R IT1) /\ Loc.diff s (R FT1).
 Proof.
-induction p; simpl; auto.
-destruct a0 as [a1 a2].
-simpl.
-intros H; elim H; intro; split.
-apply Loc.diff_sym; (try assumption).
-apply IHp; auto.
+  intros. elim H; intro. 
+  split; apply NO_SRCS_TEMP; auto; simpl; tauto.
+  elim H0; intro; subst s; simpl; split; congruence.
 Qed.
- 
-Lemma disjoint_tmp__noTmp:
- forall p,
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->  noTmp p.
-Proof.
-induction p; simpl; auto.
-destruct a as [a1 a2]; simpl getsrc; simpl getdst; unfold Loc.disjoint; intros;
- (repeat split).
-intro; unfold T; case (Loc.type r); apply H; (try (left; trivial; fail)).
-right; left; trivial.
-right; right; right; right; left; trivial.
-intro; unfold T; case (Loc.type r); apply H0; (try (left; trivial; fail)).
-right; left; trivial.
-right; right; right; right; left; trivial.
-apply IHp.
-apply Loc.disjoint_cons_left with a1; auto.
-apply Loc.disjoint_cons_left with a2; auto.
+
+Lemma dest_noteq_diff:
+  forall d l, 
+  In d dsts \/ d = R IT2 \/ d = R FT2 ->
+  l <> d ->
+  no_overlap_dests l ->
+  Loc.diff l d.
+Proof.
+  intros. elim H; intro.
+  elim (H1 d H2); intro. congruence. auto.
+  assert (forall r, l <> R r -> Loc.diff l (R r)).
+    intros. destruct l; simpl. congruence. destruct s; auto.
+  elim H2; intro; subst d; auto.
 Qed.
- 
-Theorem Fpmov_correct_IT3:
- forall p rs,
- simpleDest p ->
- no_overlap_list p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
-  (sexec (StateDone (Pmov (p, nil, nil))) rs) (R IT3) = rs (R IT3).
-Proof.
-intros p rs Hsd Hno_O Hdistmpsrc Hdistmpdst.
-generalize (Fpmov_correctMoves p rs); unfold get, Locmap.get; intros H2.
-rewrite <- H2; auto.
-generalize (get_noWrite p (R IT3)); unfold get, Locmap.get; intros.
-rewrite <- H; auto.
-apply notindst_nW.
-apply (Loc.disjoint_notin temporaries).
-apply Loc.disjoint_sym; auto.
-right; right; left; trivial.
-apply disjoint_tmp__noTmp; auto.
-unfold notemporary, T.
-intros x; case (Loc.type x); simpl; intro; discriminate.
-intros x H; right; apply Loc.in_notin_diff with (getdst p); auto.
-apply Loc.disjoint_notin with temporaries; auto.
-apply Loc.disjoint_sym; auto.
-right; right; left; trivial.
+
+Definition locmap_equiv (e1 e2: Locmap.t): Prop :=
+  forall l,
+  no_overlap_dests l -> Loc.diff l (R IT1) -> Loc.diff l (R FT1) -> e2 l = e1 l.
+
+Definition effect_move (src dst: loc) (e e': Locmap.t): Prop :=
+  e' dst = e src /\
+  forall l, Loc.diff l dst -> Loc.diff l (R IT1) -> Loc.diff l (R FT1) -> e' l = e l.
+
+Inductive effect_seqmove: list (loc * loc) -> Locmap.t -> Locmap.t -> Prop :=
+  | effect_seqmove_nil: forall e,
+      effect_seqmove nil e e
+  | effect_seqmove_cons: forall s d m e1 e2 e3,
+      effect_move s d e1 e2 ->
+      effect_seqmove m e2 e3 ->
+      effect_seqmove ((s, d) :: m) e1 e3.
+
+Lemma effect_move_equiv:
+  forall s d e1 e2 e1',
+  (In s srcs \/ s = R IT2 \/ s = R FT2) ->
+  (In d dsts \/ d = R IT2 \/ d = R FT2) ->
+  locmap_equiv e1 e2 -> effect_move s d e1 e1' ->
+  locmap_equiv e1' (Parmov.update loc val Loc.eq d (e2 s) e2).
+Proof.
+  intros. destruct H2. red; intros. 
+  unfold Parmov.update. destruct (Loc.eq l d). 
+  subst l. elim (source_not_temp1 _ H); intros.
+  rewrite H2. apply H1; auto. apply source_no_overlap_dests; auto.
+  rewrite H3; auto. apply dest_noteq_diff; auto. 
 Qed.
- 
-Theorem Fpmov_correct_map:
- forall p rs,
- simpleDest p ->
- no_overlap_list p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
-  List.map (sexec (StateDone (Pmov (p, nil, nil))) rs) (getdst p) =
-  List.map rs (getsrc p).
-Proof.
-intros; rewrite getsrc_map; rewrite getdst_map; rewrite list_map_compose;
- rewrite list_map_compose; apply list_map_exten; intros.
-generalize (Fpmov_correct2 p rs x).
-destruct x; simpl.
-unfold get, Locmap.get; intros; auto.
-rewrite H4; auto.
-apply disjoint_tmp__noTmp; auto.
+
+Lemma effect_seqmove_equiv:
+  forall mu e1 e1',
+  effect_seqmove mu e1 e1' ->
+  forall e2,
+  (forall s d, In (s, d) mu ->
+     (In s srcs \/ s = R IT2 \/ s = R FT2) /\
+     (In d dsts \/ d = R IT2 \/ d = R FT2)) ->
+  locmap_equiv e1 e2 ->
+  locmap_equiv e1' (exec_seq mu e2).
+Proof.
+  induction 1; intros.
+  simpl. auto.
+  simpl. apply IHeffect_seqmove. 
+  intros. apply H1. apply in_cons; auto. 
+  destruct (H1 s d (in_eq _ _)).
+  eapply effect_move_equiv; eauto. 
 Qed.
- 
-Theorem Fpmov_correct_ext:
- forall p rs,
- simpleDest p ->
- no_overlap_list p ->
- Loc.disjoint (getsrc p) temporaries ->
- Loc.disjoint (getdst p) temporaries ->
- forall l,
- Loc.notin l (getdst p) ->
- Loc.notin l temporaries ->
-  (sexec (StateDone (Pmov (p, nil, nil))) rs) l = rs l.
-Proof.
-intros; generalize (Fpmov_correct1 p rs l); unfold get, Locmap.get; intros.
-rewrite <- H5; auto.
-apply disjoint_tmp__noTmp; auto.
-unfold notemporary; simpl in H4 |-; unfold T; intros x; case (Loc.type x).
-elim H4;
- [intros H6 H7; elim H7; [intros H8 H9; (try clear H7 H4); (try exact H8)]].
-elim H4;
- [intros H6 H7; elim H7;
-   [intros H8 H9; elim H9;
-     [intros H10 H11; elim H11;
-       [intros H12 H13; elim H13;
-         [intros H14 H15; (try clear H13 H11 H9 H7 H4); (try exact H14)]]]]].
-unfold no_overlap_list, no_overlap in H0 |-; intros.
-case (Loc.eq l x).
-intros e; left; (try assumption).
-intros n; right; (try assumption).
-apply Loc.in_notin_diff with (getdst p); auto.
-apply notindst_nW; auto.
+
+Lemma effect_parmove:
+  forall e e',
+  effect_seqmove (parmove srcs dsts) e e' ->
+  List.map e' dsts = List.map e srcs /\
+  e' (R IT3) = e (R IT3) /\
+  forall l, Loc.notin l dsts -> Loc.notin l temporaries -> e' l = e l.
+Proof.
+  set (mu := parmove srcs dsts). intros.
+  assert (locmap_equiv e e) by (red; auto).
+  generalize (effect_seqmove_equiv mu e e' H e (parmove_prop_2 srcs dsts) H0).
+  intro. 
+  generalize (parmove_prop_1 srcs dsts LENGTH NOREPET NO_SRCS_TEMP NO_DSTS_TEMP e).
+  fold mu. intros [A B]. 
+  (* e' dsts = e srcs *)
+  split. rewrite <- A. apply list_map_exten; intros. 
+  apply H1. apply dests_no_overlap_dests; auto.
+  apply NO_DSTS_TEMP; auto; simpl; tauto.
+  apply NO_DSTS_TEMP; auto; simpl; tauto.
+  (* e' IT3 = e IT3 *)
+  split. 
+  assert (Loc.notin (R IT3) dsts).
+  apply Loc.disjoint_notin with temporaries. 
+  apply Loc.disjoint_sym; auto. simpl; tauto. 
+  transitivity (exec_seq mu e (R IT3)). 
+  symmetry. apply H1. apply notin_dests_no_overlap_dests. auto.
+  simpl; congruence. simpl; congruence.
+  apply B. apply Loc.notin_not_in; auto. congruence. congruence.
+  (* other locations *)
+  intros. transitivity (exec_seq mu e l). 
+  symmetry. apply H1. apply notin_dests_no_overlap_dests; auto.
+  eapply Loc.in_notin_diff; eauto. simpl; tauto.
+  eapply Loc.in_notin_diff; eauto. simpl; tauto.
+  apply B. apply Loc.notin_not_in; auto.
+  apply Loc.diff_not_eq. eapply Loc.in_notin_diff; eauto. simpl; tauto.
+  apply Loc.diff_not_eq. eapply Loc.in_notin_diff; eauto. simpl; tauto.
 Qed.
+
+End EQUIVALENCE.
+
diff --git a/backend/RTL.v b/backend/RTL.v
index ac9a415..4a3f8e8 100644
--- a/backend/RTL.v
+++ b/backend/RTL.v
@@ -4,12 +4,13 @@
   after Cminor.
 *)
 
-Require Import Relations.
+(*Require Import Relations.*)
 Require Import Coqlib.
 Require Import Maps.
 Require Import AST.
 Require Import Integers.
 Require Import Values.
+Require Import Events.
 Require Import Mem.
 Require Import Globalenvs.
 Require Import Op.
@@ -54,6 +55,10 @@ Inductive instruction: Set :=
           function name), giving it the values of registers [args] 
           as arguments.  It stores the return value in [dest] and branches
           to [succ]. *)
+  | Ialloc: reg -> reg -> node -> instruction
+      (** [Ialloc arg dest succ] allocates a fresh block of size
+          the contents of register [arg], stores a pointer to this
+          block in [dest], and branches to [succ]. *)
   | Icond: condition -> list reg -> node -> node -> instruction
       (** [Icond cond args ifso ifnot] evaluates the boolean condition
           [cond] over the values of registers [args].  If the condition
@@ -85,11 +90,19 @@ Record function: Set := mkfunction {
     in the CFG.  [fn_code_wf] asserts that all instructions of the function
     have nodes no greater than [fn_nextpc]. *)
 
-Definition program := AST.program function.
+Definition fundef := AST.fundef function.
+
+Definition program := AST.program fundef.
+
+Definition funsig (fd: fundef) :=
+  match fd with
+  | Internal f => f.(fn_sig)
+  | External ef => ef.(ef_sig)
+  end.
 
 (** * Operational semantics *)
 
-Definition genv := Genv.t function.
+Definition genv := Genv.t fundef.
 Definition regset := Regmap.t val.
 
 Fixpoint init_regs (vl: list val) (rl: list reg) {struct rl} : regset :=
@@ -102,7 +115,8 @@ Section RELSEM.
 
 Variable ge: genv.
 
-Definition find_function (ros: reg + ident) (rs: regset) : option function :=
+Definition find_function
+      (ros: reg + ident) (rs: regset) : option fundef :=
   match ros with
   | inl r => Genv.find_funct ge rs#r
   | inr symb =>
@@ -132,66 +146,73 @@ Definition find_function (ros: reg + ident) (rs: regset) : option function :=
   and memory state [m].  The final state is [pc'], [rs'] and [m']. *)
 
 Inductive exec_instr: code -> val ->
-                      node -> regset -> mem ->
+                      node -> regset -> mem -> trace ->
                       node -> regset -> mem -> Prop :=
   | exec_Inop:
       forall c sp pc rs m pc',
       c!pc = Some(Inop pc') ->
-      exec_instr c sp  pc rs m  pc' rs m
+      exec_instr c sp  pc rs m  E0 pc' rs m
   | exec_Iop:
       forall c sp pc rs m op args res pc' v,
       c!pc = Some(Iop op args res pc') ->
       eval_operation ge sp op rs##args = Some v ->
-      exec_instr c sp  pc rs m  pc' (rs#res <- v) m
+      exec_instr c sp  pc rs m  E0 pc' (rs#res <- v) m
   | exec_Iload:
       forall c sp pc rs m chunk addr args dst pc' a v,
       c!pc = Some(Iload chunk addr args dst pc') ->
       eval_addressing ge sp addr rs##args = Some a ->
       Mem.loadv chunk m a = Some v ->
-      exec_instr c sp  pc rs m  pc' (rs#dst <- v) m
+      exec_instr c sp  pc rs m  E0 pc' (rs#dst <- v) m
   | exec_Istore:
       forall c sp pc rs m chunk addr args src pc' a m',
       c!pc = Some(Istore chunk addr args src pc') ->
       eval_addressing ge sp addr rs##args = Some a ->
       Mem.storev chunk m a rs#src = Some m' ->
-      exec_instr c sp  pc rs m  pc' rs m'
+      exec_instr c sp  pc rs m  E0 pc' rs m'
   | exec_Icall:
-      forall c sp pc rs m sig ros args res pc' f vres m',
+      forall c sp pc rs m sig ros args res pc' f vres m' t,
       c!pc = Some(Icall sig ros args res pc') ->
       find_function ros rs = Some f ->
-      sig = f.(fn_sig) ->
-      exec_function f rs##args m vres m' ->
-      exec_instr c sp  pc rs m  pc' (rs#res <- vres) m'
+      funsig f = sig ->
+      exec_function f rs##args m t vres m' ->
+      exec_instr c sp  pc rs m  t pc' (rs#res <- vres) m'
+  | exec_Ialloc:
+      forall c sp pc rs m pc' arg res sz m' b,
+      c!pc = Some(Ialloc arg res pc') ->
+      rs#arg = Vint sz ->
+      Mem.alloc m 0 (Int.signed sz) = (m', b) ->
+      exec_instr c sp  pc rs m E0 pc' (rs#res <- (Vptr b Int.zero)) m'
   | exec_Icond_true:
       forall c sp pc rs m cond args ifso ifnot,
       c!pc = Some(Icond cond args ifso ifnot) ->
       eval_condition cond rs##args = Some true ->
-      exec_instr c sp  pc rs m  ifso rs m
+      exec_instr c sp  pc rs m  E0 ifso rs m
   | exec_Icond_false:
       forall c sp pc rs m cond args ifso ifnot,
       c!pc = Some(Icond cond args ifso ifnot) ->
       eval_condition cond rs##args = Some false ->
-      exec_instr c sp  pc rs m  ifnot rs m
+      exec_instr c sp  pc rs m  E0 ifnot rs m
 
 (** [exec_instrs ge c sp pc rs m pc' rs' m'] is the reflexive
   transitive closure of [exec_instr].  It corresponds to the execution
   of zero, one or finitely many transitions. *)
 
 with exec_instrs: code -> val ->
-                  node -> regset -> mem ->
+                  node -> regset -> mem -> trace ->
                   node -> regset -> mem -> Prop :=
   | exec_refl:
       forall c sp pc rs m,
-      exec_instrs c sp pc rs m pc rs m
+      exec_instrs c sp pc rs m E0 pc rs m
   | exec_one:
-      forall c sp pc rs m pc' rs' m',
-      exec_instr c sp pc rs m pc' rs' m' ->
-      exec_instrs c sp pc rs m pc' rs' m'
+      forall c sp pc rs m t pc' rs' m',
+      exec_instr c sp pc rs m t pc' rs' m' ->
+      exec_instrs c sp pc rs m t pc' rs' m'
   | exec_trans:
-      forall c sp pc1 rs1 m1 pc2 rs2 m2 pc3 rs3 m3,
-      exec_instrs c sp pc1 rs1 m1 pc2 rs2 m2 ->
-      exec_instrs c sp pc2 rs2 m2 pc3 rs3 m3 ->
-      exec_instrs c sp pc1 rs1 m1 pc3 rs3 m3
+      forall c sp pc1 rs1 m1 t1 pc2 rs2 m2 t2 pc3 rs3 m3 t3,
+      exec_instrs c sp pc1 rs1 m1 t1 pc2 rs2 m2 ->
+      exec_instrs c sp pc2 rs2 m2 t2 pc3 rs3 m3 ->
+      t3 = t1 ** t2 ->
+      exec_instrs c sp pc1 rs1 m1 t3 pc3 rs3 m3
 
 (** [exec_function ge f args m res m'] executes a function application.
   [f] is the called function, [args] the values of its arguments,
@@ -205,17 +226,21 @@ with exec_instrs: code -> val ->
   (Non-parameter registers are initialized to [Vundef].)  Before returning,
   the stack activation block is freed. *)
 
-with exec_function: function -> list val -> mem ->
-                                val -> mem -> Prop :=
-  | exec_funct:
-      forall f m m1 stk args pc rs m2 or vres,
+with exec_function: fundef -> list val -> mem -> trace ->
+                              val -> mem -> Prop :=
+  | exec_funct_internal:
+      forall f m m1 stk args t pc rs m2 or vres,
       Mem.alloc m 0 f.(fn_stacksize) = (m1, stk) ->
-      exec_instrs f.(fn_code) (Vptr stk Int.zero)
+      exec_instrs f.(fn_code) (Vptr stk Int.zero) 
                   f.(fn_entrypoint) (init_regs args f.(fn_params)) m1
-                  pc rs m2 ->
+                  t pc rs m2 ->
       f.(fn_code)!pc = Some(Ireturn or) ->
       vres = regmap_optget or Vundef rs ->
-      exec_function f args m vres (Mem.free m2 stk).
+      exec_function (Internal f) args m t vres (Mem.free m2 stk)
+  | exec_funct_external:
+      forall ef args m t res,
+      event_match ef args t res ->
+      exec_function (External ef) args m t res m.
 
 Scheme exec_instr_ind_3 := Minimality for exec_instr Sort Prop
   with exec_instrs_ind_3 := Minimality for exec_instrs Sort Prop
@@ -224,12 +249,13 @@ Scheme exec_instr_ind_3 := Minimality for exec_instr Sort Prop
 (** Some derived execution rules. *)
 
 Lemma exec_step:
-  forall c sp pc1 rs1 m1 pc2 rs2 m2 pc3 rs3 m3,
-  exec_instr c sp pc1 rs1 m1 pc2 rs2 m2 ->
-  exec_instrs c sp pc2 rs2 m2 pc3 rs3 m3 ->
-  exec_instrs c sp pc1 rs1 m1 pc3 rs3 m3.
+  forall c sp pc1 rs1 m1 t1 pc2 rs2 m2 t2 pc3 rs3 m3 t3,
+  exec_instr c sp pc1 rs1 m1 t1 pc2 rs2 m2 ->
+  exec_instrs c sp pc2 rs2 m2 t2 pc3 rs3 m3 ->
+  t3 = t1 ** t2 ->
+  exec_instrs c sp pc1 rs1 m1 t3 pc3 rs3 m3.
 Proof.
-  intros. eapply exec_trans. apply exec_one. eauto. eauto.
+  intros. eapply exec_trans. apply exec_one. eauto. eauto. auto.
 Qed.
 
 Lemma exec_Iop':
@@ -237,7 +263,7 @@ Lemma exec_Iop':
   c!pc = Some(Iop op args res pc') ->
   eval_operation ge sp op rs##args = Some v ->
   rs' = (rs#res <- v) ->
-  exec_instr c sp  pc rs m  pc' rs' m.
+  exec_instr c sp  pc rs m  E0 pc' rs' m.
 Proof.
   intros. subst rs'. eapply exec_Iop; eauto.
 Qed.
@@ -248,7 +274,7 @@ Lemma exec_Iload':
   eval_addressing ge sp addr rs##args = Some a ->
   Mem.loadv chunk m a = Some v ->
   rs' = (rs#dst <- v) ->
-  exec_instr c sp  pc rs m  pc' rs' m.
+  exec_instr c sp  pc rs m E0 pc' rs' m.
 Proof.
   intros. subst rs'. eapply exec_Iload; eauto.
 Qed.
@@ -257,16 +283,16 @@ Qed.
   is defined in the CFG. *)
 
 Lemma exec_instr_present:
-  forall c sp pc rs m pc' rs' m',
-  exec_instr c sp  pc rs m  pc' rs' m' ->
+  forall c sp pc rs m t pc' rs' m',
+  exec_instr c sp  pc rs m  t pc' rs' m' ->
   c!pc <> None.
 Proof.
   induction 1; congruence.
 Qed.
 
 Lemma exec_instrs_present:
-  forall c sp pc rs m pc' rs' m',
-  exec_instrs c sp  pc rs m  pc' rs' m' ->
+  forall c sp pc rs m t pc' rs' m',
+  exec_instrs c sp  pc rs m  t pc' rs' m' ->
   c!pc' <> None -> c!pc <> None.
 Proof.
   induction 1; intros.
@@ -280,14 +306,14 @@ End RELSEM.
 (** Execution of whole programs.  As in Cminor, we call the ``main'' function
   with no arguments and observe its return value. *)
 
-Definition exec_program (p: program) (r: val) : Prop :=
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
   let ge := Genv.globalenv p in
   let m0 := Genv.init_mem p in
   exists b, exists f, exists m,
   Genv.find_symbol ge p.(prog_main) = Some b /\
   Genv.find_funct_ptr ge b = Some f /\
-  f.(fn_sig) = mksignature nil (Some Tint) /\
-  exec_function ge f nil m0 r m.
+  funsig f = mksignature nil (Some Tint) /\
+  exec_function ge f nil m0 t r m.
 
 (** * Operations on RTL abstract syntax *)
 
@@ -304,14 +330,15 @@ Definition successors (f: function) (pc: node) : list node :=
       | Iload chunk addr args dst s => s :: nil
       | Istore chunk addr args src s => s :: nil
       | Icall sig ros args res s => s :: nil
+      | Ialloc arg res s => s :: nil
       | Icond cond args ifso ifnot => ifso :: ifnot :: nil
       | Ireturn optarg => nil
       end
   end.
 
 Lemma successors_correct:
-  forall ge f sp pc rs m pc' rs' m',
-  exec_instr ge f.(fn_code) sp pc rs m pc' rs' m' ->
+  forall ge f sp pc rs m t pc' rs' m',
+  exec_instr ge f.(fn_code) sp pc rs m t pc' rs' m' ->
   In pc' (successors f pc).
 Proof.
   intros ge f. unfold successors. generalize (fn_code f).
@@ -345,5 +372,5 @@ Definition transf_function (f: function) : function :=
     f.(fn_entrypoint)
     f.(fn_nextpc)
     (transf_code_wf f.(fn_code) f.(fn_nextpc) f.(fn_code_wf)).
-    
+
 End TRANSF.
diff --git a/backend/RTLgen.v b/backend/RTLgen.v
index 38b19a0..a5c3ae7 100644
--- a/backend/RTLgen.v
+++ b/backend/RTLgen.v
@@ -28,6 +28,7 @@ Fixpoint mutated_expr (a: expr) : list ident :=
   | Econdition b c d => mutated_condexpr b ++ mutated_expr c ++ mutated_expr d
   | Elet b c => mutated_expr b ++ mutated_expr c
   | Eletvar n => nil
+  | Ealloc b => mutated_expr b
   end
 
 with mutated_condexpr (a: condexpr) : list ident :=
@@ -328,6 +329,10 @@ Fixpoint transl_expr (map: mapping) (mut: list ident)
          transl_expr map mut b r nc
   | Eletvar n =>
       do r <- find_letvar map n; add_move r rd nd
+  | Ealloc a =>
+      do r <- alloc_reg map mut a;
+      do no <- add_instr (Ialloc r rd nd);
+         transl_expr map mut a r no
   end
 
 (** Translation of a conditional expression.  Similar to [transl_expr],
@@ -473,16 +478,18 @@ Definition transl_function (f: Cminor.function) : option RTL.function :=
   | Error => None
   | OK (nentry, rparams) s =>
       Some (RTL.mkfunction
-        f.(Cminor.fn_sig)
-        rparams
-        f.(Cminor.fn_stackspace)
-        s.(st_code)
-        nentry
-        s.(st_nextnode)
-        s.(st_wf))
+             f.(Cminor.fn_sig)
+             rparams
+             f.(Cminor.fn_stackspace)
+             s.(st_code)
+             nentry
+             s.(st_nextnode)
+             s.(st_wf))
   end.
 
+Definition transl_fundef := transf_partial_fundef transl_function.
+
 (** Translation of a whole program. *)
 
 Definition transl_program (p: Cminor.program) : option RTL.program :=
-  transform_partial_program transl_function p.
+  transform_partial_program transl_fundef p.
diff --git a/backend/RTLgenproof.v b/backend/RTLgenproof.v
index d34bae9..24cc41b 100644
--- a/backend/RTLgenproof.v
+++ b/backend/RTLgenproof.v
@@ -6,6 +6,7 @@ Require Import AST.
 Require Import Integers.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Registers.
@@ -30,45 +31,59 @@ Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
 Proof.
   intro. unfold ge, tge. 
-  apply Genv.find_symbol_transf_partial with transl_function.
+  apply Genv.find_symbol_transf_partial with transl_fundef.
   exact TRANSL.
 Qed.
 
 Lemma function_ptr_translated:
-  forall (b: block) (f: Cminor.function),
+  forall (b: block) (f: Cminor.fundef),
   Genv.find_funct_ptr ge b = Some f ->
   exists tf,
-  Genv.find_funct_ptr tge b = Some tf /\ transl_function f = Some tf.
+  Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = Some tf.
 Proof.
   intros. 
   generalize 
-   (Genv.find_funct_ptr_transf_partial transl_function TRANSL H).
-  case (transl_function f).
+   (Genv.find_funct_ptr_transf_partial transl_fundef TRANSL H).
+  case (transl_fundef f).
   intros tf [A B]. exists tf. tauto.
   intros [A B]. elim B. reflexivity.
 Qed.
 
 Lemma functions_translated:
-  forall (v: val) (f: Cminor.function),
+  forall (v: val) (f: Cminor.fundef),
   Genv.find_funct ge v = Some f ->
   exists tf,
-  Genv.find_funct tge v = Some tf /\ transl_function f = Some tf.
+  Genv.find_funct tge v = Some tf /\ transl_fundef f = Some tf.
 Proof.
   intros. 
   generalize 
-   (Genv.find_funct_transf_partial transl_function TRANSL H).
-  case (transl_function f).
+   (Genv.find_funct_transf_partial transl_fundef TRANSL H).
+  case (transl_fundef f).
   intros tf [A B]. exists tf. tauto.
   intros [A B]. elim B. reflexivity.
 Qed.
 
+Lemma sig_transl_function:
+  forall (f: Cminor.fundef) (tf: RTL.fundef),
+  transl_fundef f = Some tf ->
+  RTL.funsig tf = Cminor.funsig f.
+Proof.
+  intros until tf. unfold transl_fundef, transf_partial_fundef.
+  case f; intro.
+  unfold transl_function. 
+  case (transl_fun f0 init_state); intros.
+  discriminate.
+  destruct p. inversion H. reflexivity.
+  intro. inversion H. reflexivity.
+Qed.
+
 (** Correctness of the code generated by [add_move]. *)
 
 Lemma add_move_correct:
   forall r1 r2 sp nd s ns s' rs m,
   add_move r1 r2 nd s = OK ns s' ->
   exists rs',
-  exec_instrs tge s'.(st_code) sp ns rs m  nd rs' m /\
+  exec_instrs tge s'.(st_code) sp ns rs m E0 nd rs' m /\
   rs'#r2 = rs#r1 /\
   (forall r, r <> r2 -> rs'#r = rs#r).
 Proof.
@@ -118,7 +133,7 @@ Qed.
 
 Definition transl_expr_correct 
   (sp: val) (le: letenv) (e: env) (m: mem) (a: expr)
-                         (e': env) (m': mem) (v: val) : Prop :=
+              (t: trace) (e': env) (m': mem) (v: val) : Prop :=
   forall map mut rd nd s ns s' rs
     (MWF: map_wf map s)
     (TE: transl_expr map mut a rd nd s = OK ns s')
@@ -126,7 +141,7 @@ Definition transl_expr_correct
     (MUT: incl (mutated_expr a) mut)
     (TRG: target_reg_ok s map mut a rd),
   exists rs',
-     exec_instrs tge s'.(st_code) sp ns rs m nd rs' m'
+     exec_instrs tge s'.(st_code) sp ns rs m t nd rs' m'
   /\ match_env map e' le rs'
   /\ rs'#rd = v
   /\ (forall r,
@@ -139,7 +154,7 @@ Definition transl_expr_correct
 
 Definition transl_exprlist_correct 
   (sp: val) (le: letenv) (e: env) (m: mem) (al: exprlist)
-                         (e': env) (m': mem) (vl: list val) : Prop :=
+              (t: trace) (e': env) (m': mem) (vl: list val) : Prop :=
   forall map mut rl nd s ns s' rs
     (MWF: map_wf map s)
     (TE: transl_exprlist map mut al rl nd s = OK ns s')
@@ -147,7 +162,7 @@ Definition transl_exprlist_correct
     (MUT: incl (mutated_exprlist al) mut)
     (TRG: target_regs_ok s map mut al rl),
   exists rs',
-     exec_instrs tge s'.(st_code) sp ns rs m nd rs' m'
+     exec_instrs tge s'.(st_code) sp ns rs m t nd rs' m'
   /\ match_env map e' le rs'
   /\ rs'##rl = vl
   /\ (forall r,
@@ -157,14 +172,14 @@ Definition transl_exprlist_correct
 
 Definition transl_condition_correct 
   (sp: val) (le: letenv) (e: env) (m: mem) (a: condexpr)
-                         (e': env) (m': mem) (vb: bool) : Prop :=
+              (t: trace) (e': env) (m': mem) (vb: bool) : Prop :=
   forall map mut ntrue nfalse s ns s' rs
     (MWF: map_wf map s)
     (TE: transl_condition map mut a ntrue nfalse s = OK ns s')
     (ME: match_env map e le rs)
     (MUT: incl (mutated_condexpr a) mut),
   exists rs',
-     exec_instrs tge s'.(st_code) sp ns rs m (if vb then ntrue else nfalse) rs' m'
+     exec_instrs tge s'.(st_code) sp ns rs m t (if vb then ntrue else nfalse) rs' m'
   /\ match_env map e' le rs'
   /\ (forall r,
         reg_valid r s -> ~(mutated_reg map mut r) ->
@@ -233,7 +248,7 @@ Definition match_return_outcome
 
 Definition transl_stmt_correct 
   (sp: val) (e: env) (m: mem) (a: stmt)
-            (e': env) (m': mem) (out: outcome) : Prop :=
+  (t: trace) (e': env) (m': mem) (out: outcome) : Prop :=
   forall map ncont nexits nret rret s ns s' nd rs
     (MWF: map_wf map s)
     (TE: transl_stmt map a ncont nexits nret rret s = OK ns s')
@@ -241,7 +256,7 @@ Definition transl_stmt_correct
     (OUT: outcome_node out ncont nexits nret nd)
     (RRG: return_reg_ok s map rret),
   exists rs',
-     exec_instrs tge s'.(st_code) sp ns rs m nd rs' m'
+     exec_instrs tge s'.(st_code) sp ns rs m t nd rs' m'
   /\ match_env map e' nil rs'
   /\ match_return_outcome out rret rs'.
 
@@ -251,11 +266,11 @@ Definition transl_stmt_correct
   the same modifications on the memory state. *)
 
 Definition transl_function_correct
-    (m: mem) (f: Cminor.function) (vargs: list val)
-    (m':mem) (vres: val) : Prop :=
+    (m: mem) (f: Cminor.fundef) (vargs: list val)
+    (t: trace) (m':mem) (vres: val) : Prop :=
   forall tf
-    (TE: transl_function f = Some tf),
-  exec_function tge tf vargs m vres m'.
+    (TE: transl_fundef f = Some tf),
+  exec_function tge tf vargs m t vres m'.
 
 (** The correctness of the translation is a huge induction over
   the Cminor evaluation derivation for the source program.  To keep
@@ -268,7 +283,7 @@ Definition transl_function_correct
 Lemma transl_expr_Evar_correct:
   forall (sp: val) (le: letenv) (e: env) (m: mem) (id: ident) (v: val),
   e!id = Some v ->
-  transl_expr_correct sp le e m (Evar id) e m v.
+  transl_expr_correct sp le e m (Evar id) E0 e m v.
 Proof.
   intros; red; intros. monadInv TE. intro. 
   generalize EQ; unfold find_var. caseEq (map_vars map)!id.
@@ -303,12 +318,12 @@ Qed.
 
 Lemma transl_expr_Eop_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem) (op : operation)
-         (al : exprlist) (e1 : env) (m1 : mem) (vl : list val)
+         (al : exprlist) (t: trace) (e1 : env) (m1 : mem) (vl : list val)
          (v: val),
-  eval_exprlist ge sp le e m al e1 m1 vl ->
-  transl_exprlist_correct sp le e m al e1 m1 vl ->
+  eval_exprlist ge sp le e m al t e1 m1 vl ->
+  transl_exprlist_correct sp le e m al t e1 m1 vl ->
   eval_operation ge sp op vl = Some v ->
-  transl_expr_correct sp le e m (Eop op al) e1 m1 v.
+  transl_expr_correct sp le e m (Eop op al) t e1 m1 v.
 Proof.
   intros until v. intros EEL TEL EOP. red; intros.
   simpl in TE. monadInv TE. intro EQ1. 
@@ -323,9 +338,9 @@ Proof.
   apply exec_instrs_incr with s1. eauto with rtlg.
   apply exec_one; eapply exec_Iop. eauto with rtlg.
   subst vl. 
-  rewrite (@eval_operation_preserved Cminor.function RTL.function ge tge). 
+  rewrite (@eval_operation_preserved Cminor.fundef RTL.fundef ge tge). 
   eexact EOP.
-  exact symbols_preserved.
+  exact symbols_preserved. traceEq.
 (* Match-env *)
   split. inversion TRG. eauto with rtlg.
 (* Result reg *)
@@ -344,11 +359,11 @@ Qed.
 
 Lemma transl_expr_Eassign_correct:
  forall (sp: val) (le : letenv) (e : env) (m : mem) 
-    (id : ident) (a : expr) (e1 : env) (m1 : mem) 
+    (id : ident) (a : expr) (t: trace) (e1 : env) (m1 : mem) 
     (v : val),
-  eval_expr ge sp le e m a e1 m1 v ->
-  transl_expr_correct sp le e m a e1 m1 v ->
-  transl_expr_correct sp le e m (Eassign id a) (PTree.set id v e1) m1 v.
+  eval_expr ge sp le e m a t e1 m1 v ->
+  transl_expr_correct sp le e m a t e1 m1 v ->
+  transl_expr_correct sp le e m (Eassign id a) t (PTree.set id v e1) m1 v.
 Proof.
   intros; red; intros.
   simpl in TE. monadInv TE. intro EQ1. 
@@ -366,7 +381,7 @@ Proof.
 (* Exec *)
   split. eapply exec_trans. eexact EX1.
   apply exec_instrs_incr with s1. eauto with rtlg.
-  exact EX2. 
+  eexact EX2. traceEq.
 (* Match-env *)
   split. 
   apply match_env_update_var with rs1 r s s0; auto.
@@ -387,13 +402,13 @@ Qed.
 Lemma transl_expr_Eload_correct:
  forall (sp: val) (le : letenv) (e : env) (m : mem)
     (chunk : memory_chunk) (addr : addressing) 
-    (al : exprlist) (e1 : env) (m1 : mem) (v : val) 
+    (al : exprlist) (t: trace) (e1 : env) (m1 : mem) (v : val) 
     (vl : list val) (a: val),
-  eval_exprlist ge sp le e m al e1 m1 vl ->
-  transl_exprlist_correct sp le e m al e1 m1 vl ->
+  eval_exprlist ge sp le e m al t e1 m1 vl ->
+  transl_exprlist_correct sp le e m al t e1 m1 vl ->
   eval_addressing ge sp addr vl = Some a ->
   Mem.loadv chunk m1 a = Some v ->
-  transl_expr_correct sp le e m (Eload chunk addr al) e1 m1 v.
+  transl_expr_correct sp le e m (Eload chunk addr al) t e1 m1 v.
 Proof.
   intros; red; intros. simpl in TE. monadInv TE. intro EQ1. clear TE.
   simpl in MUT.
@@ -407,7 +422,7 @@ Proof.
   apply exec_instrs_incr with s1. eauto with rtlg.
   apply exec_one. eapply exec_Iload. eauto with rtlg.
   rewrite RES1. rewrite (@eval_addressing_preserved _ _ ge tge).
-  eexact H1. exact symbols_preserved. assumption.
+  eexact H1. exact symbols_preserved. assumption. traceEq.
 (* Match-env *)
   split. eapply match_env_update_temp. assumption. inversion TRG. assumption.
 (* Result *)
@@ -425,16 +440,17 @@ Qed.
 Lemma transl_expr_Estore_correct:
  forall (sp: val) (le : letenv) (e : env) (m : mem)
     (chunk : memory_chunk) (addr : addressing) 
-    (al : exprlist) (b : expr) (e1 : env) (m1 : mem) 
-    (vl : list val) (e2 : env) (m2 m3 : mem) 
+    (al : exprlist) (b : expr) (t t1: trace) (e1 : env) (m1 : mem) 
+    (vl : list val) (t2: trace) (e2 : env) (m2 m3 : mem) 
     (v : val) (a: val),
-  eval_exprlist ge sp le e m al e1 m1 vl ->
-  transl_exprlist_correct sp le e m al e1 m1 vl ->
-  eval_expr ge sp le e1 m1 b e2 m2 v ->
-  transl_expr_correct sp le e1 m1 b e2 m2 v ->
+  eval_exprlist ge sp le e m al t1 e1 m1 vl ->
+  transl_exprlist_correct sp le e m al t1 e1 m1 vl ->
+  eval_expr ge sp le e1 m1 b t2 e2 m2 v ->
+  transl_expr_correct sp le e1 m1 b t2 e2 m2 v ->
   eval_addressing ge sp addr vl = Some a -> 
   Mem.storev chunk m2 a v = Some m3 ->
-  transl_expr_correct sp le e m (Estore chunk addr al b) e2 m3 v.
+  t = t1 ** t2 ->
+  transl_expr_correct sp le e m (Estore chunk addr al b) t e2 m3 v.
 Proof.
   intros; red; intros. simpl in TE; monadInv TE. intro EQ2; clear TE.
   simpl in MUT. 
@@ -467,10 +483,11 @@ Proof.
     tauto. right. apply sym_not_equal. 
     apply valid_fresh_different with s. inversion TRG; assumption.
     assumption.
-  rewrite H5; rewrite RES1. 
+  rewrite H6; rewrite RES1. 
   rewrite (@eval_addressing_preserved _ _ ge tge).
   eexact H3. exact symbols_preserved. 
   rewrite RES2. assumption.
+  reflexivity. traceEq. 
 (* Match-env *)
   split. assumption.
 (* Result *)
@@ -488,18 +505,20 @@ Qed.
 
 Lemma transl_expr_Ecall_correct:
  forall (sp: val) (le : letenv) (e : env) (m : mem) 
-    (sig : signature) (a : expr) (bl : exprlist) 
-    (e1 e2 : env) (m1 m2 m3 : mem) (vf : val) 
-    (vargs : list val) (vres : val) (f : Cminor.function),
-  eval_expr ge sp le e m a e1 m1 vf ->
-  transl_expr_correct sp le e m a e1 m1 vf ->
-  eval_exprlist ge sp le e1 m1 bl e2 m2 vargs ->
-  transl_exprlist_correct sp le e1 m1 bl e2 m2 vargs ->
+    (sig : signature) (a : expr) (bl : exprlist) (t t1: trace)
+    (e1: env) (m1: mem) (t2: trace) (e2 : env) (m2 : mem) 
+    (t3: trace) (m3: mem) (vf : val) 
+    (vargs : list val) (vres : val) (f : Cminor.fundef),
+  eval_expr ge sp le e m a t1 e1 m1 vf ->
+  transl_expr_correct sp le e m a t1 e1 m1 vf ->
+  eval_exprlist ge sp le e1 m1 bl t2 e2 m2 vargs ->
+  transl_exprlist_correct sp le e1 m1 bl t2 e2 m2 vargs ->
   Genv.find_funct ge vf = Some f ->
-  Cminor.fn_sig f = sig ->
-  eval_funcall ge m2 f vargs m3 vres ->
-  transl_function_correct m2 f vargs m3 vres ->
-  transl_expr_correct sp le e m (Ecall sig a bl) e2 m3 vres.
+  Cminor.funsig f = sig ->
+  eval_funcall ge m2 f vargs t3 m3 vres ->
+  transl_function_correct m2 f vargs t3 m3 vres ->
+  t = t1 ** t2 ** t3 ->
+  transl_expr_correct sp le e m (Ecall sig a bl) t e2 m3 vres.
 Proof.
   intros. red; simpl; intros.
   monadInv TE. intro EQ3. clear TE.
@@ -530,7 +549,7 @@ Proof.
   generalize (H6 tf TF). intro EXF.
 
   assert (EX3: exec_instrs tge (st_code s2) sp n rs2 m2
-                     nd (rs2#rd <- vres) m3).
+                     t3 nd (rs2#rd <- vres) m3).
   apply exec_one. eapply exec_Icall.
   eauto with rtlg. simpl. replace (rs2#r) with vf. eexact TFIND.
   rewrite <- RES1. symmetry. apply OTHER2.
@@ -543,10 +562,7 @@ Proof.
   tauto. byContradiction. apply valid_fresh_absurd with r s0.
   eauto with rtlg. assumption.
   tauto.
-  generalize TF. unfold transl_function.
-  destruct (transl_fun f init_state).
-  intro; discriminate. destruct p. intros. injection TF0. intro.
-  rewrite <- H7; simpl. auto.
+  generalize (sig_transl_function _ _ TF). congruence.
   rewrite RES2. assumption.
 
   exists (rs2#rd <- vres).
@@ -555,7 +571,7 @@ Proof.
   apply exec_instrs_incr with s3. eauto with rtlg.
   eapply exec_trans. eexact EX2. 
   apply exec_instrs_incr with s2. eauto with rtlg.
-  exact EX3.
+  eexact EX3. reflexivity. traceEq. 
 (* Match env *)
   split. apply match_env_update_temp. assumption.
   inversion TRG. assumption.
@@ -591,13 +607,14 @@ Qed.
 
 Lemma transl_expr_Econdition_correct:
  forall (sp: val) (le : letenv) (e : env) (m : mem) 
-    (a : condexpr) (b c : expr) (e1 : env) (m1 : mem) 
-    (v1 : bool) (e2 : env) (m2 : mem) (v2 : val),
-  eval_condexpr ge sp le e m a e1 m1 v1 ->
-  transl_condition_correct sp le e m a e1 m1 v1 ->
-  eval_expr ge sp le e1 m1 (if v1 then b else c) e2 m2 v2 ->
-  transl_expr_correct sp le e1 m1 (if v1 then b else c) e2 m2 v2 ->
-  transl_expr_correct sp le e m (Econdition a b c) e2 m2 v2.
+    (a : condexpr) (b c : expr) (t t1: trace) (e1 : env) (m1 : mem) 
+    (v1 : bool) (t2: trace) (e2 : env) (m2 : mem) (v2 : val),
+  eval_condexpr ge sp le e m a t1 e1 m1 v1 ->
+  transl_condition_correct sp le e m a t1 e1 m1 v1 ->
+  eval_expr ge sp le e1 m1 (if v1 then b else c) t2 e2 m2 v2 ->
+  transl_expr_correct sp le e1 m1 (if v1 then b else c) t2 e2 m2 v2 ->
+  t = t1 ** t2 ->
+  transl_expr_correct sp le e m (Econdition a b c) t e2 m2 v2.
 Proof.
   intros; red; intros. simpl in TE; monadInv TE. intro EQ1; clear TE.
   simpl in MUT. 
@@ -619,7 +636,7 @@ Proof.
 (* Exec *)
   split. eapply exec_trans. eexact EX1. 
   apply exec_instrs_incr with s1. eauto with rtlg.
-  exact EX2.
+  eexact EX2. auto.
 (* Match-env *)
   split. assumption.
 (* Result value *)
@@ -639,7 +656,7 @@ Proof.
 (* Exec *)
   split. eapply exec_trans. eexact EX1. 
   apply exec_instrs_incr with s0. eauto with rtlg.
-  exact EX2.
+  eexact EX2. auto.
 (* Match-env *)
   split. assumption.
 (* Result value *)
@@ -653,13 +670,14 @@ Qed.
 
 Lemma transl_expr_Elet_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem) 
-    (a b : expr) (e1 : env) (m1 : mem) (v1 : val) 
-    (e2 : env) (m2 : mem) (v2 : val),
-  eval_expr ge sp le e m a e1 m1 v1 ->
-  transl_expr_correct sp le e m a e1 m1 v1 ->
-  eval_expr ge sp (v1 :: le) e1 m1 b e2 m2 v2 ->
-  transl_expr_correct sp (v1 :: le) e1 m1 b e2 m2 v2 ->
-  transl_expr_correct sp le e m (Elet a b) e2 m2 v2.
+    (a b : expr) (t t1: trace) (e1 : env) (m1 : mem) (v1 : val) 
+    (t2: trace) (e2 : env) (m2 : mem) (v2 : val),
+  eval_expr ge sp le e m a t1 e1 m1 v1 ->
+  transl_expr_correct sp le e m a t1 e1 m1 v1 ->
+  eval_expr ge sp (v1 :: le) e1 m1 b t2 e2 m2 v2 ->
+  transl_expr_correct sp (v1 :: le) e1 m1 b t2 e2 m2 v2 ->
+  t = t1 ** t2 ->
+  transl_expr_correct sp le e m (Elet a b) t e2 m2 v2.
 Proof.
   intros; red; intros.
   simpl in TE; monadInv TE. intro EQ1.
@@ -678,17 +696,17 @@ Proof.
   assert (TRG2: target_reg_ok s0 (add_letvar map r) mut b rd).
   inversion TRG. apply target_reg_other. 
   unfold reg_in_map, add_letvar; simpl. red; intro.
-  elim H10; intro. apply H3. left. assumption.
-  elim H11; intro. apply valid_fresh_absurd with rd s.
-  assumption. rewrite <- H12. eauto with rtlg.
-  apply H3. right. assumption.
+  elim H11; intro. apply H4. left. assumption.
+  elim H12; intro. apply valid_fresh_absurd with rd s.
+  assumption. rewrite <- H13. eauto with rtlg.
+  apply H4. right. assumption.
   eauto with rtlg.
   generalize (H2 _ _ _ _ _ _ _ _ MWF2 EQ0 ME2 MUT2 TRG2).
   intros [rs2 [EX2 [ME3 [RES2 OTHER2]]]].
   exists rs2.
 (* Exec *)
   split. eapply exec_trans. eexact EX1. 
-  apply exec_instrs_incr with s1. eauto with rtlg. exact EX2.
+  apply exec_instrs_incr with s1. eauto with rtlg. eexact EX2. auto.
 (* Match-env *)
   split. apply mk_match_env. exact (me_vars _ _ _ _ ME3). 
   generalize (me_letvars _ _ _ _ ME3). 
@@ -699,21 +717,21 @@ Proof.
   intros. transitivity (rs1#r0). 
   apply OTHER2. eauto with rtlg. 
   unfold mutated_reg. unfold add_letvar; simpl. assumption.
-  elim H5; intro. left. 
+  elim H6; intro. left. 
   unfold reg_in_map, add_letvar; simpl.
-  unfold reg_in_map in H6; tauto.
+  unfold reg_in_map in H7; tauto.
   tauto.
   apply OTHER1. eauto with rtlg.
   assumption. 
   right. red; intro. apply valid_fresh_absurd with r0 s.
-  assumption. rewrite H6. eauto with rtlg.
+  assumption. rewrite H7. eauto with rtlg.
 Qed.
 
 Lemma transl_expr_Eletvar_correct:
   forall (sp: val) (le : list val) (e : env) 
     (m : mem) (n : nat) (v : val),
   nth_error le n = Some v ->
-  transl_expr_correct sp le e m (Eletvar n) e m v.
+  transl_expr_correct sp le e m (Eletvar n) E0 e m v.
 Proof.
   intros; red; intros. 
   simpl in TE; monadInv TE. intro EQ1.
@@ -746,9 +764,46 @@ Proof.
   intro; monadSimpl.
 Qed.
 
+Lemma transl_expr_Ealloc_correct:
+  forall (sp: val) (le : letenv) (e : env) (m : mem) 
+    (a : expr) (t: trace) (e1 : env) (m1 : mem) (n: int)
+    (m2: mem) (b: block),
+  eval_expr ge sp le e m a t e1 m1 (Vint n) ->
+  transl_expr_correct sp le e m a t e1 m1 (Vint n) ->
+  Mem.alloc m1 0 (Int.signed n) = (m2, b) ->
+  transl_expr_correct sp le e m (Ealloc a) t e1 m2 (Vptr b Int.zero).
+Proof.
+  intros until b; intros EE TEC ALLOC; red; intros.
+  simpl in TE. monadInv TE. intro EQ1.
+  simpl in MUT.
+  assert (TRG': target_reg_ok s1 map mut a r); eauto with rtlg.
+  assert (MWF': map_wf map s1). eauto with rtlg.
+  generalize (TEC _ _ _ _ _ _ _ _ MWF' EQ1 ME MUT TRG').
+  intros [rs1 [EX1 [ME1 [RR1 RO1]]]].
+  exists (rs1#rd <- (Vptr b Int.zero)).
+(* Exec *)
+  split. eapply exec_trans. eexact EX1. 
+  apply exec_instrs_incr with s1. eauto with rtlg.
+  apply exec_one; eapply exec_Ialloc. eauto with rtlg.
+  eexact RR1. assumption. traceEq. 
+(* Match-env *)
+  split. inversion TRG. eauto with rtlg.
+(* Result *)
+  split. apply Regmap.gss.
+(* Other regs *)
+  intros. rewrite Regmap.gso.
+  apply RO1. eauto with rtlg. assumption.
+  case (Reg.eq r0 r); intro.
+  subst r0. left. elim (alloc_reg_fresh_or_in_map _ _ _ _ _ _ MWF EQ); intro. 
+  auto. byContradiction; eauto with rtlg.
+  right; assumption.
+  elim H1; intro. red; intro. subst r0. inversion TRG. contradiction. 
+  auto.
+Qed.
+
 Lemma transl_condition_CEtrue_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem),
-  transl_condition_correct sp le e m CEtrue e m true.
+  transl_condition_correct sp le e m CEtrue E0 e m true.
 Proof.
   intros; red; intros. simpl in TE; monadInv TE. subst ns.
   exists rs. split. apply exec_refl. split. auto. auto.
@@ -756,7 +811,7 @@ Qed.
 
 Lemma transl_condition_CEfalse_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem),
-  transl_condition_correct sp le e m CEfalse e m false.
+  transl_condition_correct sp le e m CEfalse E0 e m false.
 Proof.
   intros; red; intros. simpl in TE; monadInv TE. subst ns.
   exists rs. split. apply exec_refl. split. auto. auto.
@@ -764,12 +819,12 @@ Qed.
 
 Lemma transl_condition_CEcond_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem)
-    (cond : condition) (al : exprlist) (e1 : env) 
+    (cond : condition) (al : exprlist) (t1: trace) (e1 : env) 
     (m1 : mem) (vl : list val) (b : bool),
-  eval_exprlist ge sp le e m al e1 m1 vl ->
-  transl_exprlist_correct sp le e m al e1 m1 vl ->
+  eval_exprlist ge sp le e m al t1 e1 m1 vl ->
+  transl_exprlist_correct sp le e m al t1 e1 m1 vl ->
   eval_condition cond vl =  Some b ->
-  transl_condition_correct sp le e m (CEcond cond al) e1 m1 b.
+  transl_condition_correct sp le e m (CEcond cond al) t1 e1 m1 b.
 Proof.
   intros; red; intros. simpl in TE; monadInv TE. intro EQ1; clear TE.
   assert (MWF1: map_wf map s1). eauto with rtlg.
@@ -788,6 +843,7 @@ Proof.
   rewrite RES1. assumption.
   eapply exec_Icond_false. eauto with rtlg. 
   rewrite RES1. assumption.
+  traceEq.
 (* Match-env *)
   split. assumption.
 (* Regs *)
@@ -800,13 +856,14 @@ Qed.
 
 Lemma transl_condition_CEcondition_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem)
-    (a b c : condexpr) (e1 : env) (m1 : mem) 
-    (vb1 : bool) (e2 : env) (m2 : mem) (vb2 : bool),
-  eval_condexpr ge sp le e m a e1 m1 vb1 ->
-  transl_condition_correct sp le e m a e1 m1 vb1 ->
-  eval_condexpr ge sp le e1 m1 (if vb1 then b else c) e2 m2 vb2 ->
-  transl_condition_correct sp le e1 m1 (if vb1 then b else c) e2 m2 vb2 ->
-  transl_condition_correct sp le e m (CEcondition a b c) e2 m2 vb2.
+    (a b c : condexpr) (t t1: trace) (e1 : env) (m1 : mem) 
+    (vb1 : bool) (t2: trace) (e2 : env) (m2 : mem) (vb2 : bool),
+  eval_condexpr ge sp le e m a t1 e1 m1 vb1 ->
+  transl_condition_correct sp le e m a t1 e1 m1 vb1 ->
+  eval_condexpr ge sp le e1 m1 (if vb1 then b else c) t2 e2 m2 vb2 ->
+  transl_condition_correct sp le e1 m1 (if vb1 then b else c) t2 e2 m2 vb2 ->
+  t = t1 ** t2 ->
+  transl_condition_correct sp le e m (CEcondition a b c) t e2 m2 vb2.
 Proof.
   intros; red; intros. simpl in TE; monadInv TE. intro EQ1; clear TE.
   simpl in MUT.
@@ -823,7 +880,7 @@ Proof.
   exists rs2.
   split. eapply exec_trans. eexact EX1. 
   apply exec_instrs_incr with s1. eauto with rtlg.
-  exact EX2.
+  eexact EX2. auto.
   split. assumption. 
   intros. transitivity (rs1#r). 
   apply OTHER2; eauto with rtlg.
@@ -835,7 +892,7 @@ Proof.
   exists rs2.
   split. eapply exec_trans. eexact EX1. 
   apply exec_instrs_incr with s0. eauto with rtlg.
-  exact EX2.
+  eexact EX2. auto.
   split. assumption. 
   intros. transitivity (rs1#r). 
   apply OTHER2; eauto with rtlg.
@@ -844,7 +901,7 @@ Qed.
  
 Lemma transl_exprlist_Enil_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem),
-  transl_exprlist_correct sp le e m Enil e m nil.
+  transl_exprlist_correct sp le e m Enil E0 e m nil.
 Proof.
   intros; red; intros. 
   generalize TE. simpl. destruct rl; monadSimpl. 
@@ -857,17 +914,18 @@ Qed.
 
 Lemma transl_exprlist_Econs_correct:
   forall (sp: val) (le : letenv) (e : env) (m : mem) 
-    (a : expr) (bl : exprlist) (e1 : env) (m1 : mem) 
-    (v : val) (e2 : env) (m2 : mem) (vl : list val),
-  eval_expr ge sp le e m a e1 m1 v ->
-  transl_expr_correct sp le e m a e1 m1 v ->
-  eval_exprlist ge sp le e1 m1 bl e2 m2 vl ->
-  transl_exprlist_correct sp le e1 m1 bl e2 m2 vl ->
-  transl_exprlist_correct sp le e m (Econs a bl) e2 m2 (v :: vl).
+    (a : expr) (bl : exprlist) (t t1: trace) (e1 : env) (m1 : mem) 
+    (v : val) (t2: trace) (e2 : env) (m2 : mem) (vl : list val),
+  eval_expr ge sp le e m a t1 e1 m1 v ->
+  transl_expr_correct sp le e m a t1 e1 m1 v ->
+  eval_exprlist ge sp le e1 m1 bl t2 e2 m2 vl ->
+  transl_exprlist_correct sp le e1 m1 bl t2 e2 m2 vl ->
+  t = t1 ** t2 ->
+  transl_exprlist_correct sp le e m (Econs a bl) t e2 m2 (v :: vl).
 Proof.
   intros. red. intros. 
   inversion TRG.
-  rewrite <- H10 in TE. simpl in TE. monadInv TE. intro EQ1.
+  rewrite <- H11 in TE. simpl in TE. monadInv TE. intro EQ1.
   simpl in MUT.
   assert (MUT1: incl (mutated_expr a) mut); eauto with coqlib.
   assert (MUT2: incl (mutated_exprlist bl) mut); eauto with coqlib.
@@ -875,12 +933,13 @@ Proof.
   assert (TRG1: target_reg_ok s1 map mut a r); eauto with rtlg.
   generalize (H0 _ _ _ _ _ _ _ _ MWF1 EQ1 ME MUT1 TRG1).
   intros [rs1 [EX1 [ME1 [RES1 OTHER1]]]].
-  generalize (H2 _ _ _ _ _ _ _ _ MWF EQ ME1 MUT2 H11).
+  generalize (H2 _ _ _ _ _ _ _ _ MWF EQ ME1 MUT2 H12).
   intros [rs2 [EX2 [ME2 [RES2 OTHER2]]]].
   exists rs2.
 (* Exec *)
   split. eapply exec_trans. eexact EX1. 
-  apply exec_instrs_incr with s1. eauto with rtlg. assumption.
+  apply exec_instrs_incr with s1. eauto with rtlg. 
+  eexact EX2. auto. 
 (* Match-env *)
   split. assumption.
 (* Results *)
@@ -894,22 +953,23 @@ Proof.
   transitivity (rs1#r0).
   apply OTHER2; auto. tauto. 
   apply OTHER1; auto. eauto with rtlg. 
-  elim H14; intro. left; assumption. right; apply sym_not_equal; tauto.
+  elim H15; intro. left; assumption. right; apply sym_not_equal; tauto.
 Qed.
 
-Lemma transl_funcall_correct:
-  forall (m : mem) (f : Cminor.function) (vargs : list val) 
-    (m1 : mem) (sp : block) (e e2 : env) (m2 : mem) 
-    (out : outcome) (vres : val),
+Lemma transl_funcall_internal_correct:
+  forall (m : mem) (f : Cminor.function)
+         (vargs : list val) (m1 : mem) (sp : block) (e : env) (t : trace)
+         (e2 : env) (m2 : mem) (out : outcome) (vres : val),
   Mem.alloc m 0 (fn_stackspace f) = (m1, sp) ->
-  set_locals (Cminor.fn_vars f) (set_params vargs (Cminor.fn_params f)) = e ->
-  exec_stmt ge (Vptr sp Int.zero) e m1 (fn_body f) e2 m2 out ->
-  transl_stmt_correct (Vptr sp Int.zero) e m1 (fn_body f) e2 m2 out ->
+  set_locals (fn_vars f) (set_params vargs (Cminor.fn_params f)) = e ->
+  exec_stmt ge (Vptr sp Int.zero) e m1 (fn_body f) t e2 m2 out ->
+  transl_stmt_correct (Vptr sp Int.zero) e m1 (fn_body f) t e2 m2 out ->
   outcome_result_value out f.(Cminor.fn_sig).(sig_res) vres ->
-  transl_function_correct m f vargs (Mem.free m2 sp) vres.
+  transl_function_correct m (Internal f)
+            vargs t (Mem.free m2 sp) vres.
 Proof.
   intros; red; intros.
-  generalize TE. unfold transl_function.
+  generalize TE. unfold transl_fundef, transl_function; simpl.
   caseEq (transl_fun f init_state).
   intros; discriminate.
   intros ns s. unfold transl_fun. monadSimpl. 
@@ -934,30 +994,41 @@ Proof.
   apply map_wf_incr with s1. apply state_incr_trans with s2; eauto with rtlg.
   assumption.
 
-  assert (RRG: return_reg_ok s3 y0 (ret_reg (Cminor.fn_sig f) r)).
+  set (rr := ret_reg (Cminor.fn_sig f) r) in *.
+  assert (RRG: return_reg_ok s3 y0 rr).
   apply return_reg_ok_incr with s2. eauto with rtlg. 
-  apply new_reg_return_ok with s1; assumption.
+  unfold rr; apply new_reg_return_ok with s1; assumption.
 
   generalize (H2 _ _ _ _ _ _ _ _ _ rs MWF EQ3 ME OUT RRG).
   intros [rs1 [EX1 [ME1 MR1]]].
 
-  apply exec_funct with m1 n rs1 (ret_reg (Cminor.fn_sig f) r).
-  rewrite <- TF; simpl; assumption.
-  rewrite <- TF; simpl. exact EX1.
-  rewrite <- TF; simpl. apply instr_at_incr with s3.
+  rewrite <- TF. apply exec_funct_internal with m1 n rs1 rr; simpl.
+  assumption.
+  exact EX1.
+  apply instr_at_incr with s3.
   eauto with rtlg. discriminate. eauto with rtlg.
   generalize MR1. unfold match_return_outcome.
   generalize H3. unfold outcome_result_value.
-  unfold ret_reg; destruct (sig_res (Cminor.fn_sig f)).
+  unfold rr, ret_reg; destruct (sig_res (Cminor.fn_sig f)).
   unfold regmap_optget. destruct out; try contradiction.
   destruct o; try contradiction. intros; congruence.
   unfold regmap_optget. destruct out; contradiction||auto.
   destruct o; contradiction||auto.
 Qed.
 
+Lemma transl_funcall_external_correct:
+  forall (ef : external_function) (m : mem) (args : list val) (t: trace) (res : val),
+  event_match ef args t res ->
+  transl_function_correct m (External ef) args t m res.
+Proof.
+  intros; red; intros. unfold transl_function in TE; simpl in TE.
+  inversion TE; subst tf. 
+  apply exec_funct_external. auto.
+Qed.
+
 Lemma transl_stmt_Sskip_correct:
   forall (sp: val) (e : env) (m : mem),
-  transl_stmt_correct sp e m Sskip e m Out_normal.
+  transl_stmt_correct sp e m Sskip E0 e m Out_normal.
 Proof.
   intros; red; intros. simpl in TE. monadInv TE.
   subst s'; subst ns.
@@ -966,13 +1037,15 @@ Proof.
 Qed.
 
 Lemma transl_stmt_Sseq_continue_correct:
-  forall (sp : val) (e : env) (m : mem) (s1 : stmt) (e1 : env)
-         (m1 : mem) (s2 : stmt) (e2 : env) (m2 : mem) (out : outcome),
-  exec_stmt ge sp e m s1 e1 m1 Out_normal ->
-  transl_stmt_correct sp e m s1 e1 m1 Out_normal ->
-  exec_stmt ge sp e1 m1 s2 e2 m2 out ->
-  transl_stmt_correct sp e1 m1 s2 e2 m2 out ->
-  transl_stmt_correct sp e m (Sseq s1 s2) e2 m2 out.
+  forall (sp : val) (e : env) (m : mem) (t: trace) (s1 : stmt)
+         (t1: trace) (e1 : env) (m1 : mem) (s2 : stmt) (t2: trace)
+         (e2 : env) (m2 : mem) (out : outcome),
+  exec_stmt ge sp e m s1 t1 e1 m1 Out_normal ->
+  transl_stmt_correct sp e m s1 t1 e1 m1 Out_normal ->
+  exec_stmt ge sp e1 m1 s2 t2 e2 m2 out ->
+  transl_stmt_correct sp e1 m1 s2 t2 e2 m2 out ->
+  t = t1 ** t2 ->
+  transl_stmt_correct sp e m (Sseq s1 s2) t e2 m2 out.
 Proof.
   intros; red; intros. simpl in TE; monadInv TE. intro EQ0.
   assert (MWF1: map_wf map s0). eauto with rtlg.
@@ -987,18 +1060,18 @@ Proof.
 (* Exec *)
   split. eapply exec_trans. eexact EX1. 
   apply exec_instrs_incr with s0. eauto with rtlg.
-  exact EX2.
+  eexact EX2. auto.
 (* Match-env + return *)
   tauto.
 Qed.
 
 Lemma transl_stmt_Sseq_stop_correct:
-  forall (sp : val) (e : env) (m : mem) (s1 s2 : stmt) (e1 : env)
+  forall (sp : val) (e : env) (m : mem) (t: trace) (s1 s2 : stmt) (e1 : env)
          (m1 : mem) (out : outcome),
-  exec_stmt ge sp e m s1 e1 m1 out ->
-  transl_stmt_correct sp e m s1 e1 m1 out ->
+  exec_stmt ge sp e m s1 t e1 m1 out ->
+  transl_stmt_correct sp e m s1 t e1 m1 out ->
   out <> Out_normal ->
-  transl_stmt_correct sp e m (Sseq s1 s2) e1 m1 out.
+  transl_stmt_correct sp e m (Sseq s1 s2) t e1 m1 out.
 Proof.
   intros; red; intros. 
   simpl in TE; monadInv TE. intro EQ0; clear TE.
@@ -1010,11 +1083,11 @@ Proof.
 Qed.
 
 Lemma transl_stmt_Sexpr_correct:
-  forall (sp: val) (e : env) (m : mem) (a : expr) 
+  forall (sp: val) (e : env) (m : mem) (a : expr) (t: trace)
     (e1 : env) (m1 : mem) (v : val),
-  eval_expr ge sp nil e m a e1 m1 v ->
-  transl_expr_correct sp nil e m a e1 m1 v ->
-  transl_stmt_correct sp e m (Sexpr a) e1 m1 Out_normal.
+  eval_expr ge sp nil e m a t e1 m1 v ->
+  transl_expr_correct sp nil e m a t e1 m1 v ->
+  transl_stmt_correct sp e m (Sexpr a) t e1 m1 Out_normal.
 Proof.
   intros; red; intros.
   simpl in OUT. subst nd.
@@ -1028,17 +1101,18 @@ Qed.
 
 Lemma transl_stmt_Sifthenelse_correct:
   forall (sp: val) (e : env) (m : mem) (a : condexpr)
-    (sl1 sl2 : stmt) (e1 : env) (m1 : mem) 
-    (v1 : bool) (e2 : env) (m2 : mem) (out : outcome),
-  eval_condexpr ge sp nil e m a e1 m1 v1 ->
-  transl_condition_correct sp nil e m a e1 m1 v1 ->
-  exec_stmt ge sp e1 m1 (if v1 then sl1 else sl2) e2 m2 out ->
-  transl_stmt_correct sp e1 m1 (if v1 then sl1 else sl2) e2 m2 out ->
-  transl_stmt_correct sp e m (Sifthenelse a sl1 sl2) e2 m2 out.
+    (s1 s2 : stmt) (t t1: trace) (e1 : env) (m1 : mem) 
+    (v1 : bool) (t2: trace) (e2 : env) (m2 : mem) (out : outcome),
+  eval_condexpr ge sp nil e m a t1 e1 m1 v1 ->
+  transl_condition_correct sp nil e m a t1 e1 m1 v1 ->
+  exec_stmt ge sp e1 m1 (if v1 then s1 else s2) t2 e2 m2 out ->
+  transl_stmt_correct sp e1 m1 (if v1 then s1 else s2) t2 e2 m2 out ->
+  t = t1 ** t2 ->
+  transl_stmt_correct sp e m (Sifthenelse a s1 s2) t e2 m2 out.
 Proof.
   intros; red; intros until rs; intro MWF.
-  simpl. case (more_likely a sl1 sl2); monadSimpl; intro EQ2; intros.
-  assert (MWF1: map_wf map s1). eauto with rtlg.
+  simpl. case (more_likely a s1 s2); monadSimpl; intro EQ2; intros.
+  assert (MWF1: map_wf map s3). eauto with rtlg.
   generalize (H0 _ _ _ _ _ _ _ rs MWF1 EQ2 ME (incl_refl _)).
   intros [rs1 [EX1 [ME1 OTHER1]]].
   destruct v1.
@@ -1047,17 +1121,17 @@ Proof.
   generalize (H2 _ _ _ _ _ _ _ _ _ _ MWF0 EQ0 ME1 OUT RRG0).
   intros [rs2 [EX2 [ME2 MRE2]]].
   exists rs2. split.
-  eapply exec_trans. eexact EX1. apply exec_instrs_incr with s1.
-  eauto with rtlg. exact EX2.
+  eapply exec_trans. eexact EX1. apply exec_instrs_incr with s3.
+  eauto with rtlg. eexact EX2. auto.
   tauto.
   generalize (H2 _ _ _ _ _ _ _ _ _ _ MWF EQ ME1 OUT RRG).
   intros [rs2 [EX2 [ME2 MRE2]]].
   exists rs2. split.
   eapply exec_trans. eexact EX1. apply exec_instrs_incr with s0.
-  eauto with rtlg. exact EX2.
+  eauto with rtlg. eexact EX2. auto.
   tauto.
 
-  assert (MWF1: map_wf map s1). eauto with rtlg.
+  assert (MWF1: map_wf map s3). eauto with rtlg.
   generalize (H0 _ _ _ _ _ _ _ rs MWF1 EQ2 ME (incl_refl _)).
   intros [rs1 [EX1 [ME1 OTHER1]]].
   destruct v1.
@@ -1065,27 +1139,28 @@ Proof.
   intros [rs2 [EX2 [ME2 MRE2]]].
   exists rs2. split.
   eapply exec_trans. eexact EX1. apply exec_instrs_incr with s0.
-  eauto with rtlg. exact EX2.
+  eauto with rtlg. eexact EX2. auto.
   tauto.
   assert (MWF0: map_wf map s0). eauto with rtlg.
   assert (RRG0: return_reg_ok s0 map rret). eauto with rtlg.
   generalize (H2 _ _ _ _ _ _ _ _ _ _ MWF0 EQ0 ME1 OUT RRG0).
   intros [rs2 [EX2 [ME2 MRE2]]].
   exists rs2. split.
-  eapply exec_trans. eexact EX1. apply exec_instrs_incr with s1.
-  eauto with rtlg. exact EX2.
+  eapply exec_trans. eexact EX1. apply exec_instrs_incr with s3.
+  eauto with rtlg. eexact EX2. auto.
   tauto.
 Qed.
 
 Lemma transl_stmt_Sloop_loop_correct:
-  forall (sp: val) (e : env) (m : mem) (sl : stmt) 
-    (e1 : env) (m1 : mem) (e2 : env) (m2 : mem) 
+  forall (sp: val) (e : env) (m : mem) (sl : stmt) (t t1: trace)
+    (e1 : env) (m1 : mem) (t2: trace) (e2 : env) (m2 : mem) 
     (out : outcome),
-  exec_stmt ge sp e m sl e1 m1 Out_normal ->
-  transl_stmt_correct sp e m sl e1 m1 Out_normal ->
-  exec_stmt ge sp e1 m1 (Sloop sl) e2 m2 out ->
-  transl_stmt_correct sp e1 m1 (Sloop sl) e2 m2 out ->
-  transl_stmt_correct sp e m (Sloop sl) e2 m2 out.
+  exec_stmt ge sp e m sl t1 e1 m1 Out_normal ->
+  transl_stmt_correct sp e m sl t1 e1 m1 Out_normal ->
+  exec_stmt ge sp e1 m1 (Sloop sl) t2 e2 m2 out ->
+  transl_stmt_correct sp e1 m1 (Sloop sl) t2 e2 m2 out ->
+  t = t1 ** t2 ->
+  transl_stmt_correct sp e m (Sloop sl) t e2 m2 out.
 Proof.
   intros; red; intros.
   generalize TE. simpl. monadSimpl. subst s2; subst n0. intros.
@@ -1107,22 +1182,23 @@ Proof.
   apply exec_instrs_extends with s1. 
   eapply update_instr_extends.
   eexact EQ. eauto with rtlg. eexact EQ1. eexact EX1.
-  apply exec_trans with ns rs1 m1.
+  apply exec_trans with E0 ns rs1 m1 t2.
   apply exec_one. apply exec_Inop. 
   generalize EQ1. unfold update_instr. 
   case (plt n (st_nextnode s1)); intro; monadSimpl.
-  rewrite <- H4. simpl. apply PTree.gss.
+  rewrite <- H5. simpl. apply PTree.gss.
   exact EX2.
+  reflexivity. traceEq. 
   tauto.
 Qed.
 
 Lemma transl_stmt_Sloop_stop_correct:
-  forall (sp: val) (e : env) (m : mem) (sl : stmt) 
+  forall (sp: val) (e : env) (m : mem) (t: trace) (sl : stmt) 
     (e1 : env) (m1 : mem) (out : outcome),
-  exec_stmt ge sp e m sl e1 m1 out ->
-  transl_stmt_correct sp e m sl e1 m1 out ->
+  exec_stmt ge sp e m sl t e1 m1 out ->
+  transl_stmt_correct sp e m sl t e1 m1 out ->
   out <> Out_normal ->
-  transl_stmt_correct sp e m (Sloop sl) e1 m1 out.
+  transl_stmt_correct sp e m (Sloop sl) t e1 m1 out.
 Proof.
   intros; red; intros.
   simpl in TE. monadInv TE. subst s2; subst n0.
@@ -1145,11 +1221,11 @@ Proof.
 Qed.  
 
 Lemma transl_stmt_Sblock_correct:
-  forall (sp: val) (e : env) (m : mem) (sl : stmt) 
+  forall (sp: val) (e : env) (m : mem) (sl : stmt) (t: trace)
     (e1 : env) (m1 : mem) (out : outcome),
-  exec_stmt ge sp e m sl e1 m1 out ->
-  transl_stmt_correct sp e m sl e1 m1 out ->
-  transl_stmt_correct sp e m (Sblock sl) e1 m1 (outcome_block out).
+  exec_stmt ge sp e m sl t e1 m1 out ->
+  transl_stmt_correct sp e m sl t e1 m1 out ->
+  transl_stmt_correct sp e m (Sblock sl) t e1 m1 (outcome_block out).
 Proof.
   intros; red; intros. simpl in TE. 
   assert (OUT': outcome_node out ncont (ncont :: nexits) nret nd).
@@ -1180,7 +1256,7 @@ Qed.
 
 Lemma transl_stmt_Sexit_correct:
   forall (sp: val) (e : env) (m : mem) (n : nat),
-  transl_stmt_correct sp e m (Sexit n) e m (Out_exit n).
+  transl_stmt_correct sp e m (Sexit n) E0 e m (Out_exit n).
 Proof.
   intros; red; intros. 
   simpl in TE. simpl in OUT. 
@@ -1194,7 +1270,7 @@ Lemma transl_switch_correct:
   transl_switch r nexits cases default s = OK ns s' ->
   nth_error nexits (switch_target i default cases) = Some nd ->
   rs#r = Vint i ->
-  exec_instrs tge s'.(st_code) sp ns rs m nd rs m.
+  exec_instrs tge s'.(st_code) sp ns rs m E0 nd rs m.
 Proof.
   induction cases; simpl; intros.
   generalize (transl_exit_correct _ _ _ _ _ H). intros.
@@ -1202,23 +1278,23 @@ Proof.
   destruct a as [key1 exit1]. monadInv H. clear H. intro EQ1.
   caseEq (Int.eq i key1); intro IEQ; rewrite IEQ in H0.
   (* i = key1 *)
-  apply exec_trans with n0 rs m. apply exec_one. 
+  apply exec_trans with E0 n0 rs m E0. apply exec_one. 
   eapply exec_Icond_true. eauto with rtlg. simpl. rewrite H1. congruence.
   generalize (transl_exit_correct _ _ _ _ _ EQ0); intro.
-  assert (n0 = nd). congruence. subst n0. apply exec_refl.
+  assert (n0 = nd). congruence. subst n0. apply exec_refl. traceEq.
   (* i <> key1 *)
-  apply exec_trans with n rs m. apply exec_one.
+  apply exec_trans with E0 n rs m E0. apply exec_one.
   eapply exec_Icond_false. eauto with rtlg. simpl. rewrite H1. congruence.
-  apply exec_instrs_incr with s0; eauto with rtlg. 
+  apply exec_instrs_incr with s0; eauto with rtlg. traceEq.
 Qed.
 
 Lemma transl_stmt_Sswitch_correct:
   forall (sp : val) (e : env) (m : mem) (a : expr)
-         (cases : list (int * nat)) (default : nat) (e1 : env) (m1 : mem)
-         (n : int),
-  eval_expr ge sp nil e m a e1 m1 (Vint n) ->
-  transl_expr_correct sp nil e m a e1 m1 (Vint n) ->
-  transl_stmt_correct sp e m (Sswitch a cases default) e1 m1
+         (cases : list (int * nat)) (default : nat) 
+         (t1 : trace) (e1 : env) (m1 : mem) (n : int),
+  eval_expr ge sp nil e m a t1 e1 m1 (Vint n) ->
+  transl_expr_correct sp nil e m a t1 e1 m1 (Vint n) ->
+  transl_stmt_correct sp e m (Sswitch a cases default) t1 e1 m1
          (Out_exit (switch_target n default cases)).
 Proof.
   intros; red; intros. monadInv TE. clear TE; intros EQ1.
@@ -1234,14 +1310,14 @@ Proof.
   (* execution *)
   split. eapply exec_trans. eexact EXEC1. 
   apply exec_instrs_incr with s1. eauto with rtlg.
-  eapply transl_switch_correct; eauto. 
+  eapply transl_switch_correct; eauto. traceEq. 
   (* match_env & match_reg *)
   tauto.
 Qed.
 
 Lemma transl_stmt_Sreturn_none_correct:
   forall (sp: val) (e : env) (m : mem),
-  transl_stmt_correct sp e m (Sreturn None) e m (Out_return None).
+  transl_stmt_correct sp e m (Sreturn None) E0 e m (Out_return None).
 Proof.
   intros; red; intros. generalize TE. simpl.
   destruct rret; monadSimpl. 
@@ -1250,11 +1326,11 @@ Proof.
 Qed.
 
 Lemma transl_stmt_Sreturn_some_correct:
-  forall (sp: val) (e : env) (m : mem) (a : expr) 
+  forall (sp: val) (e : env) (m : mem) (a : expr) (t: trace)
     (e1 : env) (m1 : mem) (v : val),
-  eval_expr ge sp nil e m a e1 m1 v ->
-  transl_expr_correct sp nil e m a e1 m1 v ->
-  transl_stmt_correct sp e m (Sreturn (Some a)) e1 m1 (Out_return (Some v)).
+  eval_expr ge sp nil e m a t e1 m1 v ->
+  transl_expr_correct sp nil e m a t e1 m1 v ->
+  transl_stmt_correct sp e m (Sreturn (Some a)) t e1 m1 (Out_return (Some v)).
 Proof.
   intros; red; intros. generalize TE; simpl.
   destruct rret. intro EQ.
@@ -1278,9 +1354,9 @@ Scheme eval_expr_ind_5 := Minimality for eval_expr Sort Prop
   with exec_stmt_ind_5 := Minimality for exec_stmt Sort Prop.
 
 Theorem transl_function_correctness:
-  forall m f vargs m' vres,
-  eval_funcall ge m f vargs m' vres ->
-  transl_function_correct m f vargs m' vres.
+  forall m f vargs t m' vres,
+  eval_funcall ge m f vargs t m' vres ->
+  transl_function_correct m f vargs t m' vres.
 Proof
   (eval_funcall_ind_5 ge
     transl_expr_correct
@@ -1298,13 +1374,15 @@ Proof
     transl_expr_Econdition_correct
     transl_expr_Elet_correct
     transl_expr_Eletvar_correct
+    transl_expr_Ealloc_correct
     transl_condition_CEtrue_correct
     transl_condition_CEfalse_correct
     transl_condition_CEcond_correct
     transl_condition_CEcondition_correct
     transl_exprlist_Enil_correct
     transl_exprlist_Econs_correct
-    transl_funcall_correct
+    transl_funcall_internal_correct
+    transl_funcall_external_correct
     transl_stmt_Sskip_correct
     transl_stmt_Sexpr_correct
     transl_stmt_Sifthenelse_correct
@@ -1319,26 +1397,23 @@ Proof
     transl_stmt_Sreturn_some_correct).
 
 Theorem transl_program_correct:
-  forall (r: val),
-  Cminor.exec_program prog r ->
-  RTL.exec_program tprog r.
+  forall (t: trace) (r: val),
+  Cminor.exec_program prog t r ->
+  RTL.exec_program tprog t r.
 Proof.
-  intros r [b [f [m [SYMB [FUNC [SIG EVAL]]]]]].
+  intros t r [b [f [m [SYMB [FUNC [SIG EVAL]]]]]].
   generalize (function_ptr_translated _ _ FUNC).
   intros [tf [TFIND TRANSLF]].
   red; exists b; exists tf; exists m.
   split. rewrite symbols_preserved. 
   replace (prog_main tprog) with (prog_main prog).
   assumption. 
-  symmetry; apply transform_partial_program_main with transl_function.
+  symmetry; apply transform_partial_program_main with transl_fundef.
   exact TRANSL.
   split. exact TFIND.
-  split. generalize TRANSLF. unfold transl_function.
-  destruct (transl_fun f init_state).
-  intro; discriminate. destruct p; intro EQ; injection EQ; intro EQ1.
-  rewrite <- EQ1. simpl. congruence. 
-  rewrite (Genv.init_mem_transf_partial transl_function prog TRANSL).
-  exact (transl_function_correctness _ _ _ _ _ EVAL _ TRANSLF).
+  split. generalize (sig_transl_function _ _ TRANSLF). congruence.
+  unfold fundef; rewrite (Genv.init_mem_transf_partial transl_fundef prog TRANSL).
+  exact (transl_function_correctness _ _ _ _ _ _ EVAL _ TRANSLF).
 Qed.
 
 End CORRECTNESS.
diff --git a/backend/RTLgenproof1.v b/backend/RTLgenproof1.v
index 85d420e..8b14901 100644
--- a/backend/RTLgenproof1.v
+++ b/backend/RTLgenproof1.v
@@ -5,6 +5,7 @@ Require Import Maps.
 Require Import AST.
 Require Import Integers.
 Require Import Values.
+Require Import Events.
 Require Import Mem.
 Require Import Globalenvs.
 Require Import Op.
@@ -200,28 +201,28 @@ Variable s1 s2: state.
 Hypothesis EXT: state_extends s1 s2.
 
 Lemma exec_instr_not_halt:
-  forall ge c sp pc rs m pc' rs' m',
-  exec_instr ge c sp pc rs m pc' rs' m' -> c!pc <> None.
+  forall ge c sp pc rs m t pc' rs' m',
+  exec_instr ge c sp pc rs m t pc' rs' m' -> c!pc <> None.
 Proof.
   induction 1; rewrite H; discriminate.
 Qed.
 
 Lemma exec_instr_in_s2:
-  forall ge sp pc rs m pc' rs' m',
-  exec_instr ge s1.(st_code) sp pc rs m pc' rs' m' ->
+  forall ge sp pc rs m t pc' rs' m',
+  exec_instr ge s1.(st_code) sp pc rs m t pc' rs' m' ->
   s2.(st_code)!pc = s1.(st_code)!pc.
 Proof.
   intros.
   elim (EXT pc); intro.
-  elim (exec_instr_not_halt _ _ _ _ _ _ _ _ _ H H0).
+  elim (exec_instr_not_halt _ _ _ _ _ _ _ _ _ _ H H0).
   assumption.
 Qed.
 
 Lemma exec_instr_extends_rec:
-  forall ge c sp pc rs m pc' rs' m',
-  exec_instr ge c sp  pc rs m  pc' rs' m' ->
+  forall ge c sp pc rs m t pc' rs' m',
+  exec_instr ge c sp  pc rs m t pc' rs' m' ->
   forall c', c!pc = c'!pc ->
-  exec_instr ge c' sp  pc rs m  pc' rs' m'.
+  exec_instr ge c' sp  pc rs m t pc' rs' m'.
 Proof.
   induction 1; intros.
   apply exec_Inop. congruence.
@@ -230,14 +231,15 @@ Proof.
   apply exec_Istore with chunk addr args src a.
     congruence. auto. auto.
   apply exec_Icall with sig ros args f; auto. congruence.
+  apply exec_Ialloc with arg sz; auto. congruence. 
   apply exec_Icond_true with cond args ifnot; auto. congruence.
   apply exec_Icond_false with cond args ifso; auto. congruence.
 Qed.
 
 Lemma exec_instr_extends:
-  forall ge sp pc rs m pc' rs' m',
-  exec_instr ge s1.(st_code) sp pc rs m pc' rs' m' ->
-  exec_instr ge s2.(st_code) sp pc rs m pc' rs' m'.
+  forall ge sp pc rs m t pc' rs' m',
+  exec_instr ge s1.(st_code) sp pc rs m t pc' rs' m' ->
+  exec_instr ge s2.(st_code) sp pc rs m t pc' rs' m'.
 Proof.
   intros.
   apply exec_instr_extends_rec with (st_code s1).
@@ -246,21 +248,21 @@ Proof.
 Qed.
 
 Lemma exec_instrs_extends_rec:
-  forall ge c sp pc rs m pc' rs' m',
-  exec_instrs ge c sp  pc rs m  pc' rs' m' ->
+  forall ge c sp pc rs m t pc' rs' m',
+  exec_instrs ge c sp  pc rs m t pc' rs' m' ->
   c = s1.(st_code) ->
-  exec_instrs ge s2.(st_code) sp  pc rs m  pc' rs' m'.
+  exec_instrs ge s2.(st_code) sp  pc rs m t pc' rs' m'.
 Proof.
   induction 1; intros.
   apply exec_refl.
   apply exec_one. apply exec_instr_extends; auto. rewrite <- H0; auto.
-  apply exec_trans with pc2 rs2 m2; auto.
+  apply exec_trans with t1 pc2 rs2 m2 t2; auto.
 Qed.
 
 Lemma exec_instrs_extends:
-  forall ge sp pc rs m pc' rs' m',
-  exec_instrs ge s1.(st_code) sp  pc rs m  pc' rs' m' ->
-  exec_instrs ge s2.(st_code) sp  pc rs m  pc' rs' m'.
+  forall ge sp pc rs m t pc' rs' m',
+  exec_instrs ge s1.(st_code) sp  pc rs m t pc' rs' m' ->
+  exec_instrs ge s2.(st_code) sp  pc rs m t pc' rs' m'.
 Proof.
   intros.
   apply exec_instrs_extends_rec with (st_code s1); auto.
@@ -281,9 +283,9 @@ Variable s1 s2: state.
 Hypothesis INCR: state_incr s1 s2.
 
 Lemma exec_instr_incr:
-  forall ge sp pc rs m pc' rs' m',
-  exec_instr ge s1.(st_code) sp  pc rs m  pc' rs' m' ->
-  exec_instr ge s2.(st_code) sp  pc rs m  pc' rs' m'.
+  forall ge sp pc rs m t pc' rs' m',
+  exec_instr ge s1.(st_code) sp  pc rs m t pc' rs' m' ->
+  exec_instr ge s2.(st_code) sp  pc rs m t pc' rs' m'.
 Proof.
   intros.
   apply exec_instr_extends with s1.
@@ -292,9 +294,9 @@ Proof.
 Qed.
 
 Lemma exec_instrs_incr:
-  forall ge sp pc rs m pc' rs' m',
-  exec_instrs ge s1.(st_code) sp  pc rs m  pc' rs' m' ->
-  exec_instrs ge s2.(st_code) sp  pc rs m  pc' rs' m'.
+  forall ge sp pc rs m t pc' rs' m',
+  exec_instrs ge s1.(st_code) sp  pc rs m t pc' rs' m' ->
+  exec_instrs ge s2.(st_code) sp  pc rs m t pc' rs' m'.
 Proof.
   intros.
   apply exec_instrs_extends with s1.
@@ -1318,6 +1320,7 @@ forall (P : expr -> Prop) (P0 : condexpr -> Prop)
         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 -> P (Ealloc e)) ->
        P0 CEtrue ->
        P0 CEfalse ->
        (forall (c : condition) (e : exprlist), P1 e -> P0 (CEcond c e)) ->
diff --git a/backend/RTLtyping.v b/backend/RTLtyping.v
index d15dbb8..33338d3 100644
--- a/backend/RTLtyping.v
+++ b/backend/RTLtyping.v
@@ -6,7 +6,7 @@ Require Import AST.
 Require Import Op.
 Require Import Registers.
 Require Import RTL.
-Require Import union_find.
+Require Conventions.
 
 (** * The type system *)
 
@@ -38,7 +38,7 @@ Definition regenv := reg -> typ.
 Section WT_INSTR.
 
 Variable env: regenv.
-Variable funct: function.
+Variable funsig: signature.
 
 Inductive wt_instr : instruction -> Prop :=
   | wt_Inop:
@@ -72,13 +72,17 @@ Inductive wt_instr : instruction -> Prop :=
       List.map env args = sig.(sig_args) ->
       env res = match sig.(sig_res) with None => Tint | Some ty => ty end ->
       wt_instr (Icall sig ros args res s)
+  | wt_Ialloc:
+      forall arg res s,
+      env arg = Tint -> env res = Tint ->
+      wt_instr (Ialloc arg res s)
   | wt_Icond:
       forall cond args s1 s2,
       List.map env args = type_of_condition cond ->
       wt_instr (Icond cond args s1 s2)
   | wt_Ireturn: 
       forall optres,
-      option_map env optres = funct.(fn_sig).(sig_res) ->
+      option_map env optres = funsig.(sig_res) ->
       wt_instr (Ireturn optres).
 
 End WT_INSTR.
@@ -88,15 +92,27 @@ End WT_INSTR.
    parameters agree in types with the function signature, and
    names of parameters are pairwise distinct. *)
 
-Record wt_function (env: regenv) (f: function) : Prop :=
+Record wt_function (f: function) (env: regenv): Prop :=
   mk_wt_function {
     wt_params:
       List.map env f.(fn_params) = f.(fn_sig).(sig_args);
     wt_norepet:
       list_norepet f.(fn_params);
     wt_instrs:
-      forall pc instr, f.(fn_code)!pc = Some instr -> wt_instr env f instr
-  }.
+      forall pc instr, 
+      f.(fn_code)!pc = Some instr -> wt_instr env f.(fn_sig) instr
+}.
+
+Inductive wt_fundef: fundef -> Prop :=
+  | wt_fundef_external: forall ef,
+      Conventions.sig_external_ok ef.(ef_sig) ->
+      wt_fundef (External ef)
+  | wt_function_internal: forall f env,
+      wt_function f env ->
+      wt_fundef (Internal f).
+
+Definition wt_program (p: program): Prop :=
+  forall i f, In (i, f) (prog_funct p) -> wt_fundef f.
 
 (** * Type inference *)
 
@@ -109,1022 +125,221 @@ Record wt_function (env: regenv) (f: function) : Prop :=
   each pseudo-register from its uses in the code.  We follow the second
   approach.
 
-  The algorithm and its correctness proof in this section were
-  contributed by Damien Doligez. *)
+  We delegate the task of determining the type of each pseudo-register
+  to an external ``oracle'': a function written in Caml and not
+  proved correct.  We verify the returned type environment using
+  the following Coq code, which we will prove correct. *)
 
-(** ** Type inference algorithm *)
+Parameter infer_type_environment:
+  function -> list (node * instruction) -> option regenv.
 
-Set Implicit Arguments.
+(** ** Algorithm to check the correctness of a type environment *)
 
-(** Type inference for RTL is similar to that for simply-typed 
-  lambda-calculus: we use type variables to represent the types
-  of registers that have not yet been determined to be [Tint] or [Tfloat]
-  based on their uses.  We need exactly one type variable per pseudo-register,
-  therefore type variables can be conveniently equated with registers.
-  The type of a register during inference is therefore either
-  [tTy t] (with [t = Tint] or [t = Tfloat]) for a known type,
-  or [tReg r] to mean ``the same type as that of register [r]''. *)
+Section TYPECHECKING.
 
-Inductive myT : Set :=
-  | tTy : typ -> myT
-  | tReg : reg -> myT.
+Variable funct: function.
+Variable env: regenv.
 
-(** The algorithm proceeds by unification of the currently inferred
-  type for a pseudo-register with the type dictated by its uses.
-  Unification builds on a ``union-find'' data structure representing
-  equivalence classes of types (see module [Union_find]).
-*)
+Lemma typ_eq: forall (t1 t2: typ), {t1=t2} + {t1<>t2}.
+Proof. decide equality. Qed.
 
-Module myreg.
-  Definition T := myT.
-  Definition eq : forall (x y : T), {x=y}+{x<>y}.
-  Proof.
-    destruct x; destruct y; auto;
-    try (apply right; discriminate); try (apply left; discriminate).
-    destruct t; destruct t0;
-    try (apply right; congruence); try (apply left; congruence).
-    elim (peq r r0); intros.
-    rewrite a; apply left; apply refl_equal.
-    apply right; congruence.
-  Defined.
-End myreg.
-
-Module mymap.
-  Definition elt := myreg.T.
-  Definition encode (t : myreg.T) : positive :=
-    match t with
-    | tTy Tint => xH
-    | tTy Tfloat => xI xH
-    | tReg r => xO r
-    end.
-  Definition decode (p : positive) : elt :=
-    match p with
-    | xH => tTy Tint
-    | xI _ => tTy Tfloat
-    | xO r => tReg r
-    end.
-
-  Lemma encode_decode : forall x : myreg.T, decode (encode x) = x.
-  Proof.
-    destruct x; try destruct t; simpl; auto.
-  Qed.
-
-  Lemma encode_injective :
-    forall (x y : myreg.T), encode x = encode y -> x = y.
-  Proof.
-    intros.
-    unfold encode in H. destruct x; destruct y; try congruence;
-    try destruct t; try destruct t0; congruence.
-  Qed.
-
-  Definition T := PTree.t positive.
-  Definition empty := PTree.empty positive.
-  Definition get (adr : elt) (t : T) :=
-    option_map decode (PTree.get (encode adr) t).
-  Definition add (adr dat : elt) (t : T) :=
-    PTree.set (encode adr) (encode dat) t.
-
-  Theorem get_empty : forall (x : elt), get x empty = None.
-  Proof.
-    intro.
-    unfold get. unfold empty.
-    rewrite PTree.gempty.
-    simpl; auto.
-  Qed.
-  Theorem get_add_1 :
-    forall (x y : elt) (m : T), get x (add x y m) = Some y.
-  Proof.
-    intros.
-    unfold add. unfold get.
-    rewrite PTree.gss.
-    simpl; rewrite encode_decode; auto.
-  Qed.
-  Theorem get_add_2 :
-    forall (x y z : elt) (m : T), z <> x -> get z (add x y m) = get z m.
-  Proof.
-    intros.
-    unfold get. unfold add.
-    rewrite PTree.gso; auto.
-    intro. apply H. apply encode_injective. auto.
-  Qed.
-End mymap.
-
-Module Uf := Unionfind (myreg) (mymap).
-
-Definition error := Uf.identify Uf.empty (tTy Tint) (tTy Tfloat).
-
-Fixpoint fold2 (A B : Set) (f : Uf.T -> A -> B -> Uf.T)
-               (init : Uf.T) (la : list A) (lb : list B) {struct la}
-               : Uf.T :=
-  match la, lb with
-  | ha::ta, hb::tb => fold2 f (f init ha hb) ta tb
-  | nil, nil => init
-  | _, _ => error
-  end.
+Definition check_reg (r: reg) (ty: typ): bool :=
+  if typ_eq (env r) ty then true else false.
 
-Definition option_fold2 (A B : Set) (f : Uf.T -> A -> B -> Uf.T)
-                        (init : Uf.T) (oa : option A) (ob : option B)
-                        : Uf.T :=
-  match oa, ob with
-  | Some a, Some b => f init a b
-  | None, None => init
-  | _, _ => error
-  end.
-
-Definition teq (ty1 ty2 : typ) : bool :=
-  match ty1, ty2 with
-  | Tint, Tint => true
-  | Tfloat, Tfloat => true
+Fixpoint check_regs (rl: list reg) (tyl: list typ) {struct rl}: bool :=
+  match rl, tyl with
+  | nil, nil => true
+  | r1::rs, ty::tys => check_reg r1 ty && check_regs rs tys
   | _, _ => false
   end.
 
-Definition type_rtl_arg (u : Uf.T) (r : reg) (t : typ) :=
-  Uf.identify u (tReg r) (tTy t).
-
-Definition type_rtl_ros (u : Uf.T) (ros : reg+ident) :=
-  match ros with
-  | inl r => Uf.identify u (tReg r) (tTy Tint)
-  | inr s => u
-  end.
+Definition check_op (op: operation) (args: list reg) (res: reg): bool :=
+  let (targs, tres) := type_of_operation op in
+  check_regs args targs && check_reg res tres.
 
-Definition type_of_sig_res (sig : signature) :=
-  match sig.(sig_res) with None => Tint | Some ty => ty end.
-
-(** This is the core type inference function.  The [u] argument is
-  the current substitution / equivalence classes between types.
-  An updated set of equivalence classes, reflecting unifications
-  possibly performed during the type-checking of [i], is returned.
-  Note that [type_rtl_instr] never fails explicitly.  However,
-  in case of type error (e.g. applying the [Oadd] integer operation
-  to float registers), the equivalence relation returned will
-  put [tTy Tint] and [tTy Tfloat] in the same equivalence class.
-  This fact will propagate through type inference for other instructions,
-  and be detected at the end of type inference, indicating a typing failure.
-*)
-
-Definition type_rtl_instr (rtyp : option typ)
-    (u : Uf.T) (_ : positive) (i : instruction) :=
+Definition check_instr (i: instruction) : bool :=
   match i with
-  | Inop _ => u
-  | Iop Omove (r1 :: nil) r0 _ => Uf.identify u (tReg r0) (tReg r1)
-  | Iop Omove _ _ _ => error
-  | Iop Oundef nil _ _ => u
-  | Iop Oundef _ _ _ => error
-  | Iop op args r0 _ =>
-      let (argtyp, restyp) := type_of_operation op in
-      let u1 := type_rtl_arg u r0 restyp in
-      fold2 type_rtl_arg u1 args argtyp
-  | Iload chunk addr args r0 _ =>  
-      let u1 := type_rtl_arg u r0 (type_of_chunk chunk) in
-      fold2 type_rtl_arg u1 args (type_of_addressing addr)
-  | Istore chunk addr args r0 _ =>
-      let u1 := type_rtl_arg u r0 (type_of_chunk chunk) in
-      fold2 type_rtl_arg u1 args (type_of_addressing addr)
-  | Icall sign ros args r0 _ =>
-      let u1 := type_rtl_ros u ros in
-      let u2 := type_rtl_arg u1 r0 (type_of_sig_res sign) in
-      fold2 type_rtl_arg u2 args sign.(sig_args)
+  | Inop _ =>
+      true
+  | Iop Omove (arg::nil) res _ =>
+      if typ_eq (env arg) (env res) then true else false
+  | Iop Omove args res _ =>
+      false
+  | Iop Oundef nil res _ =>
+      true
+  | Iop Oundef args res _ =>
+      false
+  | Iop op args res _ =>
+      check_op op args res
+  | Iload chunk addr args dst _ =>
+      check_regs args (type_of_addressing addr)
+      && check_reg dst (type_of_chunk chunk)
+  | Istore chunk addr args src _ =>
+      check_regs args (type_of_addressing addr)
+      && check_reg src (type_of_chunk chunk)
+  | Icall sig ros args res _ =>
+      match ros with inl r => check_reg r Tint | inr s => true end
+      && check_regs args sig.(sig_args)
+      && check_reg res (match sig.(sig_res) with None => Tint | Some ty => ty end)
+  | Ialloc arg res _ =>
+      check_reg arg Tint && check_reg res Tint
   | Icond cond args _ _ =>
-      fold2 type_rtl_arg u args (type_of_condition cond)
-  | Ireturn o => option_fold2 type_rtl_arg u o rtyp
+      check_regs args (type_of_condition cond)
+  | Ireturn optres =>
+      match optres, funct.(fn_sig).(sig_res) with
+      | None, None => true
+      | Some r, Some t => check_reg r t
+      | _, _ => false
+      end
   end.
 
-Definition mk_env (u : Uf.T) (r : reg) :=
-  if myreg.eq (Uf.repr u (tReg r)) (Uf.repr u (tTy Tfloat))
-  then Tfloat
-  else Tint.
+Definition check_params_norepet (params: list reg): bool :=
+  if list_norepet_dec Reg.eq params then true else false.
 
-Fixpoint member (x : reg) (l : list reg) {struct l} : bool :=
-  match l with
-  | nil => false
-  | y :: rest => if peq x y then true else member x rest
+Fixpoint check_instrs (instrs: list (node * instruction)) : bool :=
+  match instrs with
+  | nil => true
+  | (pc, i) :: rem => check_instr i && check_instrs rem
   end.
 
-Fixpoint repet (l : list reg) : bool :=
-  match l with
-  | nil => false
-  | x :: rest => member x rest || repet rest
-  end.
+(** ** Correctness of the type-checking algorithm *)
 
-Definition type_rtl_function (f : function) :=
-  let u1 := PTree.fold (type_rtl_instr f.(fn_sig).(sig_res))
-                       f.(fn_code) Uf.empty in
-  let u2 := fold2 type_rtl_arg u1 f.(fn_params) f.(fn_sig).(sig_args) in
-  if repet f.(fn_params) then
-    None
-  else
-    if myreg.eq (Uf.repr u2 (tTy Tint)) (Uf.repr u2 (tTy Tfloat))
-    then None
-    else Some (mk_env u2).
-
-Unset Implicit Arguments.
-
-(** ** Correctness proof for type inference *)
-
-(** General properties of the type equivalence relation. *)
-
-Definition consistent (u : Uf.T) :=
-  Uf.repr u (tTy Tint) <> Uf.repr u (tTy Tfloat).
-
-Lemma consistent_not_eq : forall (u : Uf.T) (A : Type) (x y : A),
-  consistent u ->
-  (if myreg.eq (Uf.repr u (tTy Tint)) (Uf.repr u (tTy Tfloat)) then x else y)
-  = y.
-  Proof.
-    intros.
-    unfold consistent in H.
-    destruct (myreg.eq (Uf.repr u (tTy Tint)) (Uf.repr u (tTy Tfloat)));
-    congruence.
-  Qed.
-
-Lemma equal_eq : forall (t : myT) (A : Type) (x y : A),
-  (if myreg.eq t t then x else y) = x.
-  Proof.
-    intros.
-    destruct (myreg.eq t t); congruence.
-  Qed.
-
-Lemma error_inconsistent : forall (A : Prop), consistent error -> A.
-  Proof.
-    intros.
-    absurd (consistent error); auto.
-    intro.
-    unfold error in H.  unfold consistent in H.
-    rewrite Uf.sameclass_identify_1 in H.
-    congruence.
-  Qed.
-
-Lemma teq_correct : forall (t1 t2 : typ), teq t1 t2 = true -> t1 = t2.
-  Proof.
-    intros; destruct t1; destruct t2; try simpl in H; congruence.
-  Qed.
-
-Definition included (u1 u2 : Uf.T) : Prop :=
-  forall (e1 e2: myT),
-    Uf.repr u1 e1 = Uf.repr u1 e2 -> Uf.repr u2 e1 = Uf.repr u2 e2.
-
-Lemma included_refl :
-  forall (e : Uf.T), included e e.
-  Proof.
-    unfold included. auto.
-  Qed.
-
-Lemma included_trans :
-  forall (e1 e2 e3 : Uf.T),
-  included e3 e2 -> included e2 e1 -> included e3 e1.
-  Proof.
-    unfold included. auto.
-  Qed.
-
-Lemma included_consistent :
-  forall (u1 u2 : Uf.T),
-  included u1 u2 -> consistent u2 -> consistent u1.
-  Proof.
-    unfold consistent. unfold included.
-    intros.
-    intro. apply H0. apply H.
-    auto.
-  Qed.
-
-Lemma included_identify :
-  forall (u : Uf.T) (t1 t2 : myT), included u (Uf.identify u t1 t2).
-  Proof.
-  unfold included.
-  intros.
-  apply Uf.sameclass_identify_2; auto.
-  Qed.
-
-Lemma type_arg_correct_1 :
-  forall (u : Uf.T) (r : reg) (t : typ),
-  consistent (type_rtl_arg u r t)
-  -> Uf.repr (type_rtl_arg u r t) (tReg r)
-     = Uf.repr (type_rtl_arg u r t) (tTy t).
-  Proof.
-    intros.
-    unfold type_rtl_arg.
-    rewrite Uf.sameclass_identify_1.
-    auto.
-  Qed.
-
-Lemma type_arg_correct :
-  forall (u : Uf.T) (r : reg) (t : typ),
-  consistent (type_rtl_arg u r t) -> mk_env (type_rtl_arg u r t) r = t.
-  Proof.
-    intros.
-    unfold mk_env. 
-    rewrite type_arg_correct_1.
-    destruct t.
-    apply consistent_not_eq; auto.
-    destruct (myreg.eq (Uf.repr (type_rtl_arg u r Tfloat) (tTy Tfloat)));
-    congruence.
-    auto.
-  Qed.
-
-Lemma type_arg_included :
-  forall (u : Uf.T) (r : reg) (t : typ), included u (type_rtl_arg u r t).
-  Proof.
-    intros.
-    unfold type_rtl_arg.
-    apply included_identify.
-  Qed.
-
-Lemma type_arg_extends :
-  forall (u : Uf.T) (r : reg) (t : typ),
-  consistent (type_rtl_arg u r t) -> consistent u.
-  Proof.
-    intros.
-    apply included_consistent with (u2 := type_rtl_arg u r t).
-    apply type_arg_included.
-    auto.
-  Qed.
-
-Lemma type_args_included :
-  forall (l1 : list reg) (l2 : list typ) (u : Uf.T),
-  consistent (fold2 type_rtl_arg u l1 l2)
-  -> included u (fold2 type_rtl_arg u l1 l2).
-  Proof.
-    induction l1; intros; destruct l2.
-    simpl in H; simpl; apply included_refl.
-    simpl in H. apply error_inconsistent. auto.
-    simpl in H. apply error_inconsistent. auto.
-    simpl.
-    simpl in H.
-    apply included_trans with (e2 := type_rtl_arg u a t).
-    apply type_arg_included.
-    apply IHl1.
-    auto.
-  Qed.
-
-Lemma type_args_extends :
-  forall (l1 : list reg) (l2 : list typ) (u : Uf.T),
-  consistent (fold2 type_rtl_arg u l1 l2) -> consistent u.
-  Proof.
-    intros.
-    apply (included_consistent _ _ (type_args_included l1 l2 u H)).
-    auto.
-  Qed.
-
-Lemma type_args_correct :
-  forall (l1 : list reg) (l2 : list typ) (u : Uf.T),
-  consistent (fold2 type_rtl_arg u l1 l2)
-  -> map (mk_env (fold2 type_rtl_arg u l1 l2)) l1 = l2.
-  Proof.
-    induction l1.
-    intros.
-    destruct l2.
-    unfold map; simpl; auto.
-    simpl in H; apply error_inconsistent; auto.
-    intros.
-    destruct l2.
-    simpl in H; apply error_inconsistent; auto.
-    simpl.
-    simpl in H.
-    rewrite (IHl1 l2 (type_rtl_arg u a t) H).
-    unfold mk_env.
-    destruct t.
-    rewrite (type_args_included _ _ _ H (tReg a) (tTy Tint)).
-    rewrite consistent_not_eq; auto.
-    apply type_arg_correct_1.
-    apply type_args_extends with (l1 := l1) (l2 := l2); auto.
-    rewrite (type_args_included _ _ _ H (tReg a) (tTy Tfloat)).
-    rewrite equal_eq; auto.
-    apply type_arg_correct_1.
-    apply type_args_extends with (l1 := l1) (l2 := l2); auto.
-  Qed.
-
-(** Correctness of [wt_params]. *)
-
-Lemma type_rtl_function_params :
-  forall (f: function) (env: regenv),
-  type_rtl_function f = Some env
-  -> List.map env f.(fn_params) = f.(fn_sig).(sig_args).
-  Proof.
-    destruct f; unfold type_rtl_function; simpl.
-    destruct (repet fn_params); simpl; intros; try congruence.
-    pose (u := PTree.fold (type_rtl_instr (sig_res fn_sig)) fn_code Uf.empty).
-    fold u in H.
-    cut (consistent (fold2 type_rtl_arg u fn_params (sig_args fn_sig))).
-    intro.
-    pose (R := Uf.repr (fold2 type_rtl_arg u fn_params (sig_args fn_sig))).
-    fold R in H.
-    destruct (myreg.eq (R (tTy Tint)) (R (tTy Tfloat))).
-    congruence.
-    injection H.
-    intro.
-    rewrite <- H1.
-    apply type_args_correct.
-    auto.
-    intro.
-    rewrite H0 in H.
-    rewrite equal_eq in H.
-    congruence.
-  Qed.
-
-(** Correctness of [wt_norepet]. *)
-
-Lemma member_correct :
-  forall (l : list reg) (a : reg), member a l = false -> ~In a l.
-  Proof.
-    induction l; simpl; intros; try tauto.
-    destruct (peq a0 a); simpl; try congruence.
-    intro. destruct H0; try congruence.
-    generalize H0; apply IHl; auto.
-  Qed.
-
-Lemma repet_correct :
-  forall (l : list reg), repet l = false -> list_norepet l.
-  Proof.
-    induction l; simpl; intros.
-     exact (list_norepet_nil reg).
-     elim (orb_false_elim (member a l) (repet l) H); intros.
-     apply list_norepet_cons.
-      apply member_correct; auto.
-      apply IHl; auto.
-  Qed.
-
-Lemma type_rtl_function_norepet :
-  forall (f: function) (env: regenv),
-  type_rtl_function f = Some env
-  -> list_norepet f.(fn_params).
-  Proof.
-    destruct f; unfold type_rtl_function; simpl.
-    intros. cut (repet fn_params = false).
-     intro. apply repet_correct. auto.
-     destruct (repet fn_params); congruence.
-  Qed.
-
-(** Correctness of [wt_instrs]. *)
-
-Lemma step1 :
-  forall (f : function) (env : regenv),
-  type_rtl_function f = Some env
-  -> exists u2 : Uf.T,
-       included (PTree.fold (type_rtl_instr f.(fn_sig).(sig_res))
-                            f.(fn_code) Uf.empty)
-                u2
-       /\ env = mk_env u2
-       /\ consistent u2.
-  Proof.
-    intros f env.
-    pose (u1 := (PTree.fold (type_rtl_instr f.(fn_sig).(sig_res))
-                            f.(fn_code) Uf.empty)).
-    fold u1.
-    unfold type_rtl_function.
-    intros.
-    destruct (repet f.(fn_params)).
-    congruence.
-    fold u1 in H.
-    pose (u2 := (fold2 type_rtl_arg u1 f.(fn_params) f.(fn_sig).(sig_args))).
-    fold u2 in H.
-    exists u2.
-    caseEq (myreg.eq (Uf.repr u2 (tTy Tint)) (Uf.repr u2 (tTy Tfloat))).
-    intros.
-    rewrite e in H.
-    rewrite equal_eq in H.
-    congruence.
-    intros.
-    rewrite consistent_not_eq in H.
-    apply conj.
-    unfold u2.
-    apply type_args_included.
-    auto.
-    apply conj; auto.
-    congruence.
-    auto.
-  Qed.
-
-Lemma let_fold_args_res :
-  forall (u : Uf.T) (l : list reg) (r : reg) (e : list typ * typ),
-  (let (argtyp, restyp) := e in
-   fold2 type_rtl_arg (type_rtl_arg u r restyp) l argtyp)
-  = fold2 type_rtl_arg (type_rtl_arg u r (snd e)) l (fst e).
-  Proof.
-    intros. rewrite (surjective_pairing e). simpl. auto.
-  Qed.
-
-Lemma type_args_res_included :
-  forall (l1 : list reg) (l2 : list typ) (u : Uf.T) (r : reg) (t : typ),
-  consistent (fold2 type_rtl_arg (type_rtl_arg u r t) l1 l2)
-  -> included u (fold2 type_rtl_arg (type_rtl_arg u r t) l1 l2).
-  Proof.
-  intros.
-  apply included_trans with (e2 := type_rtl_arg u r t).
-  apply type_arg_included.
-  apply type_args_included; auto.
-  Qed.
-
-Lemma type_args_res_ros_included :
-  forall (l1 : list reg) (l2 : list typ) (u : Uf.T) (r : reg) (t : typ)
-         (ros : reg+ident),
-  consistent (fold2 type_rtl_arg (type_rtl_arg (type_rtl_ros u ros) r t) l1 l2)
-  -> included u (fold2 type_rtl_arg (type_rtl_arg (type_rtl_ros u ros) r t) l1 l2).
+Lemma check_reg_correct:
+  forall r ty, check_reg r ty = true -> env r = ty.
 Proof.
-  intros.
-  apply included_trans with (e2 := type_rtl_ros u ros).
-  unfold type_rtl_ros; destruct ros.
-  apply included_identify.
-  apply included_refl.
-  apply type_args_res_included; auto.
+  unfold check_reg; intros.
+  destruct (typ_eq (env r) ty). auto. discriminate.
 Qed.
 
-Lemma type_instr_included :
-  forall (p : positive) (i : instruction) (u : Uf.T) (res_ty : option typ),
-  consistent (type_rtl_instr res_ty u p i)
-  -> included u (type_rtl_instr res_ty u p i).
-  Proof.
-    intros.
-    destruct i; simpl; simpl in H; try apply type_args_res_included; auto.
-    apply included_refl; auto.
-    destruct o; simpl; simpl in H; try apply type_args_res_included; auto.
-    destruct l; simpl; simpl in H; auto.
-    apply error_inconsistent; auto.
-    destruct l; simpl; simpl in H; auto.
-    apply included_identify.
-    apply error_inconsistent; auto.
-    destruct l; simpl; simpl in H; auto.
-    apply included_refl.
-    apply error_inconsistent; auto.
-    apply type_args_res_ros_included; auto.
-    apply type_args_included; auto.
-    destruct res_ty; destruct o; simpl; simpl in H;
-      try (apply error_inconsistent; auto; fail).
-    apply type_arg_included.
-    apply included_refl.
-   Qed.
-
-Lemma type_instrs_extends :
-  forall (l : list (positive * instruction)) (u : Uf.T) (res_ty : option typ),
-  consistent
-      (fold_left (fun v p => type_rtl_instr res_ty v (fst p) (snd p)) l u)
-  -> consistent u.
+Lemma check_regs_correct:
+  forall rl tyl, check_regs rl tyl = true -> List.map env rl = tyl.
 Proof.
-  induction l; simpl; intros.
-  auto.
-  apply included_consistent
-     with (u2 := (type_rtl_instr res_ty u (fst a) (snd a))).
-  apply type_instr_included.
-  apply IHl with (res_ty := res_ty); auto.
-  apply IHl with (res_ty := res_ty); auto.
+  induction rl; destruct tyl; simpl; intros.
+  auto. discriminate. discriminate.
+  elim (andb_prop _ _ H); intros. 
+  rewrite (check_reg_correct _ _ H0). rewrite (IHrl tyl H1). auto.
 Qed.
 
-Lemma type_instrs_included :
-  forall (l : list (positive * instruction)) (u : Uf.T) (res_ty : option typ),
-  consistent
-      (fold_left (fun v p => type_rtl_instr res_ty v (fst p) (snd p)) l u)
-  -> included u
-         (fold_left (fun v p => type_rtl_instr res_ty v (fst p) (snd p)) l u).
-  Proof.
-    induction l; simpl; intros.
-    apply included_refl; auto.
-    apply included_trans with (e2 := (type_rtl_instr res_ty u (fst a) (snd a))).
-    apply type_instr_included.
-    apply type_instrs_extends with (res_ty := res_ty) (l := l); auto.
-    apply IHl; auto.
-  Qed.
-
-Lemma step2 :
-  forall (res_ty : option typ) (c : code) (u0 : Uf.T),
-  consistent (PTree.fold (type_rtl_instr res_ty) c u0) ->
-  forall (pc : positive) (i : instruction),
-  c!pc = Some i
-  -> exists u : Uf.T,
-        consistent (type_rtl_instr res_ty u pc i)
-     /\ included (type_rtl_instr res_ty u pc i)
-                    (PTree.fold (type_rtl_instr res_ty) c u0).
-  Proof.
-    intros.
-    rewrite PTree.fold_spec.
-    rewrite PTree.fold_spec in H.
-    pose (H1 := PTree.elements_correct _ _ H0).
-    generalize H. clear H.
-    generalize u0. clear u0.
-    generalize H1. clear H1.
-    induction (PTree.elements c).
-    intros.
-    absurd (In (pc, i) nil).
-    apply in_nil.
-    auto.
-    intros.
-    simpl in H.
-    elim H1.
-    intro.
-    rewrite H2 in H.
-    simpl in H.
-    rewrite H2. simpl.
-    exists u0.
-    apply conj.
-    apply type_instrs_extends with (res_ty := res_ty) (l := l).
-    auto.
-    apply type_instrs_included.
-    auto.
-    intro.
-    simpl.
-    apply IHl.
-    auto.
-    auto.
-  Qed.
-
-Definition mapped (u : Uf.T) (r : reg) :=
-  Uf.repr u (tReg r) = Uf.repr u (tTy Tfloat)
-  \/ Uf.repr u (tReg r) = Uf.repr u (tTy Tint).
-
-Definition definite (u : Uf.T) (i : instruction) :=
-  match i with
-  | Inop _ => True
-  | Iop Omove (r1 :: nil) r0 _ => Uf.repr u (tReg r1) = Uf.repr u (tReg r0)
-  | Iop Oundef _ _ _ => True
-  | Iop _ args r0 _ =>
-         mapped u r0 /\ forall r : reg, In r args -> mapped u r
-  | Iload _ _ args r0 _ =>
-         mapped u r0 /\ forall r : reg, In r args -> mapped u r
-  | Istore _ _ args r0 _ =>
-         mapped u r0 /\ forall r : reg, In r args -> mapped u r
-  | Icall _ ros args r0 _ =>
-      match ros with inl r => mapped u r | _ => True end
-      /\ mapped u r0 /\ forall r : reg, In r args -> mapped u r
-  | Icond _ args _ _ =>
-      forall r : reg, In r args -> mapped u r
-  | Ireturn None => True
-  | Ireturn (Some r) => mapped u r
-  end.
-
-Lemma type_arg_complete :
-  forall (u : Uf.T) (r : reg) (t : typ),
-  mapped (type_rtl_arg u r t) r.
-Proof.
-  intros.
-  unfold type_rtl_arg.
-  unfold mapped.
-  destruct t.
-  right; apply Uf.sameclass_identify_1.
-  left; apply Uf.sameclass_identify_1.
-Qed.
-
-Lemma type_arg_mapped :
-  forall (u : Uf.T) (r r0 : reg) (t : typ),
-  mapped u r0 -> mapped (type_rtl_arg u r t) r0.
-Proof.
-  unfold mapped.
-  unfold type_rtl_arg.
-  intros.
-  elim H; intros.
-  left; apply Uf.sameclass_identify_2; auto.
-  right; apply Uf.sameclass_identify_2; auto.
-Qed.
-
-Lemma type_args_mapped :
-  forall (lr : list reg) (lt : list typ) (u : Uf.T) (r : reg),
-  consistent (fold2 type_rtl_arg u lr lt) ->
-  mapped u r ->
-    mapped (fold2 type_rtl_arg u lr lt) r.
+Lemma check_op_correct:
+  forall op args res,
+  check_op op args res = true ->
+  (List.map env args, env res) = type_of_operation op.
 Proof.
-  induction lr; simpl; intros.
-  destruct lt; simpl; auto; try (apply error_inconsistent; auto; fail).
-  destruct lt; simpl; auto; try (apply error_inconsistent; auto; fail).
-  apply IHlr.
+  unfold check_op; intros.
+  destruct (type_of_operation op) as [targs tres]. 
+  elim (andb_prop _ _ H); intros.
+  rewrite (check_regs_correct _ _ H0).
+  rewrite (check_reg_correct _ _ H1).
   auto.
-  apply type_arg_mapped; auto.
-Qed.
-
-Lemma type_args_complete :
-  forall (lr : list reg) (lt : list typ) (u : Uf.T),
-  consistent (fold2 type_rtl_arg u lr lt)
-  -> forall r, (In r lr -> mapped (fold2 type_rtl_arg u lr lt) r).
-Proof.
-  induction lr; simpl; intros.
-  destruct lt; simpl; try tauto.
-  destruct lt; simpl.
-  apply error_inconsistent; auto.
-  elim H0; intros.
-  rewrite H1.
-  rewrite H1 in H.
-  apply type_args_mapped; auto.
-  apply type_arg_complete.
-  apply IHlr; auto.
-Qed.
-
-Lemma type_res_complete :
-  forall (u : Uf.T) (lr : list reg) (lt : list typ) (r : reg) (t : typ),
-  consistent (fold2 type_rtl_arg (type_rtl_arg u r t) lr lt)
-  -> mapped (fold2 type_rtl_arg (type_rtl_arg u r t) lr lt) r.
-Proof.
-  intros.
-  apply type_args_mapped; auto.
-  apply type_arg_complete.
 Qed.
 
-Lemma type_args_res_complete :
-  forall (u : Uf.T) (lr : list reg) (lt : list typ) (r : reg) (t : typ),
-  consistent (fold2 type_rtl_arg (type_rtl_arg u r t) lr lt)
-  -> mapped (fold2 type_rtl_arg (type_rtl_arg u r t) lr lt) r
-      /\ forall rr, (In rr lr -> mapped (fold2 type_rtl_arg (type_rtl_arg u r t)
-                                                            lr lt)
-                                        rr).
+Lemma check_instr_correct:
+  forall i, check_instr i = true -> wt_instr env funct.(fn_sig) i.
 Proof.
-  intros.
-  apply conj.
-  apply type_res_complete; auto.
-  apply type_args_complete; auto.
+  unfold check_instr; intros; destruct i.
+  (* nop *)
+  constructor.
+  (* op *)
+  destruct o;
+  try (apply wt_Iop; [congruence|congruence|apply check_op_correct;auto]).
+  destruct l; try discriminate. destruct l; try discriminate.
+  destruct (typ_eq (env r0) (env r)); try discriminate.
+  apply wt_Iopmove; auto.
+  destruct l; try discriminate.
+  apply wt_Iopundef.
+  (* load *)
+  elim (andb_prop _ _ H); intros.
+  constructor. apply check_regs_correct; auto. apply check_reg_correct; auto.
+  (* store *)
+  elim (andb_prop _ _ H); intros.
+  constructor. apply check_regs_correct; auto. apply check_reg_correct; auto.
+  (* call *)
+  elim (andb_prop _ _ H); clear H; intros.
+  elim (andb_prop _ _ H); clear H; intros.
+  constructor.
+  destruct s0; auto. apply check_reg_correct; auto.
+  apply check_regs_correct; auto.
+  apply check_reg_correct; auto.
+  (* alloc *)
+  elim (andb_prop _ _ H); intros.
+  constructor; apply check_reg_correct; auto.
+  (* cond *)
+  constructor. apply check_regs_correct; auto.
+  (* return *)
+  constructor. 
+  destruct o; simpl; destruct funct.(fn_sig).(sig_res); try discriminate.
+  rewrite (check_reg_correct _ _ H); auto.
+  auto.
 Qed.
 
-Lemma type_ros_complete :
-  forall (u : Uf.T) (lr : list reg) (lt : list typ) (r r1 : reg) (t : typ),
-  consistent (fold2 type_rtl_arg (type_rtl_arg
-                                    (type_rtl_ros u (inl ident r1)) r t) lr lt)
-  ->
-  mapped (fold2 type_rtl_arg (type_rtl_arg
-                                (type_rtl_ros u (inl ident r1)) r t) lr lt) r1.
+Lemma check_instrs_correct:
+  forall instrs,
+  check_instrs instrs = true ->
+  forall pc i, In (pc, i) instrs -> wt_instr env funct.(fn_sig) i.
 Proof.
-  intros.
-  apply type_args_mapped; auto.
-  apply type_arg_mapped.
-  unfold type_rtl_ros.
-  unfold mapped.
-  right.
-  apply Uf.sameclass_identify_1; auto.
+  induction instrs; simpl; intros.
+  elim H0.
+  destruct a as [pc' i']. elim (andb_prop _ _ H); clear H; intros.
+  elim H0; intro.
+  inversion H2; subst pc' i'. apply check_instr_correct; auto.
+  eauto.
 Qed.
 
-Lemma type_res_correct :
-  forall (u : Uf.T) (lr : list reg) (lt : list typ) (r : reg) (t : typ),
-  consistent (fold2 type_rtl_arg (type_rtl_arg u r t) lr lt)
-  -> mk_env (fold2 type_rtl_arg (type_rtl_arg u r t) lr lt) r = t.
-Proof.
-  intros.
-  unfold mk_env.
-  rewrite (type_args_included _ _ _ H (tReg r) (tTy t)).
-  destruct t.
-  apply consistent_not_eq; auto.
-  apply equal_eq; auto.
-  unfold type_rtl_arg; apply Uf.sameclass_identify_1; auto.
-Qed.
+End TYPECHECKING.
 
-Lemma type_ros_correct :
-  forall (u : Uf.T) (lr : list reg) (lt : list typ) (r r1 : reg) (t : typ),
-  consistent (fold2 type_rtl_arg (type_rtl_arg
-                                    (type_rtl_ros u (inl ident r1)) r t) lr lt)
-  ->
-  mk_env (fold2 type_rtl_arg (type_rtl_arg
-                                (type_rtl_ros u (inl ident r1)) r t) lr lt) r1
-  = Tint.
-Proof.
-  intros.
-  unfold mk_env.
-  rewrite (type_args_included _ _ _ H (tReg r1) (tTy Tint)).
-  apply consistent_not_eq; auto.
-  rewrite (type_arg_included (type_rtl_ros u (inl ident r1)) r t (tReg r1) (tTy Tint)).
-  auto.
-  simpl.
-  apply Uf.sameclass_identify_1; auto.
-Qed.
-
-Lemma step3 :
-  forall (u : Uf.T) (f : function) (c : code) (i : instruction) (pc : positive),
-  c!pc = Some i ->
-  consistent (type_rtl_instr f.(fn_sig).(sig_res) u pc i)
-  ->    wt_instr (mk_env (type_rtl_instr f.(fn_sig).(sig_res) u pc i)) f i
-     /\ definite (type_rtl_instr f.(fn_sig).(sig_res) u pc i) i.
-  Proof.
-    Opaque type_rtl_arg.
-    intros.
-    destruct i; simpl in H0; simpl.
-     (* Inop *)
-     apply conj; auto. apply wt_Inop.
-     (* Iop *)
-     destruct o;
-       try (apply conj; [
-             apply wt_Iop; try congruence; simpl;
-               rewrite (type_args_correct _ _ _ H0);
-               rewrite (type_res_correct _ _ _ _ _ H0);
-               auto
-            |apply (type_args_res_complete _ _ _ _ _ H0)]).
-      (* Omove *)
-      destruct l; [apply error_inconsistent; auto | idtac].
-      destruct l; [idtac | apply error_inconsistent; auto].
-      apply conj.
-      apply wt_Iopmove.
-      simpl.
-      unfold mk_env.
-      rewrite Uf.sameclass_identify_1.
-      congruence.
-      simpl.
-      rewrite Uf.sameclass_identify_1; congruence.
-      (* Oundef *)
-      destruct l; [idtac | apply error_inconsistent; auto].
-      apply conj. apply wt_Iopundef.
-      unfold definite. auto.
-     (* Iload *)
-     apply conj.
-      apply wt_Iload.
-       rewrite (type_args_correct _ _ _ H0); auto.
-       rewrite (type_res_correct _ _ _ _ _ H0); auto.
-      simpl; apply (type_args_res_complete _ _ _ _ _ H0).
-     (* IStore *)
-     apply conj.
-      apply wt_Istore.
-       rewrite (type_args_correct _ _ _ H0); auto.
-       rewrite (type_res_correct _ _ _ _ _ H0); auto.
-      simpl; apply (type_args_res_complete _ _ _ _ _ H0).
-     (* Icall *)
-     apply conj.
-      apply wt_Icall.
-       destruct s0; auto. apply type_ros_correct. auto.
-       apply type_args_correct. auto.
-       fold (type_of_sig_res s). apply type_res_correct. auto.
-      destruct s0.
-       apply conj.
-        apply type_ros_complete. auto.
-        apply type_args_res_complete. auto.
-       apply conj; auto.
-         apply type_args_res_complete. auto.
-     (* Icond *) 
-     apply conj.
-      apply wt_Icond.
-       apply (type_args_correct _ _ _ H0).
-       simpl; apply (type_args_complete _ _ _ H0).
-     (* Ireturn *)
-     destruct o; simpl.
-      apply conj.
-       apply wt_Ireturn.
-         destruct f.(fn_sig).(sig_res); simpl; simpl in H0.
-          rewrite type_arg_correct; auto.
-          apply error_inconsistent; auto.
-       destruct f.(fn_sig).(sig_res); simpl; simpl in H0.
-          apply type_arg_complete.
-          apply error_inconsistent; auto.
-      apply conj; auto. apply wt_Ireturn.
-        destruct f.(fn_sig).(sig_res); simpl; simpl in H0.
-         apply error_inconsistent; auto.
-         congruence.
-    Transparent type_rtl_arg.
-  Qed.
-
-Lemma mapped_included_consistent :
-  forall (u1 u2 : Uf.T) (r : reg),
-  mapped u1 r ->
-  included u1 u2 ->
-  consistent u2 ->
-  mk_env u2 r = mk_env u1 r.
-Proof.
-  intros.
-  unfold mk_env.
-  unfold mapped in H.
-  elim H; intros; rewrite H2; rewrite (H0 _ _ H2).
-  rewrite equal_eq; rewrite equal_eq; auto.
-  rewrite (consistent_not_eq u2).
-  rewrite (consistent_not_eq u1).
-  auto.
-  apply included_consistent with (u2 := u2).
-  auto.
-  auto.
-  auto.
-Qed.
+(** ** The type inference function **)
 
-Lemma mapped_list_included :
-  forall (u1 u2 : Uf.T) (lr : list reg),
-  (forall r, In r lr -> mapped u1 r) ->
-  included u1 u2 ->
-  consistent u2 ->
-    map (mk_env u2) lr = map (mk_env u1) lr.
-Proof.
-  induction lr; simpl; intros.
-  auto.
-  rewrite (mapped_included_consistent u1 u2 a).
-  rewrite IHlr; auto.
-  apply (H a); intros.
-  left; auto.
-  auto.
-  auto.
-Qed.
+Definition type_function (f: function): option regenv :=
+  let instrs := PTree.elements f.(fn_code) in
+  match infer_type_environment f instrs with
+  | None => None
+  | Some env =>
+      if check_regs env f.(fn_params) f.(fn_sig).(sig_args)
+      && check_params_norepet f.(fn_params)
+      && check_instrs f env instrs
+      then Some env else None
+  end.
 
-Lemma included_mapped :
-  forall (u1 u2 : Uf.T) (r : reg),
-  included u1 u2 ->
-  mapped u1 r ->
-    mapped u2 r.
-Proof.
-  unfold mapped.
-  intros.
-  elim H0; intros.
-  left; rewrite (H _ _ H1); auto.
-  right; rewrite (H _ _ H1); auto.
-Qed.
+Definition type_external_function (ef: external_function): bool :=
+  List.fold_right
+    (fun l b => match l with Locations.S _ => false | Locations.R _ => b end)
+    true (Conventions.loc_arguments ef.(ef_sig)).
 
-Lemma included_mapped_forall :
-  forall (u1 u2 : Uf.T) (r : reg) (l : list reg),
-  included u1 u2 ->
-  mapped u1 r /\ (forall r, In r l -> mapped u1 r) ->
-    mapped u2 r /\ (forall r, In r l -> mapped u2 r).
+Lemma type_function_correct:
+  forall f env,
+  type_function f = Some env ->
+  wt_function f env.
 Proof.
-  intros.
-  elim H0; intros.
-  apply conj.
-  apply (included_mapped _ _ r H); auto.
-  intros.
-  apply (included_mapped _ _ r0 H).
-  apply H2; auto.
+  unfold type_function; intros until env.
+  set (instrs := PTree.elements f.(fn_code)).
+  case (infer_type_environment f instrs).
+  intro env'. 
+  caseEq (check_regs env' f.(fn_params) f.(fn_sig).(sig_args)); intro; simpl; try congruence.
+  caseEq (check_params_norepet f.(fn_params)); intro; simpl; try congruence.
+  caseEq (check_instrs f env' instrs); intro; simpl; try congruence.
+  intro EQ; inversion EQ; subst env'.
+  constructor. 
+  apply check_regs_correct; auto.
+  unfold check_params_norepet in H0. 
+  destruct (list_norepet_dec Reg.eq (fn_params f)). auto. discriminate.
+  intros. eapply check_instrs_correct. eauto. 
+  unfold instrs. apply PTree.elements_correct. eauto.
+  congruence.
 Qed.
 
-Lemma definite_included :
-  forall (u1 u2 : Uf.T) (i : instruction),
-  included u1 u2 -> definite u1 i -> definite u2 i.
+Lemma type_external_function_correct:
+  forall ef,
+  type_external_function ef = true ->
+  Conventions.sig_external_ok ef.(ef_sig).
 Proof.
-  unfold definite.
-  intros.
-  destruct i; try apply (included_mapped_forall _ _ _ _ H H0); auto.
-  destruct o; try apply (included_mapped_forall _ _ _ _ H H0); auto.
-  destruct l; auto.
-  apply (included_mapped_forall _ _ _ _ H H0).
-  destruct l; auto.
-  apply (included_mapped_forall _ _ _ _ H H0).
-  destruct s0; auto.
-  elim H0; intros.
-  apply conj.
-  apply (included_mapped _ _ _ H H1).
-  apply (included_mapped_forall _ _ _ _ H H2).
-  elim H0; intros.
-  apply conj; auto.
-  apply (included_mapped_forall _ _ _ _ H H2).
-  intros.
-  apply (included_mapped _ _ _ H (H0 r H1)).
-  destruct o; auto.
-  apply (included_mapped _ _ _ H H0).
+  intro ef. unfold type_external_function, Conventions.sig_external_ok.
+  generalize (Conventions.loc_arguments (ef_sig ef)).
+  induction l; simpl.
+  tauto.
+  destruct a. intros. firstorder congruence.
+  congruence.
 Qed.
 
-Lemma step4 :
-  forall (f : function) (u1 u3 : Uf.T) (i : instruction),
-  included u3 u1 ->
-  wt_instr (mk_env u3) f i ->
-  definite u3 i ->
-  consistent u1 ->
-    wt_instr (mk_env u1) f i.
-  Proof.
-    intros f u1 u3 i H1 H H0 X.
-    destruct H; try simpl in H0; try (elim H0; intros).
-     apply wt_Inop.
-     apply wt_Iopmove. unfold mk_env. rewrite (H1 _ _ H0). auto.
-     apply wt_Iopundef.
-     apply wt_Iop; auto.
-       destruct op; try congruence; simpl; simpl in H3;
-       simpl in H0; elim H0; intros; rewrite (mapped_included_consistent _ _ _ H4 H1 X);
-       rewrite (mapped_list_included _ _ _ H5 H1); auto.
-     apply wt_Iload.
-      rewrite (mapped_list_included _ _ _ H4 H1); auto.
-      rewrite (mapped_included_consistent _ _ _ H3 H1 X). auto.
-     apply wt_Istore.
-      rewrite (mapped_list_included _ _ _ H4 H1); auto.
-      rewrite (mapped_included_consistent _ _ _ H3 H1 X). auto.
-     elim H5; intros; destruct ros; apply wt_Icall.
-      rewrite (mapped_included_consistent _ _ _ H4 H1 X); auto.
-      rewrite (mapped_list_included _ _ _ H7 H1); auto.
-      rewrite (mapped_included_consistent _ _ _ H6 H1 X); auto.
-      auto.
-      rewrite (mapped_list_included _ _ _ H7 H1); auto.
-      rewrite (mapped_included_consistent _ _ _ H6 H1 X); auto.
-     apply wt_Icond. rewrite (mapped_list_included _ _ _ H0 H1); auto.
-     apply wt_Ireturn.
-      destruct optres; destruct f.(fn_sig).(sig_res);
-        simpl in H; simpl; try congruence.
-        rewrite (mapped_included_consistent _ _ _ H0 H1 X); auto.
-  Qed.
-
-Lemma type_rtl_function_instrs :
-  forall (f: function) (env: regenv),
-  type_rtl_function f = Some env
-  -> forall pc i, f.(fn_code)!pc = Some i -> wt_instr env f i.
-  Proof.
-    intros.
-    elim (step1 _ _ H).
-    intros.
-    elim H1.
-    intros.
-    elim H3.
-    intros.
-    rewrite H4.
-    elim (step2 _ _ _ (included_consistent _ _ H2 H5) _ _ H0).
-    intros.
-    elim H6. intros.
-    elim (step3 x0 f _ _ _ H0); auto. intros.
-    apply (step4 f _ _ i H2); auto.
-    apply (step4 _ _ _ _ H8 H9 H10).
-    apply (included_consistent _ _ H2); auto.
-    apply (definite_included _ _ _ H8 H10); auto.
-  Qed.
-
-(** Combining the sub-proofs. *)
-
-Theorem type_rtl_function_correct:
-  forall (f: function) (env: regenv),
-  type_rtl_function f = Some env -> wt_function env f.
-  Proof.
-    intros.
-    exact (mk_wt_function env f (type_rtl_function_params f _ H)
-                                (type_rtl_function_norepet f _ H)
-                                (type_rtl_function_instrs f _ H)).
-  Qed.
-
-Definition wt_program (p: program) : Prop :=
-  forall i f, In (i, f) (prog_funct p) -> type_rtl_function f <> None.
-
 (** * Type preservation during evaluation *)
 
 (** The type system for RTL is not sound in that it does not guarantee
@@ -1143,6 +358,7 @@ Require Import Globalenvs.
 Require Import Values.
 Require Import Mem.
 Require Import Integers.
+Require Import Events.
 
 Definition wt_regset (env: regenv) (rs: regset) : Prop :=
   forall r, Val.has_type (rs#r) (env r).
@@ -1180,6 +396,14 @@ Proof.
   apply wt_regset_assign; auto.
 Qed.
 
+Lemma wt_event_match:
+  forall ef args t res,
+  event_match ef args t res ->
+  Val.has_type res (proj_sig_res ef.(ef_sig)).
+Proof.
+  induction 1. inversion H0; exact I.
+Qed.
+
 Section SUBJECT_REDUCTION.
 
 Variable p: program.
@@ -1190,26 +414,24 @@ Let ge := Genv.globalenv p.
 
 Definition exec_instr_subject_reduction
     (c: code) (sp: val)
-    (pc: node) (rs: regset) (m: mem)
+    (pc: node) (rs: regset) (m: mem) (t: trace)
     (pc': node) (rs': regset) (m': mem) : Prop :=
   forall env f
          (CODE: c = fn_code f)
-         (WT_FN: wt_function env f)
+         (WT_FN: wt_function f env)
          (WT_RS: wt_regset env rs),
   wt_regset env rs'.
 
 Definition exec_function_subject_reduction
-    (f: function) (args: list val) (m: mem) (res: val) (m': mem) : Prop :=
-  forall env,
-  wt_function env f ->  
-  Val.has_type_list args f.(fn_sig).(sig_args) ->
-  Val.has_type res
-    (match f.(fn_sig).(sig_res) with None => Tint | Some ty => ty end).
+    (f: fundef) (args: list val) (m: mem) (t: trace) (res: val) (m': mem) : Prop :=
+  wt_fundef f ->  
+  Val.has_type_list args (sig_args (funsig f)) ->
+  Val.has_type res (proj_sig_res (funsig f)).
 
 Lemma subject_reduction:
-  forall f args m res m',
-  exec_function ge f args m res m' ->
-  exec_function_subject_reduction f args m res m'.
+  forall f args m t res m',
+  exec_function ge f args m t res m' ->
+  exec_function_subject_reduction f args m t res m'.
 Proof.
   apply (exec_function_ind_3 ge
            exec_instr_subject_reduction
@@ -1217,7 +439,7 @@ Proof.
            exec_function_subject_reduction);
   intros; red; intros;
   try (rewrite CODE in H;
-       generalize (wt_instrs env _ WT_FN pc _ H);
+       generalize (wt_instrs _ _ WT_FN pc _ H);
        intro WT_INSTR;
        inversion WT_INSTR).
  
@@ -1233,7 +455,7 @@ Proof.
 
   apply wt_regset_assign. auto.
   replace (env res) with (snd (type_of_operation op)).
-  apply type_of_operation_sound with function ge rs##args sp; auto.
+  apply type_of_operation_sound with fundef ge rs##args sp; auto.
   rewrite <- H7. reflexivity.
 
   apply wt_regset_assign. auto. rewrite H8. 
@@ -1241,37 +463,39 @@ Proof.
 
   assumption.
 
-  apply wt_regset_assign. auto. rewrite H11. rewrite H1.
-  assert (type_rtl_function f <> None).
+  apply wt_regset_assign. auto. rewrite H11. rewrite <- H1.
+  assert (wt_fundef f).
     destruct ros; simpl in H0.
-    pattern f. apply Genv.find_funct_prop with function p (rs#r).
+    pattern f. apply Genv.find_funct_prop with fundef p (rs#r).
     exact wt_p. exact H0. 
     caseEq (Genv.find_symbol ge i); intros; rewrite H12 in H0.
-    pattern f. apply Genv.find_funct_ptr_prop with function p b.
+    pattern f. apply Genv.find_funct_ptr_prop with fundef p b.
     exact wt_p. exact H0.
     discriminate.
-  assert (exists env1, wt_function env1 f).
-    caseEq (type_rtl_function f); intros; try congruence.
-    exists t. apply type_rtl_function_correct; auto.
-  elim H13; intros env1 WT_FN1. 
-  eapply H3. eexact WT_FN1. rewrite <- H1. rewrite <- H10.
+  eapply H3. auto. rewrite H1. rewrite <- H10.
   apply wt_regset_list; auto. 
 
+  apply wt_regset_assign. auto. rewrite H6; exact I. 
+
   assumption.
   assumption.
   assumption.
   eauto.
   eauto.
 
+  inversion H4; subst f0.
   assert (WT_INIT: wt_regset env (init_regs args (fn_params f))).
-    apply wt_init_regs. rewrite (wt_params env f H4). assumption.
-  generalize (H1 env f (refl_equal (fn_code f)) H4 WT_INIT). 
+    apply wt_init_regs. rewrite (wt_params _ _ H7). assumption.
+  generalize (H1 env f (refl_equal (fn_code f)) H7 WT_INIT). 
   intro WT_RS.
-  generalize (wt_instrs env _ H4 pc _ H2).
+  generalize (wt_instrs _ _ H7 pc _ H2).
   intro WT_INSTR; inversion WT_INSTR.
-  destruct or; simpl in H3; simpl in H7; rewrite <- H7.
+  unfold proj_sig_res; simpl.
+  destruct or; simpl in H3; simpl in H8; rewrite <- H8.
   rewrite H3. apply WT_RS. 
   rewrite H3. simpl; auto.
+
+  simpl. eapply wt_event_match; eauto.
 Qed. 
 
 End SUBJECT_REDUCTION.
diff --git a/backend/Stacking.v b/backend/Stacking.v
index 1f0c454..85ac933 100644
--- a/backend/Stacking.v
+++ b/backend/Stacking.v
@@ -186,6 +186,8 @@ Definition transl_instr
       Mstore chunk (transl_addr fe addr) args src :: k
   | Lcall sig ros =>
       Mcall sig ros :: k
+  | Lalloc =>
+      Malloc :: k
   | Llabel lbl =>
       Mlabel lbl :: k
   | Lgoto lbl =>
@@ -222,5 +224,8 @@ Definition transf_function (f: Linear.function) : option Mach.function :=
          f.(Linear.fn_stacksize)
          fe.(fe_size)).
 
+Definition transf_fundef (f: Linear.fundef) : option Mach.fundef :=
+  AST.transf_partial_fundef transf_function f.
+
 Definition transf_program (p: Linear.program) : option Mach.program :=
-  transform_partial_program transf_function p.
+  transform_partial_program transf_fundef p.
diff --git a/backend/Stackingproof.v b/backend/Stackingproof.v
index 002ca8d..9692670 100644
--- a/backend/Stackingproof.v
+++ b/backend/Stackingproof.v
@@ -15,6 +15,7 @@ Require Import Integers.
 Require Import Values.
 Require Import Op.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Locations.
 Require Import Mach.
@@ -299,7 +300,7 @@ Lemma exec_Mgetstack':
   get_slot fr ty (offset_of_index fe idx) v ->
   Machabstr.exec_instrs tge tf sp parent
     (Mgetstack (Int.repr (offset_of_index fe idx)) ty dst :: c) rs fr m
-    c (rs#dst <- v) fr m.
+    E0 c (rs#dst <- v) fr m.
 Proof.
   intros. apply Machabstr.exec_one. apply Machabstr.exec_Mgetstack.
   rewrite offset_of_index_no_overflow. auto. auto.
@@ -311,7 +312,7 @@ Lemma exec_Msetstack':
   set_slot fr ty (offset_of_index fe idx) (rs src) fr' ->
   Machabstr.exec_instrs tge tf sp parent
     (Msetstack src (Int.repr (offset_of_index fe idx)) ty :: c) rs fr m
-    c rs fr' m.
+    E0 c rs fr' m.
 Proof.
   intros. apply Machabstr.exec_one. apply Machabstr.exec_Msetstack.
   rewrite offset_of_index_no_overflow. auto. auto.
@@ -632,7 +633,7 @@ Lemma save_int_callee_save_correct_rec:
   exists fr',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (save_int_callee_save fe) k l) rs fr m
-       k rs fr' m
+       E0 k rs fr' m
   /\ fr'.(high) = 0
   /\ fr'.(low) = -fe.(fe_size)
   /\ (forall r,
@@ -670,7 +671,7 @@ Proof.
   intros [fr' [A [B [C [D E]]]]].
   exists fr'. 
   split. eapply Machabstr.exec_trans. apply exec_Msetstack'; eauto with stacking.
-  exact A.
+  eexact A. traceEq.
   split. auto.
   split. auto.
   split. intros. elim H3; intros. subst r. 
@@ -701,7 +702,7 @@ Lemma save_int_callee_save_correct:
   exists fr',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (save_int_callee_save fe) k int_callee_save_regs) rs fr m
-       k rs fr' m
+       E0 k rs fr' m
   /\ fr'.(high) = 0
   /\ fr'.(low) = -fe.(fe_size)
   /\ (forall r,
@@ -733,7 +734,7 @@ Lemma save_float_callee_save_correct_rec:
   exists fr',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (save_float_callee_save fe) k l) rs fr m
-       k rs fr' m
+      E0 k rs fr' m
   /\ fr'.(high) = 0
   /\ fr'.(low) = -fe.(fe_size)
   /\ (forall r,
@@ -771,7 +772,7 @@ Proof.
   intros [fr' [A [B [C [D E]]]]].
   exists fr'. 
   split. eapply Machabstr.exec_trans. apply exec_Msetstack'; eauto with stacking.
-  exact A.
+  eexact A. traceEq.
   split. auto.
   split. auto.
   split. intros. elim H3; intros. subst r. 
@@ -802,7 +803,7 @@ Lemma save_float_callee_save_correct:
   exists fr',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (save_float_callee_save fe) k float_callee_save_regs) rs fr m
-       k rs fr' m
+       E0 k rs fr' m
   /\ fr'.(high) = 0
   /\ fr'.(low) = -fe.(fe_size)
   /\ (forall r,
@@ -846,7 +847,7 @@ Lemma save_callee_save_correct:
   exists fr',
     Machabstr.exec_instrs tge tf sp parent
       (save_callee_save fe k) rs fr m
-      k rs fr' m
+      E0 k rs fr' m
   /\ agree (LTL.call_regs ls) rs fr' parent rs.
 Proof.
   intros. unfold save_callee_save.
@@ -857,7 +858,7 @@ Proof.
   generalize (save_float_callee_save_correct k sp parent rs fr1 m B1 C1).
   intros [fr2 [A2 [B2 [C2 [D2 E2]]]]].
   exists fr2.
-  split. eapply Machabstr.exec_trans. eexact A1. eexact A2.
+  split. eapply Machabstr.exec_trans. eexact A1. eexact A2. traceEq.
   constructor; unfold LTL.call_regs; auto.
   (* agree_local *)
   intros. rewrite E2; auto with stacking. 
@@ -886,7 +887,7 @@ Lemma restore_int_callee_save_correct_rec:
   exists ls', exists rs',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (restore_int_callee_save fe) k l) rs fr m
-      k rs' fr m
+      E0 k rs' fr m
   /\ (forall r, In r l -> rs' r = rs0 r)
   /\ (forall r, ~(In r l) -> rs' r = rs r)
   /\ agree ls' rs' fr parent rs0.
@@ -916,11 +917,11 @@ Proof.
   generalize (IHl ls1 rs1 R1 R2 R3). 
   intros [ls' [rs' [A [B [C D]]]]].
   exists ls'. exists rs'. 
-  split. apply Machabstr.exec_trans with k1 rs1 fr m. 
+  split. apply Machabstr.exec_trans with E0 k1 rs1 fr m E0. 
   unfold rs1; apply exec_Mgetstack'; eauto with stacking.
   apply get_slot_index; eauto with stacking.
   symmetry. eauto with stacking. 
-  eauto with stacking.
+  eauto with stacking. traceEq.
   split. intros. elim H2; intros.
   subst r. rewrite C. unfold rs1. apply Regmap.gss. inversion H0; auto.
   auto.
@@ -945,7 +946,7 @@ Lemma restore_int_callee_save_correct:
   exists ls', exists rs',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (restore_int_callee_save fe) k int_callee_save_regs) rs fr m
-      k rs' fr m
+      E0 k rs' fr m
   /\ (forall r, In r int_callee_save_regs -> rs' r = rs0 r)
   /\ (forall r, ~(In r int_callee_save_regs) -> rs' r = rs r)
   /\ agree ls' rs' fr parent rs0.
@@ -962,7 +963,7 @@ Lemma restore_float_callee_save_correct_rec:
   exists ls', exists rs',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (restore_float_callee_save fe) k l) rs fr m
-      k rs' fr m
+      E0 k rs' fr m
   /\ (forall r, In r l -> rs' r = rs0 r)
   /\ (forall r, ~(In r l) -> rs' r = rs r)
   /\ agree ls' rs' fr parent rs0.
@@ -992,11 +993,11 @@ Proof.
   generalize (IHl ls1 rs1 R1 R2 R3). 
   intros [ls' [rs' [A [B [C D]]]]].
   exists ls'. exists rs'. 
-  split. apply Machabstr.exec_trans with k1 rs1 fr m. 
+  split. apply Machabstr.exec_trans with E0 k1 rs1 fr m E0. 
   unfold rs1; apply exec_Mgetstack'; eauto with stacking.
   apply get_slot_index; eauto with stacking.
   symmetry. eauto with stacking. 
-  exact A.
+  exact A. traceEq.
   split. intros. elim H2; intros.
   subst r. rewrite C. unfold rs1. apply Regmap.gss. inversion H0; auto.
   auto.
@@ -1021,7 +1022,7 @@ Lemma restore_float_callee_save_correct:
   exists ls', exists rs',
     Machabstr.exec_instrs tge tf sp parent
       (List.fold_right (restore_float_callee_save fe) k float_callee_save_regs) rs fr m
-      k rs' fr m
+      E0 k rs' fr m
   /\ (forall r, In r float_callee_save_regs -> rs' r = rs0 r)
   /\ (forall r, ~(In r float_callee_save_regs) -> rs' r = rs r)
   /\ agree ls' rs' fr parent rs0.
@@ -1036,7 +1037,7 @@ Lemma restore_callee_save_correct:
   exists rs',
     Machabstr.exec_instrs tge tf sp parent
       (restore_callee_save fe k) rs fr m
-      k rs' fr m
+      E0 k rs' fr m
   /\ (forall r, 
         In r int_callee_save_regs \/ In r float_callee_save_regs -> 
         rs' r = rs0 r)
@@ -1053,7 +1054,7 @@ Proof.
   generalize (restore_float_callee_save_correct sp parent
                 k fr m rs0 ls1 rs1 D).
   intros [ls2 [rs2 [P [Q [R S]]]]].
-  exists rs2. split. eapply Machabstr.exec_trans. eexact A. exact P.
+  exists rs2. split. eapply Machabstr.exec_trans. eexact A. eexact P. traceEq.
   split. intros. elim H0; intros.
   rewrite R. apply B. auto. apply list_disjoint_notin with int_callee_save_regs.
   apply int_float_callee_save_disjoint. auto.
@@ -1148,8 +1149,8 @@ Proof.
 Qed.
 
 Lemma exec_instr_incl:
-  forall f sp c1 ls1 m1 c2 ls2 m2,
-  Linear.exec_instr ge f sp c1 ls1 m1 c2 ls2 m2 ->
+  forall f sp c1 ls1 m1 t c2 ls2 m2,
+  Linear.exec_instr ge f sp c1 ls1 m1 t c2 ls2 m2 ->
   incl c1 f.(fn_code) ->
   incl c2 f.(fn_code).
 Proof.
@@ -1159,8 +1160,8 @@ Proof.
 Qed.
 
 Lemma exec_instrs_incl:
-  forall f sp c1 ls1 m1 c2 ls2 m2,
-  Linear.exec_instrs ge f sp c1 ls1 m1 c2 ls2 m2 ->
+  forall f sp c1 ls1 m1 t c2 ls2 m2,
+  Linear.exec_instrs ge f sp c1 ls1 m1 t c2 ls2 m2 ->
   incl c1 f.(fn_code) ->
   incl c2 f.(fn_code).
 Proof.
@@ -1174,7 +1175,7 @@ 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_function.
+  apply Genv.find_symbol_transf_partial with transf_fundef.
   exact TRANSF. 
 Qed.
 
@@ -1182,11 +1183,11 @@ Lemma functions_translated:
   forall f v,
   Genv.find_funct ge v = Some f ->
   exists tf,
-  Genv.find_funct tge v = Some tf /\ transf_function f = Some tf.
+  Genv.find_funct tge v = Some tf /\ transf_fundef f = Some tf.
 Proof.
   intros. 
-  generalize (Genv.find_funct_transf_partial transf_function TRANSF H).
-  case (transf_function f).
+  generalize (Genv.find_funct_transf_partial transf_fundef TRANSF H).
+  case (transf_fundef f).
   intros tf [A B]. exists tf. tauto.
   intros. tauto.
 Qed.
@@ -1195,15 +1196,26 @@ Lemma function_ptr_translated:
   forall f v,
   Genv.find_funct_ptr ge v = Some f ->
   exists tf,
-  Genv.find_funct_ptr tge v = Some tf /\ transf_function f = Some tf.
+  Genv.find_funct_ptr tge v = Some tf /\ transf_fundef f = Some tf.
 Proof.
   intros. 
-  generalize (Genv.find_funct_ptr_transf_partial transf_function TRANSF H).
-  case (transf_function f).
+  generalize (Genv.find_funct_ptr_transf_partial transf_fundef TRANSF H).
+  case (transf_fundef f).
   intros tf [A B]. exists tf. tauto.
   intros. tauto.
 Qed.
 
+Lemma sig_preserved:
+  forall f tf, transf_fundef f = Some tf -> Mach.funsig tf = Linear.funsig f.
+Proof.
+  intros until tf; unfold transf_fundef, transf_partial_fundef.
+  destruct f. unfold transf_function. 
+  destruct (zlt (fn_stacksize f) 0). congruence.
+  destruct (zlt (- Int.min_signed) (fe_size (make_env (function_bounds f)))). congruence.
+  intros. inversion H; reflexivity. 
+  intro. inversion H. reflexivity.
+Qed.
+
 (** Correctness of stack pointer relocation in operations and
   addressing modes. *)
 
@@ -1287,7 +1299,7 @@ Qed.
 
 Definition exec_instr_prop
       (f: function) (sp: val)
-      (c: code) (ls: locset) (m: mem)
+      (c: code) (ls: locset) (m: mem) (t: trace)
       (c': code) (ls': locset) (m': mem) :=
   forall tf rs fr parent rs0
      (TRANSL: transf_function f = Some tf)
@@ -1297,7 +1309,7 @@ Definition exec_instr_prop
   exists rs', exists fr',
     Machabstr.exec_instrs tge tf (shift_sp tf sp) parent
        (transl_code (make_env (function_bounds f)) c) rs fr m
-       (transl_code (make_env (function_bounds f)) c') rs' fr' m'
+     t (transl_code (make_env (function_bounds f)) c') rs' fr' m'
   /\ agree f ls' rs' fr' parent rs0.
 
 (** The simulation property for function calls has different preconditions
@@ -1306,19 +1318,19 @@ Definition exec_instr_prop
   postconditions (preservation of callee-save registers). *)
 
 Definition exec_function_prop
-      (f: function) 
-      (ls: locset) (m: mem)
+      (f: fundef) 
+      (ls: locset) (m: mem) (t: trace)
       (ls': locset) (m': mem) :=
   forall tf rs parent
-     (TRANSL: transf_function f = Some tf)
-     (WTF: wt_function f)
+     (TRANSL: transf_fundef f = Some tf)
+     (WTF: wt_fundef f)
      (AG1: forall r, rs r = ls (R r))
      (AG2: forall ofs ty, 
              6 <= ofs -> 
-             ofs + typesize ty <= size_arguments f.(fn_sig) ->
+             ofs + typesize ty <= size_arguments (funsig f) ->
              get_slot parent ty (Int.signed (Int.repr (4 * ofs))) (ls (S (Outgoing ofs ty)))),
   exists rs',
-    Machabstr.exec_function tge tf parent rs m rs' m'
+    Machabstr.exec_function tge tf parent rs m t rs' m'
  /\ (forall r,
         In (R r) temporaries \/ In (R r) destroyed_at_call ->
         rs' r = ls' (R r))
@@ -1329,9 +1341,9 @@ Definition exec_function_prop
 Hypothesis wt_prog: wt_program prog.
 
 Lemma transf_function_correct:
-  forall f ls m ls' m',
-  Linear.exec_function ge f ls m ls' m' ->
-  exec_function_prop f ls m ls' m'.
+  forall f ls m t ls' m',
+  Linear.exec_function ge f ls m t ls' m' ->
+  exec_function_prop f ls m t ls' m'.
 Proof.
   assert (RED: forall f i c,
           transl_code (make_env (function_bounds f)) (i :: c) = 
@@ -1412,13 +1424,13 @@ Proof.
 
   (* Lcall *)
   inversion WTI.
-  assert (WTF': wt_function f').
+  assert (WTF': wt_fundef f').
     destruct ros; simpl in H.
-    apply (Genv.find_funct_prop wt_function wt_prog H).
+    apply (Genv.find_funct_prop wt_fundef wt_prog H).
     destruct (Genv.find_symbol ge i); try discriminate.
-    apply (Genv.find_funct_ptr_prop wt_function wt_prog H).
+    apply (Genv.find_funct_ptr_prop wt_fundef wt_prog H).
   assert (TR: exists tf', Mach.find_function tge ros rs0 = Some tf'
-                       /\ transf_function f' = Some tf').
+                       /\ transf_fundef f' = Some tf').
     destruct ros; simpl in H; simpl.
     eapply functions_translated. 
     rewrite (agree_eval_reg _ _ _ _ _ _ m0 AG). auto. 
@@ -1430,7 +1442,7 @@ Proof.
     intro. symmetry. eapply agree_reg; eauto.
   assert (AG2: forall ofs ty, 
              6 <= ofs -> 
-             ofs + typesize ty <= size_arguments f'.(fn_sig) ->
+             ofs + typesize ty <= size_arguments (funsig f') ->
              get_slot fr ty (Int.signed (Int.repr (4 * ofs))) (rs (S (Outgoing ofs ty)))).
     intros. 
     assert (slot_bounded f (Outgoing ofs ty)).
@@ -1446,6 +1458,13 @@ Proof.
   apply Machabstr.exec_one; apply Machabstr.exec_Mcall with tf'; auto.
   apply agree_return_regs with rs0; auto.
 
+  (* Lalloc *)
+  exists (rs0#loc_alloc_result <- (Vptr blk Int.zero)); exists fr. split.
+  apply Machabstr.exec_one; eapply Machabstr.exec_Malloc; eauto.
+  rewrite (agree_eval_reg _ _ _ _ _ _ loc_alloc_argument AG). auto.
+  apply agree_set_reg; auto.
+  red. simpl. generalize (max_over_regs_of_funct_pos f int_callee_save). omega.
+
   (* Llabel *)
   exists rs0; exists fr. split.
   apply Machabstr.exec_one; apply Machabstr.exec_Mlabel.
@@ -1483,25 +1502,30 @@ Proof.
   generalize (H2 tf rs' fr' parent rs0 TRANSL WTF B INCL').
   intros [rs'' [fr'' [C D]]].
   exists rs''; exists fr''. split.
-  eapply Machabstr.exec_trans. eexact A. eexact C.
+  eapply Machabstr.exec_trans. eexact A. eexact C. auto.
   auto.
 
   (* function *)
+  generalize TRANSL; clear TRANSL. 
+  unfold transf_fundef, transf_partial_fundef.
+  caseEq (transf_function f); try congruence.
+  intros tfn TRANSL EQ. inversion EQ; clear EQ; subst tf.
+  inversion WTF as [|f' WTFN]. subst f'.
   assert (X: forall link ra,
    exists rs' : regset,
-   Machabstr.exec_function_body tge tf parent link ra rs0 m rs' (free m2 stk) /\
+   Machabstr.exec_function_body tge tfn parent link ra rs0 m t rs' (free m2 stk) /\
    (forall r : mreg,
     In (R r) temporaries \/ In (R r) destroyed_at_call -> rs' r = rs2 (R r)) /\
    (forall r : mreg,
     In r int_callee_save_regs \/ In r float_callee_save_regs -> rs' r = rs0 r)).
   intros.
   set (sp := Vptr stk Int.zero) in *.
-  set (tsp := shift_sp tf sp).
+  set (tsp := shift_sp tfn sp).
   set (fe := make_env (function_bounds f)).
-  assert (low (init_frame tf) = -fe.(fe_size)).
+  assert (low (init_frame tfn) = -fe.(fe_size)).
     simpl low. rewrite (unfold_transf_function _ _ TRANSL).
     reflexivity.
-  assert (exists fr1, set_slot (init_frame tf) Tint 0 link fr1).
+  assert (exists fr1, set_slot (init_frame tfn) Tint 0 link fr1).
     apply set_slot_ok. reflexivity. omega. rewrite H2. generalize (size_pos f). 
     unfold fe. simpl typesize. omega.
   elim H3; intros fr1 SET1; clear H3.
@@ -1526,28 +1550,29 @@ Proof.
     apply slot_gi. omega. omega. 
     simpl typesize. omega. simpl typesize. omega. 
     inversion H8. symmetry. exact H11.
-  generalize (save_callee_save_correct f tf TRANSL
+  generalize (save_callee_save_correct f tfn TRANSL
                 tsp parent
                 (transl_code (make_env (function_bounds f)) f.(fn_code))
                 rs0 fr2 m1 rs AG1 AG2 H5 H6 UNDEF).
   intros [fr [EXP AG]].
-  generalize (H1 tf rs0 fr parent rs0 TRANSL WTF AG (incl_refl _)).
+  generalize (H1 tfn rs0 fr parent rs0 TRANSL WTFN AG (incl_refl _)).
   intros [rs' [fr' [EXB AG']]].
-  generalize (restore_callee_save_correct f tf TRANSL tsp parent
+  generalize (restore_callee_save_correct f tfn TRANSL tsp parent
                 (Mreturn :: transl_code (make_env (function_bounds f)) b)
                 fr' m2 rs0 rs2 rs' AG').
   intros [rs'' [EXX [REGS1 REGS2]]].
   exists rs''. split. eapply Machabstr.exec_funct_body.
-    rewrite (unfold_transf_function f tf TRANSL); eexact H. 
+    rewrite (unfold_transf_function f tfn TRANSL); eexact H. 
     eexact SET1. eexact SET2. 
-    replace (Mach.fn_code tf) with
+    replace (Mach.fn_code tfn) with
             (transl_body f (make_env (function_bounds f))).    
-    replace (Vptr stk (Int.repr (- fn_framesize tf))) with tsp.
+    replace (Vptr stk (Int.repr (- fn_framesize tfn))) with tsp.
     eapply Machabstr.exec_trans. eexact EXP. 
-    eapply Machabstr.exec_trans. eexact EXB. eexact EXX.
+    eapply Machabstr.exec_trans. eexact EXB. eexact EXX. 
+    reflexivity. traceEq.
     unfold tsp, shift_sp, sp. unfold Val.add. 
     rewrite Int.add_commut. rewrite Int.add_zero. auto.
-    rewrite (unfold_transf_function f tf TRANSL). simpl. auto.
+    rewrite (unfold_transf_function f tfn TRANSL). simpl. auto.
   split. intros. rewrite REGS2. symmetry; eapply agree_reg; eauto.
   apply int_callee_save_not_destroyed; auto.
   apply float_callee_save_not_destroyed; auto.
@@ -1563,21 +1588,36 @@ Proof.
     rewrite REGS2'. apply REGS2. auto. auto.
   rewrite H4. auto.
   split; auto.
+
+  (* external function *)
+  simpl in TRANSL. inversion TRANSL; subst tf.
+  inversion WTF. subst ef0. set (sg := ef_sig ef) in *.
+  exists (rs#(loc_result sg) <- res). 
+  split. econstructor. eauto. 
+  fold sg. rewrite H0. rewrite Conventions.loc_external_arguments_loc_arguments; auto.
+  rewrite list_map_compose. apply list_map_exten; intros. auto. 
+  reflexivity.
+  split; intros. rewrite H1. 
+  unfold Regmap.set. case (RegEq.eq r (loc_result sg)); intro.
+  rewrite e. rewrite Locmap.gss; auto. rewrite Locmap.gso; auto.
+  red; auto.
+  apply Regmap.gso. red; intro; subst r.
+  elim (Conventions.loc_result_not_callee_save _ H2).
 Qed.
 
 End PRESERVATION.
 
 Theorem transl_program_correct:
-  forall (p: Linear.program) (tp: Mach.program) (r: val),
+  forall (p: Linear.program) (tp: Mach.program) (t: trace) (r: val),
   wt_program p ->
   transf_program p = Some tp ->
-  Linear.exec_program p r ->
-  Machabstr.exec_program tp r.
+  Linear.exec_program p t r ->
+  Machabstr.exec_program tp t r.
 Proof.
-  intros p tp r WTP TRANSF
+  intros p tp t r WTP TRANSF
          [fptr [f [ls' [m [FINDSYMB [FINDFUNC [SIG [EXEC RES]]]]]]]].
-  assert (WTF: wt_function f).
-    apply (Genv.find_funct_ptr_prop wt_function WTP FINDFUNC).
+  assert (WTF: wt_fundef f).
+    apply (Genv.find_funct_ptr_prop wt_fundef WTP FINDFUNC).
   set (ls := Locmap.init Vundef) in *.
   set (rs := Regmap.init Vundef).
   set (fr := empty_frame).
@@ -1585,26 +1625,25 @@ Proof.
     intros; reflexivity.
   assert (AG2: forall ofs ty, 
              6 <= ofs -> 
-             ofs + typesize ty <= size_arguments f.(fn_sig) ->
+             ofs + typesize ty <= size_arguments (funsig f) ->
              get_slot fr ty (Int.signed (Int.repr (4 * ofs))) (ls (S (Outgoing ofs ty)))).
     rewrite SIG. unfold size_arguments, sig_args, size_arguments_rec.
     intros. generalize (typesize_pos ty). 
     intro. omegaContradiction.
   generalize (function_ptr_translated p tp TRANSF f _ FINDFUNC).
   intros [tf [TFIND TRANSL]]. 
-  generalize (transf_function_correct p tp TRANSF WTP _ _ _ _ _ EXEC
+  generalize (transf_function_correct p tp TRANSF WTP _ _ _ _ _ _ EXEC
                 tf rs fr TRANSL WTF AG1 AG2).
   intros [rs' [A [B C]]].
   red. exists fptr; exists tf; exists rs'; exists m.
   split. rewrite (symbols_preserved p tp TRANSF). 
-  rewrite (transform_partial_program_main transf_function p TRANSF).
+  rewrite (transform_partial_program_main transf_fundef p TRANSF).
   assumption.
   split. assumption.
-  split. rewrite (unfold_transf_function f tf TRANSL); simpl. 
-  assumption.
   split. replace (Genv.init_mem tp) with (Genv.init_mem p).
-  exact A. symmetry. apply Genv.init_mem_transf_partial with transf_function. 
+  exact A. symmetry. apply Genv.init_mem_transf_partial with transf_fundef. 
   exact TRANSF.
-  rewrite <- RES. rewrite (unfold_transf_function f tf TRANSL); simpl. 
+  rewrite <- RES. replace R3 with (loc_result (funsig f)).
   apply B. right. apply loc_result_acceptable. 
+  rewrite SIG; reflexivity.
 Qed.
diff --git a/backend/Stackingtyping.v b/backend/Stackingtyping.v
index 85d1922..996ada4 100644
--- a/backend/Stackingtyping.v
+++ b/backend/Stackingtyping.v
@@ -166,6 +166,8 @@ Proof.
   (* call *)
   apply wt_instrs_cons; auto.
   constructor; auto.
+  (* alloc *)
+  apply wt_instrs_cons; auto. constructor. 
   (* label *)
   apply wt_instrs_cons; auto.
   constructor.
@@ -208,6 +210,20 @@ Proof.
   rewrite H2. eapply size_no_overflow; eauto.
 Qed.
 
+Lemma wt_transf_fundef:
+  forall f tf, 
+  Lineartyping.wt_fundef f ->
+  transf_fundef f = Some tf ->
+  wt_fundef tf.
+Proof.
+  intros f tf WT. inversion WT; subst.
+  simpl; intros; inversion H0. constructor; auto.
+  unfold transf_fundef, transf_partial_fundef.
+  caseEq (transf_function f0); try congruence.
+  intros tfn TRANSF EQ. inversion EQ; subst tf.
+  constructor; eapply wt_transf_function; eauto. 
+Qed.
+
 Lemma program_typing_preserved:
   forall (p: Linear.program) (tp: Mach.program),
   transf_program p = Some tp ->
@@ -215,8 +231,8 @@ Lemma program_typing_preserved:
   Machtyping.wt_program tp.
 Proof.
   intros; red; intros.
-  generalize (transform_partial_program_function transf_function p i f H H1).
+  generalize (transform_partial_program_function transf_fundef p i f H H1).
   intros [f0 [IN TRANSF]].
-  apply wt_transf_function with f0; auto.
+  apply wt_transf_fundef with f0; auto.
   eapply H0; eauto.
 Qed.
diff --git a/backend/Tunneling.v b/backend/Tunneling.v
index 9c3e82c..4fbdc9f 100644
--- a/backend/Tunneling.v
+++ b/backend/Tunneling.v
@@ -100,6 +100,8 @@ Fixpoint tunnel_block (f: LTL.function) (b: block) {struct b} : block :=
       Bstore chunk addr args src (tunnel_block f b)
   | Bcall sig ros b =>
       Bcall sig ros (tunnel_block f b)
+  | Balloc b =>
+      Balloc (tunnel_block f b)
   | Bgoto s =>
       Bgoto (branch_target f s)
   | Bcond cond args s1 s2 =>
@@ -126,6 +128,9 @@ Definition tunnel_function (f: LTL.function) : LTL.function :=
     (fn_entrypoint f)
     (wf_tunneled_code f).
 
+Definition tunnel_fundef (f: LTL.fundef) : LTL.fundef :=
+  transf_fundef tunnel_function f.
+
 Definition tunnel_program (p: LTL.program) : LTL.program :=
-  transform_program tunnel_function p.
+  transform_program tunnel_fundef p.
 
diff --git a/backend/Tunnelingproof.v b/backend/Tunnelingproof.v
index 111d1d8..88547e7 100644
--- a/backend/Tunnelingproof.v
+++ b/backend/Tunnelingproof.v
@@ -5,6 +5,7 @@ Require Import Maps.
 Require Import AST.
 Require Import Values.
 Require Import Mem.
+Require Import Events.
 Require Import Globalenvs.
 Require Import Op.
 Require Import Locations.
@@ -82,68 +83,75 @@ Let tge := Genv.globalenv tp.
 Lemma functions_translated:
   forall v f,
   Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (tunnel_function f).
-Proof (@Genv.find_funct_transf _ _ tunnel_function p).
+  Genv.find_funct tge v = Some (tunnel_fundef f).
+Proof (@Genv.find_funct_transf _ _ tunnel_fundef p).
 
 Lemma function_ptr_translated:
   forall v f,
   Genv.find_funct_ptr ge v = Some f ->
-  Genv.find_funct_ptr tge v = Some (tunnel_function f).
-Proof (@Genv.find_funct_ptr_transf _ _ tunnel_function p).
+  Genv.find_funct_ptr tge v = Some (tunnel_fundef f).
+Proof (@Genv.find_funct_ptr_transf _ _ tunnel_fundef p).
 
 Lemma symbols_preserved:
   forall id,
   Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof (@Genv.find_symbol_transf _ _ tunnel_function p).
+Proof (@Genv.find_symbol_transf _ _ tunnel_fundef p).
+
+Lemma sig_preserved:
+  forall f, funsig (tunnel_fundef f) = funsig f.
+Proof.
+  destruct f; reflexivity.
+Qed.
 
 (** These are inversion lemmas, characterizing what happens in the LTL
   semantics when executing [Bgoto] instructions or basic blocks. *)
 
 Lemma exec_instrs_Bgoto_inv:
-  forall sp b1 ls1 m1 b2 ls2 m2,
-  exec_instrs ge sp b1 ls1 m1 b2 ls2 m2 ->
+  forall sp b1 ls1 m1 t b2 ls2 m2,
+  exec_instrs ge sp b1 ls1 m1 t b2 ls2 m2 ->
   forall s1,
-  b1 = Bgoto s1 -> b2 = b1 /\ ls2 = ls1 /\ m2 = m1.
+  b1 = Bgoto s1 -> t = E0 /\ b2 = b1 /\ ls2 = ls1 /\ m2 = m1.
 Proof.
   induction 1. 
   intros. tauto.
-  intros. subst b1. inversion H.
-  intros. generalize (IHexec_instrs1 s1 H1). intros [A [B C]].
-  subst b2; subst rs2; subst m2. eauto.
+  intros. subst b1. inversion H. 
+  intros. generalize (IHexec_instrs1 s1 H2). intros [A [B [C D]]].
+  subst t1 b2 rs2 m2. 
+  generalize (IHexec_instrs2 s1 H2). intros [A [B [C D]]].
+  subst t2 b3 rs3 m3. intuition. traceEq. 
 Qed.
 
 Lemma exec_block_Bgoto_inv:
-  forall sp s ls1 m1 out ls2 m2,  
-  exec_block ge sp (Bgoto s) ls1 m1 out ls2 m2 ->
-  out = Cont s /\ ls2 = ls1 /\ m2 = m1.
+  forall sp s ls1 m1 t out ls2 m2,  
+  exec_block ge sp (Bgoto s) ls1 m1 t out ls2 m2 ->
+  t = E0 /\ out = Cont s /\ ls2 = ls1 /\ m2 = m1.
 Proof.
   intros. inversion H;
-  generalize (exec_instrs_Bgoto_inv _ _ _ _ _ _ _ H0 s (refl_equal _));
-  intros [A [B C]]. 
-  split. congruence. tauto.
-  discriminate.
-  discriminate.
-  discriminate.
+  generalize (exec_instrs_Bgoto_inv _ _ _ _ _ _ _ _ H0 s (refl_equal _));
+  intros [A [B [C D]]];
+  try discriminate.
+  intuition congruence.
 Qed.
 
 Lemma exec_blocks_Bgoto_inv:
-  forall c sp pc1 ls1 m1 out ls2 m2 s,
-  exec_blocks ge c sp pc1 ls1 m1 out ls2 m2 ->
+  forall c sp pc1 ls1 m1 t out ls2 m2 s,
+  exec_blocks ge c sp pc1 ls1 m1 t out ls2 m2 ->
   c!pc1 = Some (Bgoto s) ->
-  (out = Cont pc1 /\ ls2 = ls1 /\ m2 = m1)
-  \/ exec_blocks ge c sp s ls1 m1 out ls2 m2.
+  (t = E0 /\ out = Cont pc1 /\ ls2 = ls1 /\ m2 = m1)
+  \/ exec_blocks ge c sp s ls1 m1 t out ls2 m2.
 Proof.
   induction 1; intros.
   left; tauto.
   assert (b = Bgoto s). congruence. subst b. 
-  generalize (exec_block_Bgoto_inv _ _ _ _ _ _ _ H0). 
-  intros [A [B C]]. subst out; subst rs'; subst m'.
+  generalize (exec_block_Bgoto_inv _ _ _ _ _ _ _ _ H0). 
+  intros [A [B [C D]]]. subst t out rs' m'.
   right. apply exec_blocks_refl.
-  elim (IHexec_blocks1 H1).
-  intros [A [B C]]. 
-  assert (pc2 = pc1). congruence. subst rs2; subst m2; subst pc2.
-  apply IHexec_blocks2; auto.
-  intro. right. apply exec_blocks_trans with pc2 rs2 m2; auto.
+  elim (IHexec_blocks1 H2).
+  intros [A [B [C D]]]. 
+  assert (pc2 = pc1). congruence. subst t1 rs2 m2 pc2.
+  replace t with t2. apply IHexec_blocks2; auto. traceEq.
+  intro. right. 
+  eapply exec_blocks_trans; eauto. 
 Qed.
 
 (** The following [exec_*_prop] predicates state the correctness
@@ -163,43 +171,43 @@ Definition tunnel_outcome (f: function) (out: outcome) :=
   end.
 
 Definition exec_instr_prop
-  (sp: val) (b1: block) (ls1: locset) (m1: mem)
+  (sp: val) (b1: block) (ls1: locset) (m1: mem) (t: trace)
             (b2: block) (ls2: locset) (m2: mem) : Prop :=
   forall f,
   exec_instr tge sp (tunnel_block f b1) ls1 m1
-                    (tunnel_block f b2) ls2 m2.
+                  t (tunnel_block f b2) ls2 m2.
 
 Definition exec_instrs_prop
-  (sp: val) (b1: block) (ls1: locset) (m1: mem)
+  (sp: val) (b1: block) (ls1: locset) (m1: mem) (t: trace)
             (b2: block) (ls2: locset) (m2: mem) : Prop :=
   forall f,
   exec_instrs tge sp (tunnel_block f b1) ls1 m1
-                     (tunnel_block f b2) ls2 m2.
+                   t (tunnel_block f b2) ls2 m2.
 
 Definition exec_block_prop
-  (sp: val) (b1: block) (ls1: locset) (m1: mem)
+  (sp: val) (b1: block) (ls1: locset) (m1: mem) (t: trace)
             (out: outcome) (ls2: locset) (m2: mem) : Prop :=
   forall f,
   exec_block tge sp (tunnel_block f b1) ls1 m1
-                    (tunnel_outcome f out) ls2 m2.
+                  t (tunnel_outcome f out) ls2 m2.
 
 Definition tunneled_code (f: function) :=
   PTree.map (fun pc b => tunnel_block f b) (fn_code f).
 
 Definition exec_blocks_prop
      (c: code) (sp: val)
-     (pc: node) (ls1: locset) (m1: mem)
+     (pc: node) (ls1: locset) (m1: mem) (t: trace)
      (out: outcome) (ls2: locset) (m2: mem) : Prop :=
   forall f,
   f.(fn_code) = c ->
   exec_blocks tge (tunneled_code f) sp
               (branch_target f pc) ls1 m1
-              (tunnel_outcome f out) ls2 m2.
+            t (tunnel_outcome f out) ls2 m2.
 
 Definition exec_function_prop
-    (f: function) (ls1: locset) (m1: mem) 
-                  (ls2: locset) (m2: mem) : Prop :=
-  exec_function tge (tunnel_function f) ls1 m1 ls2 m2.
+    (f: fundef) (ls1: locset) (m1: mem) (t: trace)
+                (ls2: locset) (m2: mem) : Prop :=
+  exec_function tge (tunnel_fundef f) ls1 m1 t ls2 m2.
 
 Scheme exec_instr_ind5 := Minimality for LTL.exec_instr Sort Prop
   with exec_instrs_ind5 := Minimality for LTL.exec_instrs Sort Prop
@@ -212,9 +220,9 @@ Scheme exec_instr_ind5 := Minimality for LTL.exec_instr Sort Prop
   using the [exec_*_prop] predicates above as induction hypotheses. *)
 
 Lemma tunnel_function_correct:
-  forall f ls1 m1 ls2 m2,
-  exec_function ge f ls1 m1 ls2 m2 ->
-  exec_function_prop f ls1 m1 ls2 m2.
+  forall f ls1 m1 t ls2 m2,
+  exec_function ge f ls1 m1 t ls2 m2 ->
+  exec_function_prop f ls1 m1 t ls2 m2.
 Proof.
   apply (exec_function_ind5 ge
            exec_instr_prop
@@ -239,19 +247,21 @@ Proof.
   apply eval_addressing_preserved. exact symbols_preserved.
   auto.
   (* call *)
-  apply exec_Bcall with (tunnel_function f). 
+  apply exec_Bcall with (tunnel_fundef f). 
   generalize H; unfold find_function; destruct ros.
   intro. apply functions_translated; auto.
   rewrite symbols_preserved. destruct (Genv.find_symbol ge i).
   intro. apply function_ptr_translated; auto. congruence.
-  rewrite H0; reflexivity.
+  generalize (sig_preserved f). congruence. 
   apply H2. 
+  (* alloc *)
+  eapply exec_Balloc; eauto. 
   (* instr_refl *)
   apply exec_refl.
   (* instr_one *)
   apply exec_one. apply H0.
   (* instr_trans *)
-  apply exec_trans with (tunnel_block f b2) rs2 m2; auto.
+  apply exec_trans with t1 (tunnel_block f b2) rs2 m2 t2; auto.
   (* goto *)
   apply exec_Bgoto. red in H0. simpl in H0. apply H0. 
   (* cond, true *)
@@ -270,13 +280,13 @@ Proof.
   reflexivity. apply H1.
   intros [pc' [ATpc BTS]]. 
   assert (b = Bgoto pc'). congruence. subst b.
-  generalize (exec_block_Bgoto_inv _ _ _ _ _ _ _ H0).
-  intros [A [B C]]. subst out; subst rs'; subst m'.
+  generalize (exec_block_Bgoto_inv _ _ _ _ _ _ _ _ H0).
+  intros [A [B [C D]]]. subst t out rs' m'.
   simpl. rewrite BTS. apply exec_blocks_refl.
   (* blocks_trans *)
-  apply exec_blocks_trans with (branch_target f pc2) rs2 m2.
-  exact (H0 f H3). exact (H2 f H3). 
-  (* function *)
+  apply exec_blocks_trans with t1 (branch_target f pc2) rs2 m2 t2.
+  exact (H0 f H4). exact (H2 f H4). auto.
+  (* internal function *)
   econstructor. eexact H. 
   change (fn_code (tunnel_function f)) with (tunneled_code f).
   simpl.
@@ -284,28 +294,30 @@ Proof.
   intro BT. rewrite <- BT. exact (H1 f (refl_equal _)).
   intros [pc [ATpc BT]].
   apply exec_blocks_trans with 
-     (branch_target f (fn_entrypoint f)) (call_regs rs) m1.
+     E0 (branch_target f (fn_entrypoint f)) (call_regs rs) m1 t.
   eapply exec_blocks_one. 
   unfold tunneled_code. rewrite PTree.gmap. rewrite ATpc.
   simpl. reflexivity. 
   apply exec_Bgoto. rewrite BT. apply exec_refl.
-  exact (H1 f (refl_equal _)).
+  exact (H1 f (refl_equal _)). traceEq.
+  (* external function *)
+  econstructor; eauto. 
 Qed.
 
 End PRESERVATION.
 
 Theorem transf_program_correct:
-  forall (p: program) (r: val),
-  exec_program p r ->
-  exec_program (tunnel_program p) r.
+  forall (p: program) (t: trace) (r: val),
+  exec_program p t r ->
+  exec_program (tunnel_program p) t r.
 Proof.
-  intros p r [b [f [ls [m [FIND1 [FIND2 [SIG [EX RES]]]]]]]].
-  red. exists b; exists (tunnel_function f); exists ls; exists m.
+  intros p t r [b [f [ls [m [FIND1 [FIND2 [SIG [EX RES]]]]]]]].
+  red. exists b; exists (tunnel_fundef f); exists ls; exists m.
   split. change (prog_main (tunnel_program p)) with (prog_main p).
   rewrite <- FIND1. apply symbols_preserved.
   split. apply function_ptr_translated. assumption.
-  split. rewrite <- SIG. reflexivity. 
+  split. generalize (sig_preserved f). congruence.
   split. apply tunnel_function_correct. 
   unfold tunnel_program. rewrite Genv.init_mem_transf. auto.
-  exact RES.
+  rewrite sig_preserved. exact RES.
 Qed.
diff --git a/backend/Tunnelingtyping.v b/backend/Tunnelingtyping.v
index 29b74f1..6281afa 100644
--- a/backend/Tunnelingtyping.v
+++ b/backend/Tunnelingtyping.v
@@ -33,12 +33,19 @@ Proof.
   intros; discriminate.
 Qed.
 
+Lemma wt_tunnel_fundef:
+  forall f, wt_fundef f -> wt_fundef (tunnel_fundef f).
+Proof.
+  intros. inversion H; simpl. constructor; auto. 
+  constructor. apply wt_tunnel_function; auto.
+Qed.
+
 Lemma program_typing_preserved:
   forall (p: LTL.program),
   wt_program p -> wt_program (tunnel_program p).
 Proof.
   intros; red; intros.
-  generalize (transform_program_function tunnel_function p i f H0).
+  generalize (transform_program_function tunnel_fundef p i f H0).
   intros [f0 [IN TRANSF]].
-  subst f. apply wt_tunnel_function. eauto.
+  subst f. apply wt_tunnel_fundef. eauto.
 Qed.
diff --git a/caml/Allocationaux.ml b/caml/Allocationaux.ml
deleted file mode 100644
index c682c3c..0000000
--- a/caml/Allocationaux.ml
+++ /dev/null
@@ -1,39 +0,0 @@
-open Camlcoq
-open Datatypes
-open CList
-open AST
-open Locations
-
-type status = To_move | Being_moved | Moved
-
-let parallel_move_order lsrc ldst =
-  let src = array_of_coqlist lsrc
-  and dst = array_of_coqlist ldst in
-  let n = Array.length src in
-  let status = Array.make n To_move in
-  let moves = ref Coq_nil in
-  let rec move_one i =
-    if src.(i) <> dst.(i) then begin
-      status.(i) <- Being_moved;
-      for j = 0 to n - 1 do
-        if src.(j) = dst.(i) then
-          match status.(j) with
-            To_move ->
-              move_one j
-          | Being_moved ->
-              let tmp =
-                match Loc.coq_type src.(j) with
-                | Tint -> R IT2
-                | Tfloat -> R FT2 in
-              moves := Coq_cons (Coq_pair(src.(j), tmp), !moves);
-              src.(j) <- tmp
-          | Moved ->
-              ()
-      done;
-      moves := Coq_cons(Coq_pair(src.(i), dst.(i)), !moves);
-      status.(i) <- Moved
-    end in
-  for i = 0 to n - 1 do
-    if status.(i) = To_move then move_one i
-  done;
-  CList.rev !moves
diff --git a/caml/Allocationaux.mli b/caml/Allocationaux.mli
deleted file mode 100644
index 0cf3b94..0000000
--- a/caml/Allocationaux.mli
+++ /dev/null
@@ -1,5 +0,0 @@
-open Datatypes
-open List
-open Locations
-
-val parallel_move_order: loc list -> loc list -> (loc, loc) prod list
diff --git a/caml/CMlexer.mll b/caml/CMlexer.mll
index b8d3ae7..49d0dbd 100644
--- a/caml/CMlexer.mll
+++ b/caml/CMlexer.mll
@@ -20,6 +20,7 @@ rule token = parse
   | blank +      { token lexbuf }
   | "/*"         { comment lexbuf; token lexbuf }
   | "absf" { ABSF }
+  | "alloc" { ALLOC }
   | "&" { AMPERSAND }
   | "&&" { AMPERSANDAMPERSAND }
   | "!"    { BANG }
@@ -38,6 +39,7 @@ rule token = parse
   | "==f"    { EQUALEQUALF }
   | "==u"    { EQUALEQUALU }
   | "exit"    { EXIT }
+  | "extern"    { EXTERN }
   | "float"    { FLOAT }
   | "float32"    { FLOAT32 }
   | "float64"    { FLOAT64 }
diff --git a/caml/CMparser.mly b/caml/CMparser.mly
index d461a15..5595afe 100644
--- a/caml/CMparser.mly
+++ b/caml/CMparser.mly
@@ -24,6 +24,7 @@ let orbool e1 e2 =
 %token ABSF
 %token AMPERSAND
 %token AMPERSANDAMPERSAND
+%token ALLOC
 %token BANG
 %token BANGEQUAL
 %token BANGEQUALF
@@ -41,6 +42,7 @@ let orbool e1 e2 =
 %token EQUALEQUALU
 %token EOF
 %token EXIT
+%token EXTERN
 %token FLOAT
 %token FLOAT32
 %token FLOAT64
@@ -120,7 +122,7 @@ let orbool e1 e2 =
 %left LESSLESS GREATERGREATER GREATERGREATERU
 %left PLUS PLUSF MINUS MINUSF
 %left STAR SLASH PERCENT STARF SLASHF SLASHU PERCENTU
-%nonassoc BANG TILDE p_uminus ABSF INTOFFLOAT FLOATOFINT FLOATOFINTU INT8S INT8U INT16S INT16U FLOAT32
+%nonassoc BANG TILDE p_uminus ABSF INTOFFLOAT FLOATOFINT FLOATOFINTU INT8S INT8U INT16S INT16U FLOAT32 ALLOC
 %left LPAREN
 
 /* Entry point */
@@ -145,7 +147,8 @@ global_declarations:
 ;
 
 global_declaration:
-    VAR STRINGLIT LBRACKET INTLIT RBRACKET      { Coq_pair($2, z_of_camlint $4) }
+    VAR STRINGLIT LBRACKET INTLIT RBRACKET
+      { Coq_pair($2, Coq_cons(Init_space (z_of_camlint $4), Coq_nil)) }
 ;
 
 proc_list:
@@ -163,11 +166,15 @@ proc:
       stmt_list
     RBRACE
       { Coq_pair($1,
-         { fn_sig = $6;
-           fn_params = CList.rev $3;
-           fn_vars = CList.rev $9;
-           fn_stackspace = $8;
-           fn_body = $10 }) }
+        Internal { fn_sig = $6;
+                   fn_params = CList.rev $3;
+                   fn_vars = CList.rev $9;
+                   fn_stackspace = $8;
+                   fn_body = $10 }) }
+  | EXTERN STRINGLIT COLON signature 
+      { Coq_pair($2,
+        External { ef_id = $2;
+                   ef_sig = $4 }) }
 ;
 
 signature:
@@ -250,6 +257,7 @@ expr:
   | INT16S expr                                 { Cmconstr.cast16signed $2 }
   | INT16U expr                                 { Cmconstr.cast16unsigned $2 }
   | FLOAT32 expr                                { Cmconstr.singleoffloat $2 }
+  | ALLOC expr                                  { Ealloc $2 }
   | expr PLUS expr                              { Cmconstr.add $1 $3 }
   | expr MINUS expr                             { Cmconstr.sub $1 $3 }
   | expr STAR expr                              { Cmconstr.mul $1 $3 }
diff --git a/caml/CMtypecheck.ml b/caml/CMtypecheck.ml
index b6f94cb..4e700d7 100644
--- a/caml/CMtypecheck.ml
+++ b/caml/CMtypecheck.ml
@@ -5,6 +5,7 @@ open Datatypes
 open CList
 open Camlcoq
 open AST
+open Integers
 open Op
 open Cminor
 
@@ -95,6 +96,8 @@ let type_operation = function
   | Oundef -> [], newvar()
   | Ocast8signed -> [tint], tint
   | Ocast16signed -> [tint], tint
+  | Ocast8unsigned -> [tint], tint
+  | Ocast16unsigned -> [tint], tint
   | Oadd -> [tint;tint], tint
   | Oaddimm _ -> [tint], tint
   | Osub -> [tint;tint], tint
@@ -141,6 +144,8 @@ let name_of_operation = function
   | Oundef -> "undef"
   | Ocast8signed -> "cast8signed"
   | Ocast16signed -> "cast16signed"
+  | Ocast8unsigned -> "cast8unsigned"
+  | Ocast16unsigned -> "cast16unsigned"
   | Oadd -> "add"
   | Oaddimm n -> sprintf "addimm %ld" (camlint_of_coqint n)
   | Osub -> "sub"
@@ -282,6 +287,14 @@ let rec type_expr env lenv e =
       te2
   | Eletvar n ->
       type_letvar lenv n
+  | Ealloc e ->
+      let te = type_expr env lenv e in
+      begin try
+        unify tint te
+      with Error s ->
+        raise (Error (sprintf "In alloc:\n%s" s))
+      end;
+      tint
 
 and type_exprlist env lenv el =
   match el with
@@ -349,7 +362,7 @@ let rec env_of_vars idl =
   | Coq_nil -> []
   | Coq_cons(id1, idt) -> (id1, newvar()) :: env_of_vars idt
 
-let type_function (Coq_pair (id, f)) =
+let type_function id f =
   try
     type_stmt
        (env_of_vars f.fn_vars @ env_of_vars f.fn_params)
@@ -357,5 +370,10 @@ let type_function (Coq_pair (id, f)) =
   with Error s ->
     raise (Error (sprintf "In function %s:\n%s" (extern_atom id) s))
 
+let type_fundef (Coq_pair (id, fd)) =
+  match fd with
+  | Internal f -> type_function id f
+  | External ef -> ()
+
 let type_program p =
-  coqlist_iter type_function p.prog_funct; p
+  coqlist_iter type_fundef p.prog_funct; p
diff --git a/caml/Camlcoq.ml b/caml/Camlcoq.ml
index b0bb4ff..fc5d2d8 100644
--- a/caml/Camlcoq.ml
+++ b/caml/Camlcoq.ml
@@ -7,6 +7,11 @@ open BinInt
 
 (* Integers *)
 
+let rec camlint_of_nat n =
+  match n with
+  | O -> 0l
+  | S n -> Int32.add (camlint_of_nat n) 1l
+
 let rec camlint_of_positive = function
   | Coq_xI p -> Int32.add (Int32.shift_left (camlint_of_positive p) 1) 1l
   | Coq_xO p -> Int32.shift_left (camlint_of_positive p) 1
diff --git a/caml/Coloringaux.ml b/caml/Coloringaux.ml
index f4f4bcd..a7c8db5 100644
--- a/caml/Coloringaux.ml
+++ b/caml/Coloringaux.ml
@@ -266,15 +266,13 @@ let class_of_type = function Tint -> 0 | Tfloat -> 1
 let num_register_classes = 2
 
 let caller_save_registers = [|
-  [| R3; R4; R5; R6; R7; R8; R9; R10 |];
-  [| F1; F2; F3; F4; F5; F6; F7; F8; F9; F10 |]
+  array_of_coqlist Conventions.int_caller_save_regs;
+  array_of_coqlist Conventions.float_caller_save_regs
 |]
 
 let callee_save_registers = [|
-  [| R13; R14; R15; R16; R17; R18; R19; R20; R21; R22; 
-     R23; R24; R25; R26; R27; R28; R29; R30; R31 |];
-  [| F14; F15; F16; F17; F18; F19; F20; F21; F22; 
-     F23; F24; F25; F26; F27; F28; F29; F30; F31 |]
+  array_of_coqlist Conventions.int_callee_save_regs;
+  array_of_coqlist Conventions.float_callee_save_regs
 |]
 
 let num_available_registers = 
diff --git a/caml/Floataux.ml b/caml/Floataux.ml
index f43efa2..f61bd5b 100644
--- a/caml/Floataux.ml
+++ b/caml/Floataux.ml
@@ -1,4 +1,5 @@
 open Camlcoq
+open Integers
 
 let singleoffloat f =
   Int32.float_of_bits (Int32.bits_of_float f)
@@ -15,9 +16,9 @@ let floatofintu i =
 
 let cmp c (x: float) (y: float) =
   match c with
-  | AST.Ceq -> x = y
-  | AST.Cne -> x <> y
-  | AST.Clt -> x < y
-  | AST.Cle -> x <= y
-  | AST.Cgt -> x > y
-  | AST.Cge -> x >= y
+  | Ceq -> x = y
+  | Cne -> x <> y
+  | Clt -> x < y
+  | Cle -> x <= y
+  | Cgt -> x > y
+  | Cge -> x >= y
diff --git a/caml/PrintPPC.ml b/caml/PrintPPC.ml
index 830de0d..eaa383b 100644
--- a/caml/PrintPPC.ml
+++ b/caml/PrintPPC.ml
@@ -26,10 +26,23 @@ let label_for_label lbl =
     Hashtbl.add current_function_labels lbl lbl';
     lbl'
 
+(* Record identifiers of external functions *)
+
+module IdentSet = Set.Make(struct type t = ident let compare = compare end)
+
+let extfuns = ref IdentSet.empty
+
+let record_extfun (Coq_pair(name, defn)) =
+  match defn with
+  | Internal _ -> ()
+  | External _ -> extfuns := IdentSet.add name !extfuns
+
 (* Basic printing functions *)
 
 let print_symb oc symb =
-  fprintf oc "_%s" (extern_atom symb)
+  if IdentSet.mem symb !extfuns
+  then fprintf oc "L%s$stub" (extern_atom symb)
+  else fprintf oc "_%s" (extern_atom symb)
 
 let print_label oc lbl =
   fprintf oc "L%d" (label_for_label lbl)
@@ -99,6 +112,8 @@ let print_instruction oc labels = function
       fprintf oc "	addis	%a, %a, %a\n" ireg r1 ireg_or_zero r2 print_constant c
   | Paddze(r1, r2) ->
       fprintf oc "	addze	%a, %a\n" ireg r1 ireg r2
+  | Pallocblock ->
+      fprintf oc "	bl	_compcert_alloc\n"
   | Pallocframe(lo, hi) ->
       let lo = camlint_of_coqint lo
       and hi = camlint_of_coqint hi in
@@ -317,7 +332,7 @@ let rec labels_of_code = function
       Labelset.add lbl (labels_of_code c)
   | Coq_cons(_, c) -> labels_of_code c
 
-let print_function oc (Coq_pair(name, code)) =
+let print_function oc name code =
   Hashtbl.clear current_function_labels;
   fprintf oc "	.text\n";
   fprintf oc "	.align 2\n";
@@ -325,10 +340,52 @@ let print_function oc (Coq_pair(name, code)) =
   fprintf oc "%a:\n" print_symb name;
   coqlist_iter (print_instruction oc (labels_of_code code)) code
 
-let print_var oc (Coq_pair(name, size)) =
-  fprintf oc "	.comm	%a, %ld\n" print_symb name (camlint_of_z size)
+let print_external_function oc name =
+  let name = extern_atom name in
+  fprintf oc "	.text\n";
+  fprintf oc "	.align 2\n";
+  fprintf oc "L%s$stub:\n" name;
+  fprintf oc "	addis	r11, 0, ha16(L%s$ptr)\n" name;
+  fprintf oc "	lwz	r11, lo16(L%s$ptr)(r11)\n" name;
+  fprintf oc "	mtctr	r11\n";
+  fprintf oc "	bctr\n";
+  fprintf oc "	.non_lazy_symbol_pointer\n";
+  fprintf oc "L%s$ptr:\n" name;
+  fprintf oc "	.indirect_symbol _%s\n" name;
+  fprintf oc "	.long	0\n"
+
+let print_fundef oc (Coq_pair(name, defn)) =
+  match defn with
+  | Internal code -> print_function oc name code
+  | External ef -> print_external_function oc name
+
+let print_init_data oc = function
+  | Init_int8 n ->
+      fprintf oc "	.byte	%ld\n" (camlint_of_coqint n)
+  | Init_int16 n ->
+      fprintf oc "	.short	%ld\n" (camlint_of_coqint n)
+  | Init_int32 n ->
+      fprintf oc "	.long	%ld\n" (camlint_of_coqint n)
+  | Init_float32 n ->
+      fprintf oc "	.long	%ld # %g \n" (Int32.bits_of_float n) n
+  | Init_float64 n ->
+      fprintf oc "	.quad	%Ld # %g \n" (Int64.bits_of_float n) n
+  | Init_space n ->
+      let n = camlint_of_z n in
+      if n > 0l then fprintf oc "	.space	%ld\n" n
+
+let print_var oc (Coq_pair(name, init_data)) =
+  match init_data with
+  | Coq_nil -> ()
+  | _  ->
+      fprintf oc "	.data\n";
+      fprintf oc "	.globl	%a\n" print_symb name;
+      fprintf oc "%a:" print_symb name;
+      coqlist_iter (print_init_data oc) init_data
 
 let print_program oc p =
+  extfuns := IdentSet.empty;
+  coqlist_iter record_extfun p.prog_funct;
   coqlist_iter (print_var oc) p.prog_vars;
-  coqlist_iter (print_function oc) p.prog_funct
+  coqlist_iter (print_fundef oc) p.prog_funct
 
diff --git a/caml/RTLtypingaux.ml b/caml/RTLtypingaux.ml
new file mode 100644
index 0000000..b76a0bb
--- /dev/null
+++ b/caml/RTLtypingaux.ml
@@ -0,0 +1,122 @@
+(* Type inference for RTL *)
+
+open Datatypes
+open CList
+open Camlcoq
+open Maps
+open AST
+open Op
+open Registers
+open RTL
+
+exception Type_error of string
+
+let env = ref (PTree.empty : typ PTree.t)
+
+let set_type r ty =
+  match PTree.get r !env with
+  | None -> env := PTree.set r ty !env
+  | Some ty' -> if ty <> ty' then raise (Type_error "type mismatch")
+
+let rec set_types rl tyl =
+  match rl, tyl with
+  | Coq_nil, Coq_nil -> ()
+  | Coq_cons(r1, rs), Coq_cons(ty1, tys) -> set_type r1 ty1; set_types rs tys
+  | _, _ -> raise (Type_error "arity mismatch")
+
+(* First pass: process constraints of the form typeof(r) = ty *)
+
+let type_instr retty (Coq_pair(pc, i)) =
+  match i with
+  | Inop(_) ->
+      ()
+  | Iop(Omove, _, _, _) -> 
+      ()
+  | Iop(Oundef, Coq_nil, res, _) ->
+      ()
+  | Iop(Oundef, _, _, _) ->
+      raise (Type_error "wrong Oundef")
+  | Iop(op, args, res, _) ->
+      let (Coq_pair(targs, tres)) = type_of_operation op in
+      set_types args targs; set_type res tres
+  | Iload(chunk, addr, args, dst, _) ->
+      set_types args (type_of_addressing addr);
+      set_type dst (type_of_chunk chunk)
+  | Istore(chunk, addr, args, src, _) ->
+      set_types args (type_of_addressing addr);
+      set_type src (type_of_chunk chunk)
+  | Icall(sg, ros, args, res, _) ->
+      begin match ros with
+      | Coq_inl r -> set_type r Tint
+      | Coq_inr _ -> ()
+      end;
+      set_types args sg.sig_args;
+      set_type res (match sg.sig_res with None -> Tint | Some ty -> ty)
+  | Ialloc(arg, res, _) ->
+      set_type arg Tint; set_type res Tint
+  | Icond(cond, args, _, _) ->
+      set_types args (type_of_condition cond)
+  | Ireturn(optres) ->
+      begin match optres, retty with
+      | None, None -> ()
+      | Some r, Some ty -> set_type r ty
+      | _, _ -> raise (Type_error "type mismatch in Ireturn")
+      end
+
+let type_pass1 retty instrs = 
+  coqlist_iter (type_instr retty) instrs
+
+(* Second pass: extract move constraints typeof(r1) = typeof(r2)
+   and solve them iteratively *)
+
+let rec extract_moves = function
+  | Coq_nil -> []
+  | Coq_cons(Coq_pair(pc, i), rem) ->
+      match i with
+      | Iop(Omove, Coq_cons(r1, Coq_nil), r2, _) ->
+          (r1, r2) :: extract_moves rem
+      | Iop(Omove, _, _, _) ->
+          raise (Type_error "wrong Omove")
+      | _ ->
+          extract_moves rem
+
+let changed = ref false
+
+let rec solve_moves = function
+  | [] -> []
+  | (r1, r2) :: rem ->
+      match (PTree.get r1 !env, PTree.get r2 !env) with
+      | Some ty1, Some ty2 ->
+          if ty1 = ty2 
+          then (changed := true; solve_moves rem)
+          else raise (Type_error "type mismatch in Omove")
+      | Some ty1, None ->
+          env := PTree.set r2 ty1 !env; changed := true; solve_moves rem
+      | None, Some ty2 ->
+          env := PTree.set r1 ty2 !env; changed := true; solve_moves rem
+      | None, None ->
+          (r1, r2) :: solve_moves rem
+
+let rec iter_solve_moves mvs =
+  changed := false;
+  let mvs' = solve_moves mvs in
+  if !changed then iter_solve_moves mvs'
+
+let type_pass2 instrs =
+  iter_solve_moves (extract_moves instrs)
+
+let typeof e r =
+  match PTree.get r e with Some ty -> ty | None -> Tint
+
+let infer_type_environment f instrs =
+  try
+    env := PTree.empty;
+    set_types f.fn_params f.fn_sig.sig_args;
+    type_pass1 f.fn_sig.sig_res instrs;
+    type_pass2 instrs;
+    let e = !env in
+    env := PTree.empty;
+    Some(typeof e)
+  with Type_error msg ->
+    Printf.eprintf "Error during RTL type inference: %s\n" msg;
+    None
diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v
new file mode 100644
index 0000000..b73e83c
--- /dev/null
+++ b/cfrontend/Csem.v
@@ -0,0 +1,752 @@
+(** * Dynamic semantics for the Clight language *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import Values.
+Require Import AST.
+Require Import Mem.
+Require Import Events.
+Require Import Globalenvs.
+Require Import Csyntax.
+
+(** ** Semantics of type-dependent operations *)
+
+Inductive is_false: val -> type -> Prop :=
+  | is_false_int: forall sz sg,
+      is_false (Vint Int.zero) (Tint sz sg)
+  | is_false_pointer: forall t,
+      is_false (Vint Int.zero) (Tpointer t)
+ | is_false_float: forall sz,
+      is_false (Vfloat Float.zero) (Tfloat sz).
+
+Inductive is_true: val -> type -> Prop :=
+  | is_true_int_int: forall n sz sg,
+      n <> Int.zero ->
+      is_true (Vint n) (Tint sz sg)
+  | is_true_pointer_int: forall b ofs sz sg,
+      is_true (Vptr b ofs) (Tint sz sg)
+  | is_true_int_pointer: forall n t,
+      n <> Int.zero ->
+      is_true (Vint n) (Tpointer t)
+  | is_true_pointer_pointer: forall b ofs t,
+      is_true (Vptr b ofs) (Tpointer t)
+ | is_true_float: forall f sz,
+      f <> Float.zero ->
+      is_true (Vfloat f) (Tfloat sz).
+
+Inductive bool_of_val : val -> type -> val -> Prop :=
+  | bool_of_val_true:   forall v ty, 
+         is_true v ty -> 
+         bool_of_val v ty Vtrue
+  | bool_of_val_false:   forall v ty,
+        is_false v ty ->
+        bool_of_val v ty Vfalse.
+
+Function sem_neg (v: val) (ty: type) : option val :=
+  match ty with
+  | Tint _ _ =>
+      match v with
+      | Vint n => Some (Vint (Int.neg n))
+      | _ => None
+      end
+  | Tfloat _ =>
+      match v with
+      | Vfloat f => Some (Vfloat (Float.neg f))
+      | _ => None
+      end
+  | _ => None
+  end.
+
+Function sem_notint (v: val) : option val :=
+  match v with
+  | Vint n => Some (Vint (Int.xor n Int.mone))
+  | _ => None
+  end.
+
+Function sem_notbool (v: val) (ty: type) : option val :=
+  match ty with
+  | Tint _ _ =>
+      match v with
+      | Vint n => Some (Val.of_bool (Int.eq n Int.zero))
+      | Vptr _ _ => Some Vfalse
+      | _ => None
+      end
+  | Tpointer _ =>
+      match v with
+      | Vint n => Some (Val.of_bool (Int.eq n Int.zero))
+      | Vptr _ _ => Some Vfalse
+      | _ => None
+      end
+  | Tfloat _ =>
+      match v with
+      | Vfloat f => Some (Val.of_bool (Float.cmp Ceq f Float.zero))
+      | _ => None
+      end
+  | _ => None
+  end.
+
+Function sem_add (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+  match classify_add t1 t2 with 
+  | add_case_ii =>  
+      match v1, v2 with
+      | Vint n1, Vint n2 => Some (Vint (Int.add n1 n2))
+      | _,  _ => None
+      end
+  | add_case_ff =>
+      match v1, v2 with
+      | Vfloat n1, Vfloat n2 => Some (Vfloat (Float.add n1 n2))
+      | _,  _ => None
+      end
+  | add_case_pi ty=>
+      match v1,v2 with
+      | Vptr b1 ofs1, Vint n2 => 
+	Some (Vptr b1 (Int.add ofs1 (Int.mul (Int.repr (sizeof ty)) n2)))
+      | _,  _ => None
+      end   
+  | add_default => None
+end.
+
+Function sem_sub (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+  match classify_sub t1 t2 with
+  | sub_case_ii =>               (* integer subtraction *)
+      match v1,v2 with
+      | Vint n1, Vint n2 => Some (Vint (Int.sub n1 n2))
+      | _,  _ => None
+      end 
+  | sub_case_ff =>               (* float subtraction *)
+      match v1,v2 with
+      | Vfloat f1, Vfloat f2 => Some (Vfloat(Float.sub f1 f2))
+      | _,  _ => None
+      end
+  | sub_case_pi ty =>            (*array| pointer - offset *)
+      match v1,v2 with
+      | Vptr b1 ofs1, Vint n2 => 
+            Some (Vptr b1 (Int.sub ofs1 (Int.mul (Int.repr (sizeof ty)) n2)))
+      | _,  _ => None
+      end
+  | sub_case_pp ty =>          (* array|pointer - array|pointer *)
+      match v1,v2 with
+      | Vptr b1 ofs1, Vptr b2 ofs2 =>
+          if zeq b1 b2 then
+            if Int.eq (Int.repr (sizeof ty)) Int.zero then None
+            else Some (Vint (Int.divu (Int.sub ofs1 ofs2) (Int.repr (sizeof ty))))
+          else None
+      | _, _ => None
+      end
+  | sub_default => None
+  end.
+ 
+Function sem_mul (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+ match classify_mul t1 t2 with
+  | mul_case_ii =>
+      match v1,v2 with
+      | Vint n1, Vint n2 => Some (Vint (Int.mul n1 n2))
+      | _,  _ => None
+      end
+  | mul_case_ff =>
+      match v1,v2 with
+      | Vfloat f1, Vfloat f2 => Some (Vfloat (Float.mul f1 f2))
+      | _,  _ => None
+      end
+  | mul_default =>
+      None
+end.
+
+Function sem_div (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+   match classify_div t1 t2 with
+  | div_case_I32unsi =>
+      match v1,v2 with
+      | Vint n1, Vint n2 =>
+          if Int.eq n2 Int.zero then None else Some (Vint (Int.divu n1 n2))
+      | _,_ => None
+      end
+  | div_case_ii =>
+      match v1,v2 with
+       | Vint n1, Vint n2 =>
+          if Int.eq n2 Int.zero then None else Some (Vint(Int.divs n1 n2))
+      | _,_ => None
+      end
+  | div_case_ff =>
+      match v1,v2 with
+      | Vfloat f1, Vfloat f2 => Some (Vfloat(Float.div f1 f2))
+      | _,  _ => None
+      end 
+  | div_default =>
+      None
+end.
+
+Function sem_mod (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+  match classify_mod t1 t2 with
+  | mod_case_I32unsi =>
+      match v1, v2 with
+      | Vint n1, Vint n2 =>
+          if Int.eq n2 Int.zero then None else Some (Vint (Int.modu n1 n2))
+      | _, _ => None
+      end
+  | mod_case_ii =>
+      match v1,v2 with
+      | Vint n1, Vint n2 =>
+          if Int.eq n2 Int.zero then None else Some (Vint (Int.mods n1 n2))
+      | _, _ => None
+      end
+  | mod_default =>
+      None
+  end.
+
+Function sem_and (v1 v2: val) : option val :=
+  match v1, v2 with
+  | Vint n1, Vint n2 => Some (Vint(Int.and n1 n2))
+  | _, _ => None
+  end .
+
+Function sem_or (v1 v2: val) : option val :=
+  match v1, v2 with
+  | Vint n1, Vint n2 => Some (Vint(Int.or n1 n2))
+  | _, _ => None
+  end. 
+
+Function sem_xor (v1 v2: val): option val :=
+  match v1, v2 with
+  | Vint n1, Vint n2 => Some (Vint(Int.xor n1 n2))
+  | _, _ => None
+  end.
+
+Function sem_shl (v1 v2: val): option val :=
+  match v1, v2 with
+  | Vint n1, Vint n2 =>
+     if Int.ltu n2 (Int.repr 32) then Some (Vint(Int.shl n1 n2)) else None
+  | _, _ => None
+  end.
+
+Function sem_shr (v1: val) (t1: type) (v2: val) (t2: type): option val :=
+  match classify_shr t1 t2 with 
+  | shr_case_I32unsi => 
+      match v1,v2 with 
+      | Vint n1, Vint n2 =>
+          if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shru n1 n2)) else None
+      | _,_ => None
+      end
+   | shr_case_ii => 
+      match v1,v2 with
+      | Vint n1,  Vint n2 =>
+          if Int.ltu n2 (Int.repr 32) then Some (Vint (Int.shr n1 n2)) else None
+      | _,  _ => None
+      end
+   | shr_default=>
+      None
+   end.
+
+Function sem_cmp_mismatch (c: comparison): option val :=
+  match c with
+  | Ceq =>  Some Vfalse
+  | Cne =>  Some Vtrue
+  | _   => None
+  end.
+
+Function sem_cmp (c:comparison)
+                  (v1: val) (t1: type) (v2: val) (t2: type)
+                  (m: mem): option val :=
+  match classify_cmp t1 t2 with
+  | cmp_case_I32unsi =>
+      match v1,v2 with
+      | Vint n1, Vint n2 =>Some (Val.of_bool (Int.cmpu c n1 n2))
+      | _,  _ => None
+      end
+  | cmp_case_ii =>
+      match v1,v2 with
+      | Vint n1, Vint n2 =>Some (Val.of_bool (Int.cmp c n1 n2))
+      | _,  _ => None
+      end
+  | cmp_case_ff =>
+      match v1,v2 with
+      | Vfloat f1, Vfloat f2 =>Some (Val.of_bool (Float.cmp c f1 f2))  
+      | _,  _ => None
+      end
+  | cmp_case_pi =>
+      match v1,v2 with
+      | Vptr b ofs, Vint n2 =>
+          if Int.eq n2 Int.zero then sem_cmp_mismatch c else None
+      | _,  _ => None
+      end
+  | cmp_case_pp =>
+      match v1,v2 with
+      | Vptr b1 ofs1,  Vptr b2 ofs2  =>
+          if valid_pointer m b1 (Int.signed ofs1) && valid_pointer m b2 (Int.signed ofs2) then
+            if zeq b1 b2
+            then Some (Val.of_bool (Int.cmp c ofs1 ofs2))
+            else None
+          else None
+      | _,  _ => None
+      end 
+  | cmp_default => None
+  end.
+
+Definition sem_unary_operation
+            (op: unary_operation) (v: val) (ty: type): option val :=
+  match op with
+  | Onotbool => sem_notbool v ty
+  | Onotint => sem_notint v
+  | Oneg => sem_neg v ty
+  end.
+
+Definition sem_binary_operation
+    (op: binary_operation)
+    (v1: val) (t1: type) (v2: val) (t2:type)
+    (m: mem): option val :=
+  match op with
+  | Oadd => sem_add v1 t1 v2 t2
+  | Osub => sem_sub v1 t1 v2 t2 
+  | Omul => sem_mul v1 t1 v2 t2
+  | Omod => sem_mod v1 t1 v2 t2
+  | Odiv => sem_div v1 t1 v2 t2 
+  | Oand => sem_and v1 v2  
+  | Oor  => sem_or v1 v2 
+  | Oxor  => sem_xor v1 v2 
+  | Oshl => sem_shl v1 v2 
+  | Oshr  => sem_shr v1 t1 v2 t2   
+  | Oeq => sem_cmp Ceq v1 t1 v2 t2 m
+  | One => sem_cmp Cne v1 t1 v2 t2 m
+  | Olt => sem_cmp Clt v1 t1 v2 t2 m
+  | Ogt => sem_cmp Cgt v1 t1 v2 t2 m
+  | Ole => sem_cmp Cle v1 t1 v2 t2 m
+  | Oge => sem_cmp Cge v1 t1 v2 t2 m
+  end.
+
+Definition cast_int_int (sz: intsize) (sg: signedness) (i: int) : int :=
+  match sz, sg with
+  | I8, Signed => Int.cast8signed i
+  | I8, Unsigned => Int.cast8unsigned i
+  | I16, Signed => Int.cast16signed i
+  | I16, Unsigned => Int.cast16unsigned i 
+  | I32 , _ => i
+  end.
+
+Definition cast_int_float (si : signedness) (i: int) : float :=
+  match si with
+  | Signed => Float.floatofint i
+  | Unsigned => Float.floatofintu i
+  end.
+
+Definition cast_float_float (sz: floatsize) (f: float) : float :=
+  match sz with
+  | F32 => Float.singleoffloat f
+  | F64 => f
+  end.
+
+Inductive cast : val -> type -> type -> val -> Prop :=
+  | cast_ii:   forall i sz2 sz1 si1 si2,
+      cast (Vint i) (Tint sz1 si1) (Tint sz2 si2)
+           (Vint (cast_int_int sz2 si2 i))
+  | cast_fi:   forall f sz1 sz2 si2,
+      cast (Vfloat f) (Tfloat sz1) (Tint sz2 si2)
+           (Vint (cast_int_int sz2 si2 (Float.intoffloat f)))
+  | cast_if:   forall i sz1 sz2 si1,
+      cast (Vint i) (Tint sz1 si1) (Tfloat sz2)
+          (Vfloat (cast_float_float sz2 (cast_int_float si1 i)))
+  | cast_ff:   forall f sz1 sz2,
+      cast (Vfloat f) (Tfloat sz1) (Tfloat sz2)
+           (Vfloat (cast_float_float sz2 f))
+  | cast_ip_p:   forall b ofs t1 si2,
+      cast (Vptr b ofs) (Tint I32 si2) (Tpointer t1) (Vptr b ofs)
+  | cast_pi_p:   forall b ofs t1 si2,
+      cast (Vptr b ofs) (Tpointer t1) (Tint I32 si2) (Vptr b ofs)
+  | cast_pp_p:    forall b ofs t1 t2,
+      cast (Vptr b ofs) (Tpointer t1) (Tpointer t2) (Vptr b ofs)
+  | cast_ip_i:   forall n t1 si2,
+      cast (Vint n) (Tint I32 si2) (Tpointer t1) (Vint n)
+  | cast_pi_i:   forall n t1 si2,
+      cast (Vint n) (Tpointer t1) (Tint I32 si2) (Vint n)
+  | cast_pp_i:    forall n t1 t2,
+      cast (Vint n) (Tpointer t1) (Tpointer t2) (Vint n).
+
+(** ** Operational semantics *)
+
+(** Global environment *)
+
+Definition genv := Genv.t fundef.
+
+Definition globalenv (p: program) : genv :=
+  Genv.globalenv (program_of_program p).
+
+Definition init_mem (p: program) : mem :=  
+  Genv.init_mem (program_of_program p).
+
+(** Local environment *)
+
+Definition env := PTree.t block. (* map variable -> location *)
+
+Definition empty_env: env := (PTree.empty block).
+
+(** Outcomes for statements *)
+
+Inductive outcome: Set :=
+   | Out_break: outcome
+   | Out_continue: outcome
+   | Out_normal: outcome
+   | Out_return: option val -> outcome.
+
+Inductive out_normal_or_continue : outcome -> Prop :=
+  | Out_normal_or_continue_N: out_normal_or_continue Out_normal
+  | Out_normal_or_continue_C: out_normal_or_continue Out_continue.
+
+Inductive out_break_or_return : outcome -> outcome -> Prop :=
+  | Out_break_or_return_B: out_break_or_return Out_break Out_normal
+  | Out_break_or_return_R: forall ov,
+      out_break_or_return (Out_return ov) (Out_return ov).
+
+Definition outcome_switch (out: outcome) : outcome :=
+  match out with
+  | Out_break => Out_normal
+  | o => o
+  end.
+
+Definition outcome_result_value (out: outcome) (t: type) (v: val) : Prop :=
+  match out, t with
+  | Out_normal, Tvoid => v = Vundef
+  | Out_return None, Tvoid => v = Vundef
+  | Out_return (Some v'), ty => ty <> Tvoid /\ v'=v
+  | _, _ => False
+  end. 
+
+(** Selection of the appropriate case of a [switch] *)
+
+Fixpoint select_switch (n: int) (sl: labeled_statements)
+                       {struct sl}: labeled_statements :=
+  match sl with
+  | LSdefault _ => sl
+  | LScase c s sl' => if Int.eq c n then sl else select_switch n sl'
+  end.
+
+(** Loads and stores by type *)
+
+Definition load_value_of_type (ty: type) (m: mem) (b: block) (ofs: int) : option val :=
+  match access_mode ty with
+  | By_value chunk => Mem.loadv chunk m (Vptr b ofs)
+  | By_reference => Some (Vptr b ofs)
+  | By_nothing => None
+  end.
+
+Definition store_value_of_type (ty_dest: type) (m: mem) (loc: block) (ofs: int) (v: val) : option mem :=
+  match access_mode ty_dest with
+  | By_value chunk => Mem.storev chunk m (Vptr loc ofs) v
+  | By_reference => None
+  | By_nothing => None
+  end.
+
+(** Allocation and initialization of function-local variables *)
+
+Inductive alloc_variables: env -> mem ->
+                           list (ident * type) ->
+                           env -> mem -> list block -> Prop :=
+  | alloc_variables_nil:
+      forall e m,
+      alloc_variables e m nil e m nil
+  | alloc_variables_cons:
+      forall e m id ty vars m1 b1 m2 e2 lb,
+      Mem.alloc m 0 (sizeof ty) = (m1, b1) ->
+      alloc_variables (PTree.set id b1 e) m1 vars e2 m2 lb ->
+      alloc_variables e m ((id, ty) :: vars) e2 m2 (b1 :: lb).
+
+Inductive bind_parameters: env ->
+                           mem -> list (ident * type) -> list val ->
+                           mem -> Prop :=
+  | bind_parameters_nil:
+      forall e m,
+      bind_parameters e m nil nil m
+  | bind_parameters_cons:
+      forall e m id ty params v1 vl b m1 m2,
+      PTree.get id e = Some b ->
+      store_value_of_type ty m b Int.zero v1 = Some m1 ->
+      bind_parameters e m1 params vl m2 ->
+      bind_parameters e m ((id, ty) :: params) (v1 :: vl) m2.
+
+Section RELSEM.
+
+Variable ge: genv.
+
+(** Evaluation of an expression in r-value position *)
+
+Inductive eval_expr: env -> mem -> expr -> trace -> mem -> val -> Prop :=
+  | eval_Econst_int:   forall e m i ty,
+      eval_expr e m (Expr (Econst_int i) ty)
+               E0 m (Vint i)
+  | eval_Econst_float:   forall e m f ty,
+      eval_expr e m (Expr (Econst_float f) ty)
+               E0 m (Vfloat f)
+  | eval_Elvalue: forall e m a ty t m1 loc ofs v,
+      eval_lvalue e m (Expr a ty) t m1 loc ofs ->
+      load_value_of_type ty m1 loc ofs = Some v ->
+      eval_expr e m (Expr a ty) 
+                t m1 v
+  | eval_Eaddrof: forall e m a t m1 loc ofs ty,
+      eval_lvalue e m a t m1 loc ofs ->
+      eval_expr e m (Expr (Eaddrof a) ty)
+                t m1 (Vptr loc ofs)
+  | eval_Esizeof: forall e m ty' ty,
+      eval_expr e m (Expr (Esizeof ty') ty) 
+               E0 m (Vint (Int.repr (sizeof ty')))
+  | eval_Eunop:  forall e m op a ty t m1 v1 v,
+      eval_expr e m a t m1 v1 ->
+      sem_unary_operation op v1 (typeof a) = Some v ->
+      eval_expr e m (Expr (Eunop op a) ty) 
+                t m1 v
+  | eval_Ebinop: forall e m op a1 a2 ty t1 m1 v1 t2 m2 v2 v,
+      eval_expr e m a1 t1 m1 v1 ->
+      eval_expr e m1 a2 t2 m2 v2 ->
+      sem_binary_operation op v1 (typeof a1) v2 (typeof a2) m2 = Some v ->
+      eval_expr e m (Expr (Ebinop op a1 a2) ty)
+                (t1 ** t2) m2 v
+  | eval_Eorbool_1: forall e m a1 a2 t m1 v1 ty,
+      eval_expr e m a1 t m1 v1 ->
+      is_true v1 (typeof a1) ->
+      eval_expr e m (Expr (Eorbool a1 a2) ty)
+                  t m1 Vtrue
+  | eval_Eorbool_2: forall e m a1 a2 ty t1 m1 v1 t2 m2 v2 v,
+      eval_expr e m a1 t1 m1 v1 ->
+      is_false v1 (typeof a1) -> 
+      eval_expr e m1 a2 t2 m2 v2 ->
+      bool_of_val v2 (typeof a2) v ->
+      eval_expr e m (Expr (Eorbool a1 a2) ty)
+                (t1 ** t2) m2 v
+  | eval_Eandbool_1: forall e m a1 a2 t m1 v1 ty,
+      eval_expr e m a1 t m1 v1 ->
+      is_false v1 (typeof a1) ->
+      eval_expr e m (Expr (Eandbool a1 a2) ty)
+                  t m1 Vfalse
+  | eval_Eandbool_2: forall e m a1 a2 ty t1 m1 v1 t2 m2 v2 v,
+      eval_expr e m a1 t1 m1 v1 ->
+      is_true v1 (typeof a1) -> 
+      eval_expr e m1 a2 t2 m2 v2 ->
+      bool_of_val v2 (typeof a2) v ->
+      eval_expr e m (Expr (Eandbool a1 a2) ty)
+                (t1 ** t2) m2 v
+  | eval_Ecast:   forall e m a ty t m1 v1 v,
+      eval_expr e m a t m1 v1 ->
+      cast v1 (typeof a) ty v ->
+      eval_expr e m (Expr (Ecast ty a) ty)
+                t m1 v
+  | eval_Ecall: forall e m a bl ty m3 vres t1 m1 vf t2 m2 vargs f t3,
+      eval_expr e m a t1 m1 vf ->
+      eval_exprlist e m1 bl t2 m2 vargs ->
+      Genv.find_funct ge vf = Some f ->
+      type_of_fundef f = typeof a ->
+      eval_funcall m2 f vargs t3 m3 vres ->
+      eval_expr e m (Expr (Ecall a bl) ty)
+                (t1 ** t2 ** t3) m3 vres 
+
+(** Evaluation of an expression in l-value position *)
+
+with eval_lvalue: env -> mem -> expr -> trace -> mem -> block -> int -> Prop :=
+  | eval_Evar_local:   forall e m id l ty,
+      e!id = Some l ->
+      eval_lvalue e m (Expr (Evar id) ty) 
+                 E0 m l Int.zero
+  | eval_Evar_global: forall e m id l ty,
+      e!id = None ->
+      Genv.find_symbol ge id = Some l ->
+      eval_lvalue e m (Expr (Evar id) ty)
+                 E0 m l Int.zero
+  | eval_Ederef: forall e m m1 a t ofs ty l,
+      eval_expr e m a t m1 (Vptr l ofs) ->
+      eval_lvalue e m (Expr (Ederef a) ty)
+                  t m1 l ofs
+  | eval_Eindex: forall e m a1 t1 m1 v1 a2 t2 m2 v2 l ofs ty,
+      eval_expr e m a1 t1 m1 v1 ->
+      eval_expr e m1 a2 t2 m2 v2 ->
+      sem_add v1 (typeof a1) v2 (typeof a2) = Some (Vptr l ofs) ->
+      eval_lvalue e m (Expr (Eindex a1 a2) ty)
+                  (t1 ** t2) m2 l ofs
+ | eval_Efield_struct:   forall e m a t m1 l ofs fList i ty delta,
+      eval_lvalue e m a t m1 l ofs ->
+      typeof a = Tstruct fList ->
+      field_offset i fList = Some delta ->
+      eval_lvalue e m (Expr (Efield a i) ty)
+                  t m1 l (Int.add ofs (Int.repr delta))
+ | eval_Efield_union:   forall e m a t m1 l ofs fList i ty,
+      eval_lvalue e m a t m1 l ofs ->
+      typeof a = Tunion fList ->
+      eval_lvalue e m (Expr (Efield a i) ty) 
+                  t m1 l ofs
+
+(** Evaluation of a list of expressions *)
+
+with eval_exprlist: env -> mem -> exprlist -> trace -> mem -> list val -> Prop :=
+  | eval_Enil:   forall e m,
+      eval_exprlist e m Enil E0 m nil
+  | eval_Econs:   forall e m a bl t1 m1 v t2 m2 vl,
+      eval_expr e m a t1 m1 v ->
+      eval_exprlist e m1 bl t2 m2 vl ->
+      eval_exprlist e m (Econs a bl)
+                    (t1 ** t2) m2 (v :: vl)
+
+(** Execution of a statement *)
+
+with exec_stmt: env -> mem -> statement -> trace -> mem -> outcome -> Prop :=
+  | exec_Sskip:   forall e m,
+      exec_stmt e m Sskip
+               E0 m Out_normal
+  | exec_Sexpr: forall e m a t m1 v,
+      eval_expr e m a t m1 v ->
+      exec_stmt e m (Sexpr a)
+                t m1 Out_normal 
+  | exec_Sassign:   forall e m a1 a2 t1 m1 loc ofs t2 m2 v2 m3,
+      eval_lvalue e m a1 t1 m1 loc ofs ->
+      eval_expr e m1 a2 t2 m2 v2 ->
+      store_value_of_type (typeof a1) m2 loc ofs v2 = Some m3 ->
+      exec_stmt e m (Sassign a1 a2)
+                (t1 ** t2) m3 Out_normal
+  | exec_Sseq_1:   forall e m s1 s2 t1 m1 t2 m2 out,
+      exec_stmt e m s1 t1 m1 Out_normal ->
+      exec_stmt e m1 s2 t2 m2 out ->
+      exec_stmt e m (Ssequence s1 s2)
+                (t1 ** t2) m2 out
+  | exec_Sseq_2:   forall e m s1 s2 t1 m1 out,
+      exec_stmt e m s1 t1 m1 out ->
+      out <> Out_normal ->
+      exec_stmt e m (Ssequence s1 s2)
+                t1 m1 out
+  | exec_Sifthenelse_true: forall e m a s1 s2 t1 m1 v1 t2 m2 out,
+      eval_expr e m a t1 m1 v1 ->
+      is_true v1 (typeof a) ->
+      exec_stmt e m1 s1 t2 m2 out ->
+      exec_stmt e m (Sifthenelse a s1 s2)
+                (t1 ** t2) m2 out
+  | exec_Sifthenelse_false: forall e m a s1 s2 t1 m1 v1 t2 m2 out,
+      eval_expr e m a t1 m1 v1 ->
+      is_false v1 (typeof a) ->
+      exec_stmt e m1 s2 t2 m2 out ->
+      exec_stmt e m (Sifthenelse a s1 s2)
+                (t1 ** t2) m2 out
+  | exec_Sreturn_none:   forall e m,
+      exec_stmt e m (Sreturn None)
+               E0 m (Out_return None)
+  | exec_Sreturn_some: forall e m a t m1 v,
+      eval_expr e m a t m1 v ->
+      exec_stmt e m (Sreturn (Some a))
+                t m1 (Out_return (Some v))
+  | exec_Sbreak:   forall e m,
+      exec_stmt e m Sbreak
+               E0 m Out_break
+  | exec_Scontinue:   forall e m,
+      exec_stmt e m Scontinue
+               E0 m Out_continue
+  | exec_Swhile_false: forall e m s a t v m1,
+      eval_expr e m a t m1 v ->
+      is_false v (typeof a) ->
+      exec_stmt e m (Swhile a s)
+                t m1 Out_normal
+  | exec_Swhile_stop: forall e m a t1 m1 v s m2 t2 out2 out,
+      eval_expr e m a t1 m1 v ->
+      is_true v (typeof a) ->
+      exec_stmt e m1 s t2 m2 out2 ->
+      out_break_or_return out2 out ->
+      exec_stmt e m (Swhile a s)
+                (t1 ** t2) m2 out
+  | exec_Swhile_loop: forall e m a t1 m1 v s out2 out t2 m2 t3 m3,
+      eval_expr e m a t1 m1 v ->
+      is_true v (typeof a) ->
+      exec_stmt e m1 s t2 m2 out2 ->
+      out_normal_or_continue out2 ->
+      exec_stmt e m2 (Swhile a s) t3 m3 out ->
+      exec_stmt e m (Swhile a s)
+                (t1 ** t2 ** t3) m3 out
+  | exec_Sdowhile_false: forall e m s a t1 m1 out1 v t2 m2,
+      exec_stmt e m s t1 m1 out1 ->
+      out_normal_or_continue out1 ->
+      eval_expr e m1 a t2 m2 v ->
+      is_false v (typeof a) ->
+      exec_stmt e m (Sdowhile a s)
+                (t1 ** t2) m2 Out_normal
+  | exec_Sdowhile_stop: forall e m s a t m1 out1 out,
+      exec_stmt e m s t m1 out1 ->
+      out_break_or_return out1 out ->
+      exec_stmt e m (Sdowhile a s)
+                t m1 out
+  | exec_Sdowhile_loop: forall e m s a m1 m2 m3 t1 t2 t3 out out1 v,
+      exec_stmt e m s t1 m1 out1 ->
+      out_normal_or_continue out1 ->
+      eval_expr e m1 a t2 m2 v ->
+      is_true v (typeof a) ->
+      exec_stmt e m2 (Sdowhile a s) t3 m3 out ->
+      exec_stmt e m (Sdowhile a s) 
+                (t1 ** t2 ** t3) m3 out
+  | exec_Sfor_start: forall e m s a1 a2 a3 out m1 m2 t1 t2,
+      exec_stmt e m a1 t1 m1 Out_normal ->
+      exec_stmt e m1 (Sfor Sskip a2 a3 s) t2 m2 out ->
+      exec_stmt e m (Sfor a1 a2 a3 s) 
+                (t1 ** t2) m2 out
+  | exec_Sfor_false: forall e m s a2 a3 t v m1,
+      eval_expr e m a2 t m1 v ->
+      is_false v (typeof a2) ->
+      exec_stmt e m (Sfor Sskip a2 a3 s)
+                t m1 Out_normal
+  | exec_Sfor_stop: forall e m s a2 a3 v m1 m2 t1 t2 out2 out,
+      eval_expr e m a2 t1 m1 v ->
+      is_true v (typeof a2) ->
+      exec_stmt e m1 s t2 m2 out2 ->
+      out_break_or_return out2 out ->
+      exec_stmt e m (Sfor Sskip a2 a3 s)
+                (t1 ** t2) m2 out
+  | exec_Sfor_loop: forall e m s a2 a3 v m1 m2 m3 m4 t1 t2 t3 t4 out2 out,
+      eval_expr e m a2 t1 m1 v ->
+      is_true v (typeof a2) ->
+      exec_stmt e m1 s t2 m2 out2 ->
+      out_normal_or_continue out2 ->
+      exec_stmt e m2 a3 t3 m3 Out_normal ->
+      exec_stmt e m3 (Sfor Sskip a2 a3 s) t4 m4 out ->
+      exec_stmt e m (Sfor Sskip a2 a3 s)
+                (t1 ** t2 ** t3 ** t4) m4 out
+  | exec_Sswitch:   forall e m a t1 m1 n sl t2 m2 out,
+      eval_expr e m a t1 m1 (Vint n) ->
+      exec_lblstmts e m1 (select_switch n sl) t2 m2 out ->
+      exec_stmt e m (Sswitch a sl)
+                (t1 ** t2) m2 (outcome_switch out)
+
+(** Execution of a list of labeled statements *)
+
+with exec_lblstmts: env -> mem -> labeled_statements -> trace -> mem -> outcome -> Prop :=
+  | exec_LSdefault: forall e m s t m1 out,
+     exec_stmt e m s t m1 out ->
+     exec_lblstmts e m (LSdefault s) t m1 out
+  | exec_LScase_fallthrough: forall e m n s ls t1 m1 t2 m2 out,
+     exec_stmt e m s t1 m1 Out_normal ->
+     exec_lblstmts e m1 ls t2 m2 out ->
+     exec_lblstmts e m (LScase n s ls) (t1 ** t2) m2 out
+  | exec_LScase_stop: forall e m n s ls t m1 out,
+     exec_stmt e m s t m1 out -> out <> Out_normal ->
+     exec_lblstmts e m (LScase n s ls) t m1 out
+
+(** Evaluation of a function invocation *)
+
+with eval_funcall: mem -> fundef -> list val -> trace -> mem -> val -> Prop :=
+  | eval_funcall_internal: forall m f vargs t e m1 lb m2 m3 out vres,
+      alloc_variables empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 lb ->
+      bind_parameters e m1 f.(fn_params) vargs m2 ->
+      exec_stmt e m2 f.(fn_body) t m3 out ->
+      outcome_result_value out f.(fn_return) vres ->
+      eval_funcall m (Internal f) vargs t (Mem.free_list m3 lb) vres
+  | eval_funcall_external: forall m id targs tres vargs t vres,
+      event_match (external_function id targs tres) vargs t vres ->
+      eval_funcall m (External id targs tres) vargs t m vres.
+
+Scheme eval_expr_ind6 := Minimality for eval_expr Sort Prop
+  with eval_lvalue_ind6 := Minimality for eval_lvalue Sort Prop
+  with eval_exprlist_ind6 := Minimality for eval_exprlist Sort Prop
+  with exec_stmt_ind6 := Minimality for exec_stmt Sort Prop
+  with exec_lblstmts_ind6 := Minimality for exec_lblstmts Sort Prop
+  with eval_funcall_ind6 := Minimality for eval_funcall Sort Prop.
+
+End RELSEM.
+
+(** Execution of a whole program *)
+
+Definition exec_program (p: program) (t: trace) (r: val) : Prop :=
+  let ge := globalenv p in 
+  let m0 := init_mem p in
+  exists b, exists f, exists m1,
+  Genv.find_symbol ge p.(prog_main) = Some b /\
+  Genv.find_funct_ptr ge b = Some f /\
+  type_of_fundef f = Tfunction Tnil (Tint I32 Signed) /\
+  eval_funcall ge m0 f nil t m1 r.
diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v
new file mode 100644
index 0000000..58c0bb8
--- /dev/null
+++ b/cfrontend/Cshmgen.v
@@ -0,0 +1,598 @@
+Require Import Coqlib.
+Require Import Integers.
+Require Import Floats.
+Require Import AST.
+Require Import Csyntax.
+Require Import Csharpminor.
+
+(** The error monad *)
+
+Definition bind (A B: Set) (f: option A) (g: A -> option B) :=
+  match f with None => None | Some x => g x end.
+
+Implicit Arguments bind [A B].
+
+Notation "'do' X <- A ; B" := (bind A (fun X => B))
+   (at level 200, X ident, A at level 100, B at level 200).
+
+(** ** Operations on C types *)
+
+Definition signature_of_function (f: Csyntax.function) : signature :=
+  mksignature 
+   (typlist_of_typelist (type_of_params (Csyntax.fn_params f)))
+   (opttyp_of_type (Csyntax.fn_return f)).
+
+Definition chunk_of_type (ty: type): option memory_chunk :=
+  match access_mode ty with
+  | By_value chunk => Some chunk
+  | _ => None
+  end.
+
+Definition var_kind_of_type (ty: type): option var_kind :=
+  match ty with
+  | Tint I8 Signed => Some(Vscalar Mint8signed)
+  | Tint I8 Unsigned => Some(Vscalar Mint8unsigned)
+  | Tint I16 Signed => Some(Vscalar Mint16signed)
+  | Tint I16 Unsigned => Some(Vscalar Mint16unsigned)
+  | Tint I32 _ => Some(Vscalar Mint32)
+  | Tfloat F32 => Some(Vscalar Mfloat32)
+  | Tfloat F64 => Some(Vscalar Mfloat64)
+  | Tvoid => None
+  | Tpointer _ => Some(Vscalar Mint32)
+  | Tarray _ _ => Some(Varray (Csyntax.sizeof ty))
+  | Tfunction _ _ => None
+  | Tstruct fList => Some(Varray (Csyntax.sizeof ty))
+  | Tunion fList => Some(Varray (Csyntax.sizeof ty))
+end.
+  
+(** ** Csharpminor constructors *)
+
+(* The following functions build Csharpminor expressions that compute
+   the value of a C operation.  Most construction functions take
+   as arguments
+   - Csharpminor subexpressions that compute the values of the
+     arguments of the operation;
+   - The C types of the arguments of the operation.  These types
+     are used to insert the necessary numeric conversions and to
+     resolve operation overloading.
+   Most of these functions return an [option expr], with [None] 
+   denoting a case where the operation is not defined at the given types.
+*)
+
+Definition make_intconst (n: int) :=  Eop (Ointconst n) Enil.
+
+Definition make_floatconst (f: float) :=  Eop (Ofloatconst f) Enil.
+
+Definition make_unop (op: operation) (e: expr) :=  Eop op (Econs e Enil).
+
+Definition make_binop (op: operation) (e1 e2: expr) :=
+    Eop op (Econs e1 (Econs e2 Enil)).
+
+Definition make_floatofint (e: expr) (sg: signedness) :=
+  match sg with
+  | Signed => make_unop Ofloatofint e
+  | Unsigned => make_unop Ofloatofintu e
+  end.
+
+(* [make_boolean e ty] returns a Csharpminor expression that evaluates
+   to the boolean value of [e].  Recall that:
+     - in Csharpminor, [false] is the integer 0,
+       [true] any non-zero integer or any pointer
+     - in C, [false] is the integer 0, the null pointer, the float 0.0
+       [true] is any non-zero integer, non-null pointer, non-null float.
+*)
+Definition make_boolean (e: expr) (ty: type) :=
+  match ty with
+  | Tfloat _ => make_binop (Ocmpf Cne) e (make_floatconst Float.zero)
+  | _ => e
+  end.
+
+Definition make_neg (e: expr) (ty: type) :=
+  match ty with
+  | Tint _ _ => Some (make_binop Osub (make_intconst Int.zero) e)
+  | Tfloat _ => Some (make_unop Onegf e)
+  | _ => None
+  end.
+
+Definition make_notbool (e: expr) (ty: type) :=
+  make_binop (Ocmp Ceq) (make_boolean e ty) (make_intconst Int.zero).
+
+Definition make_notint (e: expr) (ty: type) :=
+  make_unop Onotint e.
+
+Definition make_add (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  match classify_add ty1 ty2 with
+  | add_case_ii => Some (make_binop Oadd e1 e2)
+  | add_case_ff => Some (make_binop Oaddf e1 e2)
+  | add_case_pi ty =>
+      let n := make_intconst (Int.repr (Csyntax.sizeof ty)) in
+      Some (make_binop Oadd e1 (make_binop Omul n e2))
+  | add_default => None
+  end.
+
+Definition make_sub (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  match classify_sub ty1 ty2 with
+  | sub_case_ii => Some (make_binop Osub e1 e2)
+  | sub_case_ff => Some (make_binop Osubf e1 e2)
+  | sub_case_pi ty =>
+      let n := make_intconst (Int.repr (Csyntax.sizeof ty)) in
+      Some (make_binop Osub e1 (make_binop Omul n e2))
+  | sub_case_pp ty =>
+      let n := make_intconst (Int.repr (Csyntax.sizeof ty)) in
+      Some (make_binop Odivu (make_binop Osub e1 e2) n)
+  | sub_default => None
+  end.
+
+Definition make_mul (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  match classify_mul ty1 ty2 with
+  | mul_case_ii => Some (make_binop Omul e1 e2)
+  | mul_case_ff => Some (make_binop Omulf e1 e2)
+  | mul_default => None
+  end.
+
+Definition make_div (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  match classify_div ty1 ty2 with
+  | div_case_I32unsi => Some (make_binop Odivu e1 e2)
+  | div_case_ii => Some (make_binop Odiv e1 e2)
+  | div_case_ff => Some (make_binop Odivf e1 e2)
+  | div_default => None
+  end.
+
+Definition make_mod (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  match classify_mod ty1 ty2 with
+  | mod_case_I32unsi => Some (make_binop Omodu e1 e2)
+  | mod_case_ii=> Some (make_binop Omod e1 e2)
+  | mod_default => None
+  end.
+
+Definition make_and (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  Some(make_binop Oand e1 e2).
+
+Definition make_or (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  Some(make_binop Oor e1 e2).
+
+Definition make_xor (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  Some(make_binop Oxor e1 e2).
+
+Definition make_shl (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  Some(make_binop Oshl e1 e2).
+
+Definition make_shr (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  match classify_shr ty1 ty2 with
+  | shr_case_I32unsi => Some (make_binop Oshru e1 e2)
+  | shr_case_ii=> Some (make_binop Oshr e1 e2)
+  | shr_default => None
+  end.
+
+Definition make_cmp (c: comparison) (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  match classify_cmp ty1 ty2 with
+  | cmp_case_I32unsi => Some (make_binop (Ocmpu c) e1 e2)
+  | cmp_case_ii => Some (make_binop (Ocmp c) e1 e2)
+  | cmp_case_ff => Some (make_binop (Ocmpf c) e1 e2)
+  | cmp_case_pi => Some (make_binop (Ocmp c) e1 e2)
+  | cmp_case_pp => Some (make_binop (Ocmp c) e1 e2)
+  | cmp_default => None
+  end.
+
+Definition make_andbool (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  Econdition
+    (make_boolean e1 ty1)
+    (Econdition
+       (make_boolean e2 ty2)
+       (make_intconst Int.one)
+       (make_intconst Int.zero))
+    (make_intconst Int.zero).
+
+Definition make_orbool (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
+  Econdition
+    (make_boolean e1 ty1)
+    (make_intconst Int.one)
+    (Econdition
+       (make_boolean e2 ty2)
+       (make_intconst Int.one)
+       (make_intconst Int.zero)).
+
+(* [make_cast from to e] applies to [e] the numeric conversions needed
+   to transform a result of type [from] to a result of type [to].
+   It is decomposed in two functions:
+   - [make_cast1]  converts between int/pointer and float if necessary
+   - [make_cast2]  converts to a "smaller" int or float type if necessary.
+*)
+
+Definition make_cast1 (from to: type) (e: expr) :=
+  match from, to with
+  | Tint _ uns, Tfloat _ => make_floatofint e uns
+  | Tfloat _, Tint _ _ => make_unop Ointoffloat e
+  | _, _ => e
+  end.
+
+Definition make_cast2 (from to: type) (e: expr) :=
+  match to with
+  | Tint I8 Signed => make_unop Ocast8signed e  
+  | Tint I8 Unsigned => make_unop Ocast8unsigned e  
+  | Tint I16 Signed => make_unop Ocast16signed e  
+  | Tint I16 Unsigned => make_unop Ocast16unsigned e  
+  | Tfloat F32 => make_unop Osingleoffloat e
+  | _ => e
+  end.
+
+Definition make_cast (from to: type) (e: expr) :=
+  make_cast2 from to (make_cast1 from to e).
+
+(* [make_load addr ty_res] loads a value of type [ty_res] from
+   the memory location denoted by the Csharpminor expression [addr].
+   If [ty_res] is an array or function type, returns [addr] instead,
+   as consistent with C semantics.
+*)
+
+Definition make_load (addr: expr) (ty_res: type) :=
+  match (access_mode ty_res) with
+  | By_value chunk => Some (Eload chunk addr)
+  | By_reference => Some addr
+  | By_nothing => None
+  end.
+
+(* [make_store addr ty_res rhs ty_rhs] stores the value of the
+   Csharpminor expression [rhs] into the memory location denoted by the
+   Csharpminor expression [addr].  
+   [ty] is the type of the memory location. *)
+
+Definition make_store (addr: expr) (ty: type) (rhs: expr) :=
+  match access_mode ty with
+  | By_value chunk => Some (Sstore chunk addr rhs)
+  | _ => None
+  end.
+
+(** ** Reading and writing variables *)
+
+(* [var_get id ty] builds Csharpminor code that evaluates to the
+   value of C variable [id] with type [ty].  Note that 
+   C variables of array or function type evaluate to the address
+   of the corresponding CabsCoq memory block, while variables of other types
+   evaluate to the contents of the corresponding C memory block.
+*)
+
+Definition var_get (id: ident) (ty: type) :=
+  match access_mode ty with
+  | By_value chunk => Some (Evar id)
+  | By_reference => Some (Eaddrof id)
+  | _ => None
+  end.
+
+(* [var_set id ty rhs] stores the value of the Csharpminor
+   expression [rhs] into the CabsCoq variable [id] of type [ty].
+*)
+
+Definition var_set (id: ident) (ty: type) (rhs: expr) :=
+  match access_mode ty with
+  | By_value chunk => Some (Sassign id rhs)
+  | _ => None
+  end.
+
+(** ** Translation of operators *)
+
+Definition transl_unop (op: unary_operation) (a: expr) (ta: type) : option expr :=
+  match op with
+  | Csyntax.Onotbool => Some(make_notbool a ta)
+  | Csyntax.Onotint => Some(make_notint a ta)
+  | Csyntax.Oneg => make_neg a ta
+  end.
+
+Definition transl_binop (op: binary_operation) (a: expr) (ta: type)
+                                  (b: expr) (tb: type) : option expr :=
+  match op with
+  | Csyntax.Oadd => make_add a ta b tb
+  | Csyntax.Osub => make_sub a ta b tb
+  | Csyntax.Omul => make_mul a ta b tb
+  | Csyntax.Odiv => make_div a ta b tb
+  | Csyntax.Omod => make_mod a ta b tb
+  | Csyntax.Oand => make_and a ta b tb
+  | Csyntax.Oor  => make_or a ta b tb
+  | Csyntax.Oxor => make_xor a ta b tb
+  | Csyntax.Oshl => make_shl a ta b tb
+  | Csyntax.Oshr => make_shr a ta b tb
+  | Csyntax.Oeq => make_cmp Ceq a ta b tb
+  | Csyntax.One => make_cmp Cne a ta b tb
+  | Csyntax.Olt => make_cmp Clt a ta b tb
+  | Csyntax.Ogt => make_cmp Cgt a ta b tb
+  | Csyntax.Ole => make_cmp Cle a ta b tb
+  | Csyntax.Oge => make_cmp Cge a ta b tb
+  end.
+
+(** ** Translation of expressions *)
+
+(* [transl_expr a] returns the Csharpminor code that computes the value
+   of expression [a]. The result is an option type to enable error reporting.
+
+   Most cases are self-explanatory.  We outline the non-obvious cases:
+
+   a && b    --->    a ? (b ? 1 : 0) : 0
+
+   a || b    --->    a ? 1 : (b ? 1 : 0)
+*)
+
+Fixpoint transl_expr (a: Csyntax.expr) {struct a} : option expr :=
+  match a with
+  | Expr (Csyntax.Econst_int n) _ =>
+      Some(make_intconst n)
+  | Expr (Csyntax.Econst_float n) _ =>
+      Some(make_floatconst n)
+  | Expr (Csyntax.Evar id) ty =>
+      var_get id ty
+  | Expr (Csyntax.Ederef b) _ =>
+      do tb <- transl_expr b;
+      make_load tb (typeof a)
+  | Expr (Csyntax.Eaddrof b) _ =>
+      transl_lvalue b
+  | Expr (Csyntax.Eunop op b) _ =>
+      do tb <- transl_expr b;
+      transl_unop op tb (typeof b)
+  | Expr (Csyntax.Ebinop op b c) _ =>
+      do tb <- transl_expr b;
+      do tc <- transl_expr c;
+      transl_binop op tb (typeof b) tc (typeof c)
+  | Expr (Csyntax.Ecast ty b) _ =>
+      do tb <- transl_expr b;
+      Some (make_cast (typeof b) ty tb)
+  | Expr (Csyntax.Eindex b c) ty =>
+      do tb <- transl_expr b;
+      do tc <- transl_expr c;
+      do ts <- make_add tb (typeof b) tc (typeof c);
+      make_load ts ty
+  | Expr (Csyntax.Ecall b cl) _ =>
+      match (classify_fun (typeof b)) with
+      | fun_case_f args res =>
+          do tb <- transl_expr b;
+          do tcl <- transl_exprlist cl;
+          Some(Ecall (signature_of_type args res) tb tcl)
+      | _ => None
+      end 
+  | Expr (Csyntax.Eandbool b c) _ =>
+      do tb <- transl_expr b;
+      do tc <- transl_expr c;
+      Some(make_andbool tb (typeof b) tc (typeof c))
+  | Expr (Csyntax.Eorbool b c) _ =>
+      do tb <- transl_expr b;
+      do tc <- transl_expr c;
+      Some(make_orbool tb (typeof b) tc (typeof c))
+  | Expr (Csyntax.Esizeof ty) _ =>
+      Some(make_intconst (Int.repr (Csyntax.sizeof ty)))
+  | Expr (Csyntax.Efield b i) ty => 
+      match typeof b with
+      | Tstruct fld =>
+          do tb <- transl_lvalue b;
+          do ofs <- field_offset i fld;
+          make_load
+            (make_binop Oadd tb (make_intconst (Int.repr ofs)))
+            ty
+      | Tunion fld =>
+          do tb <- transl_lvalue b;
+          make_load tb ty
+      | _ => None
+      end
+  end
+
+(* [transl_lvalue a] returns the Csharpminor code that evaluates
+   [a] as a lvalue, that is, code that returns the memory address
+   where the value of [a] is stored.
+*)
+
+with transl_lvalue (a: Csyntax.expr) {struct a} : option expr :=
+  match a with
+  | Expr (Csyntax.Evar id) _ =>
+      Some (Eaddrof id)
+  | Expr (Csyntax.Ederef b) _ =>
+      transl_expr b
+  | Expr (Csyntax.Eindex b c) _ =>
+      do tb <- transl_expr b;
+      do tc <- transl_expr c;
+      make_add tb (typeof b) tc (typeof c)
+  | Expr (Csyntax.Efield b i) ty => 
+      match typeof b with
+      | Tstruct fld =>
+          do tb <- transl_lvalue b;
+          do ofs <- field_offset i fld;
+          Some (make_binop Oadd tb (make_intconst (Int.repr ofs)))
+      | Tunion fld =>
+          transl_lvalue b
+      | _ => None
+      end
+  | _ => None
+  end
+
+(* [transl_exprlist al] returns a list of Csharpminor expressions
+   that compute the values of the list [al] of Csyntax expressions.
+   Used for function applications. *)
+
+with transl_exprlist (al: Csyntax.exprlist): option exprlist :=
+  match al with
+  | Csyntax.Enil => Some Enil
+  | Csyntax.Econs a1 a2 =>
+      do ta1 <- transl_expr a1;
+      do ta2 <- transl_exprlist a2;
+      Some (Econs ta1 ta2)
+  end.
+
+(** ** Translation of statements *)
+
+(** Determine if a C expression is a variable *)
+
+Definition is_variable (e: Csyntax.expr) : option ident :=
+  match e with
+  | Expr (Csyntax.Evar id) _ => Some id
+  | _ => None
+  end.
+
+(* [exit_if_false e] return the statement that tests the boolean
+   value of the CabsCoq expression [e] and performs an [exit 0] if [e]
+   evaluates to false.
+*)
+Definition exit_if_false (e: Csyntax.expr) : option stmt :=
+  do te <- transl_expr e;
+  Some(Sifthenelse
+        (make_notbool te (typeof e))
+        (Sexit 0%nat)
+        Sskip).
+
+(* [transl_statement nbrk ncnt s] returns a Csharpminor statement
+   that performs the same computations as the CabsCoq statement [s].
+
+   If the statement [s] terminates prematurely on a [break] construct,
+   the generated Csharpminor statement terminates prematurely on an
+   [exit nbrk] construct.
+
+   If the statement [s] terminates prematurely on a [continue]
+   construct, the generated Csharpminor statement terminates
+   prematurely on an [exit ncnt] construct.
+
+   Immediately within a loop, [nbrk = 1] and [ncnt = 0], but this 
+   changes when we're inside a [switch] construct.
+
+   The general translation for loops is as follows:
+
+while (e1) s;       --->     block {
+                               loop {
+                                 if (!e1) exit 0;
+                                 block { s }
+                                 // continue in s branches here
+                               }
+                             }
+                             // break in s branches here
+
+do s; while (e1);   --->     block {
+                               loop {
+                                 block { s }
+                                 // continue in s branches here
+                                 if (!e1) exit 0;
+                               }
+                             }
+                             // break in s branches here
+
+for (e1;e2;e3) s;   --->     e1;
+                             block {
+                               loop {
+                                 if (!e2) exit 0;
+                                 block { s }
+                                 // continue in s branches here
+                                 e3;
+                               }
+                             }
+                             // break in s branches here
+
+switch (e) {        --->    block { block { block { block {
+  case N1: s1;                switch (e) { N1: exit 0; N2: exit 1; default: exit 2; }
+  case N2: s2;                } ; s1  // with break -> exit 2  and continue -> exit 3
+  default: s;                 } ; s2  // with break -> exit 1  and continue -> exit 2
+}                             } ; s   // with break -> exit 0  and continue -> exit 1
+                              }
+*)
+
+Fixpoint switch_table (sl: labeled_statements) (k: nat) {struct sl} : list (int * nat) :=
+  match sl with
+  | LSdefault _ => nil
+  | LScase ni _ rem => (ni, k) :: switch_table rem (k+1)
+  end.
+
+Fixpoint transl_statement (nbrk ncnt: nat) (s: Csyntax.statement) {struct s} : option stmt :=
+  match s with
+  | Csyntax.Sskip =>
+      Some Sskip
+  | Csyntax.Sexpr e =>
+      do te <- transl_expr e;
+      Some (Sexpr te)
+  | Csyntax.Sassign b c =>
+      match (is_variable b) with
+      | Some id =>
+          do tc <- transl_expr c;
+          var_set id (typeof b) tc
+      | None =>
+          do tb <- transl_lvalue b;
+          do tc <- transl_expr c;
+          make_store tb (typeof b) tc
+      end 
+  | Csyntax.Ssequence s1 s2 =>
+      do ts1 <- transl_statement nbrk ncnt s1;
+      do ts2 <- transl_statement nbrk ncnt s2;
+      Some (Sseq ts1 ts2)
+  | Csyntax.Sifthenelse e s1 s2 =>
+      do te <- transl_expr e;
+      do ts1 <- transl_statement nbrk ncnt s1;
+      do ts2 <- transl_statement nbrk ncnt s2;
+      Some (Sifthenelse (make_boolean te (typeof e)) ts1 ts2)
+  | Csyntax.Swhile e s1 =>
+      do te <- exit_if_false e;
+      do ts1 <- transl_statement 1%nat 0%nat s1;
+      Some (Sblock (Sloop (Sseq te (Sblock ts1))))
+  | Csyntax.Sdowhile e s1 =>
+      do te <- exit_if_false e;
+      do ts1 <- transl_statement 1%nat 0%nat s1;
+      Some (Sblock (Sloop (Sseq (Sblock ts1) te)))
+  | Csyntax.Sfor e1 e2 e3 s1 =>
+      do te1 <- transl_statement nbrk ncnt e1;
+      do te2 <- exit_if_false e2;
+      do te3 <- transl_statement nbrk ncnt e3;
+      do ts1 <- transl_statement 1%nat 0%nat s1;
+      Some (Sseq te1 (Sblock (Sloop (Sseq te2 (Sseq (Sblock ts1) te3)))))
+  | Csyntax.Sbreak =>
+      Some (Sexit nbrk)
+  | Csyntax.Scontinue =>
+      Some (Sexit ncnt)
+  | Csyntax.Sreturn (Some e) =>
+      do te <- transl_expr e;
+      Some (Sreturn (Some te))
+  | Csyntax.Sreturn None =>
+      Some (Sreturn None)
+  | Csyntax.Sswitch e sl =>
+      let cases := switch_table sl 0 in
+      let ncases := List.length cases in
+      do te <- transl_expr e;
+      transl_lblstmts ncases (ncnt + ncases + 1)%nat sl (Sblock (Sswitch te cases ncases))
+  end
+
+with transl_lblstmts (nbrk ncnt: nat) (sl: labeled_statements) (body: stmt)
+                     {struct sl}: option stmt :=
+  match sl with
+  | LSdefault s =>
+      do ts <- transl_statement nbrk ncnt s;
+      Some (Sblock (Sseq body ts))
+  | LScase _ s rem =>
+      do ts <- transl_statement nbrk ncnt s;
+      transl_lblstmts (pred nbrk) (pred ncnt) rem (Sblock (Sseq body ts))
+  end.
+
+(*** Translation of functions *)
+
+Definition transl_params := transf_partial_program chunk_of_type.
+Definition transl_vars := transf_partial_program var_kind_of_type.
+
+Definition transl_function (f: Csyntax.function) : option function :=
+  do tparams <- transl_params (Csyntax.fn_params f);
+  do tvars <- transl_vars (Csyntax.fn_vars f);
+  do tbody <- transl_statement 1%nat 0%nat (Csyntax.fn_body f);
+  Some (mkfunction (signature_of_function f) tparams tvars tbody).
+
+Definition transl_fundef (f: Csyntax.fundef) : option fundef :=
+  match f with
+  | Csyntax.Internal g => 
+      do tg <- transl_function g; Some(AST.Internal tg)
+  | Csyntax.External id args res =>
+      Some(AST.External (external_function id args res))
+  end.
+
+(** ** Translation of programs *)
+
+Fixpoint transl_global_vars
+      (vl: list (ident * type * list init_data)) :
+      option (list (ident * var_kind * list init_data)) :=
+  match vl with
+  | nil => Some nil
+  | (id, ty, init) :: rem =>
+      do vk <- var_kind_of_type ty;
+      do trem <- transl_global_vars rem;
+      Some ((id, vk, init) :: trem)
+  end.
+
+Definition transl_program (p: Csyntax.program) : option program :=
+  do tfun <- transf_partial_program transl_fundef (Csyntax.prog_funct p);
+  do tvars <- transl_global_vars (Csyntax.prog_defs p);
+  Some (mkprogram tfun (Csyntax.prog_main p) tvars).
diff --git a/cfrontend/Cshmgenproof1.v b/cfrontend/Cshmgenproof1.v
new file mode 100644
index 0000000..17f7aa9
--- /dev/null
+++ b/cfrontend/Cshmgenproof1.v
@@ -0,0 +1,288 @@
+(** * Correctness of the C front end, part 1: syntactic properties *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import AST.
+Require Import Values.
+Require Import Events.
+Require Import Mem.
+Require Import Globalenvs.
+Require Import Csyntax.
+Require Import Csem.
+Require Import Ctyping.
+Require Import Csharpminor.
+Require Import Cshmgen.
+
+(** Monadic simplification *)
+
+Ltac monadSimpl1 :=
+  match goal with
+  | [ |- (bind ?F ?G = Some ?X) -> _ ] =>
+      unfold bind at 1;
+      generalize (refl_equal F);
+      pattern F at -1 in |- *;
+      case F;
+      [ (let EQ := fresh "EQ" in
+           (intro; intro EQ; try monadSimpl1))
+      | intro; intro; discriminate ]
+  | [ |- (None = Some _) -> _ ] =>
+      intro; discriminate
+  | [ |- (Some _ = Some _) -> _ ] =>
+      let h := fresh "H" in
+      (intro h; injection h; intro; clear h)
+  | [ |- (_ = Some _) -> _ ] =>
+      let EQ := fresh "EQ" in intro EQ
+  end.
+
+Ltac monadSimpl :=
+  match goal with
+  | [ |- (bind ?F ?G = Some ?X) -> _ ] => monadSimpl1
+  | [ |- (None = Some _) -> _ ] => monadSimpl1
+  | [ |- (Some _ = Some _) -> _ ] => monadSimpl1
+  | [ |- (?F _ _ _ _ _ _ = Some _) -> _ ] => unfold F; fold F; monadSimpl1
+  | [ |- (?F _ _ _ _ _ = Some _) -> _ ] => unfold F; fold F; monadSimpl1
+  | [ |- (?F _ _ _ _ = Some _) -> _ ] => unfold F; fold F; monadSimpl1
+  | [ |- (?F _ _ _ = Some _) -> _ ] => unfold F; fold F; monadSimpl1
+  | [ |- (?F _ _ = Some _) -> _ ] => unfold F; fold F; monadSimpl1
+  | [ |- (?F _ = Some _) -> _ ] => unfold F; fold F; monadSimpl1
+  end.
+
+Ltac monadInv H :=
+  generalize H; monadSimpl.
+
+(** Operations on types *)
+
+Lemma transl_fundef_sig1:
+  forall f tf args res,
+  transl_fundef f = Some tf ->
+  classify_fun (type_of_fundef f) = fun_case_f args res ->
+  funsig tf = signature_of_type args res.
+Proof.
+  intros. destruct f; monadInv H. 
+  monadInv EQ. rewrite <- H2. rewrite <- H3. simpl. 
+  simpl in H0. inversion H0. reflexivity. 
+  rewrite <- H2. simpl. 
+  simpl in H0. congruence.
+Qed.
+
+Lemma transl_fundef_sig2:
+  forall f tf args res,
+  transl_fundef f = Some tf ->
+  type_of_fundef f = Tfunction args res ->
+  funsig tf = signature_of_type args res.
+Proof.
+  intros. eapply transl_fundef_sig1; eauto.
+  rewrite H0; reflexivity.
+Qed.
+
+Lemma var_kind_by_value:
+  forall ty chunk,
+  access_mode ty = By_value chunk ->
+  var_kind_of_type ty = Some(Vscalar chunk).
+Proof.
+  intros ty chunk; destruct ty; simpl; try congruence.
+  destruct i; try congruence; destruct s; congruence.
+  destruct f; congruence.
+Qed.
+
+Lemma sizeof_var_kind_of_type:
+  forall ty vk,
+  var_kind_of_type ty = Some vk ->
+  Csharpminor.sizeof vk = Csyntax.sizeof ty.
+Proof.
+  intros ty vk.
+  assert (sizeof (Varray (Csyntax.sizeof ty)) = Csyntax.sizeof ty).
+    simpl. rewrite Zmax_spec. apply zlt_false. 
+    generalize (Csyntax.sizeof_pos ty). omega.
+  destruct ty; try (destruct i; try destruct s); try (destruct f); 
+  simpl; intro EQ; inversion EQ; subst vk; auto.
+Qed.
+
+(** Transformation of programs and functions *)
+
+Lemma transform_program_of_program:
+  forall prog tprog,
+  transl_program prog = Some tprog ->
+  transform_partial_program transl_fundef (Csyntax.program_of_program prog) =
+  Some (program_of_program tprog).
+Proof.
+  intros prog tprog TRANSL.  
+  monadInv TRANSL. rewrite <- H0. unfold program_of_program; simpl. 
+  unfold transform_partial_program, Csyntax.program_of_program; simpl.
+  rewrite EQ. decEq. decEq. 
+  generalize EQ0. generalize l0. generalize (prog_defs prog).
+  induction l1; simpl; intros. 
+  inversion EQ1; subst l1. reflexivity.
+  destruct a as [[id ty] init]. monadInv EQ1. subst l2. simpl. decEq. apply IHl1. auto. 
+Qed.
+
+(** ** Some properties of the translation functions *)
+
+Lemma transf_partial_program_names:
+  forall (A B: Set) (f: A -> option B)
+         (l: list (ident * A)) (tl: list (ident * B)),
+  transf_partial_program f l = Some tl ->
+  List.map (@fst ident B) tl = List.map (@fst ident A) l.
+Proof.
+  induction l; simpl.
+  intros. inversion H. reflexivity.
+  intro tl. destruct a as [id x]. destruct (f x); try congruence.
+  caseEq (transf_partial_program f l); intros; try congruence.
+  inversion H0; subst tl. simpl. decEq. auto.
+Qed.
+   
+Lemma transf_partial_program_append:
+  forall (A B: Set) (f: A -> option B)
+         (l1 l2: list (ident * A)) (tl1 tl2: list (ident * B)),
+  transf_partial_program f l1 = Some tl1 ->
+  transf_partial_program f l2 = Some tl2 ->
+  transf_partial_program f (l1 ++ l2) = Some (tl1 ++ tl2).
+Proof.
+  induction l1; intros until tl2; simpl.
+  intros. inversion H. simpl; auto.
+  destruct a as [id x]. destruct (f x); try congruence.
+  caseEq (transf_partial_program f l1); intros; try congruence.
+  inversion H0. rewrite (IHl1 _ _ _ H H1). auto.
+Qed.
+ 
+Lemma transl_params_names:
+  forall vars tvars,
+  transl_params vars = Some tvars ->
+  List.map (@fst ident memory_chunk) tvars = Ctyping.var_names vars.
+Proof.
+  exact (transf_partial_program_names _ _ chunk_of_type).
+Qed.
+
+Lemma transl_vars_names:
+  forall vars tvars,
+  transl_vars vars = Some tvars ->
+  List.map (@fst ident var_kind) tvars = Ctyping.var_names vars.
+Proof.
+  exact (transf_partial_program_names _ _ var_kind_of_type).
+Qed.
+
+Lemma transl_names_norepet:
+  forall params vars sg tparams tvars body,
+  list_norepet (var_names params ++ var_names vars) ->
+  transl_params params = Some tparams ->
+  transl_vars vars = Some tvars ->
+  let f := Csharpminor.mkfunction sg tparams tvars body in
+  list_norepet (fn_params_names f ++ fn_vars_names f).
+Proof.
+  intros. unfold fn_params_names, fn_vars_names, f. simpl.
+  rewrite (transl_params_names _ _ H0).
+  rewrite (transl_vars_names _ _ H1).
+  auto.
+Qed.
+
+Lemma transl_vars_append:
+  forall l1 l2 tl1 tl2,
+  transl_vars l1 = Some tl1 -> transl_vars l2 = Some tl2 ->
+  transl_vars (l1 ++ l2) = Some (tl1 ++ tl2).
+Proof.
+  exact (transf_partial_program_append _ _ var_kind_of_type).
+Qed.
+
+Lemma transl_params_vars:
+  forall params tparams,
+  transl_params params = Some tparams ->
+  transl_vars params =
+  Some (List.map (fun id_chunk => (fst id_chunk, Vscalar (snd id_chunk))) tparams).
+Proof.
+  induction params; intro tparams; simpl.
+  intros. inversion H. reflexivity.
+  destruct a as [id x]. 
+  unfold chunk_of_type. caseEq (access_mode x); try congruence.
+  intros chunk AM. 
+  caseEq (transl_params params); intros; try congruence.
+  inversion H0. 
+  rewrite (var_kind_by_value _ _ AM). 
+  rewrite (IHparams _ H). reflexivity.
+Qed.
+
+Lemma transl_fn_variables:
+  forall params vars sg tparams tvars body,
+  transl_params params = Some tparams ->
+  transl_vars vars = Some tvars ->
+  let f := Csharpminor.mkfunction sg tparams tvars body in
+  transl_vars (params ++ vars) = Some (fn_variables f).
+Proof.
+  intros. 
+  generalize (transl_params_vars _ _ H); intro.
+  rewrite (transl_vars_append _ _ _ _ H1 H0).
+  reflexivity.
+Qed.
+
+(** Transformation of expressions and statements *)
+
+Lemma is_variable_correct:
+  forall a id,
+  is_variable a = Some id ->
+  a = Csyntax.Expr (Csyntax.Evar id) (typeof a).
+Proof.
+  intros until id. destruct a as [ad aty]; simpl. 
+  destruct ad; intros; try discriminate.
+  congruence.
+Qed.
+
+Lemma transl_expr_lvalue:
+  forall ge e m1 a ty t m2 loc ofs ta,
+  Csem.eval_lvalue ge e m1 (Expr a ty) t m2 loc ofs ->
+  transl_expr (Expr a ty) = Some ta ->
+  (exists id, a = Csyntax.Evar id /\ var_get id ty = Some ta) \/
+  (exists tb, transl_lvalue (Expr a ty) = Some tb /\
+              make_load tb ty = Some ta).
+Proof.
+  intros. inversion H; subst; clear H; simpl in H0.
+  left; exists id; auto.
+  left; exists id; auto.
+  monadInv H0. right. exists e0; split; auto. 
+  simpl. monadInv H0. right. exists e2; split; auto. 
+  simpl. rewrite H6 in H0. rewrite H6. 
+  monadInv H0. right. 
+  exists (make_binop Oadd e0 (make_intconst (Int.repr z))). split; auto.
+  simpl. rewrite H10 in H0. rewrite H10. 
+  monadInv H0. right. 
+  exists e0; auto.
+Qed.
+
+Lemma transl_stmt_Sfor_start:
+  forall nbrk ncnt s1 e2 s3 s4 ts,
+  transl_statement nbrk ncnt (Sfor s1 e2 s3 s4) = Some ts ->
+  exists ts1, exists ts2,
+    ts = Sseq ts1 ts2
+  /\ transl_statement nbrk ncnt s1 = Some ts1
+  /\ transl_statement nbrk ncnt (Sfor Csyntax.Sskip e2 s3 s4) = Some (Sseq Sskip ts2).
+Proof.
+  intros. monadInv H. simpl. 
+  exists s; exists (Sblock (Sloop (Sseq s0 (Sseq (Sblock s5) s2)))).
+  intuition.
+Qed.
+
+(** Properties related to switch constructs *)
+
+Fixpoint lblstmts_length (sl: labeled_statements) : nat :=
+  match sl with
+  | LSdefault _ => 0%nat
+  | LScase _ _ sl' => S (lblstmts_length sl')
+  end.
+
+Lemma switch_target_table_shift:
+  forall n sl base dfl,
+  switch_target n (S dfl) (switch_table sl (S base)) =
+  S(switch_target n dfl (switch_table sl base)).
+Proof.
+  induction sl; intros; simpl.
+  auto.
+  case (Int.eq n i). auto. auto. 
+Qed.
+
+Lemma length_switch_table:
+  forall sl base, List.length (switch_table sl base) = lblstmts_length sl.
+Proof.
+  induction sl; intro; simpl. auto. decEq; auto. 
+Qed.
+
+
diff --git a/cfrontend/Cshmgenproof2.v b/cfrontend/Cshmgenproof2.v
new file mode 100644
index 0000000..602e33a
--- /dev/null
+++ b/cfrontend/Cshmgenproof2.v
@@ -0,0 +1,419 @@
+(** * Correctness of the C front end, part 2: Csharpminor construction functions *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import AST.
+Require Import Values.
+Require Import Events.
+Require Import Mem.
+Require Import Globalenvs.
+Require Import Csyntax.
+Require Import Csem.
+Require Import Ctyping.
+Require Import Csharpminor.
+Require Import Cshmgen.
+Require Import Cshmgenproof1.
+
+Section CONSTRUCTORS.
+
+Variable tprog: Csharpminor.program.
+
+(** Properties of the translation of [switch] constructs. *)
+
+Lemma transl_lblstmts_exit:
+  forall e m1 t m2 sl body n tsl nbrk ncnt,
+  exec_stmt tprog e m1 body t m2 (Out_exit (lblstmts_length sl + n)) ->
+  transl_lblstmts nbrk ncnt sl body = Some tsl ->
+  exec_stmt tprog e m1 tsl t m2 (outcome_block (Out_exit n)).
+Proof.
+  induction sl; intros.
+  simpl in H; simpl in H0; monadInv H0. 
+  rewrite <- H2. constructor. apply exec_Sseq_stop. auto. congruence.
+  simpl in H; simpl in H0; monadInv H0.
+  eapply IHsl with (body := Sblock (Sseq body s0)); eauto.
+  change (Out_exit (lblstmts_length sl + n))
+    with (outcome_block (Out_exit (S (lblstmts_length sl + n)))).
+  constructor. apply exec_Sseq_stop. auto. congruence.
+Qed.
+
+Lemma transl_lblstmts_return:
+  forall e m1 t m2 sl body optv tsl nbrk ncnt,
+  exec_stmt tprog e m1 body t m2 (Out_return optv) ->
+  transl_lblstmts nbrk ncnt sl body = Some tsl ->
+  exec_stmt tprog e m1 tsl t m2 (Out_return optv).
+Proof.
+  induction sl; intros.
+  simpl in H; simpl in H0; monadInv H0. 
+  rewrite <- H2. change (Out_return optv) with (outcome_block (Out_return optv)).
+  constructor. apply exec_Sseq_stop. auto. congruence.
+  simpl in H; simpl in H0; monadInv H0.
+  eapply IHsl with (body := Sblock (Sseq body s0)); eauto.
+  change (Out_return optv) with (outcome_block (Out_return optv)).
+  constructor. apply exec_Sseq_stop. auto. congruence.
+Qed.
+
+
+(** Correctness of Csharpminor construction functions *)
+
+Lemma make_intconst_correct:
+  forall n le e m1,
+  Csharpminor.eval_expr tprog le e m1 (make_intconst n) E0 m1 (Vint n).
+Proof.
+  intros. unfold make_intconst. econstructor. constructor. reflexivity. 
+Qed.
+
+Lemma make_floatconst_correct:
+  forall n le e m1,
+  Csharpminor.eval_expr tprog le e m1 (make_floatconst n) E0 m1 (Vfloat n).
+Proof.
+  intros. unfold make_floatconst. econstructor. constructor. reflexivity. 
+Qed.
+
+Lemma make_unop_correct:
+  forall op le e m1 a ta m2 va v,
+  Csharpminor.eval_expr tprog le e m1 a ta m2 va ->
+  eval_operation op (va :: nil) m2 = Some v ->
+  Csharpminor.eval_expr tprog le e m1 (make_unop op a) ta m2 v.
+Proof.
+  intros. unfold make_unop. econstructor. econstructor. eauto. constructor.
+  traceEq. auto.
+Qed.
+
+Lemma make_binop_correct:
+  forall op le e m1 a ta m2 va b tb m3 vb t v,
+  Csharpminor.eval_expr tprog le e m1 a ta m2 va ->
+  Csharpminor.eval_expr tprog le e m2 b tb m3 vb ->
+  eval_operation op (va :: vb :: nil) m3 = Some v ->
+  t = ta ** tb ->
+  Csharpminor.eval_expr tprog le e m1 (make_binop op a b) t m3 v.
+Proof.
+  intros. unfold make_binop. 
+  econstructor. econstructor. eauto. econstructor. eauto. constructor.
+  reflexivity. traceEq. auto.
+Qed.
+
+Hint Resolve make_intconst_correct make_floatconst_correct
+             make_unop_correct make_binop_correct: cshm.
+Hint Extern 2 (@eq trace _ _) => traceEq: cshm.
+
+Remark Vtrue_is_true: Val.is_true Vtrue.
+Proof.
+  simpl. apply Int.one_not_zero.
+Qed.
+
+Remark Vfalse_is_false: Val.is_false Vfalse.
+Proof.
+  simpl. auto.
+Qed.
+
+Lemma make_boolean_correct_true:
+ forall le e m1 a t m2 v ty,
+  Csharpminor.eval_expr tprog le e m1 a t m2 v ->
+  is_true v ty ->
+  exists vb,
+    Csharpminor.eval_expr tprog le e m1 (make_boolean a ty) t m2 vb
+    /\ Val.is_true vb.
+Proof.
+  intros until ty; intros EXEC VTRUE.
+  destruct ty; simpl;
+  try (exists v; intuition; inversion VTRUE; simpl; auto; fail).
+  exists Vtrue; split.
+  eapply make_binop_correct; eauto with cshm. 
+  inversion VTRUE; simpl. 
+  replace (Float.cmp Cne f0 Float.zero) with (negb (Float.cmp Ceq f0 Float.zero)).
+  rewrite Float.eq_zero_false. reflexivity. auto.
+  rewrite Float.cmp_ne_eq. auto.
+  apply Vtrue_is_true.
+Qed.
+
+Lemma make_boolean_correct_false:
+ forall le e m1 a t m2 v ty,
+  Csharpminor.eval_expr tprog le e m1 a t m2 v ->
+  is_false v ty ->
+  exists vb,
+    Csharpminor.eval_expr tprog le e m1 (make_boolean a ty) t m2 vb
+    /\ Val.is_false vb.
+Proof.
+  intros until ty; intros EXEC VFALSE.
+  destruct ty; simpl;
+  try (exists v; intuition; inversion VFALSE; simpl; auto; fail).
+  exists Vfalse; split.
+  eapply make_binop_correct; eauto with cshm. 
+  inversion VFALSE; simpl. 
+  replace (Float.cmp Cne Float.zero Float.zero) with (negb (Float.cmp Ceq Float.zero Float.zero)).
+  rewrite Float.eq_zero_true. reflexivity. 
+  rewrite Float.cmp_ne_eq. auto.
+  apply Vfalse_is_false.
+Qed.
+
+Lemma make_neg_correct:
+  forall a tya c ta va v le e m1 m2,
+  sem_neg va tya = Some v ->
+  make_neg a tya = Some c ->  
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m1 c ta m2 v.
+Proof.
+  intros until m2; intro SEM. unfold make_neg. 
+  functional inversion SEM; intros.
+  inversion H4. eapply make_binop_correct; eauto with cshm.
+  inversion H4. eauto with cshm.
+Qed.
+
+Lemma make_notbool_correct:
+  forall a tya c ta va v le e m1 m2,
+  sem_notbool va tya = Some v ->
+  make_notbool a tya = c ->  
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m1 c ta m2 v.
+Proof.
+  intros until m2; intro SEM. unfold make_notbool. 
+  functional inversion SEM; intros; inversion H4; simpl;
+  eauto with cshm.
+  eapply make_binop_correct. 
+  eapply make_binop_correct. eauto. eauto with cshm. 
+  simpl; reflexivity. reflexivity. eauto with cshm. 
+  simpl. rewrite Float.cmp_ne_eq. 
+  destruct (Float.cmp Ceq f Float.zero); reflexivity.
+  traceEq.
+Qed.
+
+Lemma make_notint_correct:
+  forall a tya c ta va v le e m1 m2,
+  sem_notint va = Some v ->
+  make_notint a tya = c ->  
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m1 c ta m2 v.
+Proof.
+  intros until m2; intro SEM. unfold make_notint. 
+  functional inversion SEM; intros. 
+  inversion H2; eauto with cshm.
+Qed.
+
+Definition binary_constructor_correct
+    (make: expr -> type -> expr -> type -> option expr)
+    (sem: val -> type -> val -> type -> option val): Prop :=
+  forall a tya b tyb c ta va tb vb v le e m1 m2 m3,
+  sem va tya vb tyb = Some v ->
+  make a tya b tyb = Some c ->  
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m2 b tb m3 vb ->
+  eval_expr tprog le e m1 c (ta ** tb) m3 v.
+
+Definition binary_constructor_correct'
+    (make: expr -> type -> expr -> type -> option expr)
+    (sem: val -> val -> option val): Prop :=
+  forall a tya b tyb c ta va tb vb v le e m1 m2 m3,
+  sem va vb = Some v ->
+  make a tya b tyb = Some c ->  
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m2 b tb m3 vb ->
+  eval_expr tprog le e m1 c (ta ** tb) m3 v.
+
+Lemma make_add_correct: binary_constructor_correct make_add sem_add.
+Proof.
+  red; intros until m3. intro SEM. unfold make_add. 
+  functional inversion SEM; rewrite H0; intros.
+  inversion H7. eauto with cshm. 
+  inversion H7. eauto with cshm.
+  inversion H7. 
+  eapply make_binop_correct. eauto. 
+  eapply make_binop_correct. eauto with cshm. eauto.
+  simpl. reflexivity. reflexivity. 
+  simpl. reflexivity. traceEq.
+Qed.
+
+Lemma make_sub_correct: binary_constructor_correct make_sub sem_sub.
+Proof.
+  red; intros until m3. intro SEM. unfold make_sub. 
+  functional inversion SEM; rewrite H0; intros;
+  inversion H7; eauto with cshm. 
+  eapply make_binop_correct. eauto. 
+  eapply make_binop_correct. eauto with cshm. eauto.
+  simpl. reflexivity. reflexivity. 
+  simpl. reflexivity. traceEq.
+  inversion H9. eapply make_binop_correct. 
+  eapply make_binop_correct; eauto. 
+  simpl. unfold eq_block; rewrite H3. reflexivity.
+  eauto with cshm. simpl. rewrite H8. reflexivity. traceEq.
+Qed.
+
+Lemma make_mul_correct: binary_constructor_correct make_mul sem_mul.
+Proof.
+  red; intros until m3. intro SEM. unfold make_mul. 
+  functional inversion SEM; rewrite H0; intros;
+  inversion H7; eauto with cshm. 
+Qed.
+
+Lemma make_div_correct: binary_constructor_correct make_div sem_div.
+Proof.
+  red; intros until m3. intro SEM. unfold make_div. 
+  functional inversion SEM; rewrite H0; intros.
+  inversion H8. eapply make_binop_correct; eauto with cshm. 
+  simpl. rewrite H7; auto.
+  inversion H8. eapply make_binop_correct; eauto with cshm. 
+  simpl. rewrite H7; auto.
+  inversion H7; eauto with cshm. 
+Qed.
+
+Lemma make_mod_correct: binary_constructor_correct make_mod sem_mod.
+  red; intros until m3. intro SEM. unfold make_mod. 
+  functional inversion SEM; rewrite H0; intros.
+  inversion H8. eapply make_binop_correct; eauto with cshm. 
+  simpl. rewrite H7; auto.
+  inversion H8. eapply make_binop_correct; eauto with cshm. 
+  simpl. rewrite H7; auto.
+Qed.
+
+Lemma make_and_correct: binary_constructor_correct' make_and sem_and.
+Proof.
+  red; intros until m3. intro SEM. unfold make_and. 
+  functional inversion SEM. intros. inversion H4. 
+  eauto with cshm. 
+Qed.
+
+Lemma make_or_correct: binary_constructor_correct' make_or sem_or.
+Proof.
+  red; intros until m3. intro SEM. unfold make_or. 
+  functional inversion SEM. intros. inversion H4. 
+  eauto with cshm. 
+Qed.
+
+Lemma make_xor_correct: binary_constructor_correct' make_xor sem_xor.
+Proof.
+  red; intros until m3. intro SEM. unfold make_xor. 
+  functional inversion SEM. intros. inversion H4. 
+  eauto with cshm. 
+Qed.
+
+Lemma make_shl_correct: binary_constructor_correct' make_shl sem_shl.
+Proof.
+  red; intros until m3. intro SEM. unfold make_shl. 
+  functional inversion SEM. intros. inversion H5. 
+  eapply make_binop_correct; eauto with cshm. 
+  simpl. rewrite H4. auto.
+Qed.
+
+Lemma make_shr_correct: binary_constructor_correct make_shr sem_shr.
+Proof.
+  red; intros until m3. intro SEM. unfold make_shr. 
+  functional inversion SEM; intros; rewrite H0 in H8; inversion H8.
+  eapply make_binop_correct; eauto with cshm.
+  simpl; rewrite H7; auto.
+  eapply make_binop_correct; eauto with cshm.
+  simpl; rewrite H7; auto.
+Qed.
+
+Lemma make_cmp_correct:
+  forall cmp a tya b tyb c ta va tb vb v le e m1 m2 m3,
+  sem_cmp cmp va tya vb tyb m3 = Some v ->
+  make_cmp cmp a tya b tyb = Some c ->  
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m2 b tb m3 vb ->
+  eval_expr tprog le e m1 c (ta ** tb) m3 v.
+Proof.
+  intros until m3. intro SEM. unfold make_cmp.
+  functional inversion SEM; rewrite H0; intros. 
+  inversion H8. eauto with cshm.
+  inversion H8. eauto with cshm.
+  inversion H8. eauto with cshm.
+  inversion H9. eapply make_binop_correct; eauto with cshm.
+  simpl. functional inversion H; subst; unfold eval_compare_null;
+  rewrite H8; auto.
+  inversion H10. eapply make_binop_correct; eauto with cshm.
+  simpl. rewrite H3. unfold eq_block; rewrite H9. auto.
+Qed.
+
+Lemma transl_unop_correct:
+  forall op a tya c ta va v le e m1 m2, 
+  transl_unop op a tya = Some c ->
+  sem_unary_operation op va tya = Some v ->
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m1 c ta m2 v.
+Proof.
+  intros. destruct op; simpl in *.
+  eapply make_notbool_correct; eauto. congruence.
+  eapply make_notint_correct with (tya := tya); eauto. congruence.
+  eapply make_neg_correct; eauto.
+Qed.
+
+Lemma transl_binop_correct:
+forall op a tya b tyb c ta va tb vb v le e m1 m2 m3,
+  transl_binop op a tya b tyb = Some c ->  
+  sem_binary_operation op va tya vb tyb m3 = Some v ->
+  eval_expr tprog le e m1 a ta m2 va ->
+  eval_expr tprog le e m2 b tb m3 vb ->
+  eval_expr tprog le e m1 c (ta ** tb) m3 v.
+Proof.
+  intros. destruct op; simpl in *.
+  eapply make_add_correct; eauto.
+  eapply make_sub_correct; eauto.
+  eapply make_mul_correct; eauto.
+  eapply make_div_correct; eauto.
+  eapply make_mod_correct; eauto.
+  eapply make_and_correct; eauto.
+  eapply make_or_correct; eauto.
+  eapply make_xor_correct; eauto.
+  eapply make_shl_correct; eauto.
+  eapply make_shr_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+  eapply make_cmp_correct; eauto.
+Qed. 
+
+Lemma make_cast_correct:
+  forall le e m1 a t m2 v ty1 ty2 v',
+   eval_expr tprog le e m1 a t m2 v ->
+   cast v ty1 ty2 v' ->
+   eval_expr tprog le e m1 (make_cast ty1 ty2 a) t m2 v'.
+Proof.
+  unfold make_cast, make_cast1, make_cast2, make_unop.
+  intros until v'; intros EVAL CAST.
+  inversion CAST; clear CAST; subst; auto.
+  (* cast_int_int *)
+    destruct sz2; destruct si2; repeat econstructor; eauto with cshm.
+  (* cast_float_int *)
+    destruct sz2; destruct si2; repeat econstructor; eauto with cshm; simpl; auto.
+  (* cast_int_float *)
+    destruct sz2; destruct si1; unfold make_floatofint, make_unop; repeat econstructor; eauto with cshm; simpl; auto.
+  (* cast_float_float *)
+    destruct sz2; repeat econstructor; eauto with cshm.
+Qed.
+
+Lemma make_load_correct:
+  forall addr ty code b ofs v le e m1 t m2,
+  make_load addr ty = Some code ->
+  eval_expr tprog le e m1 addr t m2 (Vptr b ofs) ->
+  load_value_of_type ty m2 b ofs = Some v ->
+  eval_expr tprog le e m1 code t m2 v.
+Proof.
+  unfold make_load, load_value_of_type.
+  intros until m2; intros MKLOAD EVEXP LDVAL.
+  destruct (access_mode ty); inversion MKLOAD.
+  (* access_mode ty = By_value m *)
+  apply eval_Eload with (Vptr b ofs); auto.
+  (* access_mode ty = By_reference *)
+  subst code. inversion LDVAL. auto.
+Qed.
+
+Lemma make_store_correct:
+  forall addr ty rhs code e m1 t1 m2 b ofs t2 m3 v m4,
+  make_store addr ty rhs = Some code ->
+  eval_expr tprog nil e m1 addr t1 m2 (Vptr b ofs) ->
+  eval_expr tprog nil e m2 rhs t2 m3 v ->
+  store_value_of_type ty m3 b ofs v = Some m4 ->
+  exec_stmt tprog e m1 code (t1 ** t2) m4 Out_normal.
+Proof.
+  unfold make_store, store_value_of_type.
+  intros until m4; intros MKSTORE EV1 EV2 STVAL.
+  destruct (access_mode ty); inversion MKSTORE.
+  (* access_mode ty = By_value m *)
+  eapply eval_Sstore; eauto. 
+Qed.
+
+End CONSTRUCTORS.
+
diff --git a/cfrontend/Cshmgenproof3.v b/cfrontend/Cshmgenproof3.v
new file mode 100644
index 0000000..b33771b
--- /dev/null
+++ b/cfrontend/Cshmgenproof3.v
@@ -0,0 +1,1503 @@
+(** * Correctness of the C front end, part 3: semantic preservation *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import Integers.
+Require Import Floats.
+Require Import AST.
+Require Import Values.
+Require Import Events.
+Require Import Mem.
+Require Import Globalenvs.
+Require Import Csyntax.
+Require Import Csem.
+Require Import Ctyping.
+Require Import Csharpminor.
+Require Import Cshmgen.
+Require Import Cshmgenproof1.
+Require Import Cshmgenproof2.
+
+Section CORRECTNESS.
+
+Variable prog: Csyntax.program.
+Variable tprog: Csharpminor.program.
+Hypothesis WTPROG: wt_program prog.
+Hypothesis TRANSL: transl_program prog = Some tprog.
+
+Let ge := Csem.globalenv prog.
+Let tge := Genv.globalenv (Csharpminor.program_of_program tprog).
+
+Lemma symbols_preserved:
+  forall s, Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof.
+  intros. unfold ge, Csem.globalenv, tge. 
+  apply Genv.find_symbol_transf_partial with transl_fundef.
+  apply transform_program_of_program; auto.
+Qed.
+
+Lemma functions_translated:
+  forall v f,
+  Genv.find_funct ge v = Some f ->
+  exists tf, Genv.find_funct tge v = Some tf /\ transl_fundef f = Some tf.
+Proof.
+  intros. 
+  generalize (Genv.find_funct_transf_partial transl_fundef (transform_program_of_program _ _ TRANSL) H).
+  intros [A B]. 
+  destruct (transl_fundef f). exists f0; split. assumption. auto. congruence.
+Qed.
+
+Lemma function_ptr_translated:
+  forall b f,
+  Genv.find_funct_ptr ge b = Some f ->
+  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = Some tf.
+Proof.
+  intros. 
+  generalize (Genv.find_funct_ptr_transf_partial transl_fundef (transform_program_of_program _ _ TRANSL) H).
+  intros [A B]. 
+  destruct (transl_fundef f). exists f0; split. assumption. auto. congruence.
+Qed.
+
+Lemma functions_well_typed:
+  forall v f,
+  Genv.find_funct ge v = Some f ->
+  wt_fundef (global_typenv prog) f.
+Proof.
+  intros. inversion WTPROG. 
+  apply (@Genv.find_funct_prop _ (wt_fundef (global_typenv prog)) 
+                               (Csyntax.program_of_program prog) v f).
+  intros. apply wt_program_funct with id. assumption.
+  assumption.
+Qed.
+
+Lemma function_ptr_well_typed:
+  forall b f,
+  Genv.find_funct_ptr ge b = Some f ->
+  wt_fundef (global_typenv prog) f.
+Proof.
+  intros. inversion WTPROG. 
+  apply (@Genv.find_funct_ptr_prop _ (wt_fundef (global_typenv prog)) 
+                               (Csyntax.program_of_program prog) b f).
+  intros. apply wt_program_funct with id. assumption.
+  assumption.
+Qed.
+
+(** ** Matching between environments *)
+
+Definition match_var_kind (ty: type) (vk: var_kind) : Prop :=
+  match access_mode ty with
+  | By_value chunk => vk = Vscalar chunk
+  | _ => True
+  end.
+
+Record match_env (tyenv: typenv) (e: Csem.env) (te: Csharpminor.env) : Prop :=
+  mk_match_env {
+    me_local:
+      forall id b ty,
+      e!id = Some b -> tyenv!id = Some ty ->
+      exists vk, match_var_kind ty vk /\ te!id = Some (b, vk);
+    me_global:
+      forall id ty,
+      e!id = None -> tyenv!id = Some ty ->
+      te!id = None /\ 
+      (forall chunk, access_mode ty = By_value chunk -> (global_var_env tprog)!id = Some (Vscalar chunk))
+  }.
+
+Definition match_globalenv (tyenv: typenv) (gv: gvarenv): Prop :=
+  forall id ty chunk,
+  tyenv!id = Some ty -> access_mode ty = By_value chunk ->
+  gv!id = Some (Vscalar chunk).
+
+Lemma match_globalenv_match_env_empty:
+  forall tyenv,
+  match_globalenv tyenv (global_var_env tprog) ->
+  match_env tyenv Csem.empty_env Csharpminor.empty_env.
+Proof.
+  intros. unfold Csem.empty_env, Csharpminor.empty_env.
+  constructor.
+  intros until ty. repeat rewrite PTree.gempty. congruence.
+  intros. split.
+  apply PTree.gempty. 
+  intros. red in H. eauto.
+Qed.
+
+Lemma match_var_kind_of_type:
+  forall ty vk, var_kind_of_type ty = Some vk -> match_var_kind ty vk.
+Proof.
+  intros; red. 
+  caseEq (access_mode ty); auto.
+  intros chunk AM. generalize (var_kind_by_value _ _ AM). congruence.
+Qed.
+
+Lemma match_env_alloc_variables:
+  forall e1 m1 vars e2 m2 lb,
+  Csem.alloc_variables e1 m1 vars e2 m2 lb ->
+  forall tyenv te1 tvars,
+  match_env tyenv e1 te1 ->
+  transl_vars vars = Some tvars ->
+  exists te2,
+  Csharpminor.alloc_variables te1 m1 tvars te2 m2 lb
+  /\ match_env (Ctyping.add_vars tyenv vars) e2 te2.
+Proof.
+  induction 1; intros.
+  simpl in H0. inversion H0; subst; clear H0. 
+  exists te1; split. constructor. simpl. auto.
+  generalize H2. simpl. 
+  caseEq (var_kind_of_type ty); [intros vk VK | congruence].
+  caseEq (transl_vars vars); [intros tvrs TVARS | congruence].
+  intro EQ; inversion EQ; subst tvars; clear EQ.
+  set (te2 := PTree.set id (b1, vk) te1).
+  assert (match_env (add_var tyenv (id, ty)) (PTree.set id b1 e) te2).
+    inversion H1. unfold te2, add_var. constructor.
+    (* me_local *)
+    intros until ty0. repeat rewrite PTree.gsspec. simpl. destruct (peq id0 id); intros.
+    subst id0. exists vk; split. 
+    apply match_var_kind_of_type. congruence. congruence.
+    auto.
+    (* me_global *)
+    intros until ty0. repeat rewrite PTree.gsspec. simpl. destruct (peq id0 id); intros.
+    discriminate.
+    auto.
+  destruct (IHalloc_variables _ _ _ H3 TVARS) as [te3 [ALLOC MENV]]. 
+  exists te3; split.
+  econstructor; eauto.
+  rewrite (sizeof_var_kind_of_type _ _ VK). auto. 
+  auto. 
+Qed. 
+
+Lemma bind_parameters_match_rec:
+  forall e m1 vars vals m2,
+  Csem.bind_parameters e m1 vars vals m2 ->
+  forall tyenv te tvars,
+  (forall id ty, In (id, ty) vars -> tyenv!id = Some ty) ->
+  match_env tyenv e te ->
+  transl_params vars = Some tvars ->
+  Csharpminor.bind_parameters te m1 tvars vals m2.
+Proof.
+  induction 1; intros.
+  simpl in H1. inversion H1. constructor.
+  generalize H4; clear H4; simpl. 
+  caseEq (chunk_of_type ty); [intros chunk CHK | congruence].
+  caseEq (transl_params params); [intros tparams TPARAMS | congruence].
+  intro EQ; inversion EQ; clear EQ; subst tvars.
+  generalize CHK. unfold chunk_of_type. 
+  caseEq (access_mode ty); intros; try discriminate.
+  inversion CHK0; clear CHK0; subst m0.
+  unfold store_value_of_type in H0. rewrite H4 in H0.
+  apply bind_parameters_cons with b m1. 
+  assert (tyenv!id = Some ty). apply H2. apply in_eq.
+  destruct (me_local _ _ _ H3 _ _ _ H H5) as [vk [A B]]. 
+  red in A; rewrite H4 in A. congruence.
+  assumption.
+  apply IHbind_parameters with tyenv; auto.
+  intros. apply H2. apply in_cons; auto.
+Qed.
+
+Lemma tyenv_add_vars_norepet:
+  forall vars tyenv,
+  list_norepet (var_names vars) ->
+  (forall id ty,
+   In (id, ty) vars -> (Ctyping.add_vars tyenv vars)!id = Some ty)
+  /\
+  (forall id,
+   ~In id (var_names vars) -> (Ctyping.add_vars tyenv vars)!id = tyenv!id).
+Proof.
+  induction vars; simpl; intros.
+  tauto.
+  destruct a as [id1 ty1]. simpl in *. inversion H; clear H; subst.
+  destruct (IHvars (add_var tyenv (id1, ty1)) H3) as [A B].
+  split; intros.
+  destruct H. inversion H; subst id1 ty1; clear H. 
+  rewrite B. unfold add_var. simpl. apply PTree.gss. auto.
+  auto.
+  rewrite B. unfold add_var; simpl. apply PTree.gso. apply sym_not_equal; tauto. tauto.
+Qed.
+
+Lemma bind_parameters_match:
+  forall e m1 params vals vars m2 tyenv tvars te,
+  Csem.bind_parameters e m1 params vals m2 ->
+  list_norepet (var_names params ++ var_names vars) ->
+  match_env (Ctyping.add_vars tyenv (params ++ vars)) e te ->
+  transl_params params = Some tvars ->
+  Csharpminor.bind_parameters te m1 tvars vals m2.
+Proof.
+  intros. 
+  eapply bind_parameters_match_rec; eauto.
+  assert (list_norepet (var_names (params ++ vars))).
+    unfold var_names. rewrite List.map_app. assumption.
+  destruct (tyenv_add_vars_norepet _ tyenv H3) as [A B].
+  intros. apply A. apply List.in_or_app. auto. 
+Qed.
+
+Definition globvarenv 
+    (gv: gvarenv)
+    (vars: list (ident * var_kind * list init_data)) :=
+  List.fold_left
+    (fun gve x => match x with (id, k, init) => PTree.set id k gve end)
+    vars gv.
+
+Definition type_not_by_value (ty: type) : Prop :=
+  match access_mode ty with
+  | By_value _ => False
+  | _ => True
+  end.
+
+Lemma add_global_funs_charact:
+  forall fns tyenv,
+  (forall id ty, tyenv!id = Some ty -> type_not_by_value ty) ->
+  (forall id ty, (add_global_funs tyenv fns)!id = Some ty -> type_not_by_value ty).
+Proof.
+  induction fns; simpl; intros.
+  eauto.
+  apply IHfns with (add_global_fun tyenv a) id.
+  intros until ty0. destruct a as [id1 fn1]. 
+  unfold add_global_fun; simpl. rewrite PTree.gsspec.
+  destruct (peq id0 id1). 
+  intros. inversion H1. 
+  unfold type_of_fundef. destruct fn1; exact I.
+  eauto.
+  auto.
+Qed.
+
+Definition global_fun_typenv :=
+  add_global_funs (PTree.empty type) (Csyntax.prog_funct prog).
+
+Lemma add_global_funs_match_global_env:
+  match_globalenv global_fun_typenv (PTree.empty var_kind).
+Proof.
+  intros; red; intros.
+  assert (type_not_by_value ty).
+    apply add_global_funs_charact with (Csyntax.prog_funct prog) (PTree.empty type) id.
+    intros until ty0. rewrite PTree.gempty. congruence.
+    assumption.
+  red in H1. rewrite H0 in H1. contradiction.
+Qed.
+
+Lemma add_global_var_match_globalenv:
+  forall vars tenv gv tvars,
+  match_globalenv tenv gv ->
+  transl_global_vars vars = Some tvars ->
+  match_globalenv (add_global_vars tenv vars) (globvarenv gv tvars).
+Proof.
+  induction vars; intros; simpl.
+  simpl in H0. inversion H0. simpl. auto.
+  destruct a as [[id ty] init]. monadInv H0. subst tvars.
+  simpl. apply IHvars; auto.
+  red. intros until chunk. repeat rewrite PTree.gsspec. 
+  destruct (peq id0 id); intros.
+  inversion H1; clear H1; subst id0 ty0. 
+  generalize (var_kind_by_value _ _ H2). congruence.
+  red in H. eauto. 
+Qed.
+
+Lemma match_global_typenv:
+  match_globalenv (global_typenv prog) (global_var_env tprog).
+Proof.
+  change (global_var_env tprog)
+    with (globvarenv (PTree.empty var_kind) (prog_vars tprog)).
+  unfold global_typenv.
+  apply add_global_var_match_globalenv.
+  apply add_global_funs_match_global_env. 
+  monadInv TRANSL. rewrite <- H0. reflexivity.
+Qed.
+
+(** ** Variable accessors *)
+
+Lemma var_get_correct:
+  forall e m id ty loc ofs v tyenv code te le,
+  Csem.eval_lvalue ge e m (Expr (Csyntax.Evar id) ty) E0 m loc ofs ->
+  load_value_of_type ty m loc ofs = Some v ->
+  wt_expr tyenv (Expr (Csyntax.Evar id) ty) ->
+  var_get id ty = Some code ->
+  match_env tyenv e te ->
+  eval_expr tprog le te m code E0 m v.
+Proof.
+  intros. inversion H1; subst; clear H1. 
+  unfold load_value_of_type in H0.
+  unfold var_get in H2. 
+  caseEq (access_mode ty).
+  (* access mode By_value *)
+  intros chunk ACC. rewrite ACC in H0. rewrite ACC in H2. 
+  inversion H2; clear H2; subst.
+  inversion H; subst; clear H.
+    (* local variable *)
+    exploit me_local; eauto. intros [vk [A B]].
+    red in A; rewrite ACC in A.
+    subst vk.
+    eapply eval_Evar. 
+    eapply eval_var_ref_local. eauto. assumption. 
+    (* global variable *)
+    exploit me_global; eauto. intros [A B].
+    eapply eval_Evar. 
+    eapply eval_var_ref_global. auto. 
+    fold tge. rewrite symbols_preserved. eauto.
+    eauto. assumption. 
+  (* access mode By_reference *)
+  intros ACC. rewrite ACC in H0. rewrite ACC in H2.
+  inversion H0; clear H0; subst.
+  inversion H2; clear H2; subst.
+  inversion H; subst; clear H.
+    (* local variable *)
+    exploit me_local; eauto. intros [vk [A B]].
+    eapply eval_Eaddrof.
+    eapply eval_var_addr_local. eauto. 
+    (* global variable *)
+    exploit me_global; eauto. intros [A B].
+    eapply eval_Eaddrof.
+    eapply eval_var_addr_global. auto. 
+    fold tge. rewrite symbols_preserved. eauto.
+  (* access mode By_nothing *)
+  intros. rewrite H1 in H0; discriminate.
+Qed.
+
+Lemma var_set_correct:
+  forall e m id ty m1 loc ofs t1 m2 v t2 m3 tyenv code te rhs, 
+  Csem.eval_lvalue ge e m (Expr (Csyntax.Evar id) ty) t1 m1 loc ofs ->
+  store_value_of_type ty m2 loc ofs v = Some m3 ->
+  wt_expr tyenv (Expr (Csyntax.Evar id) ty) ->
+  var_set id ty rhs = Some code ->
+  match_env tyenv e te ->
+  eval_expr tprog nil te m1 rhs t2 m2 v ->
+  exec_stmt tprog te m code (t1 ** t2) m3 Out_normal.
+Proof.
+  intros. inversion H1; subst; clear H1. 
+  unfold store_value_of_type in H0.
+  unfold var_set in H2. 
+  caseEq (access_mode ty).
+  (* access mode By_value *)
+  intros chunk ACC. rewrite ACC in H0. rewrite ACC in H2. 
+  inversion H2; clear H2; subst.
+  inversion H; subst; clear H; rewrite E0_left.
+    (* local variable *)
+    exploit me_local; eauto. intros [vk [A B]].
+    red in A; rewrite ACC in A; subst vk.
+    eapply eval_Sassign. eauto. 
+    eapply eval_var_ref_local. eauto. assumption. 
+    (* global variable *)
+    exploit me_global; eauto. intros [A B].
+    eapply eval_Sassign. eauto.
+    eapply eval_var_ref_global. auto. 
+    fold tge. rewrite symbols_preserved. eauto.
+    eauto. assumption. 
+  (* access mode By_reference *)
+  intros ACC. rewrite ACC in H0. discriminate.
+  (* access mode By_nothing *)
+  intros. rewrite H1 in H0; discriminate.
+Qed.
+
+(** ** Proof of semantic simulation *)
+
+(** Inductive properties *)
+
+Definition eval_expr_prop 
+    (e: Csem.env) (m1: mem) (a: Csyntax.expr) (t: trace) (m2: mem) (v: val) : Prop :=
+  forall tyenv ta te tle
+    (WT: wt_expr tyenv a)
+    (TR: transl_expr a = Some ta)
+    (MENV: match_env tyenv e te),
+  Csharpminor.eval_expr tprog tle te m1 ta t m2 v.
+
+Definition eval_lvalue_prop
+    (e: Csem.env) (m1: mem) (a: Csyntax.expr) (t: trace)
+    (m2: mem) (b: block) (ofs: int) : Prop :=
+  forall tyenv ta te tle
+    (WT: wt_expr tyenv a)
+    (TR: transl_lvalue a = Some ta)
+    (MENV: match_env tyenv e te),
+  Csharpminor.eval_expr tprog tle te m1 ta t m2 (Vptr b ofs).
+
+Definition eval_exprlist_prop
+    (e: Csem.env) (m1: mem) (al: Csyntax.exprlist) (t: trace)
+    (m2: mem) (vl: list val) : Prop :=
+  forall tyenv tal te tle
+    (WT: wt_exprlist tyenv al)
+    (TR: transl_exprlist al = Some tal)
+    (MENV: match_env tyenv e te),
+  Csharpminor.eval_exprlist tprog tle te m1 tal t m2 vl.
+
+Definition transl_outcome (nbrk ncnt: nat) (out: Csem.outcome): Csharpminor.outcome :=
+  match out with
+  | Csem.Out_normal => Csharpminor.Out_normal
+  | Csem.Out_break  => Csharpminor.Out_exit nbrk
+  | Csem.Out_continue => Csharpminor.Out_exit ncnt
+  | Csem.Out_return vopt => Csharpminor.Out_return vopt
+  end.
+
+Definition exec_stmt_prop
+    (e: Csem.env) (m1: mem) (s: Csyntax.statement) (t: trace)
+    (m2: mem) (out: Csem.outcome) : Prop :=
+  forall tyenv nbrk ncnt ts te
+    (WT: wt_stmt tyenv s)
+    (TR: transl_statement nbrk ncnt s = Some ts)   
+    (MENV: match_env tyenv e te),
+  Csharpminor.exec_stmt tprog te m1 ts t m2 (transl_outcome nbrk ncnt out).
+
+Definition exec_lblstmts_prop
+    (e: Csem.env) (m1: mem) (s: Csyntax.labeled_statements)
+    (t: trace) (m2: mem) (out: Csem.outcome) : Prop :=
+  forall tyenv nbrk ncnt body ts te m0 t0
+    (WT: wt_lblstmts tyenv s)
+    (TR: transl_lblstmts (lblstmts_length s)
+                         (1 + lblstmts_length s + ncnt)
+                         s body = Some ts)   
+    (MENV: match_env tyenv e te)
+    (BODY: Csharpminor.exec_stmt tprog te m0 body t0 m1 Out_normal),
+  Csharpminor.exec_stmt tprog te m0 ts (t0 ** t) m2 
+       (transl_outcome nbrk ncnt (outcome_switch out)).
+
+Definition eval_funcall_prop
+    (m1: mem) (f: Csyntax.fundef) (params: list val)
+    (t: trace) (m2: mem) (res: val) : Prop :=
+  forall tf
+    (WT: wt_fundef (global_typenv prog) f)
+    (TR: transl_fundef f = Some tf),
+   Csharpminor.eval_funcall tprog m1 tf params t m2 res.
+
+(*
+Set Printing Depth 100.
+Check (Csem.eval_funcall_ind6 ge eval_expr_prop eval_lvalue_prop
+         eval_exprlist_prop exec_stmt_prop exec_lblstmts_prop eval_funcall_prop).
+*)
+
+Lemma transl_Econst_int_correct:
+       (forall (e : Csem.env) (m : mem) (i : int) (ty : type),
+        eval_expr_prop e m (Expr (Econst_int i) ty) E0 m (Vint i)).
+Proof.
+  intros; red; intros.
+  monadInv TR. subst ta. apply make_intconst_correct.
+Qed.
+
+Lemma transl_Econst_float_correct:
+       (forall (e : Csem.env) (m : mem) (f0 : float) (ty : type),
+        eval_expr_prop e m (Expr (Econst_float f0) ty) E0 m (Vfloat f0)).
+Proof.
+  intros; red; intros.
+  monadInv TR. subst ta. apply make_floatconst_correct.
+Qed.
+
+Lemma transl_Elvalue_correct:
+       (forall (e : Csem.env) (m : mem) (a : expr_descr) (ty : type)
+          (t : trace) (m1 : mem) (loc : block) (ofs : int) (v : val),
+        eval_lvalue ge e m (Expr a ty) t m1 loc ofs ->
+        eval_lvalue_prop e m (Expr a ty) t m1 loc ofs ->
+        load_value_of_type ty m1 loc ofs = Some v ->
+        eval_expr_prop e m (Expr a ty) t m1 v).
+Proof.
+  intros; red; intros.
+  exploit transl_expr_lvalue; eauto. 
+  intros [[id [EQ VARGET]] | [tb [TRLVAL MKLOAD]]].
+  (* Case a is a variable *)
+  subst a. 
+  assert (t = E0 /\ m1 = m). inversion H; auto. 
+  destruct H2; subst t m1.
+  eapply var_get_correct; eauto.
+  (* Case a is another lvalue *)
+  eapply make_load_correct; eauto. 
+Qed.
+
+Lemma transl_Eaddrof_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
+          (m1 : mem) (loc : block) (ofs : int) (ty : type),
+        eval_lvalue ge e m a t m1 loc ofs ->
+        eval_lvalue_prop e m a t m1 loc ofs ->
+        eval_expr_prop e m (Expr (Csyntax.Eaddrof a) ty) t m1 (Vptr loc ofs)).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR. 
+  eauto.
+Qed.
+
+Lemma transl_Esizeof_correct:
+       (forall (e : Csem.env) (m : mem) (ty' ty : type),
+        eval_expr_prop e m (Expr (Esizeof ty') ty) E0 m
+          (Vint (Int.repr (Csyntax.sizeof ty')))).
+Proof.
+  intros; red; intros. monadInv TR. subst ta. apply make_intconst_correct. 
+Qed.
+
+Lemma transl_Eunop_correct:
+       (forall (e : Csem.env) (m : mem) (op : unary_operation)
+          (a : Csyntax.expr) (ty : type) (t : trace) (m1 : mem) (v1 v : val),
+        Csem.eval_expr ge e m a t m1 v1 ->
+        eval_expr_prop e m a t m1 v1 ->
+        sem_unary_operation op v1 (typeof a) = Some v ->
+        eval_expr_prop e m (Expr (Eunop op a) ty) t m1 v).
+Proof.
+  intros; red; intros.
+  inversion WT; clear WT; subst.
+  monadInv TR. 
+  eapply transl_unop_correct; eauto. 
+Qed.
+
+Lemma transl_Ebinop_correct:
+       (forall (e : Csem.env) (m : mem) (op : binary_operation)
+          (a1 a2 : Csyntax.expr) (ty : type) (t1 : trace) (m1 : mem)
+          (v1 : val) (t2 : trace) (m2 : mem) (v2 v : val),
+        Csem.eval_expr ge e m a1 t1 m1 v1 ->
+        eval_expr_prop e m a1 t1 m1 v1 ->
+        Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
+        eval_expr_prop e m1 a2 t2 m2 v2 ->
+        sem_binary_operation op v1 (typeof a1) v2 (typeof a2) m2 = Some v ->
+        eval_expr_prop e m (Expr (Ebinop op a1 a2) ty) (t1 ** t2) m2 v).
+Proof.
+  intros; red; intros.
+  inversion WT; clear WT; subst.
+  monadInv TR. 
+  eapply transl_binop_correct; eauto. 
+Qed.
+
+Lemma transl_Eorbool_1_correct:
+       (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (t : trace)
+          (m1 : mem) (v1 : val) (ty : type),
+        Csem.eval_expr ge e m a1 t m1 v1 ->
+        eval_expr_prop e m a1 t m1 v1 ->
+        is_true v1 (typeof a1) ->
+        eval_expr_prop e m (Expr (Eorbool a1 a2) ty) t m1 Vtrue).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
+  rewrite <- H3; unfold make_orbool.
+  exploit make_boolean_correct_true; eauto. intros [vb [EVAL ISTRUE]].
+  eapply eval_Econdition_true; eauto.
+  unfold Vtrue; apply make_intconst_correct. traceEq.
+Qed.
+
+Lemma transl_Eorbool_2_correct:
+       (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (ty : type)
+          (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace) (m2 : mem)
+          (v2 v : val),
+        Csem.eval_expr ge e m a1 t1 m1 v1 ->
+        eval_expr_prop e m a1 t1 m1 v1 ->
+        is_false v1 (typeof a1) ->
+        Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
+        eval_expr_prop e m1 a2 t2 m2 v2 ->
+        bool_of_val v2 (typeof a2) v ->
+        eval_expr_prop e m (Expr (Eorbool a1 a2) ty) (t1 ** t2) m2 v).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
+  rewrite <- H6; unfold make_orbool.
+  exploit make_boolean_correct_false. eapply H0; eauto. eauto. intros [vb [EVAL ISFALSE]].
+  eapply eval_Econdition_false; eauto.
+  inversion H4; subst.
+  exploit make_boolean_correct_true. eapply H3; eauto. eauto. intros [vc [EVAL' ISTRUE']].
+  eapply eval_Econdition_true; eauto. 
+  unfold Vtrue; apply make_intconst_correct. traceEq.
+  exploit make_boolean_correct_false. eapply H3; eauto. eauto. intros [vc [EVAL' ISFALSE']].
+  eapply eval_Econdition_false; eauto.
+  unfold Vfalse; apply make_intconst_correct. traceEq.
+Qed.
+
+Lemma transl_Eandbool_1_correct:
+       (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (t : trace)
+          (m1 : mem) (v1 : val) (ty : type),
+        Csem.eval_expr ge e m a1 t m1 v1 ->
+        eval_expr_prop e m a1 t m1 v1 ->
+        is_false v1 (typeof a1) ->
+        eval_expr_prop e m (Expr (Eandbool a1 a2) ty) t m1 Vfalse).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
+  rewrite <- H3; unfold make_andbool.
+  exploit make_boolean_correct_false; eauto. intros [vb [EVAL ISFALSE]].
+  eapply eval_Econdition_false; eauto.
+  unfold Vfalse; apply make_intconst_correct. traceEq.
+Qed.
+
+Lemma transl_Eandbool_2_correct:
+       (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (ty : type)
+          (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace) (m2 : mem)
+          (v2 v : val),
+        Csem.eval_expr ge e m a1 t1 m1 v1 ->
+        eval_expr_prop e m a1 t1 m1 v1 ->
+        is_true v1 (typeof a1) ->
+        Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
+        eval_expr_prop e m1 a2 t2 m2 v2 ->
+        bool_of_val v2 (typeof a2) v ->
+        eval_expr_prop e m (Expr (Eandbool a1 a2) ty) (t1 ** t2) m2 v).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. monadInv TR.
+  rewrite <- H6; unfold make_andbool.
+  exploit make_boolean_correct_true. eapply H0; eauto. eauto. intros [vb [EVAL ISTRUE]].
+  eapply eval_Econdition_true; eauto.
+  inversion H4; subst.
+  exploit make_boolean_correct_true. eapply H3; eauto. eauto. intros [vc [EVAL' ISTRUE']].
+  eapply eval_Econdition_true; eauto. 
+  unfold Vtrue; apply make_intconst_correct. traceEq.
+  exploit make_boolean_correct_false. eapply H3; eauto. eauto. intros [vc [EVAL' ISFALSE']].
+  eapply eval_Econdition_false; eauto.
+  unfold Vfalse; apply make_intconst_correct. traceEq.
+Qed.
+
+Lemma transl_Ecast_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (ty : type)
+          (t : trace) (m1 : mem) (v1 v : val),
+        Csem.eval_expr ge e m a t m1 v1 ->
+        eval_expr_prop e m a t m1 v1 ->
+        cast v1 (typeof a) ty v ->
+        eval_expr_prop e m (Expr (Ecast ty a) ty) t m1 v).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. monadInv TR. subst ta.
+  eapply make_cast_correct; eauto.
+Qed.
+
+Lemma transl_Ecall_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
+          (bl : Csyntax.exprlist) (ty : type) (m3 : mem) (vres : val)
+          (t1 : trace) (m1 : mem) (vf : val) (t2 : trace) (m2 : mem)
+          (vargs : list val) (f : Csyntax.fundef) (t3 : trace),
+        Csem.eval_expr ge e m a t1 m1 vf ->
+        eval_expr_prop e m a t1 m1 vf ->
+        Csem.eval_exprlist ge e m1 bl t2 m2 vargs ->
+        eval_exprlist_prop e m1 bl t2 m2 vargs ->
+        Genv.find_funct ge vf = Some f ->
+        type_of_fundef f = typeof a ->
+        Csem.eval_funcall ge m2 f vargs t3 m3 vres ->
+        eval_funcall_prop m2 f vargs t3 m3 vres ->
+        eval_expr_prop e m (Expr (Csyntax.Ecall a bl) ty) (t1 ** t2 ** t3) m3
+          vres).
+Proof.
+  intros; red; intros.
+  inversion WT; clear WT; subst.
+  simpl in TR. 
+  caseEq (classify_fun (typeof a)).
+  2: intros; rewrite H7 in TR; discriminate.
+  intros targs tres EQ. rewrite EQ in TR. 
+  monadInv TR. clear TR. subst ta.
+  rewrite <- H4 in EQ.
+  exploit functions_translated; eauto. intros [tf [FIND TRL]].
+  econstructor.
+  eapply H0; eauto.
+  eapply H2; eauto.
+  eexact FIND. 
+  eapply transl_fundef_sig1; eauto. 
+  eapply H6; eauto. 
+  eapply functions_well_typed; eauto.
+  auto.
+Qed.
+
+Lemma transl_Evar_local_correct:
+       (forall (e : Csem.env) (m : mem) (id : positive) (l : block)
+          (ty : type),
+        e ! id = Some l ->
+        eval_lvalue_prop e m (Expr (Csyntax.Evar id) ty) E0 m l Int.zero).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. monadInv TR. subst ta.
+  exploit (me_local _ _ _ MENV); eauto. intros [vk [A B]].
+  econstructor. eapply eval_var_addr_local. eauto. 
+Qed.
+
+Lemma transl_Evar_global_correct:
+       (forall (e : PTree.t block) (m : mem) (id : positive) (l : block)
+          (ty : type),
+        e ! id = None ->
+        Genv.find_symbol ge id = Some l ->
+        eval_lvalue_prop e m (Expr (Csyntax.Evar id) ty) E0 m l Int.zero).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. monadInv TR. subst ta.
+  exploit (me_global _ _ _ MENV); eauto. intros [A B].
+  econstructor. eapply eval_var_addr_global. eauto. 
+  rewrite symbols_preserved. auto.
+Qed.
+
+Lemma transl_Ederef_correct:
+       (forall (e : Csem.env) (m m1 : mem) (a : Csyntax.expr) (t : trace)
+          (ofs : int) (ty : type) (l : block),
+        Csem.eval_expr ge e m a t m1 (Vptr l ofs) ->
+        eval_expr_prop e m a t m1 (Vptr l ofs) ->
+        eval_lvalue_prop e m (Expr (Ederef a) ty) t m1 l ofs).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR. 
+  eauto.
+Qed.
+
+Lemma transl_Eindex_correct:
+       (forall (e : Csem.env) (m : mem) (a1 : Csyntax.expr) (t1 : trace)
+          (m1 : mem) (v1 : val) (a2 : Csyntax.expr) (t2 : trace) (m2 : mem)
+          (v2 : val) (l : block) (ofs : int) (ty : type),
+        Csem.eval_expr ge e m a1 t1 m1 v1 ->
+        eval_expr_prop e m a1 t1 m1 v1 ->
+        Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
+        eval_expr_prop e m1 a2 t2 m2 v2 ->
+        sem_add v1 (typeof a1) v2 (typeof a2) = Some (Vptr l ofs) ->
+        eval_lvalue_prop e m (Expr (Eindex a1 a2) ty) (t1 ** t2) m2 l ofs).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR. monadInv TR.
+  eapply (make_add_correct tprog); eauto. 
+Qed.
+
+Lemma transl_Efield_struct_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
+          (m1 : mem) (l : block) (ofs : int) (fList : fieldlist) (i : ident)
+          (ty : type) (delta : Z),
+        eval_lvalue ge e m a t m1 l ofs ->
+        eval_lvalue_prop e m a t m1 l ofs ->
+        typeof a = Tstruct fList ->
+        field_offset i fList = Some delta ->
+        eval_lvalue_prop e m (Expr (Efield a i) ty) t m1 l
+          (Int.add ofs (Int.repr delta))).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. 
+  simpl in TR. rewrite H1 in TR. monadInv TR.
+  rewrite <- H5. eapply make_binop_correct; eauto.
+  apply make_intconst_correct. 
+  simpl. congruence. traceEq.
+Qed.
+
+Lemma transl_Efield_union_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
+          (m1 : mem) (l : block) (ofs : int) (fList : fieldlist) (i : ident)
+          (ty : type),
+        eval_lvalue ge e m a t m1 l ofs ->
+        eval_lvalue_prop e m a t m1 l ofs ->
+        typeof a = Tunion fList ->
+        eval_lvalue_prop e m (Expr (Efield a i) ty) t m1 l ofs).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. 
+  simpl in TR. rewrite H1 in TR. eauto.
+Qed.
+
+Lemma transl_Enil_correct:
+       (forall (e : Csem.env) (m : mem),
+        eval_exprlist_prop e m Csyntax.Enil E0 m nil).
+Proof.
+  intros; red; intros. monadInv TR. subst tal. constructor.
+Qed.
+
+Lemma transl_Econs_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
+          (bl : Csyntax.exprlist) (t1 : trace) (m1 : mem) (v : val)
+          (t2 : trace) (m2 : mem) (vl : list val),
+        Csem.eval_expr ge e m a t1 m1 v ->
+        eval_expr_prop e m a t1 m1 v ->
+        Csem.eval_exprlist ge e m1 bl t2 m2 vl ->
+        eval_exprlist_prop e m1 bl t2 m2 vl ->
+        eval_exprlist_prop e m (Csyntax.Econs a bl) (t1 ** t2) m2 (v :: vl)).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR. 
+  subst tal. econstructor; eauto. 
+Qed.
+
+Lemma transl_Sskip_correct:
+       (forall (e : Csem.env) (m : mem),
+        exec_stmt_prop e m Csyntax.Sskip E0 m Csem.Out_normal).
+Proof.
+  intros; red; intros. monadInv TR. subst ts. simpl. constructor.
+Qed.
+
+Lemma transl_Sexpr_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
+          (m1 : mem) (v : val),
+        Csem.eval_expr ge e m a t m1 v ->
+        eval_expr_prop e m a t m1 v ->
+        exec_stmt_prop e m (Csyntax.Sexpr a) t m1 Csem.Out_normal).
+Proof.
+  intros; red; intros; simpl. inversion WT; clear WT; subst. 
+  monadInv TR. subst ts. 
+  econstructor; eauto.
+Qed.
+
+Lemma transl_Sassign_correct:
+       (forall (e : Csem.env) (m : mem) (a1 a2 : Csyntax.expr) (t1 : trace)
+          (m1 : mem) (loc : block) (ofs : int) (t2 : trace) (m2 : mem)
+          (v2 : val) (m3 : mem),
+        eval_lvalue ge e m a1 t1 m1 loc ofs ->
+        eval_lvalue_prop e m a1 t1 m1 loc ofs ->
+        Csem.eval_expr ge e m1 a2 t2 m2 v2 ->
+        eval_expr_prop e m1 a2 t2 m2 v2 ->
+        store_value_of_type (typeof a1) m2 loc ofs v2 = Some m3 ->
+        exec_stmt_prop e m (Csyntax.Sassign a1 a2) (t1 ** t2) m3
+          Csem.Out_normal).
+Proof.
+  intros; red; intros.
+  inversion WT; subst; clear WT.
+  simpl in TR. 
+  caseEq (is_variable a1).
+  (* a = variable id *)
+  intros id ISVAR. rewrite ISVAR in TR. 
+  generalize (is_variable_correct _ _ ISVAR). intro EQ. 
+  rewrite EQ in H; rewrite EQ in H0; rewrite EQ in H6.
+  monadInv TR.
+  eapply var_set_correct; eauto. 
+  (* a is not a variable *)
+  intro ISVAR; rewrite ISVAR in TR. monadInv TR.
+  eapply make_store_correct; eauto.
+Qed.
+
+Lemma transl_Ssequence_1_correct:
+       (forall (e : Csem.env) (m : mem) (s1 s2 : statement) (t1 : trace)
+          (m1 : mem) (t2 : trace) (m2 : mem) (out : Csem.outcome),
+        Csem.exec_stmt ge e m s1 t1 m1 Csem.Out_normal ->
+        exec_stmt_prop e m s1 t1 m1 Csem.Out_normal ->
+        Csem.exec_stmt ge e m1 s2 t2 m2 out ->
+        exec_stmt_prop e m1 s2 t2 m2 out ->
+        exec_stmt_prop e m (Ssequence s1 s2) (t1 ** t2) m2 out).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. red in H0; simpl in H0. eapply exec_Sseq_continue; eauto. 
+Qed.
+
+Lemma transl_Ssequence_2_correct:
+       (forall (e : Csem.env) (m : mem) (s1 s2 : statement) (t1 : trace)
+          (m1 : mem) (out : Csem.outcome),
+        Csem.exec_stmt ge e m s1 t1 m1 out ->
+        exec_stmt_prop e m s1 t1 m1 out ->
+        out <> Csem.Out_normal ->
+        exec_stmt_prop e m (Ssequence s1 s2) t1 m1 out).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. eapply exec_Sseq_stop; eauto. 
+  destruct out; simpl; congruence.
+Qed.
+
+Lemma transl_Sifthenelse_true_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
+          (s1 s2 : statement) (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace)
+          (m2 : mem) (out : Csem.outcome),
+        Csem.eval_expr ge e m a t1 m1 v1 ->
+        eval_expr_prop e m a t1 m1 v1 ->
+        is_true v1 (typeof a) ->
+        Csem.exec_stmt ge e m1 s1 t2 m2 out ->
+        exec_stmt_prop e m1 s1 t2 m2 out ->
+        exec_stmt_prop e m (Csyntax.Sifthenelse a s1 s2) (t1 ** t2) m2 out).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  exploit make_boolean_correct_true. eapply H0; eauto. eauto. intros [vb [EVAL ISTRUE]].
+  subst ts. eapply exec_Sifthenelse_true; eauto. 
+Qed.
+
+Lemma transl_Sifthenelse_false_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr)
+          (s1 s2 : statement) (t1 : trace) (m1 : mem) (v1 : val) (t2 : trace)
+          (m2 : mem) (out : Csem.outcome),
+        Csem.eval_expr ge e m a t1 m1 v1 ->
+        eval_expr_prop e m a t1 m1 v1 ->
+        is_false v1 (typeof a) ->
+        Csem.exec_stmt ge e m1 s2 t2 m2 out ->
+        exec_stmt_prop e m1 s2 t2 m2 out ->
+        exec_stmt_prop e m (Csyntax.Sifthenelse a s1 s2) (t1 ** t2) m2 out).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  exploit make_boolean_correct_false. eapply H0; eauto. eauto. intros [vb [EVAL ISFALSE]].
+  subst ts. eapply exec_Sifthenelse_false; eauto. 
+Qed.
+
+Lemma transl_Sreturn_none_correct:
+       (forall (e : Csem.env) (m : mem),
+        exec_stmt_prop e m (Csyntax.Sreturn None) E0 m (Csem.Out_return None)).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl. apply exec_Sreturn_none. 
+Qed.
+
+Lemma transl_Sreturn_some_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t : trace)
+          (m1 : mem) (v : val),
+        Csem.eval_expr ge e m a t m1 v ->
+        eval_expr_prop e m a t m1 v ->
+        exec_stmt_prop e m (Csyntax.Sreturn (Some a)) t m1
+          (Csem.Out_return (Some v))).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl. eapply exec_Sreturn_some; eauto. 
+Qed.
+
+Lemma transl_Sbreak_correct:
+       (forall (e : Csem.env) (m : mem),
+        exec_stmt_prop e m Sbreak E0 m Out_break).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl. apply exec_Sexit.  
+Qed.
+
+Lemma transl_Scontinue_correct:
+       (forall (e : Csem.env) (m : mem),
+        exec_stmt_prop e m Scontinue E0 m Out_continue).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl. apply exec_Sexit.  
+Qed.
+
+Lemma exit_if_false_true:
+  forall a ts e m1 t m2 v tyenv te,
+  exit_if_false a = Some ts ->
+  eval_expr_prop e m1 a t m2 v ->
+  match_env tyenv e te ->
+  wt_expr tyenv a ->
+  is_true v (typeof a) ->
+  exec_stmt tprog te m1 ts t m2 Out_normal.
+Proof.
+  intros. monadInv H. rewrite <- H5. 
+  eapply exec_Sifthenelse_false with (v1 := Vfalse).
+  eapply make_notbool_correct with (va := v); eauto.
+  inversion H3; subst; simpl; auto.
+  rewrite Int.eq_false; auto.
+  rewrite Int.eq_false; auto.
+  rewrite Float.eq_zero_false; auto.
+  simpl; auto.
+  constructor. traceEq.
+Qed.
+ 
+Lemma exit_if_false_false:
+  forall a ts e m1 t m2 v tyenv te,
+  exit_if_false a = Some ts ->
+  eval_expr_prop e m1 a t m2 v ->
+  match_env tyenv e te ->
+  wt_expr tyenv a ->
+  is_false v (typeof a) ->
+  exec_stmt tprog te m1 ts t m2 (Out_exit 0).
+Proof.
+  intros. monadInv H. rewrite <- H5. 
+  eapply exec_Sifthenelse_true with (v1 := Vtrue).
+  eapply make_notbool_correct with (va := v); eauto.
+  inversion H3; subst; simpl; auto.
+  rewrite Float.eq_zero_true; auto.
+  simpl; apply Int.one_not_zero.
+  constructor. traceEq.
+Qed.
+
+Lemma transl_Swhile_false_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (a : Csyntax.expr)
+          (t : trace) (v : val) (m1 : mem),
+        Csem.eval_expr ge e m a t m1 v ->
+        eval_expr_prop e m a t m1 v ->
+        is_false v (typeof a) ->
+        exec_stmt_prop e m (Swhile a s) t m1 Csem.Out_normal).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl.
+  change Out_normal with (outcome_block (Out_exit 0)).
+  apply exec_Sblock. apply exec_Sloop_stop. apply exec_Sseq_stop.
+  eapply exit_if_false_false; eauto. congruence. congruence.
+Qed.
+
+Lemma transl_out_break_or_return:
+  forall out1 out2 nbrk ncnt,
+  out_break_or_return out1 out2 ->
+  transl_outcome nbrk ncnt out2 =
+  outcome_block (outcome_block (transl_outcome 1 0 out1)).
+Proof.
+  intros. inversion H; subst; reflexivity.
+Qed.
+
+Lemma transl_out_normal_or_continue:
+  forall out,
+  out_normal_or_continue out ->
+  Out_normal = outcome_block (transl_outcome 1 0 out).
+Proof.
+  intros; inversion H; reflexivity.
+Qed.
+
+Lemma transl_Swhile_stop_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t1 : trace)
+          (m1 : mem) (v : val) (s : statement) (m2 : mem) (t2 : trace)
+          (out2 out : Csem.outcome),
+        Csem.eval_expr ge e m a t1 m1 v ->
+        eval_expr_prop e m a t1 m1 v ->
+        is_true v (typeof a) ->
+        Csem.exec_stmt ge e m1 s t2 m2 out2 ->
+        exec_stmt_prop e m1 s t2 m2 out2 ->
+        out_break_or_return out2 out ->
+        exec_stmt_prop e m (Swhile a s) (t1 ** t2) m2 out).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. rewrite (transl_out_break_or_return _ _ nbrk ncnt H4).
+  apply exec_Sblock. apply exec_Sloop_stop. 
+  eapply exec_Sseq_continue. 
+  eapply exit_if_false_true; eauto. 
+  apply exec_Sblock. eauto.
+  auto. inversion H4; simpl; congruence.
+Qed.
+
+Lemma transl_Swhile_loop_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t1 : trace)
+          (m1 : mem) (v : val) (s : statement) (out2 out : Csem.outcome)
+          (t2 : trace) (m2 : mem) (t3 : trace) (m3 : mem),
+        Csem.eval_expr ge e m a t1 m1 v ->
+        eval_expr_prop e m a t1 m1 v ->
+        is_true v (typeof a) ->
+        Csem.exec_stmt ge e m1 s t2 m2 out2 ->
+        exec_stmt_prop e m1 s t2 m2 out2 ->
+        out_normal_or_continue out2 ->
+        Csem.exec_stmt ge e m2 (Swhile a s) t3 m3 out ->
+        exec_stmt_prop e m2 (Swhile a s) t3 m3 out ->
+        exec_stmt_prop e m (Swhile a s) (t1 ** t2 ** t3) m3 out).
+Proof.
+  intros; red; intros. 
+  exploit H6; eauto. intro NEXTITER.
+  inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. 
+  inversion NEXTITER; subst.
+  apply exec_Sblock. 
+  eapply exec_Sloop_loop. eapply exec_Sseq_continue.
+  eapply exit_if_false_true; eauto. 
+  rewrite (transl_out_normal_or_continue _ H4).
+  apply exec_Sblock. eauto. 
+  reflexivity. eassumption.
+  traceEq.
+Qed.
+
+Lemma transl_Sdowhile_false_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (a : Csyntax.expr)
+          (t1 : trace) (m1 : mem) (out1 : Csem.outcome) (v : val)
+          (t2 : trace) (m2 : mem),
+        Csem.exec_stmt ge e m s t1 m1 out1 ->
+        exec_stmt_prop e m s t1 m1 out1 ->
+        out_normal_or_continue out1 ->
+        Csem.eval_expr ge e m1 a t2 m2 v ->
+        eval_expr_prop e m1 a t2 m2 v ->
+        is_false v (typeof a) ->
+        exec_stmt_prop e m (Sdowhile a s) (t1 ** t2) m2 Csem.Out_normal).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl.
+  change Out_normal with (outcome_block (Out_exit 0)).
+  apply exec_Sblock. apply exec_Sloop_stop. eapply exec_Sseq_continue.
+  rewrite (transl_out_normal_or_continue out1 H1).
+  apply exec_Sblock. eauto. 
+  eapply exit_if_false_false; eauto. auto. congruence. 
+Qed.
+
+Lemma transl_Sdowhile_stop_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (a : Csyntax.expr)
+          (t : trace) (m1 : mem) (out1 out : Csem.outcome),
+        Csem.exec_stmt ge e m s t m1 out1 ->
+        exec_stmt_prop e m s t m1 out1 ->
+        out_break_or_return out1 out ->
+        exec_stmt_prop e m (Sdowhile a s) t m1 out).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl.
+  assert (outcome_block (transl_outcome 1 0 out1) <> Out_normal).
+    inversion H1; simpl; congruence.
+  rewrite (transl_out_break_or_return _ _ nbrk ncnt H1). 
+  apply exec_Sblock. apply exec_Sloop_stop. 
+  apply exec_Sseq_stop. apply exec_Sblock. eauto. 
+  auto. auto. 
+Qed.
+
+Lemma transl_Sdowhile_loop_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (a : Csyntax.expr)
+          (m1 m2 m3 : mem) (t1 t2 t3 : trace) (out out1 : Csem.outcome)
+          (v : val),
+        Csem.exec_stmt ge e m s t1 m1 out1 ->
+        exec_stmt_prop e m s t1 m1 out1 ->
+        out_normal_or_continue out1 ->
+        Csem.eval_expr ge e m1 a t2 m2 v ->
+        eval_expr_prop e m1 a t2 m2 v ->
+        is_true v (typeof a) ->
+        Csem.exec_stmt ge e m2 (Sdowhile a s) t3 m3 out ->
+        exec_stmt_prop e m2 (Sdowhile a s) t3 m3 out ->
+        exec_stmt_prop e m (Sdowhile a s) (t1 ** t2 ** t3) m3 out).
+Proof.
+  intros; red; intros. 
+  exploit H6; eauto. intro NEXTITER.
+  inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. 
+  inversion NEXTITER; subst.
+  apply exec_Sblock. 
+  eapply exec_Sloop_loop. eapply exec_Sseq_continue.
+  rewrite (transl_out_normal_or_continue _ H1).
+  apply exec_Sblock. eauto. 
+  eapply exit_if_false_true; eauto. 
+  reflexivity. eassumption. traceEq.
+Qed.
+
+Lemma transl_Sfor_start_correct:
+       (forall (e : Csem.env) (m : mem) (s a1 : statement)
+          (a2 : Csyntax.expr) (a3 : statement) (out : Csem.outcome)
+          (m1 m2 : mem) (t1 t2 : trace),
+        Csem.exec_stmt ge e m a1 t1 m1 Csem.Out_normal ->
+        exec_stmt_prop e m a1 t1 m1 Csem.Out_normal ->
+        Csem.exec_stmt ge e m1 (Sfor Csyntax.Sskip a2 a3 s) t2 m2 out ->
+        exec_stmt_prop e m1 (Sfor Csyntax.Sskip a2 a3 s) t2 m2 out ->
+        exec_stmt_prop e m (Sfor a1 a2 a3 s) (t1 ** t2) m2 out).
+Proof.
+  intros; red; intros.
+  exploit transl_stmt_Sfor_start; eauto. 
+  intros [ts1 [ts2 [A [B C]]]].
+  clear TR; subst ts. 
+  inversion WT; subst.
+  assert (WT': wt_stmt tyenv (Sfor Csyntax.Sskip a2 a3 s)).
+    constructor; auto. constructor.
+  exploit H0; eauto. simpl. intro EXEC1.
+  exploit H2; eauto. intro EXEC2. 
+  assert (EXEC3: exec_stmt tprog te m1 ts2 t2 m2 (transl_outcome nbrk ncnt out)).
+    inversion EXEC2; subst.
+    inversion H5; subst. rewrite E0_left; auto.
+    inversion H11; subst. congruence.
+  eapply exec_Sseq_continue; eauto. 
+Qed.
+
+Lemma transl_Sfor_false_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (a2 : Csyntax.expr)
+          (a3 : statement) (t : trace) (v : val) (m1 : mem),
+        Csem.eval_expr ge e m a2 t m1 v ->
+        eval_expr_prop e m a2 t m1 v ->
+        is_false v (typeof a2) ->
+        exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s) t m1 Csem.Out_normal).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl.
+  eapply exec_Sseq_continue. apply exec_Sskip.
+  change Out_normal with (outcome_block (Out_exit 0)).
+  apply exec_Sblock. apply exec_Sloop_stop. 
+  apply exec_Sseq_stop. eapply exit_if_false_false; eauto. 
+  congruence. congruence. traceEq. 
+Qed.
+
+Lemma transl_Sfor_stop_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (a2 : Csyntax.expr)
+          (a3 : statement) (v : val) (m1 m2 : mem) (t1 t2 : trace)
+          (out2 out : Csem.outcome),
+        Csem.eval_expr ge e m a2 t1 m1 v ->
+        eval_expr_prop e m a2 t1 m1 v ->
+        is_true v (typeof a2) ->
+        Csem.exec_stmt ge e m1 s t2 m2 out2 ->
+        exec_stmt_prop e m1 s t2 m2 out2 ->
+        out_break_or_return out2 out ->
+        exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s) (t1 ** t2) m2 out).
+Proof.
+  intros; red; intros. inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. simpl.
+  assert (outcome_block (transl_outcome 1 0 out2) <> Out_normal).
+    inversion H4; simpl; congruence.
+  rewrite (transl_out_break_or_return _ _ nbrk ncnt H4). 
+  eapply exec_Sseq_continue. apply exec_Sskip.
+  apply exec_Sblock. apply exec_Sloop_stop. 
+  eapply exec_Sseq_continue. eapply exit_if_false_true; eauto.
+  apply exec_Sseq_stop. apply exec_Sblock. eauto. 
+  auto. reflexivity. auto. traceEq. 
+Qed.
+
+Lemma transl_Sfor_loop_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (a2 : Csyntax.expr)
+          (a3 : statement) (v : val) (m1 m2 m3 m4 : mem)
+          (t1 t2 t3 t4 : trace) (out2 out : Csem.outcome),
+        Csem.eval_expr ge e m a2 t1 m1 v ->
+        eval_expr_prop e m a2 t1 m1 v ->
+        is_true v (typeof a2) ->
+        Csem.exec_stmt ge e m1 s t2 m2 out2 ->
+        exec_stmt_prop e m1 s t2 m2 out2 ->
+        out_normal_or_continue out2 ->
+        Csem.exec_stmt ge e m2 a3 t3 m3 Csem.Out_normal ->
+        exec_stmt_prop e m2 a3 t3 m3 Csem.Out_normal ->
+        Csem.exec_stmt ge e m3 (Sfor Csyntax.Sskip a2 a3 s) t4 m4 out ->
+        exec_stmt_prop e m3 (Sfor Csyntax.Sskip a2 a3 s) t4 m4 out ->
+        exec_stmt_prop e m (Sfor Csyntax.Sskip a2 a3 s)
+          (t1 ** t2 ** t3 ** t4) m4 out).
+Proof.
+  intros; red; intros. 
+  exploit H8; eauto. intro NEXTITER.
+  inversion WT; clear WT; subst. simpl in TR; monadInv TR.
+  subst ts. 
+  inversion NEXTITER; subst.
+  inversion H11; subst.
+  inversion H18; subst.   
+  eapply exec_Sseq_continue. apply exec_Sskip.
+  apply exec_Sblock. 
+  eapply exec_Sloop_loop. eapply exec_Sseq_continue.
+  eapply exit_if_false_true; eauto.
+  eapply exec_Sseq_continue.
+  rewrite (transl_out_normal_or_continue _ H4).
+  apply exec_Sblock. eauto. 
+  red in H6; simpl in H6; eauto.
+  reflexivity. reflexivity. eassumption. 
+  reflexivity. traceEq. 
+  inversion H17. congruence.
+Qed.
+
+Lemma transl_lblstmts_switch:
+  forall e m0 t1 m1 n nbrk ncnt tyenv te t2 m2 out sl body ts,
+  exec_stmt tprog te m0 body t1 m1 
+    (Out_exit (switch_target n (lblstmts_length sl) (switch_table sl 0))) ->
+  transl_lblstmts 
+    (lblstmts_length sl)
+    (S (lblstmts_length sl + ncnt))
+    sl (Sblock body) = Some ts ->
+  wt_lblstmts tyenv sl ->
+  match_env tyenv e te ->
+  exec_lblstmts_prop e m1 (select_switch n sl) t2 m2 out ->
+  Csharpminor.exec_stmt tprog te m0 ts (t1 ** t2) m2 
+    (transl_outcome nbrk ncnt (outcome_switch out)).
+Proof.
+  induction sl; intros.
+  simpl in H. simpl in H3.
+  eapply H3; eauto. 
+  change Out_normal with (outcome_block (Out_exit 0)).
+  apply exec_Sblock. auto.
+  (* Inductive case *)
+  simpl in H. simpl in H3. rewrite Int.eq_sym in H3. destruct (Int.eq n i).
+  (* first case selected *)
+  eapply H3; eauto. 
+  change Out_normal with (outcome_block (Out_exit 0)).
+  apply exec_Sblock. auto.
+  (* next case selected *)
+  inversion H1; clear H1; subst.
+  simpl in H0; monadInv H0.
+  eapply IHsl with (body := Sseq (Sblock body) s0); eauto.
+  apply exec_Sseq_stop. 
+  change (Out_exit (switch_target n (lblstmts_length sl) (switch_table sl 0)))
+    with (outcome_block (Out_exit (S (switch_target n (lblstmts_length sl) (switch_table sl 0))))).
+  apply exec_Sblock. 
+  rewrite switch_target_table_shift in H. auto. congruence.
+Qed.
+
+Lemma transl_Sswitch_correct:
+       (forall (e : Csem.env) (m : mem) (a : Csyntax.expr) (t1 : trace)
+          (m1 : mem) (n : int) (sl : labeled_statements) (t2 : trace)
+          (m2 : mem) (out : Csem.outcome),
+        Csem.eval_expr ge e m a t1 m1 (Vint n) ->
+        eval_expr_prop e m a t1 m1 (Vint n) ->
+        exec_lblstmts ge e m1 (select_switch n sl) t2 m2 out ->
+        exec_lblstmts_prop e m1 (select_switch n sl) t2 m2 out ->
+        exec_stmt_prop e m (Csyntax.Sswitch a sl) (t1 ** t2) m2
+          (outcome_switch out)).
+Proof.
+  intros; red; intros.
+  inversion WT; clear WT; subst.
+  simpl in TR. monadInv TR; clear TR. 
+  rewrite length_switch_table in EQ0. 
+  replace (ncnt + lblstmts_length sl + 1)%nat
+     with (S (lblstmts_length sl + ncnt))%nat in EQ0 by omega.
+  eapply transl_lblstmts_switch; eauto. 
+  constructor. eapply H0; eauto. 
+Qed.
+
+Lemma transl_LSdefault_correct:
+       (forall (e : Csem.env) (m : mem) (s : statement) (t : trace)
+          (m1 : mem) (out : Csem.outcome),
+        Csem.exec_stmt ge e m s t m1 out ->
+        exec_stmt_prop e m s t m1 out ->
+        exec_lblstmts_prop e m (LSdefault s) t m1 out).
+Proof.
+  intros; red; intros.
+  inversion WT; subst.
+  simpl in TR. monadInv TR.
+  rewrite <- H3. 
+  replace (transl_outcome nbrk ncnt (outcome_switch out))
+     with (outcome_block (transl_outcome 0 (S ncnt) out)).
+  constructor. 
+  eapply exec_Sseq_continue. eauto. 
+  eapply H0; eauto. traceEq.
+  destruct out; simpl; auto.
+Qed.
+
+Lemma transl_LScase_fallthrough_correct:
+       (forall (e : Csem.env) (m : mem) (n : int) (s : statement)
+          (ls : labeled_statements) (t1 : trace) (m1 : mem) (t2 : trace)
+          (m2 : mem) (out : Csem.outcome),
+        Csem.exec_stmt ge e m s t1 m1 Csem.Out_normal ->
+        exec_stmt_prop e m s t1 m1 Csem.Out_normal ->
+        exec_lblstmts ge e m1 ls t2 m2 out ->
+        exec_lblstmts_prop e m1 ls t2 m2 out ->
+        exec_lblstmts_prop e m (LScase n s ls) (t1 ** t2) m2 out).
+Proof.
+  intros; red; intros.
+  inversion WT; subst.
+  simpl in TR. monadInv TR; clear TR.
+  assert (exec_stmt tprog te m0 (Sblock (Sseq body s0)) 
+                  (t0 ** t1) m1 Out_normal).
+  change Out_normal with
+    (outcome_block (transl_outcome (S (lblstmts_length ls))
+                                   (S (S (lblstmts_length ls + ncnt)))
+                                   Csem.Out_normal)).
+  apply exec_Sblock. eapply exec_Sseq_continue. eexact BODY. 
+  eapply H0; eauto.
+  auto.
+  exploit H2. eauto. simpl; eauto. eauto. eauto. simpl. 
+  rewrite Eapp_assoc. eauto.
+Qed.
+
+Lemma transl_LScase_stop_correct:
+       (forall (e : Csem.env) (m : mem) (n : int) (s : statement)
+          (ls : labeled_statements) (t : trace) (m1 : mem)
+          (out : Csem.outcome),
+        Csem.exec_stmt ge e m s t m1 out ->
+        exec_stmt_prop e m s t m1 out ->
+        out <> Csem.Out_normal ->
+        exec_lblstmts_prop e m (LScase n s ls) t m1 out).
+Proof.
+  intros; red; intros.
+  inversion WT; subst.
+  simpl in TR. monadInv TR; clear TR.
+  exploit H0; eauto. intro EXEC.
+  destruct out; simpl; simpl in EXEC.
+  (* out = Out_break *)
+  change Out_normal with (outcome_block (Out_exit 0)).
+  eapply transl_lblstmts_exit with (body := Sblock (Sseq body s0)); eauto.
+  rewrite plus_0_r. 
+  change (Out_exit (lblstmts_length ls))
+    with (outcome_block (Out_exit (S (lblstmts_length ls)))).
+  constructor. eapply exec_Sseq_continue; eauto.
+  (* out = Out_continue *)
+  change (Out_exit ncnt) with (outcome_block (Out_exit (S ncnt))).
+  eapply transl_lblstmts_exit with (body := Sblock (Sseq body s0)); eauto.
+  replace (Out_exit (lblstmts_length ls + S ncnt))
+    with (outcome_block (Out_exit (S (S (lblstmts_length ls + ncnt))))).
+  constructor. eapply exec_Sseq_continue; eauto.
+  simpl. decEq. omega. 
+  (* out = Out_normal *)
+  congruence.
+  (* out = Out_return *)
+  eapply transl_lblstmts_return with (body := Sblock (Sseq body s0)); eauto.
+  change (Out_return o)
+    with (outcome_block (Out_return o)).
+  constructor. eapply exec_Sseq_continue; eauto.
+Qed.
+
+Remark outcome_result_value_match:
+  forall out ty v nbrk ncnt,
+  Csem.outcome_result_value out ty v ->
+  Csharpminor.outcome_result_value (transl_outcome nbrk ncnt out) (opttyp_of_type ty) v.
+Proof.
+  intros until ncnt.
+  destruct out; simpl; try contradiction.
+  destruct ty; simpl; auto.
+  destruct o. intros [A B]. destruct ty; simpl; congruence.
+  destruct ty; simpl; auto.
+Qed.
+
+Lemma transl_funcall_internal_correct:
+       (forall (m : mem) (f : Csyntax.function) (vargs : list val)
+          (t : trace) (e : Csem.env) (m1 : mem) (lb : list block)
+          (m2 m3 : mem) (out : Csem.outcome) (vres : val),
+        Csem.alloc_variables Csem.empty_env m
+          (Csyntax.fn_params f ++ Csyntax.fn_vars f) e m1 lb ->
+        Csem.bind_parameters e m1 (Csyntax.fn_params f) vargs m2 ->
+        Csem.exec_stmt ge e m2 (Csyntax.fn_body f) t m3 out ->
+        exec_stmt_prop e m2 (Csyntax.fn_body f) t m3 out ->
+        Csem.outcome_result_value out (fn_return f) vres ->
+        eval_funcall_prop m (Internal f) vargs t (free_list m3 lb) vres).
+Proof.
+  intros; red; intros.
+  (* Exploitation of typing hypothesis *)
+  inversion WT; clear WT; subst. 
+  inversion H6; clear H6; subst.
+  (* Exploitation of translation hypothesis *)
+  monadInv TR. subst tf. clear TR. 
+  monadInv EQ. clear EQ. subst f0.
+  (* Allocation of variables *)
+  exploit match_env_alloc_variables; eauto.
+  apply match_globalenv_match_env_empty. 
+  apply match_global_typenv.
+  eexact (transl_fn_variables _ _ (signature_of_function f) _ _ s EQ0 EQ1).
+  intros [te [ALLOCVARS MATCHENV]].
+  (* Execution *)
+  econstructor; simpl.
+    (* Norepet *)
+    eapply transl_names_norepet; eauto. 
+    (* Alloc *)
+    eexact ALLOCVARS.
+    (* Bind *)
+    eapply bind_parameters_match; eauto.
+    (* Execution of body *)
+    eapply H2; eauto.
+    (* Outcome_result_value *)
+    apply outcome_result_value_match; auto.
+Qed.
+
+Lemma transl_funcall_external_correct:
+       (forall (m : mem) (id : ident) (targs : typelist) (tres : type)
+          (vargs : list val) (t : trace) (vres : val),
+        event_match (external_function id targs tres) vargs t vres ->
+        eval_funcall_prop m (External id targs tres) vargs t m vres).
+Proof.
+  intros; red; intros.
+  monadInv TR. subst tf. constructor. auto.
+Qed.
+
+Theorem transl_funcall_correct:
+  forall (m : mem) (f : Csyntax.fundef) (l : list val) (t : trace)
+         (m0 : mem) (v : val),
+  Csem.eval_funcall ge m f l t m0 v ->
+  eval_funcall_prop m f l t m0 v.
+Proof
+  (Csem.eval_funcall_ind6 ge
+         eval_expr_prop
+         eval_lvalue_prop
+         eval_exprlist_prop
+         exec_stmt_prop
+         exec_lblstmts_prop
+         eval_funcall_prop
+
+         transl_Econst_int_correct
+         transl_Econst_float_correct
+         transl_Elvalue_correct
+         transl_Eaddrof_correct
+         transl_Esizeof_correct
+         transl_Eunop_correct
+         transl_Ebinop_correct
+         transl_Eorbool_1_correct
+         transl_Eorbool_2_correct
+         transl_Eandbool_1_correct
+         transl_Eandbool_2_correct
+         transl_Ecast_correct
+         transl_Ecall_correct
+         transl_Evar_local_correct
+         transl_Evar_global_correct
+         transl_Ederef_correct
+         transl_Eindex_correct
+         transl_Efield_struct_correct
+         transl_Efield_union_correct
+         transl_Enil_correct
+         transl_Econs_correct
+         transl_Sskip_correct
+         transl_Sexpr_correct
+         transl_Sassign_correct
+         transl_Ssequence_1_correct
+         transl_Ssequence_2_correct
+         transl_Sifthenelse_true_correct
+         transl_Sifthenelse_false_correct
+         transl_Sreturn_none_correct
+         transl_Sreturn_some_correct
+         transl_Sbreak_correct
+         transl_Scontinue_correct
+         transl_Swhile_false_correct
+         transl_Swhile_stop_correct
+         transl_Swhile_loop_correct
+         transl_Sdowhile_false_correct
+         transl_Sdowhile_stop_correct
+         transl_Sdowhile_loop_correct
+         transl_Sfor_start_correct
+         transl_Sfor_false_correct
+         transl_Sfor_stop_correct
+         transl_Sfor_loop_correct
+         transl_Sswitch_correct
+         transl_LSdefault_correct
+         transl_LScase_fallthrough_correct
+         transl_LScase_stop_correct
+         transl_funcall_internal_correct
+         transl_funcall_external_correct).
+
+End CORRECTNESS.
+
+(** Semantic preservation for whole programs. *)
+
+Theorem transl_program_correct:
+  forall prog tprog t r,
+  transl_program prog = Some tprog ->
+  Ctyping.wt_program prog ->
+  Csem.exec_program prog t r ->
+  Csharpminor.exec_program tprog t r.
+Proof.
+  intros until r. intros TRANSL WT [b [f [m1 [FINDS [FINDF [TYP EVAL]]]]]].
+  inversion WT; subst.
+  
+  assert (type_of_fundef f = Tfunction Tnil (Tint I32 Signed)).
+    apply wt_program_main.
+    change (Csyntax.prog_funct prog)
+      with (AST.prog_funct (Csyntax.program_of_program prog)).
+    eapply Genv.find_funct_ptr_symbol_inversion; eauto. 
+  exploit function_ptr_translated; eauto. intros [tf [TFINDF TRANSLFD]].
+  exists b; exists tf; exists m1.
+  split. 
+    rewrite (symbols_preserved _ _ TRANSL).
+    monadInv TRANSL. rewrite <- H1. simpl. auto.
+  split. auto.
+  split. 
+    generalize (transl_fundef_sig2 _ _ _ _ TRANSLFD H). simpl; auto.
+  rewrite (@Genv.init_mem_transf_partial _ _ transl_fundef 
+             (Csyntax.program_of_program prog)
+             (Csharpminor.program_of_program tprog)).
+  generalize (transl_funcall_correct _ _ WT TRANSL _ _ _ _ _ _ EVAL).
+  intro. eapply H0. 
+  eapply function_ptr_well_typed; eauto.
+  auto.
+  apply transform_program_of_program; auto.
+Qed.
diff --git a/cfrontend/Csyntax.v b/cfrontend/Csyntax.v
new file mode 100644
index 0000000..d3bd8d6
--- /dev/null
+++ b/cfrontend/Csyntax.v
@@ -0,0 +1,456 @@
+(** * Abstract syntax for the Clight language *)
+
+Require Import Coqlib.
+Require Import Integers.
+Require Import Floats.
+Require Import AST.
+
+(** ** Abstract syntax *)
+
+(** Types *)
+
+Inductive signedness : Set :=
+  | Signed: signedness
+  | Unsigned: signedness.
+
+Inductive intsize : Set :=
+  | I8: intsize
+  | I16: intsize
+  | I32: intsize.
+
+Inductive floatsize : Set :=
+  | F32: floatsize
+  | F64: floatsize.
+
+Inductive type : Set :=
+  | Tvoid: type
+  | Tint: intsize -> signedness -> type
+  | Tfloat: floatsize -> type
+  | Tpointer: type -> type
+  | Tarray: type -> Z -> type
+  | Tfunction: typelist -> type -> type
+  | Tstruct: fieldlist -> type
+  | Tunion: fieldlist -> type
+
+with typelist : Set :=
+  | Tnil: typelist
+  | Tcons: type -> typelist -> typelist
+
+with fieldlist : Set :=
+  | Fnil: fieldlist
+  | Fcons: ident -> type -> fieldlist -> fieldlist.
+
+(** Arithmetic and logical operators *)
+
+Inductive unary_operation : Set :=
+  | Onotbool : unary_operation
+  | Onotint : unary_operation
+  | Oneg : unary_operation.
+
+Inductive binary_operation : Set :=
+  | Oadd : binary_operation
+  | Osub : binary_operation
+  | Omul : binary_operation
+  | Odiv : binary_operation
+  | Omod : binary_operation
+  | Oand : binary_operation
+  | Oor : binary_operation
+  | Oxor : binary_operation
+  | Oshl : binary_operation
+  | Oshr : binary_operation
+  | Oeq: binary_operation
+  | One: binary_operation
+  | Olt: binary_operation
+  | Ogt: binary_operation
+  | Ole: binary_operation
+  | Oge: binary_operation.
+
+(** Expressions *)
+
+Inductive expr : Set :=
+  | Expr: expr_descr -> type -> expr
+
+with expr_descr : Set :=
+  | Econst_int: int -> expr_descr
+  | Econst_float: float -> expr_descr
+  | Evar: ident -> expr_descr
+  | Ederef: expr -> expr_descr
+  | Eaddrof: expr -> expr_descr
+  | Eunop: unary_operation -> expr -> expr_descr
+  | Ebinop: binary_operation -> expr -> expr -> expr_descr
+  | Ecast: type -> expr -> expr_descr
+  | Eindex: expr -> expr -> expr_descr 
+  | Ecall: expr -> exprlist -> expr_descr 
+  | Eandbool: expr -> expr -> expr_descr
+  | Eorbool: expr -> expr -> expr_descr
+  | Esizeof: type -> expr_descr
+  | Efield: expr -> ident -> expr_descr
+
+with exprlist : Set :=
+  | Enil: exprlist
+  | Econs: expr -> exprlist -> exprlist.
+
+(** Extract the type part of a type-annotated Clight expression. *)
+
+Definition typeof (e: expr) : type :=
+  match e with Expr de te => te end.
+
+(** Statements *)
+
+Inductive statement : Set :=
+  | Sskip : statement
+  | Sexpr : expr -> statement
+  | Sassign : expr -> expr -> statement
+  | Ssequence : statement -> statement -> statement
+  | Sifthenelse : expr  -> statement -> statement -> statement
+  | Swhile : expr -> statement -> statement
+  | Sdowhile : expr -> statement -> statement
+  | Sfor: statement -> expr -> statement -> statement -> statement
+  | Sbreak : statement
+  | Scontinue : statement
+  | Sreturn : option expr -> statement
+  | Sswitch : expr -> labeled_statements -> statement
+
+with labeled_statements : Set :=
+  | LSdefault: statement -> labeled_statements
+  | LScase: int -> statement -> labeled_statements -> labeled_statements.
+
+(** Function definition *)
+
+Record function : Set := mkfunction {
+  fn_return: type;
+  fn_params: list (ident * type);
+  fn_vars: list (ident * type);
+  fn_body: statement
+}.
+
+Inductive fundef : Set :=
+  | Internal: function -> fundef
+  | External: ident -> typelist -> type -> fundef.
+
+(** Program *)
+
+Record program : Set := mkprogram {
+    prog_funct: list (ident * fundef);
+    prog_defs: list (ident * type * list init_data);
+    prog_main: ident
+}.
+
+(** ** Operations over types *)
+
+(** The type of a function definition *)
+
+Fixpoint type_of_params (params: list (ident * type)) : typelist :=
+  match params with
+  | nil => Tnil
+  | (id, ty) :: rem => Tcons ty (type_of_params rem)
+  end.
+
+Definition type_of_function (f: function) : type :=
+  Tfunction (type_of_params (fn_params f)) (fn_return f).
+
+Definition type_of_fundef (f: fundef) : type :=
+  match f with
+  | Internal fd => type_of_function fd
+  | External id args res => Tfunction args res
+  end.
+
+(** Natural alignment of a type *)
+
+Fixpoint alignof (t: type) : Z :=
+  match t with
+  | Tvoid => 1
+  | Tint I8 _ => 1
+  | Tint I16 _ => 2
+  | Tint I32 _ => 4
+  | Tfloat F32 => 4
+  | Tfloat F64 => 8
+  | Tpointer _ => 4
+  | Tarray t' n => alignof t'
+  | Tfunction _ _ => 1
+  | Tstruct fld => alignof_fields fld
+  | Tunion fld => alignof_fields fld
+  end
+
+with alignof_fields (f: fieldlist) : Z :=
+  match f with
+  | Fnil => 1
+  | Fcons id t f' => Zmax (alignof t) (alignof_fields f')
+  end.
+
+Scheme type_ind2 := Induction for type Sort Prop
+  with fieldlist_ind2 := Induction for fieldlist Sort Prop.
+
+Lemma alignof_fields_pos:
+  forall f, alignof_fields f > 0.
+Proof.
+  induction f; simpl.
+  omega.
+  generalize (Zmax2 (alignof t) (alignof_fields f)). omega.
+Qed.
+
+Lemma alignof_pos:
+  forall t, alignof t > 0.
+Proof.
+  induction t; simpl; auto; try omega.
+  destruct i; omega.
+  destruct f; omega.
+  apply alignof_fields_pos.
+  apply alignof_fields_pos.
+Qed.
+
+(** Size of a type (in bytes) *)
+
+Fixpoint sizeof (t: type) : Z :=
+  match t with
+  | Tvoid => 1
+  | Tint I8 _ => 1
+  | Tint I16 _ => 2
+  | Tint I32 _ => 4
+  | Tfloat F32 => 4
+  | Tfloat F64 => 8
+  | Tpointer _ => 4
+  | Tarray t' n => sizeof t' * Zmax 1 n
+  | Tfunction _ _ => 1
+  | Tstruct fld => align (Zmax 1 (sizeof_struct fld 0)) (alignof t)
+  | Tunion fld => align (Zmax 1 (sizeof_union fld)) (alignof t)
+  end
+
+with sizeof_struct (fld: fieldlist) (pos: Z) {struct fld} : Z :=
+  match fld with
+  | Fnil => pos
+  | Fcons id t fld' => sizeof_struct fld' (align pos (alignof t) + sizeof t)
+  end
+
+with sizeof_union (fld: fieldlist) : Z :=
+  match fld with
+  | Fnil => 0
+  | Fcons id t fld' => Zmax (sizeof t) (sizeof_union fld')
+  end.
+
+Lemma sizeof_pos:
+  forall t, sizeof t > 0.
+Proof.
+  intro t0.
+  apply (type_ind2 (fun t => sizeof t > 0)
+                   (fun f => sizeof_union f >= 0 /\ forall pos, pos >= 0 -> sizeof_struct f pos >= 0));
+  intros; simpl; auto; try omega.
+  destruct i; omega.
+  destruct f; omega.
+  apply Zmult_gt_0_compat. auto. generalize (Zmax1 1 z); omega.
+  destruct H. 
+  generalize (align_le (Zmax 1 (sizeof_struct f 0)) (alignof_fields f) (alignof_fields_pos f)). 
+  generalize (Zmax1 1 (sizeof_struct f 0)). omega. 
+  generalize (align_le (Zmax 1 (sizeof_union f)) (alignof_fields f) (alignof_fields_pos f)). 
+  generalize (Zmax1 1 (sizeof_union f)). omega. 
+  split. omega. auto.
+  destruct H0. split; intros.
+  generalize (Zmax2 (sizeof t) (sizeof_union f)). omega.
+  apply H1. 
+  generalize (align_le pos (alignof t) (alignof_pos t)). omega.
+Qed.
+
+(** Byte offset for a field in a struct. *)
+
+Fixpoint field_offset_rec (id: ident) (fld: fieldlist) (pos: Z)
+                              {struct fld} : option Z :=
+  match fld with
+  | Fnil => None
+  | Fcons id' t fld' =>
+      if ident_eq id id'
+      then Some (align pos (alignof t))
+      else field_offset_rec id fld' (align pos (alignof t) + sizeof t)
+  end.
+
+Definition field_offset (id: ident) (fld: fieldlist) : option Z :=
+  field_offset_rec id fld 0.
+
+(* Describe how a variable of the given type must be accessed:
+     - by value, i.e. by loading from the address of the variable
+       with the given chunk
+     - by reference, i.e. by just returning the address of the variable
+     - not at all, e.g. the [void] type. *)
+
+Inductive mode: Set :=
+  | By_value: memory_chunk -> mode
+  | By_reference: mode
+  | By_nothing: mode.
+
+Definition access_mode (ty: type) : mode :=
+  match ty with
+  | Tint I8 Signed => By_value Mint8signed
+  | Tint I8 Unsigned => By_value Mint8unsigned
+  | Tint I16 Signed => By_value Mint16signed
+  | Tint I16 Unsigned => By_value Mint16unsigned
+  | Tint I32 _ => By_value Mint32
+  | Tfloat F32 => By_value Mfloat32
+  | Tfloat F64 => By_value Mfloat64
+  | Tvoid => By_nothing
+  | Tpointer _ => By_value Mint32
+  | Tarray _ _ => By_reference
+  | Tfunction _ _ => By_reference
+  | Tstruct fList => By_nothing
+  | Tunion fList => By_nothing
+end.
+
+(** Conversion of a Clight program into an AST program *)
+
+Definition extract_global_var (id_ty_init: ident * type * list init_data) :=
+  match id_ty_init with (id, ty, init) => (id, init) end.
+
+Definition program_of_program (p: program) : AST.program fundef :=
+  AST.mkprogram
+    p.(prog_funct)
+    p.(prog_main)
+    (List.map extract_global_var p.(prog_defs)).
+
+(** Classification of arithmetic operations and comparisons *)
+
+Inductive classify_add_cases : Set :=
+  | add_case_ii: classify_add_cases         (* int , int *)
+  | add_case_ff: classify_add_cases         (* float , float *)
+  | add_case_pi: type -> classify_add_cases (* ptr | array, int *)
+  | add_default: classify_add_cases.        (* other *)
+
+Definition classify_add (ty1: type) (ty2: type) :=
+  match ty1, ty2 with
+  | Tint _ _, Tint _ _ => add_case_ii
+  | Tfloat _, Tfloat _ => add_case_ff
+  | Tpointer ty, Tint _ _ => add_case_pi ty
+  | Tarray ty _, Tint _ _ => add_case_pi ty 
+  | _, _ => add_default
+  end.
+
+Inductive classify_sub_cases : Set :=
+  | sub_case_ii: classify_sub_cases          (* int , int *)
+  | sub_case_ff: classify_sub_cases          (* float , float *)
+  | sub_case_pi: type -> classify_sub_cases  (* ptr | array , int *)
+  | sub_case_pp: type -> classify_sub_cases  (* ptr | array , ptr | array *)
+  | sub_default: classify_sub_cases .        (* other *)
+
+Definition classify_sub (ty1: type) (ty2: type) :=
+  match ty1, ty2 with
+  | Tint _ _ , Tint _ _ => sub_case_ii
+  | Tfloat _ , Tfloat _ => sub_case_ff
+  | Tpointer ty , Tint _ _ => sub_case_pi ty
+  | Tarray ty _ , Tint _ _ => sub_case_pi ty
+  | Tpointer ty , Tpointer _ => sub_case_pp ty
+  | Tpointer ty , Tarray _ _=> sub_case_pp ty
+  | Tarray ty _ , Tpointer _ => sub_case_pp ty
+  | Tarray ty _ , Tarray _ _ => sub_case_pp ty 
+  | _ ,_ => sub_default
+  end.
+
+Inductive classify_mul_cases : Set:=
+  | mul_case_ii: classify_mul_cases (* int , int *)
+  | mul_case_ff: classify_mul_cases (* float , float *)
+  | mul_default: classify_mul_cases . (* other *)
+
+Definition classify_mul (ty1: type) (ty2: type) :=
+  match ty1,ty2 with
+  | Tint _ _, Tint _ _ => mul_case_ii
+  | Tfloat _ , Tfloat _ => mul_case_ff
+  | _,_  => mul_default
+end.
+
+Inductive classify_div_cases : Set:=
+  | div_case_I32unsi: classify_div_cases (* uns int32 , int *)
+  | div_case_ii: classify_div_cases    (* int , int *) 
+  | div_case_ff: classify_div_cases    (* float , float *)
+  | div_default: classify_div_cases. (* other *)
+
+Definition classify_div (ty1: type) (ty2: type) :=
+  match ty1,ty2 with 
+  | Tint I32 Unsigned, Tint _ _ => div_case_I32unsi 
+  | Tint _ _ , Tint I32 Unsigned => div_case_I32unsi 
+  | Tint _ _ , Tint _ _ => div_case_ii 
+  | Tfloat _ , Tfloat _ => div_case_ff 
+  | _ ,_ => div_default 
+end.
+
+Inductive classify_mod_cases : Set:=
+  | mod_case_I32unsi: classify_mod_cases  (* uns I32 , int *)
+  | mod_case_ii: classify_mod_cases  (* int , int *)
+  | mod_default: classify_mod_cases . (* other *)
+
+Definition classify_mod (ty1: type) (ty2: type) :=
+  match ty1,ty2 with
+  | Tint I32 Unsigned , Tint _ _ => mod_case_I32unsi 
+  | Tint _ _ , Tint I32 Unsigned => mod_case_I32unsi 
+  | Tint _ _ , Tint _ _ => mod_case_ii 
+  | _ , _ => mod_default 
+end .
+
+Inductive classify_shr_cases :Set:=
+  | shr_case_I32unsi:  classify_shr_cases (* uns I32 , int *)
+  | shr_case_ii :classify_shr_cases (* int , int *)
+  | shr_default : classify_shr_cases . (* other *)
+
+Definition classify_shr (ty1: type) (ty2: type) :=
+  match ty1,ty2 with
+  | Tint I32 Unsigned , Tint _ _ => shr_case_I32unsi
+  | Tint _ _ , Tint _ _ => shr_case_ii
+  | _ , _ => shr_default 
+  end.
+
+Inductive classify_cmp_cases : Set:=
+  | cmp_case_I32unsi: classify_cmp_cases (* uns I32 , int *)
+  | cmp_case_ii: classify_cmp_cases  (* int , int*)
+  | cmp_case_ff: classify_cmp_cases  (* float , float *)
+  | cmp_case_pi: classify_cmp_cases  (* ptr | array , int *)
+  | cmp_case_pp:classify_cmp_cases   (* ptr | array , ptr | array *)
+  | cmp_default: classify_cmp_cases . (* other *)
+
+Definition classify_cmp (ty1: type) (ty2: type) :=
+  match ty1,ty2 with 
+  | Tint I32 Unsigned , Tint _ _ => cmp_case_I32unsi 
+  | Tint _ _ , Tint I32 Unsigned => cmp_case_I32unsi 
+  | Tint _ _ , Tint _ _ => cmp_case_ii 
+  | Tfloat _ , Tfloat _ => cmp_case_ff
+  | Tpointer _ , Tint _ _ => cmp_case_pi 
+  | Tarray _ _ , Tint _ _ => cmp_case_pi 
+  | Tpointer _ , Tpointer _ => cmp_case_pp
+  | Tpointer _ , Tarray _ _ => cmp_case_pp
+  | Tarray _ _ ,Tpointer _ => cmp_case_pp
+  | Tarray _ _ ,Tarray _ _ => cmp_case_pp
+  | _ , _ => cmp_default
+  end.
+
+Inductive classify_fun_cases : Set:=
+  | fun_case_f: typelist -> type -> classify_fun_cases   (* type fun | ptr fun*)
+  | fun_default: classify_fun_cases . (* other *)
+
+Definition classify_fun (ty: type) :=
+  match ty with 
+  | Tfunction args res => fun_case_f args res
+  | Tpointer (Tfunction args res) => fun_case_f args res
+  | _ => fun_default
+  end.
+
+(** Mapping between Clight types and Cminor types and external functions *)
+
+Definition typ_of_type (t: type) : AST.typ :=
+  match t with
+  | Tfloat _ => AST.Tfloat
+  | _ => AST.Tint
+  end.
+
+Definition opttyp_of_type (t: type) : option AST.typ :=
+  match t with
+  | Tvoid => None
+  | Tfloat _ => Some AST.Tfloat
+  | _ => Some AST.Tint
+  end.
+
+Fixpoint typlist_of_typelist (tl: typelist) : list AST.typ :=
+  match tl with
+  | Tnil => nil
+  | Tcons hd tl => typ_of_type hd :: typlist_of_typelist tl
+  end.
+
+Definition signature_of_type (args: typelist) (res: type) : signature :=
+  mksignature (typlist_of_typelist args) (opttyp_of_type res).
+
+Definition external_function
+    (id: ident) (targs: typelist) (tres: type) : AST.external_function :=
+  mkextfun id (signature_of_type targs tres).
diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v
new file mode 100644
index 0000000..8b2f90f
--- /dev/null
+++ b/cfrontend/Ctyping.v
@@ -0,0 +1,420 @@
+(** * Type well-formedness of C programs *)
+
+Require Import Coqlib.
+Require Import Maps.
+Require Import AST.
+Require Import Csyntax.
+
+(** ** Typing rules *)
+
+(** This ``type system'' is very coarse: we check only the typing properties
+  that matter for the translation to be correct.  Essentially,
+  we need to check that the types attached to variable references
+  match the declaration types for those variables. *)
+
+Definition typenv := PTree.t type.
+
+Section TYPING.
+
+Variable env: typenv.
+
+Inductive wt_expr: expr -> Prop :=
+  | wt_Econst_int: forall i ty,
+     wt_expr (Expr (Econst_int i) ty)
+  | wt_Econst_float: forall f ty,
+     wt_expr (Expr (Econst_float f) ty)
+  | wt_Evar: forall id ty,
+     env!id = Some ty ->
+     wt_expr (Expr (Evar id) ty)
+  | wt_Ederef: forall e ty,
+     wt_expr e ->
+     wt_expr (Expr (Ederef e) ty)
+  | wt_Eaddrof: forall e ty,
+     wt_expr e ->
+     wt_expr (Expr (Eaddrof e) ty)
+  | wt_Eunop: forall op e ty,
+     wt_expr e ->
+     wt_expr (Expr (Eunop op e) ty)
+  | wt_Ebinop: forall op e1 e2 ty,
+     wt_expr e1 -> wt_expr e2 ->
+     wt_expr (Expr (Ebinop op e1 e2) ty)
+  | wt_Ecast: forall e ty ty',
+     wt_expr e ->
+     wt_expr (Expr (Ecast ty' e) ty)
+  | wt_Eindex: forall e1 e2 ty,
+     wt_expr e1 -> wt_expr e2 ->
+     wt_expr (Expr (Eindex e1 e2) ty)
+  | wt_Ecall: forall e1 el ty,
+     wt_expr e1 ->
+     wt_exprlist el ->
+     wt_expr (Expr (Ecall e1 el) ty)
+  | wt_Eandbool: forall e1 e2 ty,
+     wt_expr e1 -> wt_expr e2 ->
+     wt_expr (Expr (Eandbool e1 e2) ty)
+  | wt_Eorbool: forall e1 e2 ty,
+     wt_expr e1 -> wt_expr e2 ->
+     wt_expr (Expr (Eorbool e1 e2) ty)
+  | wt_Esizeof: forall ty' ty,
+     wt_expr (Expr (Esizeof ty') ty)
+  | wt_Efield: forall e id ty,
+     wt_expr e ->
+     wt_expr (Expr (Efield e id) ty)
+
+with wt_exprlist: exprlist -> Prop :=
+  | wt_Enil:
+     wt_exprlist Enil
+  | wt_Econs: forall e el,
+     wt_expr e -> wt_exprlist el -> wt_exprlist (Econs e el).
+
+Inductive wt_stmt: statement -> Prop :=
+  | wt_Sskip:
+     wt_stmt Sskip
+  | wt_Sexpr: forall e,
+     wt_expr e ->
+     wt_stmt (Sexpr e)
+  | wt_Sassign: forall e1 e2,
+     wt_expr e1 -> wt_expr e2 ->
+     wt_stmt (Sassign e1 e2)
+  | wt_Ssequence: forall s1 s2,
+     wt_stmt s1 -> wt_stmt s2 ->
+     wt_stmt (Ssequence s1 s2)
+  | wt_Sifthenelse: forall e s1 s2,
+     wt_expr e -> wt_stmt s1 -> wt_stmt s2 ->
+     wt_stmt (Sifthenelse e s1 s2)
+  | wt_Swhile: forall e s,
+     wt_expr e -> wt_stmt s ->
+     wt_stmt (Swhile e s)
+  | wt_Sdowhile: forall e s,
+     wt_expr e -> wt_stmt s ->
+     wt_stmt (Sdowhile e s)
+  | wt_Sfor: forall e s1 s2 s3,
+     wt_expr e -> wt_stmt s1 -> wt_stmt s2 -> wt_stmt s3 ->
+     wt_stmt (Sfor s1 e s2 s3)
+  | wt_Sbreak:
+     wt_stmt Sbreak
+  | wt_Scontinue:
+     wt_stmt Scontinue
+  | wt_Sreturn_some: forall e,
+     wt_expr e ->
+     wt_stmt (Sreturn (Some e))
+  | wt_Sreturn_none:
+     wt_stmt (Sreturn None)
+  | wt_Sswitch: forall e sl,
+     wt_expr e -> wt_lblstmts sl ->
+     wt_stmt (Sswitch e sl)
+
+with wt_lblstmts: labeled_statements -> Prop :=
+  | wt_LSdefault: forall s,
+     wt_stmt s ->
+     wt_lblstmts (LSdefault s)
+  | wt_LScase: forall n s sl,
+     wt_stmt s -> wt_lblstmts sl ->
+     wt_lblstmts (LScase n s sl).
+
+End TYPING.
+
+Definition add_var (env: typenv) (id_ty: ident * type) : typenv :=
+  PTree.set (fst id_ty) (snd id_ty) env.
+
+Definition add_vars (env: typenv) (vars: list(ident * type)) : typenv :=
+  List.fold_left add_var vars env.
+
+Definition var_names (vars: list(ident * type)) : list ident :=
+  List.map (@fst ident type) vars.
+
+Inductive wt_function: typenv -> function -> Prop :=
+  | wt_function_intro: forall env f,
+      list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
+      wt_stmt (add_vars env (f.(fn_params) ++ f.(fn_vars))) f.(fn_body) ->
+      wt_function env f.
+
+Inductive wt_fundef: typenv -> fundef -> Prop :=
+  | wt_fundef_Internal: forall env f,
+      wt_function env f ->
+      wt_fundef env (Internal f)
+  | wt_fundef_External: forall env id args res,
+      wt_fundef env (External id args res).
+
+Definition add_global_var
+     (env: typenv) (id_ty_init: ident * type * list init_data) : typenv :=
+  match id_ty_init with (id, ty, init) => PTree.set id ty env end.
+
+Definition add_global_vars
+     (env: typenv) (vars: list(ident * type * list init_data)) : typenv :=
+  List.fold_left add_global_var vars env.
+
+Definition add_global_fun
+     (env: typenv) (id_fd: ident * fundef) : typenv :=
+  PTree.set (fst id_fd) (type_of_fundef (snd id_fd)) env.
+
+Definition add_global_funs
+     (env: typenv) (funs: list(ident * fundef)) : typenv :=
+  List.fold_left add_global_fun funs env.
+
+Definition global_typenv (p: program) :=
+  add_global_vars (add_global_funs (PTree.empty type) p.(prog_funct)) p.(prog_defs).
+
+Record wt_program (p: program) : Prop :=  mk_wt_program {
+  wt_program_funct:
+    forall id fd,
+    In (id, fd) p.(prog_funct) ->
+    wt_fundef (global_typenv p) fd;
+  wt_program_main:
+    forall fd,
+    In (p.(prog_main), fd) p.(prog_funct) ->
+    type_of_fundef fd = Tfunction Tnil (Tint I32 Signed)
+}.
+
+(** ** Type-checking algorithm *)
+
+Lemma eq_signedness: forall (s1 s2: signedness), {s1=s2} + {s1<>s2}.
+Proof. decide equality. Qed.
+
+Lemma eq_intsize: forall (s1 s2: intsize), {s1=s2} + {s1<>s2}.
+Proof. decide equality. Qed.
+
+Lemma eq_floatsize: forall (s1 s2: floatsize), {s1=s2} + {s1<>s2}.
+Proof. decide equality. Qed.
+
+Fixpoint eq_type (t1 t2: type) {struct t1}: bool :=
+  match t1, t2 with
+  | Tvoid, Tvoid => true
+  | Tint sz1 sg1, Tint sz2 sg2 =>
+      if eq_intsize sz1 sz2
+      then if eq_signedness sg1 sg2 then true else false
+      else false
+  | Tfloat sz1, Tfloat sz2 =>
+      if eq_floatsize sz1 sz2 then true else false
+  | Tpointer u1, Tpointer u2 => eq_type u1 u2
+  | Tarray u1 sz1, Tarray u2 sz2 =>
+      eq_type u1 u2 && if zeq sz1 sz2 then true else false
+  | Tfunction args1 res1, Tfunction args2 res2 =>
+      eq_typelist args1 args2 && eq_type res1 res2
+  | Tstruct f1, Tstruct f2 => eq_fieldlist f1 f2
+  | Tunion f1, Tunion f2 => eq_fieldlist f1 f2
+  | _, _ => false
+  end
+
+with eq_typelist (t1 t2: typelist) {struct t1} : bool :=
+  match t1, t2 with
+  | Tnil, Tnil => true
+  | Tcons u1 r1, Tcons u2 r2 => eq_type u1 u2 && eq_typelist r1 r2
+  | _, _ => false
+  end
+
+with eq_fieldlist (f1 f2: fieldlist) {struct f1} : bool :=
+  match f1, f2 with
+  | Fnil, Fnil => true
+  | Fcons id1 t1 r1, Fcons id2 t2 r2 =>
+      if ident_eq id1 id2
+      then eq_type t1 t2 && eq_fieldlist r1 r2
+      else false
+  | _, _ => false
+  end.
+
+Ltac TrueInv :=
+  match goal with
+  | [ H: ((if ?x then ?y else false) = true) |- _ ] =>
+        destruct x; [TrueInv | discriminate]
+  | [ H: (?x && ?y = true) |- _ ] =>
+        elim (andb_prop _ _ H); clear H; intros; TrueInv
+  | _ =>
+        idtac
+  end.
+
+Scheme type_ind_3 := Induction for type Sort Prop
+  with typelist_ind_3 := Induction for typelist Sort Prop
+  with fieldlist_ind_3 := Induction for fieldlist Sort Prop.
+
+Lemma eq_type_correct:
+  forall t1 t2, eq_type t1 t2 = true -> t1 = t2.
+Proof.
+  apply (type_ind_3 (fun t1 => forall t2, eq_type t1 t2 = true -> t1 = t2)
+                    (fun t1 => forall t2, eq_typelist t1 t2 = true -> t1 = t2)
+                    (fun t1 => forall t2, eq_fieldlist t1 t2 = true -> t1 = t2));
+  intros; destruct t2; simpl in *; try discriminate.
+  auto.
+  TrueInv. congruence.
+  TrueInv. congruence.
+  decEq; auto.
+  TrueInv. decEq; auto.
+  TrueInv. decEq; auto.
+  decEq; auto.
+  decEq; auto.
+  auto.
+  TrueInv. decEq; auto.
+  auto.
+  TrueInv. decEq; auto.
+Qed.
+
+Section TYPECHECKING.
+
+Variable env: typenv.
+
+Fixpoint typecheck_expr (a: Csyntax.expr) {struct a} : bool :=
+  match a with
+  | Expr ad aty => typecheck_exprdescr ad aty
+  end
+
+with typecheck_exprdescr (a: Csyntax.expr_descr) (ty: type) {struct a} : bool :=
+  match a with
+  | Csyntax.Econst_int n => true
+  | Csyntax.Econst_float n => true
+  | Csyntax.Evar id =>
+      match env!id with
+      | None => false
+      | Some ty' => eq_type ty ty'
+      end
+  | Csyntax.Ederef b => typecheck_expr b
+  | Csyntax.Eaddrof b => typecheck_expr b
+  | Csyntax.Eunop op b => typecheck_expr b
+  | Csyntax.Ebinop op b c => typecheck_expr b && typecheck_expr c
+  | Csyntax.Ecast ty b => typecheck_expr b
+  | Csyntax.Eindex b c => typecheck_expr b && typecheck_expr c
+  | Csyntax.Ecall b cl => typecheck_expr b && typecheck_exprlist cl
+  | Csyntax.Eandbool b c => typecheck_expr b && typecheck_expr c
+  | Csyntax.Eorbool b c => typecheck_expr b && typecheck_expr c
+  | Csyntax.Esizeof ty => true
+  | Csyntax.Efield b i => typecheck_expr b
+  end
+
+with typecheck_exprlist (al: Csyntax.exprlist): bool :=
+  match al with
+  | Csyntax.Enil => true
+  | Csyntax.Econs a1 a2 => typecheck_expr a1 && typecheck_exprlist a2
+  end.
+
+Scheme expr_ind_3 := Induction for expr Sort Prop
+  with expr_descr_ind_3 := Induction for expr_descr Sort Prop
+  with exprlist_ind_3 := Induction for exprlist Sort Prop.
+
+Lemma typecheck_expr_correct:
+  forall a, typecheck_expr a = true -> wt_expr env a.
+Proof.
+  apply (expr_ind_3 (fun a => typecheck_expr a = true -> wt_expr env a)
+                    (fun a => forall ty, typecheck_exprdescr a ty = true -> wt_expr env (Expr a ty))
+                    (fun a => typecheck_exprlist a = true -> wt_exprlist env a));
+  simpl; intros; TrueInv.
+  auto.
+  constructor.
+  constructor.
+  constructor. destruct (env!i). decEq; symmetry; apply eq_type_correct; auto.
+  discriminate.
+  constructor; auto.
+  constructor; auto.
+  constructor; auto.
+  constructor; auto.
+  constructor; auto.
+  constructor; auto.
+  constructor; auto.
+  constructor; auto.
+  constructor; auto.
+  auto.
+  constructor; auto.
+  constructor; auto.
+  constructor.
+  constructor; auto.
+Qed.
+
+Lemma typecheck_exprlist_correct:
+  forall a, typecheck_exprlist a = true -> wt_exprlist env a.
+Proof.
+  induction a; simpl; intros.
+  constructor.
+  TrueInv. constructor; auto. apply typecheck_expr_correct; auto.
+Qed.
+
+Fixpoint typecheck_stmt (s: Csyntax.statement) {struct s} : bool :=
+  match s with
+  | Csyntax.Sskip => true
+  | Csyntax.Sexpr e => typecheck_expr e
+  | Csyntax.Sassign b c => typecheck_expr b && typecheck_expr c
+  | Csyntax.Ssequence s1 s2 => typecheck_stmt s1 && typecheck_stmt s2
+  | Csyntax.Sifthenelse e s1 s2 =>
+      typecheck_expr e && typecheck_stmt s1 && typecheck_stmt s2
+  | Csyntax.Swhile e s1 => typecheck_expr e && typecheck_stmt s1
+  | Csyntax.Sdowhile e s1 => typecheck_expr e && typecheck_stmt s1
+  | Csyntax.Sfor e1 e2 e3 s1 =>
+      typecheck_stmt e1 && typecheck_expr e2 &&
+      typecheck_stmt e3 && typecheck_stmt s1
+  | Csyntax.Sbreak => true
+  | Csyntax.Scontinue => true
+  | Csyntax.Sreturn (Some e) => typecheck_expr e
+  | Csyntax.Sreturn None => true
+  | Csyntax.Sswitch e sl => typecheck_expr e && typecheck_lblstmts sl
+  end    
+
+with typecheck_lblstmts (sl: labeled_statements) {struct sl}: bool :=
+  match sl with
+  | LSdefault s => typecheck_stmt s
+  | LScase _ s rem => typecheck_stmt s && typecheck_lblstmts rem
+  end.
+
+Scheme stmt_ind_2 := Induction for statement Sort Prop
+  with lblstmts_ind_2 := Induction for labeled_statements Sort Prop.
+
+Lemma typecheck_stmt_correct:
+  forall s, typecheck_stmt s = true -> wt_stmt env s.
+Proof.
+  generalize typecheck_expr_correct; intro.
+  apply (stmt_ind_2 (fun s => typecheck_stmt s = true -> wt_stmt env s)
+                    (fun s => typecheck_lblstmts s = true -> wt_lblstmts env s));
+  simpl; intros; TrueInv; try constructor; auto.
+  destruct o; constructor; auto.
+Qed.
+
+End TYPECHECKING.
+
+Definition typecheck_function (env: typenv) (f: function) : bool :=
+  if list_norepet_dec ident_eq
+                      (var_names f.(fn_params) ++ var_names f.(fn_vars))
+  then typecheck_stmt (add_vars env (f.(fn_params) ++ f.(fn_vars)))
+                      f.(fn_body)
+  else false.
+
+Lemma typecheck_function_correct:
+  forall env f, typecheck_function env f = true -> wt_function env f.
+Proof.
+  unfold typecheck_function; intros; TrueInv.
+  constructor. auto. apply typecheck_stmt_correct; auto.
+Qed.
+
+Definition typecheck_fundef (main: ident) (env: typenv) (id_fd: ident * fundef) : bool :=
+  let (id, fd) := id_fd in
+  match fd with
+  | Internal f => typecheck_function env f
+  | External _ _ _ => true
+  end &&
+  if ident_eq id main
+  then eq_type (type_of_fundef fd) (Tfunction Tnil (Tint I32 Signed))
+  else true.
+
+Lemma typecheck_fundef_correct:
+  forall main env id fd,
+  typecheck_fundef main env (id, fd) = true ->
+  wt_fundef env fd /\
+  (id = main -> type_of_fundef fd = Tfunction Tnil (Tint I32 Signed)).
+Proof.
+  intros. unfold typecheck_fundef in H; TrueInv.
+  split. 
+    destruct fd.
+    constructor. apply typecheck_function_correct; auto. 
+    constructor.
+  intro. destruct (ident_eq id main). 
+  apply eq_type_correct; auto.
+  congruence.
+Qed.
+
+Definition typecheck_program (p: program) : bool :=
+  List.forallb (typecheck_fundef p.(prog_main) (global_typenv p))
+               p.(prog_funct).
+
+Lemma typecheck_program_correct:
+  forall p, typecheck_program p = true -> wt_program p.
+Proof.
+  unfold typecheck_program; intros. 
+  rewrite List.forallb_forall in H. 
+  constructor; intros.
+  exploit typecheck_fundef_correct; eauto. tauto. 
+  exploit typecheck_fundef_correct; eauto. tauto. 
+Qed.
diff --git a/extraction/.depend b/extraction/.depend
index 9d6895d..20f0876 100644
--- a/extraction/.depend
+++ b/extraction/.depend
@@ -1,14 +1,9 @@
-../caml/Allocationaux.cmi: Locations.cmi Datatypes.cmi 
 ../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/Allocationaux.cmo: Locations.cmi Datatypes.cmi ../caml/Camlcoq.cmo \
-    CList.cmi AST.cmi ../caml/Allocationaux.cmi 
-../caml/Allocationaux.cmx: Locations.cmx Datatypes.cmx ../caml/Camlcoq.cmx \
-    CList.cmx AST.cmx ../caml/Allocationaux.cmi 
 ../caml/Camlcoq.cmo: Integers.cmi Datatypes.cmi CList.cmi BinPos.cmi \
     BinInt.cmi 
 ../caml/Camlcoq.cmx: Integers.cmx Datatypes.cmx CList.cmx BinPos.cmx \
@@ -17,24 +12,24 @@
     ../caml/CMlexer.cmi 
 ../caml/CMlexer.cmx: ../caml/Camlcoq.cmx ../caml/CMparser.cmx \
     ../caml/CMlexer.cmi 
-../caml/CMparser.cmo: Op.cmi Integers.cmi Datatypes.cmi Cminor.cmi \
+../caml/CMparser.cmo: Op.cmi Integers.cmi Int.cmi Datatypes.cmi Cminor.cmi \
     Cmconstr.cmi ../caml/Camlcoq.cmo CList.cmi BinPos.cmi BinInt.cmi AST.cmi \
     ../caml/CMparser.cmi 
-../caml/CMparser.cmx: Op.cmx Integers.cmx Datatypes.cmx Cminor.cmx \
+../caml/CMparser.cmx: Op.cmx Integers.cmx Int.cmx Datatypes.cmx Cminor.cmx \
     Cmconstr.cmx ../caml/Camlcoq.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx \
     ../caml/CMparser.cmi 
-../caml/CMtypecheck.cmo: Op.cmi Datatypes.cmi Cminor.cmi ../caml/Camlcoq.cmo \
-    CList.cmi AST.cmi ../caml/CMtypecheck.cmi 
-../caml/CMtypecheck.cmx: Op.cmx Datatypes.cmx Cminor.cmx ../caml/Camlcoq.cmx \
-    CList.cmx AST.cmx ../caml/CMtypecheck.cmi 
+../caml/CMtypecheck.cmo: Op.cmi Integers.cmi Datatypes.cmi Cminor.cmi \
+    ../caml/Camlcoq.cmo CList.cmi AST.cmi ../caml/CMtypecheck.cmi 
+../caml/CMtypecheck.cmx: Op.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/Floataux.cmo: ../caml/Camlcoq.cmo AST.cmi 
-../caml/Floataux.cmx: ../caml/Camlcoq.cmx AST.cmx 
+../caml/Floataux.cmo: Integers.cmi ../caml/Camlcoq.cmo 
+../caml/Floataux.cmx: Integers.cmx ../caml/Camlcoq.cmx 
 ../caml/Main2.cmo: ../caml/PrintPPC.cmi Main.cmi Datatypes.cmi \
     ../caml/CMtypecheck.cmi ../caml/CMparser.cmi ../caml/CMlexer.cmi 
 ../caml/Main2.cmx: ../caml/PrintPPC.cmx Main.cmx Datatypes.cmx \
@@ -45,18 +40,23 @@
     AST.cmx ../caml/PrintPPC.cmi 
 ../caml/RTLgenaux.cmo: Cminor.cmi 
 ../caml/RTLgenaux.cmx: Cminor.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 \
     Parallelmove.cmi Op.cmi Maps.cmi Locations.cmi LTL.cmi Datatypes.cmi \
     Conventions.cmi Coloring.cmi CList.cmi BinPos.cmi AST.cmi 
-AST.cmi: Specif.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi 
+AST.cmi: Specif.cmi Integers.cmi Floats.cmi Datatypes.cmi Coqlib.cmi \
+    CList.cmi BinPos.cmi BinInt.cmi 
 BinInt.cmi: Datatypes.cmi BinPos.cmi BinNat.cmi 
-BinNat.cmi: Datatypes.cmi BinPos.cmi 
+BinNat.cmi: Specif.cmi Datatypes.cmi BinPos.cmi 
 BinPos.cmi: Peano.cmi Datatypes.cmi 
 Bool.cmi: Specif.cmi Datatypes.cmi 
 CList.cmi: Specif.cmi Datatypes.cmi 
 Cmconstr.cmi: Specif.cmi Op.cmi Integers.cmi Datatypes.cmi Compare_dec.cmi \
     Cminor.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi 
-Cminorgen.cmi: Zmin.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
+Cminorgen.cmi: Zmax.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi Integers.cmi \
     Datatypes.cmi Csharpminor.cmi Coqlib.cmi Cminor.cmi Cmconstr.cmi \
     CList.cmi BinPos.cmi BinInt.cmi AST.cmi 
 Cminor.cmi: Values.cmi Op.cmi Maps.cmi Integers.cmi Globalenvs.cmi \
@@ -67,43 +67,45 @@ Coloring.cmi: Specif.cmi Registers.cmi RTLtyping.cmi RTL.cmi Op.cmi Maps.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 CList.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: Zmin.cmi Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
+Csharpminor.cmi: Zmax.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 
-Floats.cmi: Specif.cmi Integers.cmi Datatypes.cmi AST.cmi 
-FSetAVL.cmi: ZArith_dec.cmi Wf.cmi Specif.cmi Peano.cmi FSetInterface.cmi \
+Floats.cmi: Specif.cmi Integers.cmi Datatypes.cmi 
+FSetAVL.cmi: Wf.cmi Specif.cmi Peano.cmi OrderedType.cmi Int.cmi \
     Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi 
 FSetBridge.cmi: Specif.cmi FSetInterface.cmi Datatypes.cmi CList.cmi 
 FSetInterface.cmi: Specif.cmi Datatypes.cmi CList.cmi 
-FSetList.cmi: Specif.cmi FSetInterface.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 AST.cmi 
-InterfGraph.cmi: Specif.cmi Registers.cmi Locations.cmi FSetInterface.cmi \
-    Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi 
-Kildall.cmi: Wf.cmi Specif.cmi Maps.cmi Lattice.cmi Datatypes.cmi Coqlib.cmi \
-    CList.cmi BinPos.cmi 
+    CList.cmi Bool.cmi BinPos.cmi BinInt.cmi 
+InterfGraph.cmi: Specif.cmi Registers.cmi OrderedType.cmi Locations.cmi \
+    Int.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi 
+Int.cmi: Zmax.cmi ZArith_dec.cmi Specif.cmi BinPos.cmi BinInt.cmi 
+Iteration.cmi: Wf.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi 
+Kildall.cmi: Specif.cmi Maps.cmi Lattice.cmi Iteration.cmi Datatypes.cmi \
+    Coqlib.cmi CList.cmi BinPos.cmi 
 Lattice.cmi: Specif.cmi Maps.cmi Datatypes.cmi BinPos.cmi 
 Linearize.cmi: Specif.cmi Op.cmi Maps.cmi Linear.cmi Lattice.cmi LTL.cmi \
     Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi 
 Linear.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 
-Lineartyping.cmi: Zmin.cmi Locations.cmi Linear.cmi Datatypes.cmi \
+Lineartyping.cmi: Zmax.cmi Locations.cmi Linear.cmi Datatypes.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 
 LTL.cmi: Values.cmi Specif.cmi Op.cmi Maps.cmi Locations.cmi Integers.cmi \
     Globalenvs.cmi Datatypes.cmi Conventions.cmi CList.cmi BinPos.cmi \
     BinInt.cmi AST.cmi 
-Mach.cmi: Zmin.cmi Zdiv.cmi Values.cmi Specif.cmi Op.cmi Mem.cmi \
+Mach.cmi: Zmax.cmi Zdiv.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 
 Main.cmi: Tunneling.cmi Stacking.cmi RTLgen.cmi PPCgen.cmi PPC.cmi \
@@ -111,14 +113,15 @@ Main.cmi: Tunneling.cmi Stacking.cmi RTLgen.cmi PPCgen.cmi PPC.cmi \
     Cminor.cmi CSE.cmi Allocation.cmi AST.cmi 
 Maps.cmi: Specif.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinNat.cmi \
     BinInt.cmi 
-Mem.cmi: Values.cmi Specif.cmi Integers.cmi Datatypes.cmi Coqlib.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 Integers.cmi Globalenvs.cmi Floats.cmi \
     Datatypes.cmi CList.cmi Bool.cmi BinPos.cmi BinInt.cmi AST.cmi 
-Ordered.cmi: Specif.cmi Maps.cmi FSetInterface.cmi Datatypes.cmi Coqlib.cmi \
+Ordered.cmi: Specif.cmi OrderedType.cmi Maps.cmi Datatypes.cmi Coqlib.cmi \
     BinPos.cmi 
-Parallelmove.cmi: Wf.cmi Values.cmi Specif.cmi Peano.cmi Locations.cmi \
-    LTL.cmi Datatypes.cmi CList.cmi AST.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 \
     Datatypes.cmi Coqlib.cmi CList.cmi Bool.cmi BinPos.cmi BinInt.cmi AST.cmi 
@@ -130,8 +133,8 @@ RTLgen.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Integers.cmi \
     Datatypes.cmi Coqlib.cmi Cminor.cmi CList.cmi BinPos.cmi AST.cmi 
 RTL.cmi: Values.cmi Registers.cmi Op.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 Datatypes.cmi \
-    Coqlib.cmi CList.cmi BinPos.cmi AST.cmi 
+RTLtyping.cmi: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Locations.cmi \
+    Datatypes.cmi Coqlib.cmi Conventions.cmi CList.cmi AST.cmi 
 Sets.cmi: Specif.cmi Maps.cmi Datatypes.cmi CList.cmi 
 Specif.cmi: Datatypes.cmi 
 Stacking.cmi: Specif.cmi Op.cmi Mach.cmi Locations.cmi Lineartyping.cmi \
@@ -148,6 +151,7 @@ Zbool.cmi: Zeven.cmi ZArith_dec.cmi Sumbool.cmi Specif.cmi Datatypes.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 
 Zmin.cmi: Datatypes.cmi BinInt.cmi 
 Zmisc.cmi: Datatypes.cmi BinPos.cmi BinInt.cmi 
 Zpower.cmi: Zmisc.cmi Datatypes.cmi BinPos.cmi BinInt.cmi 
@@ -159,14 +163,14 @@ Allocation.cmx: Specif.cmx Registers.cmx RTLtyping.cmx RTL.cmx \
     Parallelmove.cmx Op.cmx Maps.cmx Locations.cmx LTL.cmx Kildall.cmx \
     Datatypes.cmx Conventions.cmx Coloring.cmx CList.cmx BinPos.cmx AST.cmx \
     Allocation.cmi 
-AST.cmo: Specif.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi BinInt.cmi \
-    AST.cmi 
-AST.cmx: Specif.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
-    AST.cmi 
+AST.cmo: Specif.cmi Integers.cmi Floats.cmi Datatypes.cmi Coqlib.cmi \
+    CList.cmi BinPos.cmi BinInt.cmi AST.cmi 
+AST.cmx: Specif.cmx Integers.cmx Floats.cmx Datatypes.cmx Coqlib.cmx \
+    CList.cmx BinPos.cmx BinInt.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: Datatypes.cmi BinPos.cmi BinNat.cmi 
-BinNat.cmx: Datatypes.cmx BinPos.cmx BinNat.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 
@@ -177,10 +181,10 @@ Cmconstr.cmo: Specif.cmi Op.cmi Integers.cmi Datatypes.cmi Compare_dec.cmi \
     Cminor.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi Cmconstr.cmi 
 Cmconstr.cmx: Specif.cmx Op.cmx Integers.cmx Datatypes.cmx Compare_dec.cmx \
     Cminor.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx Cmconstr.cmi 
-Cminorgen.cmo: Zmin.cmi Specif.cmi Sets.cmi Op.cmi Mem.cmi Maps.cmi \
+Cminorgen.cmo: Zmax.cmi Specif.cmi Sets.cmi Op.cmi Mem.cmi Maps.cmi \
     Integers.cmi Datatypes.cmi Csharpminor.cmi Coqlib.cmi Cminor.cmi \
     Cmconstr.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi Cminorgen.cmi 
-Cminorgen.cmx: Zmin.cmx Specif.cmx Sets.cmx Op.cmx Mem.cmx Maps.cmx \
+Cminorgen.cmx: Zmax.cmx Specif.cmx Sets.cmx Op.cmx Mem.cmx Maps.cmx \
     Integers.cmx Datatypes.cmx Csharpminor.cmx Coqlib.cmx Cminor.cmx \
     Cmconstr.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx Cminorgen.cmi 
 Cminor.cmo: Values.cmi Op.cmi Maps.cmi Integers.cmi Globalenvs.cmi \
@@ -201,10 +205,10 @@ Constprop.cmo: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Lattice.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 CList.cmi BinPos.cmi BinInt.cmi \
-    AST.cmi Conventions.cmi 
-Conventions.cmx: Locations.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx \
-    AST.cmx Conventions.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 \
@@ -215,52 +219,54 @@ CSE.cmo: Specif.cmi Registers.cmi RTL.cmi Op.cmi Maps.cmi Kildall.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: Zmin.cmi Values.cmi Specif.cmi Mem.cmi Maps.cmi Integers.cmi \
+Csharpminor.cmo: Zmax.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 Csharpminor.cmi 
-Csharpminor.cmx: Zmin.cmx Values.cmx Specif.cmx Mem.cmx Maps.cmx Integers.cmx \
+Csharpminor.cmx: Zmax.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 Csharpminor.cmi 
 Datatypes.cmo: Datatypes.cmi 
 Datatypes.cmx: Datatypes.cmi 
 Floats.cmo: Specif.cmi Integers.cmi ../caml/Floataux.cmo Datatypes.cmi \
-    AST.cmi Floats.cmi 
+    Floats.cmi 
 Floats.cmx: Specif.cmx Integers.cmx ../caml/Floataux.cmx Datatypes.cmx \
-    AST.cmx Floats.cmi 
-FSetAVL.cmo: ZArith_dec.cmi Wf.cmi Specif.cmi Peano.cmi FSetList.cmi \
-    FSetInterface.cmi Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi \
-    FSetAVL.cmi 
-FSetAVL.cmx: ZArith_dec.cmx Wf.cmx Specif.cmx Peano.cmx FSetList.cmx \
-    FSetInterface.cmx Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx \
-    FSetAVL.cmi 
+    Floats.cmi 
+FSetAVL.cmo: Wf.cmi Specif.cmi Peano.cmi OrderedType.cmi Int.cmi FSetList.cmi \
+    Datatypes.cmi CList.cmi BinPos.cmi BinInt.cmi FSetAVL.cmi 
+FSetAVL.cmx: Wf.cmx Specif.cmx Peano.cmx OrderedType.cmx Int.cmx FSetList.cmx \
+    Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx FSetAVL.cmi 
 FSetBridge.cmo: Specif.cmi FSetInterface.cmi Datatypes.cmi CList.cmi \
     FSetBridge.cmi 
 FSetBridge.cmx: Specif.cmx FSetInterface.cmx Datatypes.cmx CList.cmx \
     FSetBridge.cmi 
 FSetInterface.cmo: Specif.cmi Datatypes.cmi CList.cmi FSetInterface.cmi 
 FSetInterface.cmx: Specif.cmx Datatypes.cmx CList.cmx FSetInterface.cmi 
-FSetList.cmo: Specif.cmi FSetInterface.cmi Datatypes.cmi CList.cmi \
-    FSetList.cmi 
-FSetList.cmx: Specif.cmx FSetInterface.cmx Datatypes.cmx CList.cmx \
-    FSetList.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 AST.cmi Integers.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 AST.cmx Integers.cmi 
-InterfGraph.cmo: Specif.cmi Registers.cmi Ordered.cmi Locations.cmi \
-    FSetInterface.cmi FSetBridge.cmi FSetAVL.cmi Datatypes.cmi Coqlib.cmi \
-    CList.cmi BinPos.cmi BinInt.cmi InterfGraph.cmi 
-InterfGraph.cmx: Specif.cmx Registers.cmx Ordered.cmx Locations.cmx \
-    FSetInterface.cmx FSetBridge.cmx FSetAVL.cmx Datatypes.cmx Coqlib.cmx \
-    CList.cmx BinPos.cmx BinInt.cmx InterfGraph.cmi 
-Kildall.cmo: Wf.cmi Specif.cmi Maps.cmi Lattice.cmi Datatypes.cmi Coqlib.cmi \
-    CList.cmi BinPos.cmi Kildall.cmi 
-Kildall.cmx: Wf.cmx Specif.cmx Maps.cmx Lattice.cmx Datatypes.cmx Coqlib.cmx \
-    CList.cmx BinPos.cmx Kildall.cmi 
+    CList.cmx Bool.cmx BinPos.cmx BinInt.cmx Integers.cmi 
+InterfGraph.cmo: Specif.cmi Registers.cmi OrderedType.cmi Ordered.cmi \
+    Locations.cmi Int.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 Int.cmx FSetAVL.cmx Datatypes.cmx Coqlib.cmx CList.cmx \
+    BinPos.cmx BinInt.cmx InterfGraph.cmi 
+Int.cmo: Zmax.cmi ZArith_dec.cmi Specif.cmi BinPos.cmi BinInt.cmi Int.cmi 
+Int.cmx: Zmax.cmx ZArith_dec.cmx Specif.cmx BinPos.cmx BinInt.cmx Int.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 Maps.cmi Lattice.cmi Iteration.cmi Datatypes.cmi \
+    Coqlib.cmi CList.cmi BinPos.cmi Kildall.cmi 
+Kildall.cmx: Specif.cmx Maps.cmx Lattice.cmx Iteration.cmx Datatypes.cmx \
+    Coqlib.cmx CList.cmx BinPos.cmx Kildall.cmi 
 Lattice.cmo: Specif.cmi Maps.cmi Datatypes.cmi BinPos.cmi Lattice.cmi 
 Lattice.cmx: Specif.cmx Maps.cmx Datatypes.cmx BinPos.cmx Lattice.cmi 
 Linearize.cmo: Specif.cmi Op.cmi Maps.cmi Linear.cmi Lattice.cmi LTL.cmi \
@@ -275,9 +281,9 @@ Linear.cmo: Values.cmi Specif.cmi Op.cmi Locations.cmi Integers.cmi \
 Linear.cmx: Values.cmx Specif.cmx Op.cmx Locations.cmx Integers.cmx \
     Globalenvs.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx BinInt.cmx \
     AST.cmx Linear.cmi 
-Lineartyping.cmo: Zmin.cmi Locations.cmi Linear.cmi Datatypes.cmi \
+Lineartyping.cmo: Zmax.cmi Locations.cmi Linear.cmi Datatypes.cmi \
     Conventions.cmi CList.cmi BinPos.cmi BinInt.cmi AST.cmi Lineartyping.cmi 
-Lineartyping.cmx: Zmin.cmx Locations.cmx Linear.cmx Datatypes.cmx \
+Lineartyping.cmx: Zmax.cmx Locations.cmx Linear.cmx Datatypes.cmx \
     Conventions.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx Lineartyping.cmi 
 Locations.cmo: Values.cmi Specif.cmi Datatypes.cmi Coqlib.cmi BinPos.cmi \
     BinInt.cmi AST.cmi Locations.cmi 
@@ -291,10 +297,10 @@ LTL.cmo: Values.cmi Specif.cmi Op.cmi Maps.cmi Locations.cmi Integers.cmi \
 LTL.cmx: Values.cmx Specif.cmx Op.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: Zmin.cmi Zdiv.cmi Values.cmi Specif.cmi Op.cmi Mem.cmi Maps.cmi \
+Mach.cmo: Zmax.cmi Zdiv.cmi Values.cmi Specif.cmi Op.cmi Mem.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: Zmin.cmx Zdiv.cmx Values.cmx Specif.cmx Op.cmx Mem.cmx Maps.cmx \
+Mach.cmx: Zmax.cmx Zdiv.cmx Values.cmx Specif.cmx Op.cmx Mem.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 RTLgen.cmi PPCgen.cmi PPC.cmi \
@@ -307,22 +313,26 @@ 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: Values.cmi Specif.cmi Integers.cmi Datatypes.cmi Coqlib.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: Values.cmx Specif.cmx Integers.cmx Datatypes.cmx Coqlib.cmx \
+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 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 Integers.cmx Globalenvs.cmx Floats.cmx \
     Datatypes.cmx CList.cmx Bool.cmx BinPos.cmx BinInt.cmx AST.cmx Op.cmi 
-Ordered.cmo: Specif.cmi Maps.cmi FSetInterface.cmi Datatypes.cmi Coqlib.cmi \
+Ordered.cmo: Specif.cmi OrderedType.cmi Maps.cmi Datatypes.cmi Coqlib.cmi \
     BinPos.cmi Ordered.cmi 
-Ordered.cmx: Specif.cmx Maps.cmx FSetInterface.cmx Datatypes.cmx Coqlib.cmx \
+Ordered.cmx: Specif.cmx OrderedType.cmx Maps.cmx Datatypes.cmx Coqlib.cmx \
     BinPos.cmx Ordered.cmi 
-Parallelmove.cmo: Wf.cmi Values.cmi Specif.cmi Peano.cmi Locations.cmi \
-    LTL.cmi Datatypes.cmi CList.cmi AST.cmi Parallelmove.cmi 
-Parallelmove.cmx: Wf.cmx Values.cmx Specif.cmx Peano.cmx Locations.cmx \
-    LTL.cmx Datatypes.cmx CList.cmx AST.cmx Parallelmove.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 \
@@ -351,12 +361,12 @@ RTL.cmo: Values.cmi Registers.cmi Op.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 Maps.cmx Integers.cmx Globalenvs.cmx \
     Datatypes.cmx CList.cmx BinPos.cmx BinInt.cmx AST.cmx RTL.cmi 
-RTLtyping.cmo: union_find.cmi Specif.cmi Registers.cmi RTL.cmi Op.cmi \
-    Maps.cmi Datatypes.cmi Coqlib.cmi CList.cmi BinPos.cmi AST.cmi \
-    RTLtyping.cmi 
-RTLtyping.cmx: union_find.cmx Specif.cmx Registers.cmx RTL.cmx Op.cmx \
-    Maps.cmx Datatypes.cmx Coqlib.cmx CList.cmx BinPos.cmx AST.cmx \
-    RTLtyping.cmi 
+RTLtyping.cmo: Specif.cmi Registers.cmi ../caml/RTLtypingaux.cmo RTL.cmi \
+    Op.cmi Maps.cmi Locations.cmi Datatypes.cmi Coqlib.cmi Conventions.cmi \
+    CList.cmi AST.cmi RTLtyping.cmi 
+RTLtyping.cmx: Specif.cmx Registers.cmx ../caml/RTLtypingaux.cmx RTL.cmx \
+    Op.cmx Maps.cmx Locations.cmx Datatypes.cmx Coqlib.cmx Conventions.cmx \
+    CList.cmx AST.cmx RTLtyping.cmi 
 Sets.cmo: Specif.cmi Maps.cmi Datatypes.cmi CList.cmi Sets.cmi 
 Sets.cmx: Specif.cmx Maps.cmx Datatypes.cmx CList.cmx Sets.cmi 
 Specif.cmo: Datatypes.cmi Specif.cmi 
@@ -393,6 +403,8 @@ 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 
 Zmin.cmo: Datatypes.cmi BinInt.cmi Zmin.cmi 
 Zmin.cmx: Datatypes.cmx BinInt.cmx Zmin.cmi 
 Zmisc.cmo: Datatypes.cmi BinPos.cmi BinInt.cmi Zmisc.cmi 
diff --git a/extraction/Makefile b/extraction/Makefile
index 687c5c5..6ae8e35 100644
--- a/extraction/Makefile
+++ b/extraction/Makefile
@@ -1,19 +1,20 @@
 FILES=\
   Datatypes.ml Logic.ml Wf.ml Peano.ml Specif.ml Compare_dec.ml \
   Bool.ml CList.ml Sumbool.ml BinPos.ml BinNat.ml BinInt.ml \
-  ZArith_dec.ml Zeven.ml Zmin.ml Zmisc.ml Zbool.ml Zpower.ml Zdiv.ml \
-  FSetInterface.ml FSetBridge.ml FSetList.ml FSetAVL.ml \
-  Coqlib.ml Maps.ml Sets.ml union_find.ml AST.ml Integers.ml \
-  ../caml/Camlcoq.ml ../caml/Floataux.ml Floats.ml Values.ml \
+  ZArith_dec.ml Zeven.ml Zmax.ml Zmisc.ml Zbool.ml Zpower.ml Zdiv.ml \
+  Int.ml OrderedType.ml FSetList.ml FSetAVL.ml \
+  Coqlib.ml Maps.ml Sets.ml AST.ml Iteration.ml Integers.ml \
+  ../caml/Camlcoq.ml ../caml/Floataux.ml Floats.ml Parmov.ml Values.ml \
   Mem.ml Globalenvs.ml \
   Op.ml Cminor.ml Cmconstr.ml \
   Csharpminor.ml Cminorgen.ml \
   Registers.ml RTL.ml \
   ../caml/RTLgenaux.ml RTLgen.ml \
-  RTLtyping.ml \
+  Locations.ml Conventions.ml \
+  ../caml/RTLtypingaux.ml RTLtyping.ml \
   Lattice.ml Kildall.ml \
   Constprop.ml CSE.ml \
-  Locations.ml Conventions.ml LTL.ml \
+  LTL.ml \
   Ordered.ml InterfGraph.ml ../caml/Coloringaux.ml Coloring.ml \
   Parallelmove.ml Allocation.ml  \
   Tunneling.ml Linear.ml Lineartyping.ml Linearize.ml \
diff --git a/extraction/extraction.v b/extraction/extraction.v
index 1717882..47c6f36 100644
--- a/extraction/extraction.v
+++ b/extraction/extraction.v
@@ -1,9 +1,8 @@
+Require Iteration.
 Require Floats.
-Require Kildall.
 Require RTLgen.
 Require Coloring.
 Require Allocation.
-Require Cmconstr.
 Require Main.
 
 (* Standard lib *)
@@ -28,9 +27,22 @@ Extract Constant Floats.Float.div => "( /. )".
 Extract Constant Floats.Float.cmp => "Floataux.cmp".
 Extract Constant Floats.Float.eq_dec => "fun (x: float) (y: float) -> x = y".
 
+(* Iteration *)
+Extract Constant Iteration.dependent_description' =>
+  "fun x -> assert false".
+
+Extract Constant Iteration.GenIter.iterate =>
+  "let rec iter f a =
+     match f a with Coq_inl b -> Some b | Coq_inr a' -> iter f a'
+   in iter".
+
+
 (* RTLgen *)
 Extract Constant RTLgen.more_likely => "RTLgenaux.more_likely".
 
+(* RTLtyping *)
+Extract Constant RTLtyping.infer_type_environment => "RTLtypingaux.infer_type_environment".
+
 (* Coloring *)
 Extract Constant Coloring.graph_coloring => "Coloringaux.graph_coloring".
 
@@ -49,5 +61,3 @@ Extract Constant PPC.preg_eq => "fun (x: preg) (y: preg) -> x = y".
 
 (* Go! *)
 Recursive Extraction Library Main.
-(*Extraction Library Compare_dec.
-  Extraction Library Cmconstr.*)
diff --git a/lib/Coqlib.v b/lib/Coqlib.v
index 039dd03..3bcc8a6 100644
--- a/lib/Coqlib.v
+++ b/lib/Coqlib.v
@@ -33,20 +33,7 @@ Ltac destructEq name :=
 
 Ltac decEq :=
   match goal with
-  | [ |- (_, _) = (_, _) ] =>
-      apply injective_projections; unfold fst,snd; try reflexivity
-  | [ |- (@Some ?T _ = @Some ?T _) ] =>
-      apply (f_equal (@Some T)); try reflexivity
-  | [ |- (?X _ _ _ _ _ = ?X _ _ _ _ _) ] =>
-      apply (f_equal5 X); try reflexivity
-  | [ |- (?X _ _ _ _ = ?X _ _ _ _) ] =>
-      apply (f_equal4 X); try reflexivity
-  | [ |- (?X _ _ _ = ?X _ _ _) ] =>
-      apply (f_equal3 X); try reflexivity
-  | [ |- (?X _ _ = ?X _ _) ] =>
-      apply (f_equal2 X); try reflexivity
-  | [ |- (?X _ = ?X _) ] =>
-      apply (f_equal X); try reflexivity
+  | [ |- _ = _ ] => f_equal
   | [ |- (?X ?A <> ?X ?B) ] =>
       cut (A <> B); [intro; congruence | try discriminate]
   end.
@@ -57,6 +44,46 @@ Ltac byContradiction :=
 Ltac omegaContradiction :=
   cut False; [contradiction|omega].
 
+Lemma modusponens: forall (P Q: Prop), P -> (P -> Q) -> Q.
+Proof. auto. Qed.
+
+Ltac exploit x :=
+    refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _ _) _)
+ || refine (modusponens _ _ (x _ _ _) _)
+ || refine (modusponens _ _ (x _ _) _)
+ || refine (modusponens _ _ (x _) _).
+
 (** * Definitions and theorems over the type [positive] *)
 
 Definition peq (x y: positive): {x = y} + {x <> y}.
@@ -510,6 +537,13 @@ Proof.
   induction l; simpl. reflexivity. rewrite IHl; reflexivity.
 Qed.
 
+Lemma list_map_identity:
+  forall (A: Set) (l: list A),
+  List.map (fun (x:A) => x) l = l.
+Proof.
+  induction l; simpl; congruence.
+Qed.
+
 Lemma list_map_nth:
   forall (A B: Set) (f: A -> B) (l: list A) (n: nat),
   nth_error (List.map f l) n = option_map f (nth_error l n).
@@ -546,6 +580,27 @@ Proof.
   auto. rewrite IHl1. auto.
 Qed.
 
+(** Properties of list membership. *)
+
+Lemma in_cns:
+  forall (A: Set) (x y: A) (l: list A), In x (y :: l) <-> y = x \/ In x l.
+Proof.
+  intros. simpl. tauto.
+Qed.
+
+Lemma in_app:
+  forall (A: Set) (x: A) (l1 l2: list A), In x (l1 ++ l2) <-> In x l1 \/ In x l2.
+Proof.
+  intros. split; intro. apply in_app_or. auto. apply in_or_app. auto.
+Qed.
+
+Lemma list_in_insert:
+  forall (A: Set) (x: A) (l1 l2: list A) (y: A),
+  In x (l1 ++ l2) -> In x (l1 ++ y :: l2).
+Proof.
+  intros. apply in_or_app; simpl. elim (in_app_or _ _ _ H); intro; auto.
+Qed.
+
 (** [list_disjoint l1 l2] holds iff [l1] and [l2] have no elements 
   in common. *)
 
@@ -644,35 +699,42 @@ Proof.
   red; intro; elim H3. apply in_or_app. tauto.
 Qed.
 
+Lemma list_norepet_app:
+  forall (A: Set) (l1 l2: list A),
+  list_norepet (l1 ++ l2) <->
+  list_norepet l1 /\ list_norepet l2 /\ list_disjoint l1 l2.
+Proof.
+  induction l1; simpl; intros; split; intros.
+  intuition. constructor. red;simpl;auto.
+  tauto.
+  inversion H; subst. rewrite IHl1 in H3. rewrite in_app in H2.
+  intuition.
+  constructor; auto. red; intros. elim H2; intro. congruence. auto. 
+  destruct H as [B [C D]]. inversion B; subst. 
+  constructor. rewrite in_app. intuition. elim (D a a); auto. apply in_eq. 
+  rewrite IHl1. intuition. red; intros. apply D; auto. apply in_cons; auto. 
+Qed.
+
 Lemma list_norepet_append:
   forall (A: Set) (l1 l2: list A),
   list_norepet l1 -> list_norepet l2 -> list_disjoint l1 l2 ->
   list_norepet (l1 ++ l2).
 Proof.
-  induction l1; simpl; intros.
-  auto.
-  inversion H. subst hd tl. 
-  constructor. red; intro. apply (H1 a a). auto with coqlib. 
-  elim (in_app_or _ _ _ H2); tauto. auto.
-  apply IHl1. auto. auto. 
-  red; intros; apply H1; auto with coqlib. 
+  generalize list_norepet_app; firstorder.
 Qed.
 
 Lemma list_norepet_append_right:
   forall (A: Set) (l1 l2: list A),
   list_norepet (l1 ++ l2) -> list_norepet l2.
 Proof.
-  induction l1; intros.
-  assumption.
-  simpl in H. inversion H. eauto. 
+  generalize list_norepet_app; firstorder.
 Qed.
 
 Lemma list_norepet_append_left:
   forall (A: Set) (l1 l2: list A),
   list_norepet (l1 ++ l2) -> list_norepet l1.
 Proof.
-  intros. apply list_norepet_append_right with l2. 
-  apply list_norepet_append_commut. auto.
+  generalize list_norepet_app; firstorder.
 Qed.
 
 (** [list_forall2 P [x1 ... xN] [y1 ... yM] holds iff [N = M] and
@@ -707,3 +769,37 @@ Proof.
   constructor. auto with coqlib. apply IHlist_forall2; auto. 
   intros. auto with coqlib.
 Qed.
+
+(** Dropping the first or first two elements of a list. *)
+
+Definition list_drop1 (A: Set) (x: list A) :=
+  match x with nil => nil | hd :: tl => tl end.
+Definition list_drop2 (A: Set) (x: list A) :=
+  match x with nil => nil | hd :: nil => nil | hd1 :: hd2 :: tl => tl end.
+
+Lemma list_drop1_incl:
+  forall (A: Set) (x: A) (l: list A), In x (list_drop1 l) -> In x l.
+Proof.
+  intros. destruct l. elim H. simpl in H. auto with coqlib.
+Qed.
+
+Lemma list_drop2_incl:
+  forall (A: Set) (x: A) (l: list A), In x (list_drop2 l) -> In x l.
+Proof.
+  intros. destruct l. elim H. destruct l. elim H.
+  simpl in H. auto with coqlib.
+Qed.
+
+Lemma list_drop1_norepet:
+  forall (A: Set) (l: list A), list_norepet l -> list_norepet (list_drop1 l).
+Proof.
+  intros. destruct l; simpl. constructor. inversion H. auto.
+Qed.
+
+Lemma list_drop2_norepet:
+  forall (A: Set) (l: list A), list_norepet l -> list_norepet (list_drop2 l).
+Proof.
+  intros. destruct l; simpl. constructor.
+  destruct l; simpl. constructor. inversion H. inversion H3. auto.
+Qed.
+
diff --git a/lib/Floats.v b/lib/Floats.v
index b95789e..67b0e53 100644
--- a/lib/Floats.v
+++ b/lib/Floats.v
@@ -6,7 +6,6 @@
   and the associated operations.  *)
 
 Require Import Bool.
-Require Import AST.
 Require Import Integers.
 
 Parameter float: Set.
diff --git a/lib/Integers.v b/lib/Integers.v
index 6b605bd..5a18dc0 100644
--- a/lib/Integers.v
+++ b/lib/Integers.v
@@ -1,29 +1,48 @@
 (** Formalizations of integers modulo $2^32$ #2<sup>32</sup>#. *)
 
 Require Import Coqlib.
-Require Import AST.
 
 Definition wordsize : nat := 32%nat.
 Definition modulus : Z := two_power_nat wordsize.
 Definition half_modulus : Z := modulus / 2.
 
+(** * Comparisons *)
+
+Inductive comparison : Set :=
+  | Ceq : comparison               (**r same *)
+  | Cne : comparison               (**r different *)
+  | Clt : comparison               (**r less than *)
+  | Cle : comparison               (**r less than or equal *)
+  | Cgt : comparison               (**r greater than *)
+  | Cge : comparison.              (**r greater than or equal *)
+
+Definition negate_comparison (c: comparison): comparison :=
+  match c with
+  | Ceq => Cne
+  | Cne => Ceq
+  | Clt => Cge
+  | Cle => Cgt
+  | Cgt => Cle
+  | Cge => Clt
+  end.
+
+Definition swap_comparison (c: comparison): comparison :=
+  match c with
+  | Ceq => Ceq
+  | Cne => Cne
+  | Clt => Cgt
+  | Cle => Cge
+  | Cgt => Clt
+  | Cge => Cle
+  end.
+
 (** * Representation of machine integers *)
 
 (** A machine integer (type [int]) is represented as a Coq arbitrary-precision
   integer (type [Z]) plus a proof that it is in the range 0 (included) to
   [modulus] (excluded. *)
 
-Definition in_range (x: Z) :=
-  match x ?= 0 with
-  | Lt => False
-  | _  =>
-    match x ?= modulus with
-    | Lt => True
-    | _  => False
-    end
-  end.
-
-Record int: Set := mkint { intval: Z; intrange: in_range intval }.
+Record int: Set := mkint { intval: Z; intrange: 0 <= intval < modulus }.
 
 Module Int.
 
@@ -43,14 +62,10 @@ Definition signed (n: int) : Z :=
   else unsigned n - modulus.
 
 Lemma mod_in_range:
-  forall x, in_range (Zmod x modulus).
+  forall x, 0 <= Zmod x modulus < modulus.
 Proof.
   intro.
-  generalize (Z_mod_lt x modulus (two_power_nat_pos wordsize)).
-  intros [A B].
-  assert (C: x mod modulus >= 0). omega.
-  red. red in C. red in B. 
-  rewrite B. destruct (x mod modulus ?= 0); auto. 
+  exact (Z_mod_lt x modulus (two_power_nat_pos wordsize)).
 Qed.
 
 (** Conversely, [repr] takes a Coq integer and returns the corresponding
@@ -550,26 +565,10 @@ Proof.
   apply eqmod_refl. red; exists (-1); ring. 
 Qed.
 
-Lemma in_range_range:
-  forall z, in_range z -> 0 <= z < modulus.
-Proof.
-  intros. 
-  assert (z >= 0 /\ z < modulus).
-  generalize H. unfold in_range, Zge, Zlt.
-  destruct (z ?= 0).
-  destruct (z ?= modulus); try contradiction.
-  intuition congruence.
-  contradiction.
-  destruct (z ?= modulus); try contradiction.
-  intuition congruence.
-  omega.
-Qed.
-
 Theorem unsigned_range:
   forall i, 0 <= unsigned i < modulus.
 Proof.
-  destruct i; simpl. 
-  apply in_range_range. auto.
+  destruct i; simpl. auto.
 Qed.
 Hint Resolve unsigned_range: ints.
 
@@ -597,7 +596,7 @@ Theorem repr_unsigned:
   forall i, repr (unsigned i) = i.
 Proof.
   destruct i; simpl. unfold repr. apply mkint_eq.
-  apply Zmod_small. apply in_range_range; auto.
+  apply Zmod_small. auto.
 Qed.
 Hint Resolve repr_unsigned: ints.
 
diff --git a/lib/Iteration.v b/lib/Iteration.v
new file mode 100644
index 0000000..85c5ded
--- /dev/null
+++ b/lib/Iteration.v
@@ -0,0 +1,293 @@
+(* Bounded and unbounded iterators *)
+
+Require Import Coqlib.
+Require Import Classical.
+Require Import Max.
+
+Module Type ITER.
+Variable iterate
+     : forall A B : Set, (A -> B + A) -> A -> option B.
+Hypothesis iterate_prop
+     : forall (A B : Set) (step : A -> B + A) (P : A -> Prop) (Q : B -> Prop),
+       (forall a : A, P a ->
+           match step a with inl b => Q b | inr a' => P a' end) ->
+       forall (a : A) (b : B), iterate A B step a = Some b -> P a -> Q b.
+End ITER.
+
+Axiom
+  dependent_description' :
+    forall (A:Type) (B:A -> Type) (R:forall x:A, B x -> Prop),
+      (forall x:A,
+          exists y : B x, R x y /\ (forall y':B x, R x y' -> y = y')) ->
+       sigT (fun f : forall x:A, B x => (forall x:A, R x (f x))).
+
+(* A constructive implementation using bounded iteration. *)
+
+Module PrimIter: ITER.
+
+Section ITERATION.
+
+Variables A B: Set.
+Variable step: A -> B + A.
+
+(** The [step] parameter represents one step of the iteration.  From a 
+  current iteration state [a: A], it either returns a value of type [B],
+  meaning that iteration is over and that this [B] value is the final
+  result of the iteration, or a value [a' : A] which is the next state
+  of the iteration.
+
+  The naive way to define the iteration is:
+<<
+Fixpoint iterate (a: A) : B :=
+  match step a with
+  | inl b => b
+  | inr a' => iterate a'
+  end.
+>>
+  However, this is a general recursion, not guaranteed to terminate,
+  and therefore not expressible in Coq.  The standard way to work around
+  this difficulty is to use Noetherian recursion (Coq module [Wf]).
+  This requires that we equip the type [A] with a well-founded ordering [<]
+  (no infinite ascending chains) and we demand that [step] satisfies
+  [step a = inr a' -> a < a'].  For the types [A] that are of interest to us
+  in this development, it is however very painful to define adequate
+  well-founded orderings, even though we know our iterations always
+  terminate.
+
+  Instead, we choose to bound the number of iterations by an arbitrary
+  constant.  [iterate] then becomes a function that can fail,
+  of type [A -> option B].  The [None] result denotes failure to reach
+  a result in the number of iterations prescribed, or, in other terms,
+  failure to find a solution to the dataflow problem.  The compiler
+  passes that exploit dataflow analysis (the [Constprop], [CSE] and
+  [Allocation] passes) will, in this case, either fail ([Allocation])
+  or turn off the optimization pass ([Constprop] and [CSE]).
+
+  Since we know (informally) that our computations terminate, we can
+  take a very large constant as the maximal number of iterations.
+  Failure will therefore never happen in practice, but of
+  course our proofs also cover the failure case and show that 
+  nothing bad happens in this hypothetical case either.  *)
+
+Definition num_iterations := 1000000000000%positive.
+
+(** The simple definition of bounded iteration is:
+<<
+Fixpoint iterate (niter: nat) (a: A) {struct niter} : option B :=
+  match niter with
+  | O => None
+  | S niter' =>
+      match step a with
+      | inl b => b
+      | inr a' => iterate niter' a'
+      end
+  end.
+>>
+  This function is structural recursive over the parameter [niter]
+  (number of iterations), represented here as a Peano integer (type [nat]).
+  However, we want to use very large values of [niter].  As Peano integers,
+  these values would be much too large to fit in memory.  Therefore,
+  we must express iteration counts as a binary integer (type [positive]).
+  However, Peano induction over type [positive] is not structural recursion,
+  so we cannot define [iterate] as a Coq fixpoint and must use
+  Noetherian recursion instead. *)
+
+Definition iter_step (x: positive)
+                     (next: forall y, Plt y x -> A -> option B)
+                     (s: A) : option B :=
+  match peq x xH with
+  | left EQ => None
+  | right NOTEQ =>
+      match step s with
+      | inl res => Some res
+      | inr s'  => next (Ppred x) (Ppred_Plt x NOTEQ) s'
+      end
+  end.
+
+Definition iter: positive -> A -> option B :=
+  Fix Plt_wf (fun _ => A -> option B) iter_step.
+
+(** We then prove the expected unrolling equations for [iter]. *)
+
+Remark unroll_iter:
+  forall x, iter x = iter_step x (fun y _ => iter y).
+Proof.
+  unfold iter; apply (Fix_eq Plt_wf (fun _ => A -> option B) iter_step).
+  intros. unfold iter_step. apply extensionality. intro s. 
+  case (peq x xH); intro. auto. 
+  rewrite H. auto. 
+Qed.
+
+(** The [iterate] function is defined as [iter] up to
+    [num_iterations] through the loop. *)
+
+Definition iterate := iter num_iterations.
+
+(** We now prove the invariance property [iterate_prop]. *)
+
+Variable P: A -> Prop.
+Variable Q: B -> Prop.
+
+Hypothesis step_prop:
+  forall a : A, P a ->
+  match step a with inl b => Q b | inr a' => P a' end.
+
+Lemma iter_prop:
+  forall n a b, P a -> iter n a = Some b -> Q b.
+Proof.
+  apply (well_founded_ind Plt_wf 
+         (fun p => forall a b, P a -> iter p a = Some b -> Q b)).
+  intros until b. intro. rewrite unroll_iter.
+  unfold iter_step. case (peq x 1); intro. congruence.
+  generalize (step_prop a H0).
+  case (step a); intros. congruence. 
+  apply H with (Ppred x) a0. apply Ppred_Plt; auto. auto. auto.
+Qed.
+
+Lemma iterate_prop:
+  forall a b, iterate a = Some b -> P a -> Q b.
+Proof.
+  intros. apply iter_prop with num_iterations a; assumption.
+Qed.
+
+End ITERATION.
+
+End PrimIter.
+
+(* An implementation using classical logic and unbounded iteration,
+  in the style of Yves Bertot's paper, "Extending the Calculus
+  of Constructions with Tarski's fix-point theorem". *)
+
+Module GenIter: ITER.
+
+Section ITERATION.
+
+Variables A B: Set.
+Variable step: A -> B + A.
+
+Definition B_le (x y: option B) : Prop := x = None \/ y = x.
+Definition F_le (x y: A -> option B) : Prop := forall a, B_le (x a) (y a).
+
+Definition F_iter (next: A -> option B) (a: A) : option B :=
+  match step a with
+  | inl b => Some b
+  | inr a' => next a'
+  end.
+
+Lemma F_iter_monot:
+ forall f g, F_le f g -> F_le (F_iter f) (F_iter g).
+Proof.
+  intros; red; intros. unfold F_iter. 
+  destruct (step a) as [b | a']. red; auto. apply H. 
+Qed.
+
+Fixpoint iter (n: nat) : A -> option B :=
+  match n with
+  | O => (fun a => None)
+  | S m => F_iter (iter m)
+  end.
+
+Lemma iter_monot:
+  forall p q, (p <= q)%nat -> F_le (iter p) (iter q).
+Proof.
+  induction p; intros. 
+  simpl. red; intros; red; auto.
+  destruct q. elimtype False; omega. 
+  simpl. apply F_iter_monot. apply IHp. omega.
+Qed.
+
+Lemma iter_either:
+  forall a,
+  (exists n, exists b, iter n a = Some b) \/
+  (forall n, iter n a = None).
+Proof.
+  intro a. elim (classic (forall n, iter n a = None)); intro.
+  right; assumption.
+  left. generalize (not_all_ex_not nat (fun n => iter n a = None) H).
+  intros [n D]. exists n. generalize D. 
+  case (iter n a); intros. exists b; auto. congruence.
+Qed.
+
+Definition converges_to (a: A) (b: option B) : Prop :=
+  exists n, forall m, (n <= m)%nat -> iter m a = b.
+
+Lemma converges_to_Some:
+  forall a n b, iter n a = Some b -> converges_to a (Some b).
+Proof.
+  intros. exists n. intros. 
+  assert (B_le (iter n a) (iter m a)). apply iter_monot. auto.
+  elim H1; intro; congruence. 
+Qed.
+
+Lemma converges_to_exists:
+  forall a, exists b, converges_to a b.
+Proof.
+  intros. elim (iter_either a). 
+  intros [n [b EQ]]. exists (Some b). apply converges_to_Some with n. assumption.
+  intro. exists (@None B). exists O. intros. auto. 
+Qed.
+
+Lemma converges_to_unique:
+  forall a b, converges_to a b -> forall b', converges_to a b' -> b = b'.
+Proof.
+  intros a b [n C] b' [n' C']. 
+  rewrite <- (C (max n n')). rewrite <- (C' (max n n')). auto.
+  apply le_max_r. apply le_max_l.
+Qed.
+
+Lemma converges_to_exists_uniquely:
+  forall a, exists b, converges_to a b /\ forall b', converges_to a b' -> b = b'.
+Proof.
+  intro. destruct (converges_to_exists a) as [b CT]. 
+  exists b. split. assumption. exact (converges_to_unique _ _ CT).
+Qed.
+
+Definition exists_iterate :=
+  dependent_description' A (fun _ => option B)
+     converges_to converges_to_exists_uniquely.
+
+Definition iterate : A -> option B :=
+  match exists_iterate with existT f P => f end.
+
+Lemma converges_to_iterate:
+  forall a b, converges_to a b -> iterate a = b.
+Proof.
+  intros. unfold iterate. destruct exists_iterate as [f P]. 
+  apply converges_to_unique with a. apply P. auto.
+Qed.
+
+Lemma iterate_converges_to:
+  forall a, converges_to a (iterate a).
+Proof.
+  intros. unfold iterate. destruct exists_iterate as [f P]. apply P.
+Qed.
+
+(** Invariance property. *)
+
+Variable P: A -> Prop.
+Variable Q: B -> Prop.
+
+Hypothesis step_prop:
+  forall a : A, P a ->
+  match step a with inl b => Q b | inr a' => P a' end.
+
+Lemma iter_prop:
+  forall n a b, P a -> iter n a = Some b -> Q b.
+Proof.
+  induction n; intros until b; intro H; simpl.
+  congruence.
+  unfold F_iter. generalize (step_prop a H). 
+  case (step a); intros. congruence. 
+  apply IHn with a0; auto.
+Qed.
+
+Lemma iterate_prop:
+  forall a b, iterate a = Some b -> P a -> Q b.
+Proof.
+  intros. destruct (iterate_converges_to a) as [n IT]. 
+  rewrite H in IT. apply iter_prop with n a. auto. apply IT. auto.
+Qed.
+
+End ITERATION.
+
+End GenIter.
diff --git a/lib/Ordered.v b/lib/Ordered.v
index 1747bbb..ad47314 100644
--- a/lib/Ordered.v
+++ b/lib/Ordered.v
@@ -1,7 +1,7 @@
 (** Constructions of ordered types, for use with the [FSet] functors
   for finite sets. *)
 
-Require Import FSet.
+Require Import FSets.
 Require Import Coqlib.
 Require Import Maps.
 
@@ -26,10 +26,10 @@ Proof Plt_ne.
 Lemma compare : forall x y : t, Compare lt eq x y.
 Proof.
   intros. case (plt x y); intro.
-  apply Lt. auto.
+  apply LT. auto.
   case (peq x y); intro.
-  apply Eq. auto.
-  apply Gt. red; unfold Plt in *. 
+  apply EQ. auto.
+  apply GT. red; unfold Plt in *. 
   assert (Zpos x <> Zpos y). congruence. omega.
 Qed.
 
@@ -64,9 +64,9 @@ Qed.
 Lemma compare : forall x y : t, Compare lt eq x y.
 Proof.
   intros. case (OrderedPositive.compare (A.index x) (A.index y)); intro.
-  apply Lt. exact l. 
-  apply Eq. red; red in e. apply A.index_inj; auto.
-  apply Gt. exact l.
+  apply LT. exact l. 
+  apply EQ. red; red in e. apply A.index_inj; auto.
+  apply GT. exact l.
 Qed.
 
 End OrderedIndexed.
@@ -144,12 +144,12 @@ Lemma compare : forall x y : t, Compare lt eq x y.
 Proof.
   intros.
   case (A.compare (fst x) (fst y)); intro.
-  apply Lt. red. left. auto.
+  apply LT. red. left. auto.
   case (B.compare (snd x) (snd y)); intro.
-  apply Lt. red. right. tauto.
-  apply Eq. red. tauto.
-  apply Gt. red. right. split. apply A.eq_sym. auto. auto.
-  apply Gt. red. left. auto.
+  apply LT. red. right. tauto.
+  apply EQ. red. tauto.
+  apply GT. red. right. split. apply A.eq_sym. auto. auto.
+  apply GT. red. left. auto.
 Qed.
 
 End OrderedPair.
diff --git a/lib/Parmov.v b/lib/Parmov.v
new file mode 100644
index 0000000..cd24dd9
--- /dev/null
+++ b/lib/Parmov.v
@@ -0,0 +1,1206 @@
+(** Translation of parallel moves into sequences of individual moves *)
+
+(** The ``parallel move'' problem, also known as ``parallel assignment'',
+  is the following.  We are given a list of (source, destination) pairs
+  of locations.  The goal is to find a sequence of elementary
+  moves ([loc <- loc] assignments) such that, at the end of the sequence,
+  location [dst] contains the value of location [src] at the beginning of
+  the sequence, for each ([src], [dst]) pairs in the given problem.
+  Moreover, other locations should keep their values, except one register
+  of each type, which can be used as temporaries in the generated sequences.
+
+  The parallel move problem is trivial if the sources and destinations do
+  not overlap.  For instance,
+<<
+  (R1, R2) <- (R3, R4)     becomes    R1 <- R3; R2 <- R4
+>>
+  However, arbitrary overlap is allowed between sources and destinations.
+  This requires some care in ordering the individual moves, as in
+<<
+  (R1, R2) <- (R3, R1)     becomes    R2 <- R1; R1 <- R3
+>>
+  Worse, cycles (permutations) can require the use of temporaries, as in
+<<
+  (R1, R2, R3) <- (R2, R3, R1)   becomes   T <- R1; R1 <- R2; R2 <- R3; R3 <- T;
+>>
+  An amazing fact is that for any parallel move problem, at most one temporary
+  (or in our case one integer temporary and one float temporary) is needed.
+
+  The development in this section was contributed by Laurence Rideau and
+  Bernard Serpette.  It is described in their paper
+  ``Coq à la conquête des moulins'', JFLA 2005, 
+  #<A HREF="http://www-sop.inria.fr/lemme/Laurence.Rideau/RideauSerpetteJFLA05.ps">#
+  http://www-sop.inria.fr/lemme/Laurence.Rideau/RideauSerpetteJFLA05.ps
+  #</A>#
+*)
+
+Require Import Coqlib.
+Require Recdef.
+
+Section PARMOV.
+
+Variable reg: Set.
+Variable temp: reg -> reg.
+
+Definition moves := (list (reg * reg))%type.  (* src -> dst *)
+
+Definition srcs (m: moves) := List.map (@fst reg reg) m.
+Definition dests (m: moves) := List.map (@snd reg reg) m.
+
+(* Semantics of moves *)
+
+Variable val: Set.
+Definition env := reg -> val.
+Variable reg_eq : forall (r1 r2: reg), {r1=r2} + {r1<>r2}.
+
+Lemma env_ext:
+  forall (e1 e2: env),
+  (forall r, e1 r = e2 r) -> e1 = e2.
+Proof (extensionality reg val).
+
+Definition update (r: reg) (v: val) (e: env) : env :=
+  fun r' => if reg_eq r' r then v else e r'.
+
+Lemma update_s:
+  forall r v e, update r v e r = v.
+Proof.
+  unfold update; intros. destruct (reg_eq r r). auto. congruence.
+Qed.
+
+Lemma update_o:
+  forall r v e r', r' <> r -> update r v e r' =  e r'.
+Proof.
+  unfold update; intros. destruct (reg_eq r' r). congruence. auto.
+Qed.
+
+Lemma update_ident:
+  forall r e, update r (e r) e = e.
+Proof.
+  intros. apply env_ext; intro. unfold update. destruct (reg_eq r0 r); congruence.
+Qed.
+
+Lemma update_commut:
+  forall r1 v1 r2 v2 e,
+  r1 <> r2 ->
+  update r1 v1 (update r2 v2 e) = update r2 v2 (update r1 v1 e).
+Proof.
+  intros. apply env_ext; intro; unfold update. 
+  destruct (reg_eq r r1); destruct (reg_eq r r2); auto.
+  congruence.
+Qed.
+
+Lemma update_twice:
+  forall r v e,
+  update r v (update r v e) = update r v e.
+Proof.
+  intros. apply env_ext; intro; unfold update.
+  destruct (reg_eq r0 r); auto.
+Qed.
+
+Fixpoint exec_par (m: moves) (e: env) {struct m}: env :=
+  match m with
+  | nil => e
+  | (s, d) :: m' => update d (e s) (exec_par m' e)
+  end.
+
+Fixpoint exec_seq (m: moves) (e: env) {struct m}: env :=
+  match m with
+  | nil => e
+  | (s, d) :: m' => exec_seq m' (update d (e s) e)
+  end.
+
+Fixpoint exec_seq_rev (m: moves) (e: env) {struct m}: env :=
+  match m with
+  | nil => e
+  | (s, d) :: m' => 
+      let e' := exec_seq_rev m' e in
+      update d (e' s) e'
+  end.
+
+(* Specification of the parallel move *)
+
+Definition no_read (mu: moves) (d: reg) : Prop :=
+  ~In d (srcs mu).
+
+Inductive transition: moves -> moves -> moves
+                   -> moves -> moves -> moves -> Prop :=
+  | tr_nop: forall mu1 r mu2 sigma tau,
+      transition (mu1 ++ (r, r) :: mu2) sigma tau
+                 (mu1 ++ mu2) sigma tau
+  | tr_start: forall mu1 s d mu2 tau,
+      transition (mu1 ++ (s, d) :: mu2) nil tau
+                 (mu1 ++ mu2) ((s, d) :: nil) tau
+  | tr_push: forall mu1 d r mu2 s sigma tau,
+      transition (mu1 ++ (d, r) :: mu2) ((s, d) :: sigma) tau
+                 (mu1 ++ mu2) ((d, r) :: (s, d) :: sigma) tau
+  | tr_loop: forall mu sigma s d tau,
+      transition mu (sigma ++ (s, d) :: nil) tau
+                 mu (sigma ++ (temp s, d) :: nil) ((s, temp s) :: tau)
+  | tr_pop: forall mu s0 d0 s1 d1 sigma tau,
+      no_read mu d1 -> d1 <> s0 ->
+      transition mu ((s1, d1) :: sigma ++ (s0, d0) :: nil) tau
+                 mu (sigma ++ (s0, d0) :: nil) ((s1, d1) :: tau)
+  | tr_last: forall mu s d tau,
+      no_read mu d ->
+      transition mu ((s, d) :: nil) tau
+                 mu nil ((s, d) :: tau).
+
+Inductive transitions: moves -> moves -> moves
+                    -> moves -> moves -> moves -> Prop :=
+  | tr_refl:
+      forall mu sigma tau,
+      transitions mu sigma tau mu sigma tau
+  | tr_one:
+      forall mu1 sigma1 tau1 mu2 sigma2 tau2,
+      transition mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+      transitions mu1 sigma1 tau1 mu2 sigma2 tau2
+  | tr_trans:
+      forall mu1 sigma1 tau1 mu2 sigma2 tau2 mu3 sigma3 tau3,
+      transitions mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+      transitions mu2 sigma2 tau2 mu3 sigma3 tau3 ->
+      transitions mu1 sigma1 tau1 mu3 sigma3 tau3.
+
+(* Well-formedness properties *)
+
+Definition is_mill (m: moves) : Prop :=
+  list_norepet (dests m).
+
+Definition is_not_temp (r: reg) : Prop :=
+  forall d, r <> temp d.
+
+Definition move_no_temp (m: moves) : Prop :=
+  forall s d, In (s, d) m -> is_not_temp s /\ is_not_temp d.
+
+Definition temp_last (m: moves) : Prop :=
+  match List.rev m with
+  | nil => True
+  | (s, d) :: m' => is_not_temp d /\ move_no_temp m'
+  end.
+
+Definition is_first_dest (m: moves) (d: reg) : Prop :=
+  match m with
+  | nil => True
+  | (s0, d0) :: _ => d = d0
+  end.
+
+Inductive is_path: moves -> Prop :=
+  | is_path_nil:
+      is_path nil
+  | is_path_cons: forall s d m,
+      is_first_dest m s ->
+      is_path m ->
+      is_path ((s, d) :: m).
+
+Definition state_wf (mu sigma tau: moves) : Prop :=
+  is_mill (mu ++ sigma)
+  /\ move_no_temp mu
+  /\ temp_last sigma
+  /\ is_path sigma.
+
+(* Some properties of srcs and dests *)
+
+Lemma dests_append:
+  forall m1 m2, dests (m1 ++ m2) = dests m1 ++ dests m2.
+Proof.
+  intros. unfold dests. apply map_app. 
+Qed.
+
+Lemma dests_decomp:
+  forall m1 s d m2, dests (m1 ++ (s, d) :: m2) = dests m1 ++ d :: dests m2.
+Proof.
+  intros. unfold dests. rewrite map_app. reflexivity.
+Qed.
+
+Lemma srcs_append:
+  forall m1 m2, srcs (m1 ++ m2) = srcs m1 ++ srcs m2.
+Proof.
+  intros. unfold srcs. apply map_app. 
+Qed.
+
+Lemma srcs_decomp:
+  forall m1 s d m2, srcs (m1 ++ (s, d) :: m2) = srcs m1 ++ s :: srcs m2.
+Proof.
+  intros. unfold srcs. rewrite map_app. reflexivity.
+Qed.
+
+Lemma srcs_dests_combine:
+  forall s d,
+  List.length s = List.length d ->
+  srcs (List.combine s d) = s /\
+  dests (List.combine s d) = d.
+Proof.
+  induction s; destruct d; simpl; intros.
+  tauto.
+  discriminate.
+  discriminate.
+  elim (IHs d); intros. split; congruence. congruence.
+Qed.
+
+(* Some properties of is_mill and dests_disjoint *)
+
+Definition dests_disjoint (m1 m2: moves) : Prop :=
+  list_disjoint (dests m1) (dests m2).
+
+Lemma dests_disjoint_sym:
+  forall m1 m2,
+  dests_disjoint m1 m2 <-> dests_disjoint m2 m1.
+Proof.
+  unfold dests_disjoint; intros. 
+  split; intros; apply list_disjoint_sym; auto.
+Qed.
+
+Lemma dests_disjoint_cons_left:
+  forall m1 s d m2,
+  dests_disjoint ((s, d) :: m1) m2 <->
+  dests_disjoint m1 m2 /\ ~In d (dests m2).
+Proof.
+  unfold dests_disjoint, list_disjoint. 
+  simpl; intros; split; intros.
+  split. auto. firstorder. 
+  destruct H. elim H0; intro.
+  red; intro; subst. contradiction.
+  apply H; auto.
+Qed.
+
+Lemma dests_disjoint_cons_right:
+  forall m1 s d m2,
+  dests_disjoint m1 ((s, d) :: m2) <->
+  dests_disjoint m1 m2 /\ ~In d (dests m1).
+Proof.
+  intros. rewrite dests_disjoint_sym. rewrite dests_disjoint_cons_left. 
+  rewrite dests_disjoint_sym. tauto.
+Qed.
+
+Lemma dests_disjoint_append_left:
+  forall m1 m2 m3,
+  dests_disjoint (m1 ++ m2) m3 <->
+  dests_disjoint m1 m3 /\ dests_disjoint m2 m3.
+Proof.
+  unfold dests_disjoint, list_disjoint. 
+  intros; split; intros. split; intros.
+  apply H; eauto. rewrite dests_append. apply in_or_app. auto.
+  apply H; eauto. rewrite dests_append. apply in_or_app. auto.
+  destruct H. 
+  rewrite dests_append in H0. elim (in_app_or _ _ _ H0); auto.
+Qed.
+
+Lemma dests_disjoint_append_right:
+  forall m1 m2 m3,
+  dests_disjoint m1 (m2 ++ m3) <->
+  dests_disjoint m1 m2 /\ dests_disjoint m1 m3.
+Proof.
+  intros. rewrite dests_disjoint_sym. rewrite dests_disjoint_append_left. 
+  intuition; rewrite dests_disjoint_sym; assumption.
+Qed.
+
+Lemma is_mill_cons:
+  forall s d m,
+  is_mill ((s, d) :: m) <->
+  is_mill m /\ ~In d (dests m).
+Proof.
+  unfold is_mill, dests_disjoint; intros. simpl.
+  split; intros. 
+  inversion H; tauto.
+  constructor; tauto.
+Qed.
+
+Lemma is_mill_append:
+  forall m1 m2,
+  is_mill (m1 ++ m2) <->
+  is_mill m1 /\ is_mill m2 /\ dests_disjoint m1 m2.
+Proof.
+  unfold is_mill, dests_disjoint; intros. rewrite dests_append. 
+  apply list_norepet_app.
+Qed.
+
+(* Some properties of move_no_temp *)
+
+Lemma move_no_temp_append:
+  forall m1 m2,
+  move_no_temp m1 -> move_no_temp m2 -> move_no_temp (m1 ++ m2).
+Proof.
+  intros; red; intros. elim (in_app_or _ _ _ H1); intro. 
+  apply H; auto. apply H0; auto.
+Qed.
+
+Lemma move_no_temp_rev:
+  forall m, move_no_temp (List.rev m) -> move_no_temp m.
+Proof.
+  intros; red; intros. apply H. rewrite <- List.In_rev. auto.
+Qed.
+
+(* Some properties of temp_last *)
+
+Lemma temp_last_change_last_source:
+  forall s d s' sigma,
+  temp_last (sigma ++ (s, d) :: nil) ->
+  temp_last (sigma ++ (s', d) :: nil).
+Proof.
+  intros until sigma. unfold temp_last.
+  repeat rewrite rev_unit. auto.
+Qed.
+
+Lemma temp_last_push:
+  forall s1 d1 s2 d2 sigma,
+  temp_last ((s2, d2) :: sigma) ->
+  is_not_temp s1 -> is_not_temp d1 ->
+  temp_last ((s1, d1) :: (s2, d2) :: sigma).
+Proof.
+  unfold temp_last; intros. simpl. simpl in H. 
+  destruct (rev sigma); simpl in *.
+  intuition. red; simpl; intros. 
+  elim H; intros. inversion H4. subst; tauto. tauto. 
+  destruct p as [sN dN]. intuition. 
+  red; intros. elim (in_app_or _ _ _ H); intros. 
+  apply H3; auto.
+  elim H4; intros. inversion H5; subst; tauto. elim H5.
+Qed.
+
+Lemma temp_last_pop:
+  forall s1 d1 sigma s2 d2,
+  temp_last ((s1, d1) :: sigma ++ (s2, d2) :: nil) ->
+  temp_last (sigma ++ (s2, d2) :: nil).
+Proof.
+  intros until d2. 
+  change ((s1, d1) :: sigma ++ (s2, d2) :: nil)
+    with ((((s1, d1) :: nil) ++ sigma) ++ ((s2, d2) :: nil)).
+  unfold temp_last. repeat rewrite rev_unit. 
+  intuition. simpl in H1. red; intros. apply H1. 
+  apply in_or_app. auto. 
+Qed.
+
+(* Some properties of is_path *)
+
+Lemma is_path_pop:
+  forall s d m,
+  is_path ((s, d) :: m) -> is_path m.
+Proof.
+  intros. inversion H; subst. auto.
+Qed.
+
+Lemma is_path_change_last_source:
+  forall s s' d sigma,
+  is_path (sigma ++ (s, d) :: nil) ->
+  is_path (sigma ++ (s', d) :: nil).
+Proof.
+  induction sigma; simpl; intros.
+  constructor. red; auto. constructor.
+  inversion H; subst; clear H.
+  constructor. 
+  destruct sigma as [ | [s1 d1] sigma']; simpl; simpl in H2; auto.
+  auto.
+Qed.
+
+Lemma path_sources_dests:
+  forall s0 d0 sigma,
+  is_path (sigma ++ (s0, d0) :: nil) ->
+  List.incl (srcs (sigma ++ (s0, d0) :: nil))
+            (s0 :: dests (sigma ++ (s0, d0) :: nil)).
+Proof.
+  induction sigma; simpl; intros.
+  red; simpl; tauto.
+  inversion H; subst; clear H. simpl. 
+  assert (In s (dests (sigma ++ (s0, d0) :: nil))).
+    destruct sigma as [ | [s1 d1] sigma']; simpl; simpl in H2; intuition. 
+  apply incl_cons. simpl; tauto. 
+  apply incl_tran with (s0 :: dests (sigma ++ (s0, d0) :: nil)).
+  eapply IHsigma; eauto.   
+  red; simpl; tauto.
+Qed.
+
+Lemma no_read_path:
+  forall d1 sigma s0 d0,
+  d1 <> s0 ->
+  is_path (sigma ++ (s0, d0) :: nil) ->
+  ~In d1 (dests (sigma ++ (s0, d0) :: nil)) ->  
+  no_read (sigma ++ (s0, d0) :: nil) d1.
+Proof.
+  intros.
+  generalize (path_sources_dests _ _ _ H0). intro. 
+  intro. elim H1. elim (H2 _ H3); intro. congruence. auto.
+Qed.
+
+(* Populating a rewrite database. *)
+
+Lemma notin_dests_cons:
+  forall x s d m,
+  ~In x (dests ((s, d) :: m)) <-> x <> d /\ ~In x (dests m).
+Proof.
+  intros. simpl. intuition auto. 
+Qed.
+
+Lemma notin_dests_append:
+  forall d m1 m2,
+  ~In d (dests (m1 ++ m2)) <-> ~In d (dests m1) /\ ~In d (dests m2).
+Proof.
+  intros. rewrite dests_append. rewrite in_app. tauto.
+Qed.
+
+Hint Rewrite is_mill_cons is_mill_append 
+  dests_disjoint_cons_left dests_disjoint_cons_right
+  dests_disjoint_append_left dests_disjoint_append_right
+  notin_dests_cons notin_dests_append: pmov.
+
+(* Preservation of well-formedness *)
+
+Lemma transition_preserves_wf:
+  forall mu sigma tau mu' sigma' tau',
+  transition mu sigma tau mu' sigma' tau' ->
+  state_wf mu sigma tau -> state_wf mu' sigma' tau'.
+Proof.
+  induction 1; unfold state_wf; intros [A [B [C D]]];
+  autorewrite with pmov in A; autorewrite with pmov.
+
+  (* Nop *)
+  split. tauto.
+  split. red; intros. apply B. apply list_in_insert; auto.
+  split; auto.
+
+  (* Start *)
+  split. tauto.
+  split. red; intros. apply B. apply list_in_insert; auto.
+  split. red. simpl. split. elim (B s d). auto. 
+  apply in_or_app. right. apply in_eq. 
+  red; simpl; tauto.
+  constructor. exact I. constructor. 
+
+  (* Push *)
+  split. intuition.
+  split. red; intros. apply B. apply list_in_insert; auto.
+  split. elim (B d r). apply temp_last_push; auto. 
+  apply in_or_app; right; apply in_eq.
+  constructor. simpl. auto. auto.
+
+  (* Loop *)
+  split. tauto. 
+  split. auto.
+  split. eapply temp_last_change_last_source; eauto. 
+  eapply is_path_change_last_source; eauto.
+
+  (* Pop *)
+  split. intuition.
+  split. auto.
+  split. eapply temp_last_pop; eauto.
+  eapply is_path_pop; eauto.
+
+  (* Last *)
+  split. intuition. 
+  split. auto.
+  split. unfold temp_last. simpl. auto.
+  constructor.
+Qed.
+
+Lemma transitions_preserve_wf:
+  forall mu sigma tau mu' sigma' tau',
+  transitions mu sigma tau mu' sigma' tau' ->
+  state_wf mu sigma tau -> state_wf mu' sigma' tau'.
+Proof.
+  induction 1; intros; eauto.
+  eapply transition_preserves_wf; eauto.
+Qed.
+
+(* Properties of exec_ *)
+
+Lemma exec_par_outside:
+  forall m e r, ~In r (dests m) -> exec_par m e r = e r.
+Proof.
+  induction m; simpl; intros. auto.
+  destruct a as [s d]. rewrite update_o. apply IHm. tauto. 
+  simpl in H. intuition.
+Qed.
+
+Lemma exec_par_lift:
+  forall m1 s d m2 e,
+  ~In d (dests m1) ->
+  exec_par (m1 ++ (s, d) :: m2) e = exec_par ((s, d) :: m1 ++ m2) e.
+Proof.
+  induction m1; simpl; intros.
+  auto.
+  destruct a as [s0 d0]. simpl in H. rewrite IHm1. simpl. 
+  apply update_commut. tauto. tauto. 
+Qed.
+
+Lemma exec_par_ident:
+  forall m1 r m2 e,
+  is_mill (m1 ++ (r, r) :: m2) ->
+  exec_par (m1 ++ (r, r) :: m2) e = exec_par (m1 ++ m2) e.
+Proof.
+  intros. autorewrite with pmov in H. 
+  rewrite exec_par_lift. simpl. 
+  replace (e r) with (exec_par (m1 ++ m2) e r). apply update_ident. 
+  apply exec_par_outside. autorewrite with pmov. tauto. tauto.
+Qed.
+
+Lemma exec_seq_app:
+  forall m1 m2 e,
+  exec_seq (m1 ++ m2) e = exec_seq m2 (exec_seq m1 e).
+Proof.
+  induction m1; simpl; intros. auto. 
+  destruct a as [s d]. rewrite IHm1. auto.
+Qed.
+
+Lemma exec_seq_rev_app:
+  forall m1 m2 e,
+  exec_seq_rev (m1 ++ m2) e = exec_seq_rev m1 (exec_seq_rev m2 e).
+Proof.
+  induction m1; simpl; intros. auto. 
+  destruct a as [s d]. rewrite IHm1. auto.
+Qed.
+
+Lemma exec_seq_exec_seq_rev:
+  forall m e,
+  exec_seq_rev m e = exec_seq (List.rev m) e.
+Proof.
+  induction m; simpl; intros.
+  auto.
+  destruct a as [s d]. rewrite exec_seq_app. simpl. rewrite IHm. auto.
+Qed.
+
+Lemma exec_seq_rev_exec_seq:
+  forall m e,
+  exec_seq m e = exec_seq_rev (List.rev m) e.
+Proof.
+  intros. generalize (exec_seq_exec_seq_rev (List.rev m) e).
+  rewrite List.rev_involutive. auto.
+Qed.
+
+Lemma exec_par_update_no_read:
+  forall s d m e,
+  no_read m d ->
+  ~In d (dests m) ->
+  exec_par m (update d (e s) e) =
+  update d (e s) (exec_par m e).
+Proof.
+  unfold no_read; induction m; simpl; intros.
+  auto.
+  destruct a as [s0 d0]; simpl in *. rewrite IHm. 
+  rewrite update_commut. f_equal. f_equal. 
+  apply update_o. tauto. tauto. tauto. tauto.
+Qed.
+
+Lemma exec_par_append_eq:
+  forall m1 m2 m3 e2 e3,
+  exec_par m2 e2 = exec_par m3 e3 ->
+  (forall r, In r (srcs m1) -> e2 r = e3 r) ->
+  exec_par (m1 ++ m2) e2 = exec_par (m1 ++ m3) e3.
+Proof.
+  induction m1; simpl; intros.
+  auto. destruct a as [s d]. f_equal; eauto.
+Qed.
+
+Lemma exec_par_combine:
+  forall e sl dl,
+  List.length sl = List.length dl ->
+  list_norepet dl ->
+  let e' := exec_par (combine sl dl) e in
+  List.map e' dl = List.map e sl /\
+  (forall l, ~In l dl -> e' l = e l).
+Proof.
+  induction sl; destruct dl; simpl; intros; try discriminate.
+  split; auto.
+  inversion H0; subst; clear H0. 
+  injection H; intro; clear H.
+  destruct (IHsl dl H0 H4) as [A B].
+  set (e' := exec_par (combine sl dl) e) in *.
+  split.
+  decEq. apply update_s. 
+  rewrite <- A. apply list_map_exten; intros.
+  rewrite update_o. auto. congruence. 
+  intros. rewrite update_o. apply B. tauto. intuition.
+Qed.
+
+(* Semantics of triples (mu, sigma, tau) *)
+
+Definition statemove (mu sigma tau: moves) (e: env) :=
+  exec_par (mu ++ sigma) (exec_seq_rev tau e).
+
+(* Equivalence over non-temp regs *)
+
+Definition env_equiv (e1 e2: env) : Prop :=
+  forall r, is_not_temp r -> e1 r = e2 r.
+
+Lemma env_equiv_refl:
+  forall e, env_equiv e e.
+Proof.
+  unfold env_equiv; auto.
+Qed.
+
+Lemma env_equiv_refl':
+  forall e1 e2, e1 = e2 -> env_equiv e1 e2.
+Proof.
+  unfold env_equiv; intros. rewrite H. auto.
+Qed.
+
+Lemma env_equiv_sym:
+  forall e1 e2, env_equiv e1 e2 -> env_equiv e2 e1.
+Proof.
+  unfold env_equiv; intros. symmetry; auto.
+Qed.
+
+Lemma env_equiv_trans:
+  forall e1 e2 e3, env_equiv e1 e2 -> env_equiv e2 e3 -> env_equiv e1 e3.
+Proof.
+  unfold env_equiv; intros. transitivity (e2 r); auto.
+Qed.
+
+Lemma exec_par_env_equiv:
+  forall m e1 e2,
+  move_no_temp m ->
+  env_equiv e1 e2 ->
+  env_equiv (exec_par m e1) (exec_par m e2).
+Proof.
+  unfold move_no_temp; induction m; simpl; intros.
+  auto.
+  destruct a as [s d]. 
+  red; intros. unfold update. destruct (reg_eq r d).
+  apply H0. elim (H s d); tauto. 
+  apply IHm; auto. 
+Qed.
+
+(* Preservation of semantics by transformations. *)
+
+Lemma transition_preserves_semantics:
+  forall mu1 sigma1 tau1 mu2 sigma2 tau2 e,
+  transition mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+  state_wf mu1 sigma1 tau1 ->
+  env_equiv (statemove mu2 sigma2 tau2 e) (statemove mu1 sigma1 tau1 e).
+Proof.
+  induction 1; intros [A [B [C D]]].
+
+  (* nop *)
+  apply env_equiv_refl'. unfold statemove. 
+  repeat rewrite app_ass. simpl. symmetry. apply exec_par_ident. 
+  rewrite app_ass in A. exact A. 
+
+  (* start *)
+  apply env_equiv_refl'. unfold statemove. 
+  autorewrite with pmov in A. 
+  rewrite exec_par_lift. repeat rewrite app_ass. simpl. rewrite exec_par_lift. reflexivity.
+  tauto. autorewrite with pmov. tauto. 
+
+  (* push *)
+  apply env_equiv_refl'. unfold statemove. 
+  autorewrite with pmov in A.
+  rewrite exec_par_lift. rewrite exec_par_lift. simpl.
+  rewrite exec_par_lift. repeat rewrite app_ass. simpl. rewrite exec_par_lift. 
+  simpl. apply update_commut. intuition. 
+  tauto. autorewrite with pmov; tauto. 
+  autorewrite with pmov; intuition. 
+  autorewrite with pmov; intuition.
+
+  (* loop *)
+  unfold statemove. simpl exec_seq_rev. 
+  set (e1 := exec_seq_rev tau e). 
+  autorewrite with pmov in A.
+  repeat rewrite <- app_ass. 
+  assert (~In d (dests (mu ++ sigma))). autorewrite with pmov. tauto. 
+  repeat rewrite exec_par_lift; auto. simpl. 
+  repeat rewrite <- app_nil_end.
+  assert (move_no_temp (mu ++ sigma)).
+    red in C. rewrite rev_unit in C. destruct C. 
+    apply move_no_temp_append; auto. apply move_no_temp_rev; auto.
+  set (e2 := update (temp s) (e1 s) e1).
+  set (e3 := exec_par (mu ++ sigma) e1).
+  set (e4 := exec_par (mu ++ sigma) e2).
+  assert (env_equiv e2 e1).
+    unfold e2; red; intros. apply update_o. apply H1. 
+  assert (env_equiv e4 e3).
+    unfold e4, e3. apply exec_par_env_equiv; auto.
+  red; intros. unfold update. destruct (reg_eq r d). 
+  unfold e2. apply update_s. apply H2. auto.
+
+  (* pop *)
+  apply env_equiv_refl'. unfold statemove. simpl exec_seq_rev. 
+  set (e1 := exec_seq_rev tau e).
+  autorewrite with pmov in A.
+  apply exec_par_append_eq. simpl. 
+  apply exec_par_update_no_read. 
+  apply no_read_path; auto. eapply is_path_pop; eauto. 
+  autorewrite with pmov; tauto.
+  autorewrite with pmov; tauto.
+  intros. apply update_o. red; intro; subst r. elim (H H1). 
+
+  (* last *)
+  apply env_equiv_refl'. unfold statemove. simpl exec_seq_rev.
+  set (e1 := exec_seq_rev tau e).
+  apply exec_par_append_eq. simpl. auto.
+  intros. apply update_o. red; intro; subst r. elim (H H0).
+Qed.
+
+Lemma transitions_preserve_semantics:
+  forall mu1 sigma1 tau1 mu2 sigma2 tau2 e,
+  transitions mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+  state_wf mu1 sigma1 tau1 ->
+  env_equiv (statemove mu2 sigma2 tau2 e) (statemove mu1 sigma1 tau1 e).
+Proof.
+  induction 1; intros. 
+  apply env_equiv_refl. 
+  eapply transition_preserves_semantics; eauto.
+  apply env_equiv_trans with (statemove mu2 sigma2 tau2 e).
+  apply IHtransitions2. eapply transitions_preserve_wf; eauto.
+  apply IHtransitions1. auto.
+Qed.
+
+Lemma state_wf_start:
+  forall mu,
+  move_no_temp mu ->
+  is_mill mu ->
+  state_wf mu nil nil.
+Proof.
+  split. rewrite <- app_nil_end. auto. 
+  split. auto.
+  split. red. simpl. auto.
+  constructor.
+Qed.  
+
+Theorem transitions_correctness:
+  forall mu tau,
+  move_no_temp mu ->
+  is_mill mu ->
+  transitions mu nil nil  nil nil tau ->
+  forall e, env_equiv (exec_seq (List.rev tau) e) (exec_par mu e).
+Proof.
+  intros. 
+  generalize (transitions_preserve_semantics _ _ _ _ _ _ e H1
+              (state_wf_start _ H H0)).
+  unfold statemove. simpl. rewrite <- app_nil_end. 
+  rewrite exec_seq_exec_seq_rev. auto.
+Qed.
+
+(* Determinisation of the transition relation *)
+
+Inductive dtransition: moves -> moves -> moves
+                    -> moves -> moves -> moves -> Prop :=
+  | dtr_nop: forall r mu tau,
+      dtransition ((r, r) :: mu) nil tau
+                   mu nil tau
+  | dtr_start: forall s d mu tau,
+      s <> d ->
+      dtransition ((s, d) :: mu) nil tau
+                   mu ((s, d) :: nil) tau
+  | dtr_push: forall mu1 d r mu2 s sigma tau,
+      no_read mu1 d ->
+      dtransition (mu1 ++ (d, r) :: mu2) ((s, d) :: sigma) tau
+                   (mu1 ++ mu2) ((d, r) :: (s, d) :: sigma) tau
+  | dtr_loop_pop: forall mu s r0 d  sigma tau,
+      no_read mu r0 ->
+      dtransition mu ((s, r0) :: sigma ++ (r0, d) :: nil) tau
+                   mu (sigma ++ (temp r0, d) :: nil) ((s, r0) :: (r0, temp r0) :: tau)
+  | dtr_pop: forall mu s0 d0 s1 d1 sigma tau,
+      no_read mu d1 -> d1 <> s0 ->
+      dtransition mu ((s1, d1) :: sigma ++ (s0, d0) :: nil) tau
+                   mu (sigma ++ (s0, d0) :: nil) ((s1, d1) :: tau)
+  | dtr_last: forall mu s d tau,
+      no_read mu d ->
+      dtransition mu ((s, d) :: nil) tau
+                   mu nil ((s, d) :: tau).
+
+Inductive dtransitions: moves -> moves -> moves
+                      -> moves -> moves -> moves -> Prop :=
+  | dtr_refl:
+      forall mu sigma tau,
+      dtransitions mu sigma tau mu sigma tau
+  | dtr_one:
+      forall mu1 sigma1 tau1 mu2 sigma2 tau2,
+      dtransition mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+      dtransitions mu1 sigma1 tau1 mu2 sigma2 tau2
+  | dtr_trans:
+      forall mu1 sigma1 tau1 mu2 sigma2 tau2 mu3 sigma3 tau3,
+      dtransitions mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+      dtransitions mu2 sigma2 tau2 mu3 sigma3 tau3 ->
+      dtransitions mu1 sigma1 tau1 mu3 sigma3 tau3.
+
+Lemma transition_determ:
+  forall mu1 sigma1 tau1 mu2 sigma2 tau2,
+  dtransition mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+  state_wf mu1 sigma1 tau1 ->
+  transitions mu1 sigma1 tau1 mu2 sigma2 tau2.
+Proof.
+  induction 1; intro.
+  apply tr_one. exact (tr_nop nil r mu nil tau). 
+  apply tr_one. exact (tr_start nil s d mu tau). 
+  apply tr_one. apply tr_push. 
+  eapply tr_trans.
+    apply tr_one. 
+    change ((s, r0) :: sigma ++ (r0, d) :: nil)
+      with (((s, r0) :: sigma) ++ (r0, d) :: nil).
+    apply tr_loop. 
+    apply tr_one. simpl. apply tr_pop. auto. 
+    destruct H0 as [A [B [C D]]]. 
+    generalize C. 
+    change ((s, r0) :: sigma ++ (r0, d) :: nil)
+      with (((s, r0) :: sigma) ++ (r0, d) :: nil).
+    unfold temp_last; rewrite List.rev_unit. intros [E F].
+    elim (F s r0). unfold is_not_temp. auto. 
+    rewrite <- List.In_rev. apply in_eq.
+  apply tr_one. apply tr_pop. auto. auto. 
+  apply tr_one. apply tr_last. auto. 
+Qed.
+
+Lemma transitions_determ:
+  forall mu1 sigma1 tau1 mu2 sigma2 tau2,
+  dtransitions mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+  state_wf mu1 sigma1 tau1 ->
+  transitions mu1 sigma1 tau1 mu2 sigma2 tau2.
+Proof.
+  induction 1; intros.
+  apply tr_refl.
+  eapply transition_determ; eauto.
+  eapply tr_trans.
+    apply IHdtransitions1. auto.
+    apply IHdtransitions2. eapply transitions_preserve_wf; eauto.
+Qed.
+
+Theorem dtransitions_correctness:
+  forall mu tau,
+  move_no_temp mu ->
+  is_mill mu ->
+  dtransitions mu nil nil  nil nil tau ->
+  forall e, env_equiv (exec_seq (List.rev tau) e) (exec_par mu e).
+Proof.
+  intros. 
+  eapply transitions_correctness; eauto.
+  apply transitions_determ. auto. apply state_wf_start; auto. 
+Qed.
+
+(* Transition function *)
+
+Function split_move (m: moves) (r: reg) {struct m} : option (moves * reg * moves) :=
+  match m with
+  | nil => None
+  | (s, d) :: tl =>
+      if reg_eq s r
+      then Some (nil, d, tl)
+      else match split_move tl r with
+           | None => None
+           | Some (before, d', after) => Some ((s, d) :: before, d', after)
+           end
+  end.
+
+Function is_last_source (r: reg) (m: moves) {struct m} : bool :=
+  match m with
+  | nil => false
+  | (s, d) :: nil =>
+      if reg_eq s r then true else false
+  | (s, d) :: tl =>
+      is_last_source r tl
+  end.
+
+Function replace_last_source (r: reg) (m: moves) {struct m} : moves :=
+  match m with
+  | nil => nil
+  | (s, d) :: nil => (r, d) :: nil
+  | s_d :: tl => s_d :: replace_last_source r tl
+  end.
+
+Inductive state : Set := State: moves -> moves -> moves -> state.
+
+Definition final_state (st: state) : bool :=
+  match st with
+  | State nil nil _ => true
+  | _ => false
+  end.
+
+Function parmove_step (st: state) : state :=
+  match st with
+  | State nil nil _ => st
+  | State ((s, d) :: tl) nil l =>
+      if reg_eq s d
+      then State tl nil l
+      else State tl ((s, d) :: nil) l
+  | State t ((s, d) :: b) l =>
+      match split_move t d with
+      | Some (t1, r, t2) =>
+          State (t1 ++ t2) ((d, r) :: (s, d) :: b) l
+      | None =>
+          match b with
+          | nil => State t nil ((s, d) :: l)
+          | _ =>
+              if is_last_source d b
+              then State t (replace_last_source (temp d) b) ((s, d) :: (d, temp d) :: l)
+              else State t b ((s, d) :: l)
+          end
+      end
+  end.
+
+(* Correctness properties of these functions *)
+
+Lemma split_move_charact:
+  forall m r,
+  match split_move m r with
+  | Some (before, d, after) => m = before ++ (r, d) :: after /\ no_read before r
+  | None => no_read m r
+  end.
+Proof.
+  unfold no_read. intros m r. functional induction (split_move m r).
+  red; simpl. tauto.
+  rewrite _x. split. reflexivity. simpl;auto.
+  rewrite e1 in IHo. simpl. intuition.
+  rewrite e1 in IHo. destruct IHo. split. rewrite H. reflexivity.
+  simpl. intuition.
+Qed.
+
+Lemma is_last_source_charact:
+  forall r s d m,
+  if is_last_source r (m ++ (s, d) :: nil)
+  then s = r
+  else s <> r.
+Proof.
+  induction m; simpl. 
+  destruct (reg_eq s r); congruence.
+  destruct a as [s0 d0]. case_eq (m ++ (s, d) :: nil); intros.
+  generalize (app_cons_not_nil m nil (s, d)). congruence.
+  rewrite <- H. auto. 
+Qed.
+
+Lemma replace_last_source_charact:
+  forall s d s' m,
+  replace_last_source s' (m ++ (s, d) :: nil) =
+  m ++ (s', d) :: nil.
+Proof.
+  induction m; simpl.
+  auto.
+  destruct a as [s0 d0]. case_eq (m ++ (s, d) :: nil); intros.
+  generalize (app_cons_not_nil m nil (s, d)). congruence.
+  rewrite <- H. congruence.
+Qed.
+
+Lemma parmove_step_compatible:
+  forall mu sigma tau mu' sigma' tau',
+  final_state (State mu sigma tau) = false ->
+  parmove_step (State mu sigma tau) = State mu' sigma' tau' ->
+  dtransition mu sigma tau mu' sigma' tau'.
+Proof.
+  intros until tau'. intro NOTFINAL.
+  unfold parmove_step. 
+  case_eq mu; [intros MEQ | intros [ms md] mtl MEQ]. 
+  case_eq sigma; [intros SEQ | intros [ss sd] stl SEQ]. 
+  subst mu sigma. discriminate. 
+  simpl. 
+  case_eq stl; [intros STLEQ | intros xx1 xx2 STLEQ].
+  intro R; inversion R; clear R; subst.
+  apply dtr_last. red; simpl; auto.
+  elim (@exists_last _ stl). 2:congruence. intros sigma1 [[ss1 sd1] SEQ2]. 
+  rewrite <- STLEQ. clear STLEQ xx1 xx2. 
+  generalize (is_last_source_charact sd ss1 sd1 sigma1). 
+  rewrite SEQ2. destruct (is_last_source sd (sigma1 ++ (ss1, sd1) :: nil)).
+  intro. subst ss1. intro R; inversion R; clear R; subst.
+  rewrite replace_last_source_charact. apply dtr_loop_pop. 
+  red; simpl; auto.
+  intro. intro R; inversion R; clear R; subst.
+  apply dtr_pop. red; simpl; auto. auto. 
+
+  case_eq sigma; [intros SEQ | intros [ss sd] stl SEQ]. 
+  destruct (reg_eq ms md); intro R; inversion R; clear R; subst.
+  apply dtr_nop. 
+  apply dtr_start. auto.
+
+  generalize (split_move_charact ((ms, md) :: mtl) sd).
+  case (split_move ((ms, md) :: mtl) sd); [intros [[before r] after] | idtac].
+  intros [MEQ2 NOREAD]. intro R; inversion R; clear R; subst.
+  rewrite MEQ2. apply dtr_push. auto.
+  intro NOREAD.
+  case_eq stl; [intros STLEQ | intros xx1 xx2 STLEQ].
+  intro R; inversion R; clear R; subst.
+  apply dtr_last. auto.
+  elim (@exists_last _ stl). 2:congruence. intros sigma1 [[ss1 sd1] SEQ2]. 
+  rewrite <- STLEQ. clear STLEQ xx1 xx2. 
+  generalize (is_last_source_charact sd ss1 sd1 sigma1). 
+  rewrite SEQ2. destruct (is_last_source sd (sigma1 ++ (ss1, sd1) :: nil)).
+  intro. subst ss1. intro R; inversion R; clear R; subst.
+  rewrite replace_last_source_charact. apply dtr_loop_pop. auto.
+  intro. intro R; inversion R; clear R; subst.
+  apply dtr_pop. auto. auto.
+Qed.
+
+(* Decreasing measure over states *)
+
+Open Scope nat_scope.
+
+Definition measure (st: state) : nat :=
+  match st with
+  | State mu sigma tau => 2 * List.length mu + List.length sigma
+  end.
+
+Lemma measure_decreasing_1:
+  forall mu1 sigma1 tau1 mu2 sigma2 tau2,
+  dtransition mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+  measure (State mu2 sigma2 tau2) < measure (State mu1 sigma1 tau1).
+Proof.
+  induction 1; repeat (simpl; rewrite List.app_length); simpl; omega.
+Qed.
+
+Lemma measure_decreasing_2:
+  forall st,
+  final_state st = false ->
+  measure (parmove_step st) < measure st.
+Proof.
+  intros. destruct st as [mu sigma tau]. 
+  case_eq (parmove_step (State mu sigma tau)). intros mu' sigma' tau' EQ.
+  apply measure_decreasing_1. 
+  apply parmove_step_compatible; auto.
+Qed.
+
+(* Compilation function for parallel moves *)
+
+Function parmove_aux (st: state) {measure measure st} : moves :=
+  if final_state st 
+  then match st with State _ _ tau => tau end
+  else parmove_aux (parmove_step st).
+Proof.
+  intros. apply measure_decreasing_2. auto.
+Qed.
+
+Lemma parmove_aux_transitions:
+  forall mu sigma tau,
+  dtransitions mu sigma tau nil nil (parmove_aux (State mu sigma tau)).
+Proof.
+  assert (forall st,
+          match st with State mu sigma tau =>
+             dtransitions mu sigma tau nil nil (parmove_aux st)
+          end).
+    intro st. functional induction (parmove_aux st).
+    destruct _x; destruct _x0; simpl in e; discriminate || apply dtr_refl.
+    case_eq (parmove_step st). intros mu' sigma' tau' PSTEP.
+    destruct st as [mu sigma tau]. 
+    eapply dtr_trans. apply dtr_one. apply parmove_step_compatible; eauto. 
+    rewrite PSTEP in IHm. auto.
+
+  intros. apply (H (State mu sigma tau)). 
+Qed.
+
+Definition parmove (mu: moves) : moves :=
+  List.rev (parmove_aux (State mu nil nil)).
+
+Theorem parmove_correctness:
+  forall mu,
+  move_no_temp mu -> is_mill mu ->
+  forall e,
+  env_equiv (exec_seq (parmove mu) e) (exec_par mu e).
+Proof.
+  intros. unfold parmove. apply dtransitions_correctness; auto.
+  apply parmove_aux_transitions. 
+Qed.
+
+Definition parmove2 (sl dl: list reg) : moves :=
+  parmove (List.combine sl dl).
+
+Theorem parmove2_correctness:
+  forall sl dl,
+  List.length sl = List.length dl ->
+  list_norepet dl ->
+  (forall r, In r sl -> is_not_temp r) ->
+  (forall r, In r dl -> is_not_temp r) ->
+  forall e,
+  let e' := exec_seq (parmove2 sl dl) e in
+  List.map e' dl = List.map e sl /\
+  forall r, ~In r dl -> is_not_temp r -> e' r = e r.
+Proof.
+  intros. 
+  destruct (srcs_dests_combine sl dl H) as [A B].
+  assert (env_equiv e' (exec_par (List.combine sl dl) e)).
+    unfold e', parmove2. apply parmove_correctness.
+    red; intros; split.
+    apply H1. eapply List.in_combine_l; eauto.
+    apply H2. eapply List.in_combine_r; eauto.
+    red. rewrite B. auto.
+  destruct (exec_par_combine e sl dl H H0) as [C D].
+  set (e1 := exec_par (combine sl dl) e) in *.
+  split. rewrite <- C. apply list_map_exten; intros. 
+  symmetry. apply H3. auto. 
+  intros. transitivity (e1 r); auto.
+Qed.
+
+(* Additional properties on the generated sequence of moves. *)
+
+Section PROPERTIES.
+
+Variable initial_move: moves.
+
+Inductive wf_move: reg -> reg -> Prop :=
+  | wf_move_same: forall s d,
+      In (s, d) initial_move -> wf_move s d
+  | wf_move_temp_left: forall s d,
+      wf_move s d -> wf_move (temp s) d
+  | wf_move_temp_right: forall s d,
+      wf_move s d -> wf_move s (temp s).
+
+Definition wf_moves (m: moves) : Prop :=
+  forall s d, In (s, d) m -> wf_move s d.
+
+Lemma wf_moves_cons: forall s d m,
+  wf_moves ((s, d) :: m) <-> wf_move s d /\ wf_moves m.
+Proof.
+  unfold wf_moves; intros; simpl. firstorder. 
+  inversion H0; subst s0 d0. auto.
+Qed.
+
+Lemma wf_moves_append: forall m1 m2,
+  wf_moves (m1 ++ m2) <-> wf_moves m1 /\ wf_moves m2.
+Proof.
+  unfold wf_moves; intros. split; intros.
+  split; intros; apply H; apply in_or_app; auto.
+  destruct H. elim (in_app_or _ _ _ H0); intro; auto.
+Qed.
+
+Hint Rewrite wf_moves_cons wf_moves_append: pmov.
+
+Definition wf_state (mu sigma tau: moves) : Prop :=
+  wf_moves mu /\ wf_moves sigma /\ wf_moves tau.
+
+Lemma dtransition_preserves_wf_state:
+  forall mu1 sigma1 tau1 mu2 sigma2 tau2,
+  dtransition mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+  wf_state mu1 sigma1 tau1 -> wf_state mu2 sigma2 tau2.
+Proof.
+  induction 1; intros [A [B C]]; unfold wf_state;
+  autorewrite with pmov in A; autorewrite with pmov in B; 
+  autorewrite with pmov in C; autorewrite with pmov.
+
+  tauto.
+
+  tauto.
+
+  tauto. 
+
+  intuition. apply wf_move_temp_left; auto. 
+  eapply wf_move_temp_right; eauto.
+
+  intuition. 
+
+  intuition.
+Qed.
+
+Lemma dtransitions_preserve_wf_state:
+  forall mu1 sigma1 tau1 mu2 sigma2 tau2,
+  dtransitions mu1 sigma1 tau1 mu2 sigma2 tau2 ->
+  wf_state mu1 sigma1 tau1 -> wf_state mu2 sigma2 tau2.
+Proof.
+  induction 1; intros; eauto. 
+  eapply dtransition_preserves_wf_state; eauto.
+Qed.  
+
+End PROPERTIES.
+
+Lemma parmove_wf_moves:
+  forall mu, wf_moves mu (parmove mu).
+Proof.
+  intros. 
+  assert (wf_state mu mu nil nil).
+    split. red; intros. apply wf_move_same. auto.
+    split. red; simpl; tauto. red; simpl; tauto.
+  generalize (dtransitions_preserve_wf_state mu
+              _ _ _ _ _ _
+              (parmove_aux_transitions mu nil nil) H).
+  intros [A [B C]].
+  unfold parmove. red; intros. apply C. 
+  rewrite List.In_rev. auto.
+Qed.
+
+Lemma parmove2_wf_moves:
+  forall sl dl, wf_moves (List.combine sl dl) (parmove2 sl dl).
+Proof.
+  intros. unfold parmove2. apply parmove_wf_moves. 
+Qed.
+
+End PARMOV.
diff --git a/lib/union_find.v b/lib/union_find.v
index 61817d7..452459f 100644
--- a/lib/union_find.v
+++ b/lib/union_find.v
@@ -1,6 +1,7 @@
 (** A purely functional union-find algorithm *)
 
 Require Import Wf.
+Require Recdef.
 
 (** The ``union-find'' algorithm is used to represent equivalence classes
   over a given type.  It maintains a data structure representing a partition
@@ -27,21 +28,6 @@ Require Import Wf.
   presentation where the mapping is a separate functional data structure.
 *)
 
-Ltac CaseEq name :=
-  generalize (refl_equal name); pattern name at -1 in |- *; case name.
-
-Ltac IntroElim :=
-  match goal with
-  |  |- (forall id : exists x : _, _, _) =>
-      intro id; elim id; clear id; IntroElim
-  |  |- (forall id : _ /\ _, _) => intro id; elim id; clear id; IntroElim
-  |  |- (forall id : _ \/ _, _) => intro id; elim id; clear id; IntroElim
-  |  |- (_ -> _) => intro; IntroElim
-  | _ => idtac
-  end.
-
-Ltac MyElim n := elim n; IntroElim.
-
 (** The elements of equivalence classes are represented by the following
   signature: a type with a decidable equality. *)
 
@@ -139,82 +125,47 @@ Definition repr_order (m: M.T) (a a': elt) : Prop :=
 (** The canonical representative of an element.  
   Needs Noetherian recursion. *)
 
-Lemma option_sum:
-  forall (x: option elt), {y: elt | x = Some y} + {x = None}.
-Proof.
-  intro x. case x.
-  left. exists e. auto.
-  right. auto.
-Qed.
+Section REPR.
+
+Variable m: M.T.
+Variable wf: well_founded (repr_order m).
 
-Definition repr_rec
-  (m: M.T) (a: elt) (rec: forall b: elt, repr_order m b a -> elt) :=
-     match option_sum (M.get a m) with
-     | inleft (exist b P) => rec b P
-     | inright _ => a
-     end.
-
-Definition repr_aux
-    (m: M.T) (wf: well_founded (repr_order m)) (a: elt) : elt :=
-  Fix wf (fun (_: elt) => elt) (repr_rec m) a.
-
-Lemma repr_rec_ext:
-  forall (m: M.T) (x: elt) (f g: forall y:elt, repr_order m y x -> elt),
-  (forall (y: elt) (p: repr_order m y x), f y p = g y p) ->
-  repr_rec m x f = repr_rec m x g.
+Function repr_aux (a: elt) {wf (repr_order m) a} : elt :=
+  match M.get a m with
+  | Some a' => repr_aux a'
+  | None => a
+  end.
 Proof.
-  intros. unfold repr_rec. 
-  case (option_sum (M.get x m)).
-  intros. elim s; intros. apply H.
-  intros. auto.
+  intros.  assumption.
+  assumption.
 Qed.
 
 Lemma repr_aux_none:
-  forall (m: M.T) (wf: well_founded (repr_order m)) (a: elt),
+  forall (a: elt),
   M.get a m = None ->
-  repr_aux m wf a = a.
+  repr_aux a = a.
 Proof.
-  intros. 
-  generalize (Fix_eq wf (fun (_:elt) => elt) (repr_rec m) (repr_rec_ext m) a). 
-  intro. unfold repr_aux. rewrite H0. 
-  unfold repr_rec. 
-  case (option_sum (M.get a m)).
-  intro s; elim s; intros.
-  rewrite H in p; discriminate.
-  intros. auto.
+  intros. rewrite repr_aux_equation. rewrite H. auto.
 Qed.
 
 Lemma repr_aux_some:
-  forall (m: M.T) (wf: well_founded (repr_order m)) (a a': elt),
+  forall (a a': elt),
   M.get a m = Some a' ->
-  repr_aux m wf a = repr_aux m wf a'.
+  repr_aux a = repr_aux a'.
 Proof.
-  intros. 
-  generalize (Fix_eq wf (fun (_:elt) => elt) (repr_rec m) (repr_rec_ext m) a). 
-  intro. unfold repr_aux. rewrite H0. unfold repr_rec.
-  case (option_sum (M.get a m)).
-  intro s; elim s; intros.
-  rewrite H in p. injection p; intros. rewrite H1. auto.
-  intros. rewrite H in e. discriminate.
+  intros. rewrite repr_aux_equation. rewrite H. auto.
 Qed.
- 
+
 Lemma repr_aux_canon:
-  forall (m: M.T) (wf: well_founded (repr_order m)) (a: elt),
-  M.get (repr_aux m wf a) m = None.
+  forall (a: elt), M.get (repr_aux a) m = None.
 Proof.
-  intros.
-  apply (well_founded_ind wf (fun (a: elt) => M.get (repr_aux m wf a) m = None)).
-  intros.
-  generalize (Fix_eq wf (fun (_:elt) => elt) (repr_rec m) (repr_rec_ext m) x). 
-  intro. unfold repr_aux. rewrite H0. 
-  unfold repr_rec.
-  case (option_sum (M.get x m)).
-  intro s; elim s; intros. 
-  unfold repr_aux in H. apply H.
-  unfold repr_order. auto.
-  intro. auto.
+  intros a0.
+  apply (repr_aux_ind (fun a a' => M.get a' m = None)).
+  auto. auto.
 Qed.
 
+End REPR.
+
 (** The empty partition (each element in its own class) is well founded. *)
 
 Lemma wf_empty:
@@ -282,11 +233,9 @@ Proof.
 
   induction 1.
   apply Acc_intro. intros.
-  MyElim (identify_base_repr_order y x H1).
+  destruct (identify_base_repr_order y x H1) as [A | [A B]].
   apply H0; auto.
-  rewrite H3.
-  apply Acc_intro.
-  intros z H4.
+  subst x y. apply Acc_intro. intros z H4.
   red in H4. rewrite identify_base_b_canon in H4. discriminate.
 Qed.
 
@@ -312,31 +261,29 @@ Lemma identify_base_repr:
   repr_aux identify_base identify_base_order_wf x =
   (if E.eq (repr_aux m mwf x) a then b else repr_aux m mwf x).
 Proof.
-  intro x0.
   apply (well_founded_ind mwf
     (fun (x: elt) =>
       repr_aux identify_base identify_base_order_wf x =
       (if E.eq (repr_aux m mwf x) a then b else repr_aux m mwf x)));
   intros.
-  MyElim (identify_aux_decomp x).
+  destruct (identify_aux_decomp x) as [[A B] | [[A [B C]] | [y [A B]]]].
 
-  rewrite (repr_aux_none identify_base).
-  rewrite (repr_aux_none m mwf x).
+  rewrite (repr_aux_none identify_base); auto.
+  rewrite (repr_aux_none m mwf x); auto.
   case (E.eq x a); intro.
   subst x.
-  rewrite identify_base_a_maps_to_b in H1.
-  discriminate.
-  auto. auto. auto.
+  rewrite identify_base_a_maps_to_b in B. discriminate.
+  auto. 
 
   subst x. rewrite (repr_aux_none m mwf a); auto.
   case (E.eq a a); intro.
-  rewrite (repr_aux_some identify_base identify_base_order_wf a b).
-  rewrite (repr_aux_none identify_base identify_base_order_wf b).
-  auto. apply identify_base_b_canon. auto. 
+  rewrite (repr_aux_some identify_base identify_base_order_wf a b); auto.
+  rewrite (repr_aux_none identify_base identify_base_order_wf b); auto.
+  apply identify_base_b_canon. 
   tauto.
 
-  rewrite (repr_aux_some identify_base identify_base_order_wf x x1); auto.
-  rewrite (repr_aux_some m mwf x x1); auto.
+  rewrite (repr_aux_some identify_base identify_base_order_wf x y); auto.
+  rewrite (repr_aux_some m mwf x y); auto.
 Qed.
 
 Lemma identify_base_sameclass_1:
diff --git a/test/cminor/Makefile b/test/cminor/Makefile
index 35d3e07..f9b863e 100644
--- a/test/cminor/Makefile
+++ b/test/cminor/Makefile
@@ -1,10 +1,11 @@
 CCOMP=../../ccomp
 CPP=cpp -P
 CC=gcc
-CFLAGS=-g
+CFLAGS=-arch ppc -g
+ASFLAGS=-arch ppc
 VPATH=../harness ../lib
 
-PROGS=fib integr qsort fft sha1 aes almabench manyargs
+PROGS=fib integr qsort fft sha1 aes almabench manyargs lists
 
 all_s: $(PROGS:%=%.s)
 
@@ -27,13 +28,13 @@ qsort: qsort.o mainqsort.o
 clean::
 	rm -f qsort
 
-fft: fft.o mainfft.o staticlib.o
-	$(CC) $(CFLAGS) -o fft fft.o mainfft.o staticlib.o -lm
+fft: fft.o mainfft.o
+	$(CC) $(CFLAGS) -o fft fft.o mainfft.o -lm
 clean::
 	rm -f fft
 
-sha1: sha1.o mainsha1.o staticlib.o
-	$(CC) $(CFLAGS) -o sha1 sha1.o mainsha1.o staticlib.o
+sha1: sha1.o mainsha1.o
+	$(CC) $(CFLAGS) -o sha1 sha1.o mainsha1.o
 clean::
 	rm -f sha1 sha1.cm
 
@@ -42,8 +43,8 @@ aes: aes.o mainaes.o
 clean::
 	rm -f aes aes.cm
 
-almabench: almabench.o mainalmabench.o staticlib.o
-	$(CC) $(CFLAGS) -o almabench almabench.o mainalmabench.o staticlib.o -lm
+almabench: almabench.o mainalmabench.o
+	$(CC) $(CFLAGS) -o almabench almabench.o mainalmabench.o -lm
 clean::
 	rm -f almabench almabench.cm
 
@@ -52,6 +53,11 @@ manyargs: manyargs.o mainmanyargs.o
 clean::
 	rm -f manyargs
 
+lists: lists.o mainlists.o
+	$(CC) $(CFLAGS) -o lists lists.o mainlists.o
+clean::
+	rm -f lists
+
 .SUFFIXES:
 
 .SUFFIXES: .cmp .cm .s .o .c .S
diff --git a/test/cminor/almabench.cmp b/test/cminor/almabench.cmp
index e9e8392..bafcb5d 100644
--- a/test/cminor/almabench.cmp
+++ b/test/cminor/almabench.cmp
@@ -28,12 +28,20 @@
 #define sl(x,y) float64["sl" + ((x) * 80 + (y) * 8)]
 
 /* Function calls */
-#define cos(x) ("cos_static"(x): float -> float)
-#define sin(x) ("sin_static"(x): float -> float)
-#define atan2(x,y) ("atan2_static"(x,y): float -> float -> float)
-#define asin(x) ("asin_static"(x): float -> float)
-#define sqrt(x) ("sqrt_static"(x): float -> float)
-#define fmod(x,y) ("fmod_static"(x,y): float -> float -> float)
+
+extern "cos": float -> float
+extern "sin": float -> float
+extern "atan2": float -> float -> float
+extern "asin": float -> float
+extern "sqrt": float -> float
+extern "fmod": float -> float -> float
+
+#define cos(x) ("cos"(x): float -> float)
+#define sin(x) ("sin"(x): float -> float)
+#define atan2(x,y) ("atan2"(x,y): float -> float -> float)
+#define asin(x) ("asin"(x): float -> float)
+#define sqrt(x) ("sqrt"(x): float -> float)
+#define fmod(x,y) ("fmod"(x,y): float -> float -> float)
 #define anpm(x) ("anpm"(x) : float -> float)
 
 "anpm"(a): float -> float
@@ -90,7 +98,7 @@
         k = k + 1;
     } }}
 
-    dl = "fmod_static"(dl,TWOPI) : float -> float -> float;
+    dl = "fmod"(dl,TWOPI) : float -> float -> float;
 
     am = dl -f dp;
     ae = am +f de *f sin(am);
diff --git a/test/cminor/fft.cm b/test/cminor/fft.cm
index b4e6a40..ed3b103 100644
--- a/test/cminor/fft.cm
+++ b/test/cminor/fft.cm
@@ -5,6 +5,9 @@
 /*     Length is n.                                     */
 /********************************************************/
 
+extern "cos" : float -> float
+extern "sin" : float -> float
+
 "dfft"(x, y, np): int /*float ptr*/ -> int /*float ptr*/ -> int -> int
 {
   var px, py, /*float ptr*/
@@ -48,11 +51,11 @@
     j = 1;
     {{ loop {
       if (! (j <= n4)) exit;
-      cc1 = "cos_static"(a) : float -> float; 
-      ss1 = "sin_static"(a) : float -> float;
+      cc1 = "cos"(a) : float -> float; 
+      ss1 = "sin"(a) : float -> float;
       a3 = 3.0 *f a; 
-      cc3 = "cos_static"(a3) : float -> float; 
-      ss3 = "sin_static"(a3) : float -> float; 
+      cc3 = "cos"(a3) : float -> float; 
+      ss3 = "sin"(a3) : float -> float; 
       a = e *f floatofint(j);
       is = j; 
       id = 2 * n2;
diff --git a/test/cminor/lists.cm b/test/cminor/lists.cm
new file mode 100644
index 0000000..c445623
--- /dev/null
+++ b/test/cminor/lists.cm
@@ -0,0 +1,27 @@
+/* List manipulations */
+
+"buildlist"(n): int -> int
+{
+  var b;
+
+  if (n < 0) return 0;
+  b = alloc 8;
+  int32[b] = n;
+  int32[b+4] = "buildlist"(n - 1) : int -> int;
+  return b;
+}
+
+"reverselist"(l): int -> int
+{
+  var r, r2;
+  r = 0;
+  loop {
+    if (l == 0) return r;
+    r2 = alloc 8;
+    int32[r2] = int32[l];
+    int32[r2+4] = r;
+    r = r2;
+    l = int32[l+4];
+  }
+}
+
diff --git a/test/cminor/sha1.cmp b/test/cminor/sha1.cmp
index 9a588e4..ca24544 100644
--- a/test/cminor/sha1.cmp
+++ b/test/cminor/sha1.cmp
@@ -3,6 +3,9 @@
 
 /* To be preprocessed by cpp -P */
 
+extern "memcpy" : int -> int -> int -> void
+extern "memset" : int -> int -> int -> void
+
 #define ARCH_BIG_ENDIAN
 
 #define rol1(x) (((x) << 1) | ((x) >>u 31))
@@ -12,7 +15,7 @@
 "SHA1_copy_and_swap"(src, dst, numwords) : int -> int -> int -> void
 {
 #ifdef ARCH_BIG_ENDIAN
-  "memcpy_static"(dst, src, numwords * 4) : int -> int -> int -> void;
+  "memcpy"(dst, src, numwords * 4) : int -> int -> int -> void;
 #else
   var s, d, a, b;
   s = src;
@@ -134,12 +137,12 @@
   if (context_numbytes(ctx) != 0) {
     t = 64 - context_numbytes(ctx);
     if (len <u t) {
-      "memcpy_static"(context_buffer(ctx) + context_numbytes(ctx), data, len)
+      "memcpy"(context_buffer(ctx) + context_numbytes(ctx), data, len)
         : int -> int -> int -> void;
       context_numbytes(ctx) = context_numbytes(ctx) + len;
       return;
     }
-    "memcpy_static"(context_buffer(ctx) + context_numbytes(ctx), data, t)
+    "memcpy"(context_buffer(ctx) + context_numbytes(ctx), data, t)
         : int -> int -> int -> void;
     "SHA1_transform"(ctx) : int -> void;
     data = data + t;
@@ -148,14 +151,14 @@
   /* Munge data in 64-byte chunks */
   {{ loop {
     if (! (len >=u 64)) exit;
-    "memcpy_static"(context_buffer(ctx), data, 64)
+    "memcpy"(context_buffer(ctx), data, 64)
         : int -> int -> int -> void;
     "SHA1_transform"(ctx) : int -> void;
     data = data + 64;
     len = len - 64;
   } }}
   /* Save remaining data */
-  "memcpy_static"(context_buffer(ctx), data, len)
+  "memcpy"(context_buffer(ctx), data, len)
         : int -> int -> int -> void;
   context_numbytes(ctx) = len;
 }
@@ -170,13 +173,13 @@
   /* If we do not have room for the length (8 bytes), pad to 64 bytes
      with zeroes and munge the data block */
   if (i > 56) {
-    "memset_static"(context_buffer(ctx) + i, 0, 64 - i)
+    "memset"(context_buffer(ctx) + i, 0, 64 - i)
         : int -> int -> int -> void;
     "SHA1_transform"(ctx) : int -> void;
     i = 0;
   }
   /* Pad to byte 56 with zeroes */
-  "memset_static"(context_buffer(ctx) + i, 0, 56 - i)
+  "memset"(context_buffer(ctx) + i, 0, 56 - i)
         : int -> int -> int -> void;
   /* Add length in big-endian */
   "SHA1_copy_and_swap"(context_length(ctx), context_buffer(ctx) + 56, 2)
diff --git a/test/harness/mainlists.c b/test/harness/mainlists.c
new file mode 100644
index 0000000..ef11f6e
--- /dev/null
+++ b/test/harness/mainlists.c
@@ -0,0 +1,40 @@
+#include <stdio.h>
+#include <stddef.h>
+#include <stdlib.h>
+
+void * compcert_alloc(int sz)
+{
+  return malloc(sz);
+}
+
+struct cons { int hd; struct cons * tl; };
+typedef struct cons * list;
+
+extern list buildlist(int n);
+extern list reverselist(list l);
+
+int checklist(int n, list l)
+{
+  int i;
+  for (i = 0; i <= n; i++) {
+    if (l == NULL) return 0;
+    if (l->hd != i) return 0;
+    l = l->tl;
+  }
+  return (l == NULL);
+}
+
+int main(int argc, char ** argv)
+{
+  int n;
+
+  if (argc >= 2) n = atoi(argv[1]); else n = 10;
+  if (checklist(n, reverselist(buildlist(n)))) {
+    printf("OK\n");
+    return 0;
+  } else {
+    printf("Bug!\n");
+    return 2;
+  }
+}
+