Merge branch 'master' into cleanup

author: Bernhard Schommer <bernhardschommer@gmail.com> 2016-03-21 08:48:20 +0100
committer: Bernhard Schommer <bernhardschommer@gmail.com> 2016-03-21 08:48:20 +0100
commit: 01e32a075023ce7b037d42d048b1904ba3d9a82b (patch)
tree: 2d01f3855234e6eb945b929e489232001c406592
parent: 093e0ea167fde39429bf4bd3fc693a232af0d093 (diff)
parent: 1fdca8371317e656cb08eaec3adb4596d6447e9b (diff)
download: compcert-kvx-01e32a075023ce7b037d42d048b1904ba3d9a82b.tar.gz
compcert-kvx-01e32a075023ce7b037d42d048b1904ba3d9a82b.zip
88 files changed, 6282 insertions, 5401 deletions
diff --git a/.depend b/.depend
index 3cfb86ae..e62929bc 100644
--- a/.depend
+++ b/.depend
@@ -17,9 +17,10 @@ lib/Postorder.vo lib/Postorder.glob lib/Postorder.v.beautified: lib/Postorder.v
 lib/FSetAVLplus.vo lib/FSetAVLplus.glob lib/FSetAVLplus.v.beautified: lib/FSetAVLplus.v lib/Coqlib.vo
 lib/IntvSets.vo lib/IntvSets.glob lib/IntvSets.v.beautified: lib/IntvSets.v lib/Coqlib.vo
 common/Errors.vo common/Errors.glob common/Errors.v.beautified: common/Errors.v lib/Coqlib.vo
-common/AST.vo common/AST.glob common/AST.v.beautified: common/AST.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo
+common/AST.vo common/AST.glob common/AST.v.beautified: common/AST.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo
+common/Linking.vo common/Linking.glob common/Linking.v.beautified: common/Linking.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo
 common/Events.vo common/Events.glob common/Events.v.beautified: common/Events.v lib/Coqlib.vo lib/Intv.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo
-common/Globalenvs.vo common/Globalenvs.glob common/Globalenvs.v.beautified: common/Globalenvs.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo
+common/Globalenvs.vo common/Globalenvs.glob common/Globalenvs.v.beautified: common/Globalenvs.v lib/Axioms.vo lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo common/Linking.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo
 common/Memdata.vo common/Memdata.glob common/Memdata.v.beautified: common/Memdata.v lib/Coqlib.vo $(ARCH)/Archi.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo
 common/Memtype.vo common/Memtype.glob common/Memtype.v.beautified: common/Memtype.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memdata.vo
 common/Memory.vo common/Memory.glob common/Memory.v.beautified: common/Memory.v lib/Axioms.vo lib/Coqlib.vo lib/Intv.vo lib/Maps.vo $(ARCH)/Archi.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memdata.vo common/Memtype.vo
@@ -34,45 +35,45 @@ $(ARCH)/Op.vo $(ARCH)/Op.glob $(ARCH)/Op.v.beautified: $(ARCH)/Op.v lib/Coqlib.v
 backend/CminorSel.vo backend/CminorSel.glob backend/CminorSel.v.beautified: backend/CminorSel.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Events.vo common/Values.vo common/Memory.vo backend/Cminor.vo $(ARCH)/Op.vo common/Globalenvs.vo common/Smallstep.vo
 $(ARCH)/SelectOp.vo $(ARCH)/SelectOp.glob $(ARCH)/SelectOp.v.beautified: $(ARCH)/SelectOp.v lib/Coqlib.vo driver/Compopts.vo common/AST.vo lib/Integers.vo lib/Floats.vo $(ARCH)/Op.vo backend/CminorSel.vo
 backend/SelectDiv.vo backend/SelectDiv.glob backend/SelectDiv.v.beautified: backend/SelectDiv.v lib/Coqlib.vo driver/Compopts.vo common/AST.vo lib/Integers.vo lib/Floats.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo
-backend/SelectLong.vo backend/SelectLong.glob backend/SelectLong.v.beautified: backend/SelectLong.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo common/Errors.vo common/Globalenvs.vo
-backend/Selection.vo backend/Selection.glob backend/Selection.v.beautified: backend/Selection.v lib/Coqlib.vo common/AST.vo common/Errors.vo lib/Integers.vo common/Globalenvs.vo common/Switch.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo backend/SelectDiv.vo backend/SelectLong.vo $(ARCH)/Machregs.vo
+backend/SelectLong.vo backend/SelectLong.glob backend/SelectLong.v.beautified: backend/SelectLong.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo
+backend/Selection.vo backend/Selection.glob backend/Selection.v.beautified: backend/Selection.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Errors.vo lib/Integers.vo common/Globalenvs.vo common/Switch.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo backend/SelectDiv.vo backend/SelectLong.vo $(ARCH)/Machregs.vo
 $(ARCH)/SelectOpproof.vo $(ARCH)/SelectOpproof.glob $(ARCH)/SelectOpproof.v.beautified: $(ARCH)/SelectOpproof.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo
 backend/SelectDivproof.vo backend/SelectDivproof.glob backend/SelectDivproof.v.beautified: backend/SelectDivproof.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo $(ARCH)/SelectOpproof.vo backend/SelectDiv.vo
-backend/SelectLongproof.vo backend/SelectLongproof.glob backend/SelectLongproof.v.beautified: backend/SelectLongproof.v lib/Coqlib.vo common/AST.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo $(ARCH)/SelectOpproof.vo backend/SelectLong.vo
-backend/Selectionproof.vo backend/Selectionproof.glob backend/Selectionproof.v.beautified: backend/Selectionproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Errors.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo common/Switch.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo backend/SelectDiv.vo backend/SelectLong.vo backend/Selection.vo $(ARCH)/SelectOpproof.vo backend/SelectDivproof.vo backend/SelectLongproof.vo
+backend/SelectLongproof.vo backend/SelectLongproof.glob backend/SelectLongproof.v.beautified: backend/SelectLongproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo $(ARCH)/SelectOpproof.vo backend/SelectLong.vo
+backend/Selectionproof.vo backend/Selectionproof.glob backend/Selectionproof.v.beautified: backend/Selectionproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Linking.vo common/Errors.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo common/Switch.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo $(ARCH)/SelectOp.vo backend/SelectDiv.vo backend/SelectLong.vo backend/Selection.vo $(ARCH)/SelectOpproof.vo backend/SelectDivproof.vo backend/SelectLongproof.vo
 backend/Registers.vo backend/Registers.glob backend/Registers.v.beautified: backend/Registers.v lib/Coqlib.vo common/AST.vo lib/Maps.vo lib/Ordered.vo common/Values.vo
 backend/RTL.vo backend/RTL.glob backend/RTL.v.beautified: backend/RTL.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Memory.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo
 backend/RTLgen.vo backend/RTLgen.glob backend/RTLgen.v.beautified: backend/RTLgen.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Switch.vo $(ARCH)/Op.vo backend/Registers.vo backend/CminorSel.vo backend/RTL.vo
 backend/RTLgenspec.vo backend/RTLgenspec.glob backend/RTLgenspec.v.beautified: backend/RTLgenspec.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Switch.vo $(ARCH)/Op.vo backend/Registers.vo backend/CminorSel.vo backend/RTL.vo backend/RTLgen.vo
-backend/RTLgenproof.vo backend/RTLgenproof.glob backend/RTLgenproof.v.beautified: backend/RTLgenproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Events.vo common/Smallstep.vo common/Globalenvs.vo common/Switch.vo backend/Registers.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo backend/RTL.vo backend/RTLgen.vo backend/RTLgenspec.vo common/Errors.vo
+backend/RTLgenproof.vo backend/RTLgenproof.glob backend/RTLgenproof.v.beautified: backend/RTLgenproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Linking.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Events.vo common/Smallstep.vo common/Globalenvs.vo common/Switch.vo backend/Registers.vo backend/Cminor.vo $(ARCH)/Op.vo backend/CminorSel.vo backend/RTL.vo backend/RTLgen.vo backend/RTLgenspec.vo common/Errors.vo
 backend/Tailcall.vo backend/Tailcall.glob backend/Tailcall.v.beautified: backend/Tailcall.v lib/Coqlib.vo lib/Maps.vo common/AST.vo backend/Registers.vo $(ARCH)/Op.vo backend/RTL.vo backend/Conventions.vo
-backend/Tailcallproof.vo backend/Tailcallproof.glob backend/Tailcallproof.v.beautified: backend/Tailcallproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Memory.vo $(ARCH)/Op.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo backend/Registers.vo backend/RTL.vo backend/Conventions.vo backend/Tailcall.vo
-backend/Inlining.vo backend/Inlining.glob backend/Inlining.v.beautified: backend/Inlining.v lib/Coqlib.vo lib/Wfsimpl.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo
-backend/Inliningspec.vo backend/Inliningspec.glob backend/Inliningspec.v.beautified: backend/Inliningspec.v lib/Coqlib.vo lib/Wfsimpl.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Inlining.vo
-backend/Inliningproof.vo backend/Inliningproof.glob backend/Inliningproof.v.beautified: backend/Inliningproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/Inlining.vo backend/Inliningspec.vo backend/RTL.vo
+backend/Tailcallproof.vo backend/Tailcallproof.glob backend/Tailcallproof.v.beautified: backend/Tailcallproof.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Conventions.vo backend/Tailcall.vo
+backend/Inlining.vo backend/Inlining.glob backend/Inlining.v.beautified: backend/Inlining.v lib/Coqlib.vo lib/Wfsimpl.vo lib/Maps.vo common/Errors.vo lib/Integers.vo common/AST.vo common/Linking.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo
+backend/Inliningspec.vo backend/Inliningspec.glob backend/Inliningspec.v.beautified: backend/Inliningspec.v lib/Coqlib.vo lib/Wfsimpl.vo lib/Maps.vo common/Errors.vo lib/Integers.vo common/AST.vo common/Linking.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Inlining.vo
+backend/Inliningproof.vo backend/Inliningproof.glob backend/Inliningproof.v.beautified: backend/Inliningproof.v lib/Coqlib.vo lib/Wfsimpl.vo lib/Maps.vo common/Errors.vo lib/Integers.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Inlining.vo backend/Inliningspec.vo
 backend/Renumber.vo backend/Renumber.glob backend/Renumber.v.beautified: backend/Renumber.v lib/Coqlib.vo lib/Maps.vo lib/Postorder.vo backend/RTL.vo
 backend/Renumberproof.vo backend/Renumberproof.glob backend/Renumberproof.v.beautified: backend/Renumberproof.v lib/Coqlib.vo lib/Maps.vo lib/Postorder.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Renumber.vo
 backend/RTLtyping.vo backend/RTLtyping.glob backend/RTLtyping.v.beautified: backend/RTLtyping.v lib/Coqlib.vo common/Errors.vo common/Unityping.vo lib/Maps.vo common/AST.vo $(ARCH)/Op.vo backend/Registers.vo common/Globalenvs.vo common/Values.vo lib/Integers.vo common/Memory.vo common/Events.vo backend/RTL.vo backend/Conventions.vo
 backend/Kildall.vo backend/Kildall.glob backend/Kildall.v.beautified: backend/Kildall.v lib/Coqlib.vo lib/Iteration.vo lib/Maps.vo lib/Lattice.vo lib/Heaps.vo
 backend/Liveness.vo backend/Liveness.glob backend/Liveness.v.beautified: backend/Liveness.v lib/Coqlib.vo lib/Maps.vo lib/Lattice.vo common/AST.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Kildall.vo
-backend/ValueDomain.vo backend/ValueDomain.glob backend/ValueDomain.v.beautified: backend/ValueDomain.v lib/Coqlib.vo lib/Maps.vo driver/Compopts.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo lib/Lattice.vo backend/Kildall.vo backend/Registers.vo backend/RTL.vo
+backend/ValueDomain.vo backend/ValueDomain.glob backend/ValueDomain.v.beautified: backend/ValueDomain.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo driver/Compopts.vo common/AST.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo backend/Registers.vo backend/RTL.vo
 $(ARCH)/ValueAOp.vo $(ARCH)/ValueAOp.glob $(ARCH)/ValueAOp.v.beautified: $(ARCH)/ValueAOp.v lib/Coqlib.vo driver/Compopts.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/ValueDomain.vo backend/RTL.vo
-backend/ValueAnalysis.vo backend/ValueAnalysis.glob backend/ValueAnalysis.v.beautified: backend/ValueAnalysis.v lib/Coqlib.vo lib/Maps.vo driver/Compopts.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo lib/Lattice.vo backend/Kildall.vo backend/Registers.vo $(ARCH)/Op.vo backend/RTL.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/Liveness.vo lib/Axioms.vo
+backend/ValueAnalysis.vo backend/ValueAnalysis.glob backend/ValueAnalysis.v.beautified: backend/ValueAnalysis.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo backend/Kildall.vo driver/Compopts.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo backend/Registers.vo $(ARCH)/Op.vo backend/RTL.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/Liveness.vo lib/Axioms.vo
 $(ARCH)/ConstpropOp.vo $(ARCH)/ConstpropOp.glob $(ARCH)/ConstpropOp.v.beautified: $(ARCH)/ConstpropOp.v lib/Coqlib.vo driver/Compopts.vo common/AST.vo lib/Integers.vo lib/Floats.vo $(ARCH)/Op.vo backend/Registers.vo backend/ValueDomain.vo
-backend/Constprop.vo backend/Constprop.glob backend/Constprop.v.beautified: backend/Constprop.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo $(ARCH)/Op.vo $(ARCH)/Machregs.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo backend/Liveness.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/ValueAnalysis.vo $(ARCH)/ConstpropOp.vo
+backend/Constprop.vo backend/Constprop.glob backend/Constprop.v.beautified: backend/Constprop.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo backend/Kildall.vo common/AST.vo common/Linking.vo driver/Compopts.vo $(ARCH)/Machregs.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Liveness.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/ValueAnalysis.vo $(ARCH)/ConstpropOp.vo
 $(ARCH)/ConstpropOpproof.vo $(ARCH)/ConstpropOpproof.glob $(ARCH)/ConstpropOpproof.v.beautified: $(ARCH)/ConstpropOpproof.v lib/Coqlib.vo driver/Compopts.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/ValueDomain.vo $(ARCH)/ConstpropOp.vo
-backend/Constpropproof.vo backend/Constpropproof.glob backend/Constpropproof.v.beautified: backend/Constpropproof.v lib/Coqlib.vo lib/Maps.vo driver/Compopts.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Memory.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/ValueAnalysis.vo $(ARCH)/ConstpropOp.vo backend/Constprop.vo $(ARCH)/ConstpropOpproof.vo
+backend/Constpropproof.vo backend/Constpropproof.glob backend/Constpropproof.v.beautified: backend/Constpropproof.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo backend/Kildall.vo common/AST.vo common/Linking.vo common/Values.vo common/Events.vo common/Memory.vo common/Globalenvs.vo common/Smallstep.vo driver/Compopts.vo $(ARCH)/Machregs.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Liveness.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/ValueAnalysis.vo $(ARCH)/ConstpropOp.vo $(ARCH)/ConstpropOpproof.vo backend/Constprop.vo
 backend/CSEdomain.vo backend/CSEdomain.glob backend/CSEdomain.v.beautified: backend/CSEdomain.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Values.vo common/Memory.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo
 $(ARCH)/CombineOp.vo $(ARCH)/CombineOp.glob $(ARCH)/CombineOp.v.beautified: $(ARCH)/CombineOp.v lib/Coqlib.vo common/AST.vo lib/Integers.vo $(ARCH)/Op.vo backend/CSEdomain.vo
-backend/CSE.vo backend/CSE.glob backend/CSE.v.beautified: backend/CSE.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/ValueDomain.vo backend/ValueAnalysis.vo backend/CSEdomain.vo backend/Kildall.vo $(ARCH)/CombineOp.vo
+backend/CSE.vo backend/CSE.glob backend/CSE.v.beautified: backend/CSE.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo backend/Kildall.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/ValueDomain.vo backend/ValueAnalysis.vo backend/CSEdomain.vo $(ARCH)/CombineOp.vo
 $(ARCH)/CombineOpproof.vo $(ARCH)/CombineOpproof.glob $(ARCH)/CombineOpproof.v.beautified: $(ARCH)/CombineOpproof.v lib/Coqlib.vo lib/Integers.vo common/Values.vo common/Memory.vo $(ARCH)/Op.vo backend/RTL.vo backend/CSEdomain.vo $(ARCH)/CombineOp.vo
-backend/CSEproof.vo backend/CSEproof.glob backend/CSEproof.v.beautified: backend/CSEproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Kildall.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/ValueAnalysis.vo backend/CSEdomain.vo $(ARCH)/CombineOp.vo $(ARCH)/CombineOpproof.vo backend/CSE.vo
+backend/CSEproof.vo backend/CSEproof.glob backend/CSEproof.v.beautified: backend/CSEproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo backend/Kildall.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/ValueDomain.vo $(ARCH)/ValueAOp.vo backend/ValueAnalysis.vo backend/CSEdomain.vo $(ARCH)/CombineOp.vo $(ARCH)/CombineOpproof.vo backend/CSE.vo
 backend/NeedDomain.vo backend/NeedDomain.glob backend/NeedDomain.v.beautified: backend/NeedDomain.v lib/Coqlib.vo lib/Maps.vo lib/IntvSets.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo lib/Lattice.vo backend/Registers.vo backend/ValueDomain.vo $(ARCH)/Op.vo backend/RTL.vo
 $(ARCH)/NeedOp.vo $(ARCH)/NeedOp.glob $(ARCH)/NeedOp.v.beautified: $(ARCH)/NeedOp.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/NeedDomain.vo backend/RTL.vo
-backend/Deadcode.vo backend/Deadcode.glob backend/Deadcode.v.beautified: backend/Deadcode.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Memory.vo backend/Registers.vo $(ARCH)/Op.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo backend/ValueDomain.vo backend/ValueAnalysis.vo backend/NeedDomain.vo $(ARCH)/NeedOp.vo
-backend/Deadcodeproof.vo backend/Deadcodeproof.glob backend/Deadcodeproof.v.beautified: backend/Deadcodeproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/IntvSets.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo lib/Lattice.vo backend/Kildall.vo backend/ValueDomain.vo backend/ValueAnalysis.vo backend/NeedDomain.vo $(ARCH)/NeedOp.vo backend/Deadcode.vo
-backend/Unusedglob.vo backend/Unusedglob.glob backend/Unusedglob.v.beautified: backend/Unusedglob.v lib/Coqlib.vo lib/Ordered.vo lib/Maps.vo lib/Iteration.vo common/AST.vo common/Errors.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo
-backend/Unusedglobproof.vo backend/Unusedglobproof.glob backend/Unusedglobproof.v.beautified: backend/Unusedglobproof.v lib/Coqlib.vo lib/Ordered.vo lib/Maps.vo lib/Iteration.vo common/AST.vo common/Errors.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Unusedglob.vo
+backend/Deadcode.vo backend/Deadcode.glob backend/Deadcode.v.beautified: backend/Deadcode.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo backend/Kildall.vo common/AST.vo common/Linking.vo common/Memory.vo backend/Registers.vo $(ARCH)/Op.vo backend/RTL.vo backend/ValueDomain.vo backend/ValueAnalysis.vo backend/NeedDomain.vo $(ARCH)/NeedOp.vo
+backend/Deadcodeproof.vo backend/Deadcodeproof.glob backend/Deadcodeproof.v.beautified: backend/Deadcodeproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo lib/Lattice.vo backend/Kildall.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo backend/Registers.vo $(ARCH)/Op.vo backend/RTL.vo backend/ValueDomain.vo backend/ValueAnalysis.vo backend/NeedDomain.vo $(ARCH)/NeedOp.vo backend/Deadcode.vo
+backend/Unusedglob.vo backend/Unusedglob.glob backend/Unusedglob.v.beautified: backend/Unusedglob.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo lib/Iteration.vo common/Errors.vo common/AST.vo common/Linking.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo
+backend/Unusedglobproof.vo backend/Unusedglobproof.glob backend/Unusedglobproof.v.beautified: backend/Unusedglobproof.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo lib/Iteration.vo common/Errors.vo common/AST.vo common/Linking.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Registers.vo backend/RTL.vo backend/Unusedglob.vo
 $(ARCH)/Machregs.vo $(ARCH)/Machregs.glob $(ARCH)/Machregs.v.beautified: $(ARCH)/Machregs.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo $(ARCH)/Op.vo
 backend/Locations.vo backend/Locations.glob backend/Locations.v.beautified: backend/Locations.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo common/AST.vo common/Values.vo $(ARCH)/Machregs.vo
 $(ARCH)/Conventions1.vo $(ARCH)/Conventions1.glob $(ARCH)/Conventions1.v.beautified: $(ARCH)/Conventions1.v lib/Coqlib.vo common/AST.vo common/Events.vo backend/Locations.vo
@@ -100,9 +101,9 @@ $(ARCH)/Asmgen.vo $(ARCH)/Asmgen.glob $(ARCH)/Asmgen.v.beautified: $(ARCH)/Asmge
 backend/Asmgenproof0.vo backend/Asmgenproof0.glob backend/Asmgenproof0.v.beautified: backend/Asmgenproof0.v lib/Coqlib.vo lib/Intv.vo common/AST.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo backend/Locations.vo backend/Mach.vo $(ARCH)/Asm.vo $(ARCH)/Asmgen.vo backend/Conventions.vo
 $(ARCH)/Asmgenproof1.vo $(ARCH)/Asmgenproof1.glob $(ARCH)/Asmgenproof1.v.beautified: $(ARCH)/Asmgenproof1.v lib/Coqlib.vo common/AST.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo $(ARCH)/Op.vo backend/Locations.vo backend/Mach.vo $(ARCH)/Asm.vo $(ARCH)/Asmgen.vo backend/Asmgenproof0.vo backend/Conventions.vo
 $(ARCH)/Asmgenproof.vo $(ARCH)/Asmgenproof.glob $(ARCH)/Asmgenproof.v.beautified: $(ARCH)/Asmgenproof.v lib/Coqlib.vo common/Errors.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo $(ARCH)/Op.vo backend/Locations.vo backend/Mach.vo backend/Conventions.vo $(ARCH)/Asm.vo $(ARCH)/Asmgen.vo backend/Asmgenproof0.vo $(ARCH)/Asmgenproof1.vo
-cfrontend/Ctypes.vo cfrontend/Ctypes.glob cfrontend/Ctypes.v.beautified: cfrontend/Ctypes.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Errors.vo $(ARCH)/Archi.vo
+cfrontend/Ctypes.vo cfrontend/Ctypes.glob cfrontend/Ctypes.v.beautified: cfrontend/Ctypes.v lib/Axioms.vo lib/Coqlib.vo lib/Maps.vo common/Errors.vo common/AST.vo common/Linking.vo $(ARCH)/Archi.vo
 cfrontend/Cop.vo cfrontend/Cop.glob cfrontend/Cop.v.beautified: cfrontend/Cop.v lib/Coqlib.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo cfrontend/Ctypes.vo
-cfrontend/Csyntax.vo cfrontend/Csyntax.glob cfrontend/Csyntax.v.beautified: cfrontend/Csyntax.v lib/Coqlib.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Errors.vo cfrontend/Ctypes.vo cfrontend/Cop.vo
+cfrontend/Csyntax.vo cfrontend/Csyntax.glob cfrontend/Csyntax.v.beautified: cfrontend/Csyntax.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Errors.vo common/AST.vo common/Linking.vo common/Values.vo cfrontend/Ctypes.vo cfrontend/Cop.vo
 cfrontend/Csem.vo cfrontend/Csem.glob cfrontend/Csem.v.beautified: cfrontend/Csem.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Memory.vo common/Events.vo common/Globalenvs.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo common/Smallstep.vo
 cfrontend/Ctyping.vo cfrontend/Ctyping.glob cfrontend/Ctyping.v.beautified: cfrontend/Ctyping.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/AST.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Csem.vo common/Errors.vo
 cfrontend/Cstrategy.vo cfrontend/Cstrategy.glob cfrontend/Cstrategy.v.beautified: cfrontend/Cstrategy.v lib/Axioms.vo lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Csem.vo
@@ -110,17 +111,17 @@ cfrontend/Cexec.vo cfrontend/Cexec.glob cfrontend/Cexec.v.beautified: cfrontend/
 cfrontend/Initializers.vo cfrontend/Initializers.glob cfrontend/Initializers.v.beautified: cfrontend/Initializers.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Memory.vo common/Globalenvs.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo
 cfrontend/Initializersproof.vo cfrontend/Initializersproof.glob cfrontend/Initializersproof.v.beautified: cfrontend/Initializersproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Initializers.vo
 cfrontend/SimplExpr.vo cfrontend/SimplExpr.glob cfrontend/SimplExpr.v.beautified: cfrontend/SimplExpr.v lib/Coqlib.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/AST.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Clight.vo
-cfrontend/SimplExprspec.vo cfrontend/SimplExprspec.glob cfrontend/SimplExprspec.v.beautified: cfrontend/SimplExprspec.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Memory.vo common/AST.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Clight.vo cfrontend/SimplExpr.vo
-cfrontend/SimplExprproof.vo cfrontend/SimplExprproof.glob cfrontend/SimplExprproof.v.beautified: cfrontend/SimplExprproof.v lib/Coqlib.vo lib/Maps.vo common/AST.vo common/Errors.vo lib/Integers.vo common/Values.vo common/Memory.vo common/Events.vo common/Smallstep.vo common/Globalenvs.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Cstrategy.vo cfrontend/Clight.vo cfrontend/SimplExpr.vo cfrontend/SimplExprspec.vo
+cfrontend/SimplExprspec.vo cfrontend/SimplExprspec.glob cfrontend/SimplExprspec.v.beautified: cfrontend/SimplExprspec.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Linking.vo common/Memory.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Clight.vo cfrontend/SimplExpr.vo
+cfrontend/SimplExprproof.vo cfrontend/SimplExprproof.glob cfrontend/SimplExprproof.v.beautified: cfrontend/SimplExprproof.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Cstrategy.vo cfrontend/Clight.vo cfrontend/SimplExpr.vo cfrontend/SimplExprspec.vo
 cfrontend/Clight.vo cfrontend/Clight.glob cfrontend/Clight.v.beautified: cfrontend/Clight.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo
 cfrontend/ClightBigstep.vo cfrontend/ClightBigstep.glob cfrontend/ClightBigstep.v.beautified: cfrontend/ClightBigstep.v lib/Coqlib.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/AST.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo
-cfrontend/SimplLocals.vo cfrontend/SimplLocals.glob cfrontend/SimplLocals.v.beautified: cfrontend/SimplLocals.v lib/Coqlib.vo lib/Ordered.vo common/Errors.vo common/AST.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo driver/Compopts.vo
-cfrontend/SimplLocalsproof.vo cfrontend/SimplLocalsproof.glob cfrontend/SimplLocalsproof.v.beautified: cfrontend/SimplLocalsproof.v lib/Coqlib.vo common/Errors.vo lib/Ordered.vo common/AST.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo cfrontend/SimplLocals.vo
-cfrontend/Cshmgen.vo cfrontend/Cshmgen.glob cfrontend/Cshmgen.v.beautified: cfrontend/Cshmgen.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo backend/Cminor.vo cfrontend/Csharpminor.vo
-cfrontend/Cshmgenproof.vo cfrontend/Cshmgenproof.glob cfrontend/Cshmgenproof.v.beautified: cfrontend/Cshmgenproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Values.vo common/Events.vo common/Memory.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo
+cfrontend/SimplLocals.vo cfrontend/SimplLocals.glob cfrontend/SimplLocals.v.beautified: cfrontend/SimplLocals.v lib/Coqlib.vo lib/Ordered.vo common/Errors.vo common/AST.vo common/Linking.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo driver/Compopts.vo
+cfrontend/SimplLocalsproof.vo cfrontend/SimplLocalsproof.glob cfrontend/SimplLocalsproof.v.beautified: cfrontend/SimplLocalsproof.v lib/Coqlib.vo common/Errors.vo lib/Ordered.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Globalenvs.vo common/Events.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo cfrontend/SimplLocals.vo
+cfrontend/Cshmgen.vo cfrontend/Cshmgen.glob cfrontend/Cshmgen.v.beautified: cfrontend/Cshmgen.v lib/Coqlib.vo lib/Maps.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Linking.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo backend/Cminor.vo cfrontend/Csharpminor.vo
+cfrontend/Cshmgenproof.vo cfrontend/Cshmgenproof.glob cfrontend/Cshmgenproof.v.beautified: cfrontend/Cshmgenproof.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Linking.vo common/Values.vo common/Events.vo common/Memory.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Ctypes.vo cfrontend/Cop.vo cfrontend/Clight.vo backend/Cminor.vo cfrontend/Csharpminor.vo cfrontend/Cshmgen.vo
 cfrontend/Csharpminor.vo cfrontend/Csharpminor.glob cfrontend/Csharpminor.v.beautified: cfrontend/Csharpminor.v lib/Coqlib.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Switch.vo backend/Cminor.vo common/Smallstep.vo
-cfrontend/Cminorgen.vo cfrontend/Cminorgen.glob cfrontend/Cminorgen.v.beautified: cfrontend/Cminorgen.v lib/Coqlib.vo common/Errors.vo lib/Maps.vo lib/Ordered.vo common/AST.vo lib/Integers.vo lib/Floats.vo cfrontend/Csharpminor.vo backend/Cminor.vo
-cfrontend/Cminorgenproof.vo cfrontend/Cminorgenproof.glob cfrontend/Cminorgenproof.v.beautified: cfrontend/Cminorgenproof.v lib/Coqlib.vo lib/Intv.vo common/Errors.vo lib/Maps.vo common/AST.vo lib/Integers.vo lib/Floats.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo common/Switch.vo cfrontend/Csharpminor.vo backend/Cminor.vo cfrontend/Cminorgen.vo
+cfrontend/Cminorgen.vo cfrontend/Cminorgen.glob cfrontend/Cminorgen.v.beautified: cfrontend/Cminorgen.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo common/Errors.vo lib/Integers.vo lib/Floats.vo common/AST.vo common/Linking.vo cfrontend/Csharpminor.vo backend/Cminor.vo
+cfrontend/Cminorgenproof.vo cfrontend/Cminorgenproof.glob cfrontend/Cminorgenproof.v.beautified: cfrontend/Cminorgenproof.v lib/Coqlib.vo lib/Maps.vo lib/Ordered.vo common/Errors.vo lib/Integers.vo lib/Floats.vo lib/Intv.vo common/AST.vo common/Linking.vo common/Values.vo common/Memory.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo cfrontend/Csharpminor.vo common/Switch.vo backend/Cminor.vo cfrontend/Cminorgen.vo
 driver/Compopts.vo driver/Compopts.glob driver/Compopts.v.beautified: driver/Compopts.v
 driver/Compiler.vo driver/Compiler.glob driver/Compiler.v.beautified: driver/Compiler.v lib/Coqlib.vo common/Errors.vo common/AST.vo common/Smallstep.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Cstrategy.vo cfrontend/Cexec.vo cfrontend/Clight.vo cfrontend/Csharpminor.vo backend/Cminor.vo backend/CminorSel.vo backend/RTL.vo backend/LTL.vo backend/Linear.vo backend/Mach.vo $(ARCH)/Asm.vo cfrontend/Initializers.vo cfrontend/SimplExpr.vo cfrontend/SimplLocals.vo cfrontend/Cshmgen.vo cfrontend/Cminorgen.vo backend/Selection.vo backend/RTLgen.vo backend/Tailcall.vo backend/Inlining.vo backend/Renumber.vo backend/Constprop.vo backend/CSE.vo backend/Deadcode.vo backend/Unusedglob.vo backend/Allocation.vo backend/Tunneling.vo backend/Linearize.vo backend/CleanupLabels.vo backend/Debugvar.vo backend/Stacking.vo $(ARCH)/Asmgen.vo cfrontend/SimplExprproof.vo cfrontend/SimplLocalsproof.vo cfrontend/Cshmgenproof.vo cfrontend/Cminorgenproof.vo backend/Selectionproof.vo backend/RTLgenproof.vo backend/Tailcallproof.vo backend/Inliningproof.vo backend/Renumberproof.vo backend/Constpropproof.vo backend/CSEproof.vo backend/Deadcodeproof.vo backend/Unusedglobproof.vo backend/Allocproof.vo backend/Tunnelingproof.vo backend/Linearizeproof.vo backend/CleanupLabelsproof.vo backend/Debugvarproof.vo backend/Stackingproof.vo $(ARCH)/Asmgenproof.vo driver/Compopts.vo
 driver/Complements.vo driver/Complements.glob driver/Complements.v.beautified: driver/Complements.v lib/Coqlib.vo common/AST.vo lib/Integers.vo common/Values.vo common/Events.vo common/Globalenvs.vo common/Smallstep.vo common/Behaviors.vo cfrontend/Csyntax.vo cfrontend/Csem.vo cfrontend/Cstrategy.vo cfrontend/Clight.vo backend/Cminor.vo backend/RTL.vo $(ARCH)/Asm.vo driver/Compiler.vo common/Errors.vo
diff --git a/Makefile b/Makefile
index 88a8cc6d..7df9e73f 100644
--- a/Makefile
+++ b/Makefile
@@ -56,7 +56,8 @@ VLIB=Axioms.v Coqlib.v Intv.v Maps.v Heaps.v Lattice.v Ordered.v \
 
 # Parts common to the front-ends and the back-end (in common/)
 
-COMMON=Errors.v AST.v Events.v Globalenvs.v Memdata.v Memtype.v Memory.v \
+COMMON=Errors.v AST.v Linking.v \
+  Events.v Globalenvs.v Memdata.v Memtype.v Memory.v \
   Values.v Smallstep.v Behaviors.v Switch.v Determinism.v Unityping.v
 
 # Back-end modules (in backend/, $(ARCH)/)
diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml
index e114ab28..79f06991 100644
--- a/arm/Asmexpand.ml
+++ b/arm/Asmexpand.ml
@@ -439,4 +439,4 @@ let expand_fundef id = function
       Errors.OK (External ef)
 
 let expand_program (p: Asm.program) : Asm.program Errors.res =
-  AST.transform_partial_ident_program expand_fundef p
+  AST.transform_partial_program2 expand_fundef (fun id v -> Errors.OK v) p
diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v
index 7a29e4a5..eb52d16e 100644
--- a/arm/Asmgenproof.v
+++ b/arm/Asmgenproof.v
@@ -12,76 +12,52 @@
 
 (** Correctness proof for ARM code generation: main proof. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Locations.
-Require Import Conventions.
-Require Import Mach.
-Require Import Compopts.
-Require Import Asm.
-Require Import Asmgen.
-Require Import Asmgenproof0.
-Require Import Asmgenproof1.
+Require Import Coqlib Errors.
+Require Import Integers Floats AST Linking Compopts.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Locations Mach Conventions Asm.
+Require Import Asmgen Asmgenproof0 Asmgenproof1.
+
+Definition match_prog (p: Mach.program) (tp: Asm.program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
 
 Section PRESERVATION.
 
 Variable prog: Mach.program.
 Variable tprog: Asm.program.
-Hypothesis TRANSF: transf_program prog = Errors.OK tprog.
-
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
-  forall id, Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall id, Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.public_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall b f,
   Genv.find_funct_ptr ge b = Some f ->
-  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = Errors.OK tf.
-Proof
-  (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
+  exists tf,
+  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf.
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
 
 Lemma functions_transl:
-  forall f b tf,
-  Genv.find_funct_ptr ge b = Some (Internal f) ->
+  forall fb f tf,
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
   transf_function f = OK tf ->
-  Genv.find_funct_ptr tge b = Some (Internal tf).
-Proof.
-  intros.
-  destruct (functions_translated _ _ H) as [tf' [A B]].
-  rewrite A. monadInv B. f_equal. congruence.
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
+  Genv.find_funct_ptr tge fb = Some (Internal tf).
 Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_var_info_transf_partial with transf_fundef.
-  exact TRANSF.
+  intros. exploit functions_translated; eauto. intros [tf' [A B]].
+  monadInv B. rewrite H0 in EQ; inv EQ; auto.
 Qed.
 
 (** * Properties of control flow *)
@@ -758,8 +734,7 @@ Opaque loadind.
   eapply find_instr_tail; eauto.
   erewrite <- sp_val by eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   eauto.
   econstructor; eauto.
   instantiate (2 := tf); instantiate (1 := x).
@@ -921,8 +896,7 @@ Opaque loadind.
   intros [res' [m2' [P [Q [R S]]]]].
   left; econstructor; split.
   apply plus_one. eapply exec_step_external; eauto.
-  eapply external_call_symbols_preserved'; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   econstructor; eauto.
   apply agree_set_other; auto with asmgen.
   eapply agree_set_mregs; eauto.
@@ -940,7 +914,7 @@ Proof.
   intros. inversion H. unfold ge0 in *.
   econstructor; split.
   econstructor.
-  eapply Genv.init_mem_transf_partial; eauto.
+  eapply (Genv.init_mem_transf_partial TRANSF); eauto.
   replace (Genv.symbol_address (Genv.globalenv tprog) (prog_main tprog) Int.zero)
      with (Vptr fb Int.zero).
   econstructor; eauto.
@@ -948,7 +922,7 @@ Proof.
   apply Mem.extends_refl.
   split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto.
   unfold Genv.symbol_address.
-  rewrite (transform_partial_program_main _ _ TRANSF).
+  rewrite (match_program_main TRANSF).
   rewrite symbols_preserved.
   unfold ge; rewrite H1. auto.
 Qed.
@@ -967,7 +941,7 @@ Theorem transf_program_correct:
   forward_simulation (Mach.semantics return_address_offset prog) (Asm.semantics tprog).
 Proof.
   eapply forward_simulation_star with (measure := measure).
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   exact step_simulation.
diff --git a/arm/PrintOp.ml b/arm/PrintOp.ml
index 886f6de3..71e1dfc3 100644
--- a/arm/PrintOp.ml
+++ b/arm/PrintOp.ml
@@ -66,8 +66,8 @@ let print_condition reg pp = function
 let print_operation reg pp = function
   | Omove, [r1] -> reg pp r1
   | Ointconst n, [] -> fprintf pp "%ld" (camlint_of_coqint n)
-  | Ofloatconst n, [] -> fprintf pp "%F" (camlfloat_of_coqfloat n)
-  | Osingleconst n, [] -> fprintf pp "%Ff" (camlfloat_of_coqfloat32 n)
+  | Ofloatconst n, [] -> fprintf pp "%.15F" (camlfloat_of_coqfloat n)
+  | Osingleconst n, [] -> fprintf pp "%.15Ff" (camlfloat_of_coqfloat32 n)
   | Oaddrsymbol(id, ofs), [] ->
       fprintf pp "\"%s\" + %ld" (extern_atom id) (camlint_of_coqint ofs)
   | Oaddrstack ofs, [] ->
diff --git a/arm/TargetPrinter.ml b/arm/TargetPrinter.ml
index 87f1057c..bfe11555 100644
--- a/arm/TargetPrinter.ml
+++ b/arm/TargetPrinter.ml
@@ -593,7 +593,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET =
       | Pflid(r1, f) ->
           let f = camlint64_of_coqint(Floats.Float.to_bits f) in
           if Opt.vfpv3 && is_immediate_float64 f then begin
-            fprintf oc "	vmov.f64 %a, #%F\n"
+            fprintf oc "	vmov.f64 %a, #%.15F\n"
               freg r1 (Int64.float_of_bits f); 1
               (* immediate floats have at most 4 bits of fraction, so they
                  should print exactly with OCaml's F decimal format. *)
@@ -645,7 +645,7 @@ module Target (Opt: PRINTER_OPTIONS) : TARGET =
       | Pflis(r1, f) ->
           let f = camlint_of_coqint(Floats.Float32.to_bits f) in
           if Opt.vfpv3 && is_immediate_float32 f then begin
-            fprintf oc "	vmov.f32 %a, #%F\n"
+            fprintf oc "	vmov.f32 %a, #%.15F\n"
               freg_single r1 (Int32.float_of_bits f); 1
               (* immediate floats have at most 4 bits of fraction, so they
                  should print exactly with OCaml's F decimal format. *)
diff --git a/backend/Allocation.v b/backend/Allocation.v
index 7534e23f..6a6c1eb6 100644
--- a/backend/Allocation.v
+++ b/backend/Allocation.v
@@ -12,26 +12,11 @@
 
 (** Register allocation by external oracle and a posteriori validation. *)
 
-Require Import FSets.
-Require FSetAVLplus.
+Require Import FSets FSetAVLplus.
+Require Import Coqlib Ordered Maps Errors Integers Floats.
+Require Import AST Lattice Kildall Memdata.
 Require Archi.
-Require Import Coqlib.
-Require Import Ordered.
-Require Import Errors.
-Require Import Maps.
-Require Import Lattice.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Memdata.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import Kildall.
-Require Import Locations.
-Require Import Conventions.
-Require Import RTLtyping.
-Require Import LTL.
+Require Import Op Registers RTL Locations Conventions RTLtyping LTL.
 
 (** The validation algorithm used here is described in
   "Validating register allocation and spilling",
diff --git a/backend/Allocproof.v b/backend/Allocproof.v
index 2bcc038c..84d4bdd5 100644
--- a/backend/Allocproof.v
+++ b/backend/Allocproof.v
@@ -14,29 +14,22 @@
   RTL to LTL). *)
 
 Require Import FSets.
+Require Import Coqlib Ordered Maps Errors Integers Floats.
+Require Import AST Linking Lattice Kildall.
+Require Import Values Memory Globalenvs Events Smallstep.
 Require Archi.
-Require Import Coqlib.
-Require Import Ordered.
-Require Import Errors.
-Require Import Maps.
-Require Import Lattice.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import RTLtyping.
-Require Import Kildall.
-Require Import Locations.
-Require Import Conventions.
-Require Import LTL.
+Require Import Op Registers RTL Locations Conventions RTLtyping LTL.
 Require Import Allocation.
 
+Definition match_prog (p: RTL.program) (tp: LTL.program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
+
 (** * Soundness of structural checks *)
 
 Definition expand_move (sd: loc * loc) : instruction :=
@@ -1608,48 +1601,32 @@ Section PRESERVATION.
 
 Variable prog: RTL.program.
 Variable tprog: LTL.program.
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intro. unfold ge, tge.
-  apply Genv.find_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  intro. unfold ge, tge.
-  apply Genv.public_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intro. unfold ge, tge.
-  apply Genv.find_var_info_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall (v: val) (f: RTL.fundef),
   Genv.find_funct ge v = Some f ->
   exists tf,
   Genv.find_funct tge v = Some tf /\ transf_fundef f = OK tf.
-Proof (Genv.find_funct_transf_partial transf_fundef _ TRANSF).
+Proof (Genv.find_funct_transf_partial TRANSF).
 
 Lemma function_ptr_translated:
   forall (b: block) (f: RTL.fundef),
   Genv.find_funct_ptr ge b = Some f ->
   exists tf,
   Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
 
 Lemma sig_function_translated:
   forall f tf,
@@ -2185,8 +2162,7 @@ Proof.
   eapply star_trans. eexact A1.
   eapply star_left. econstructor.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved. apply senv_preserved. eauto.
   instantiate (1 := ls2); auto.
   eapply star_right. eexact A3.
   econstructor.
@@ -2278,8 +2254,7 @@ Proof.
   econstructor; split.
   apply plus_one. econstructor; eauto.
   eapply external_call_symbols_preserved' with (ge1 := ge).
-  econstructor; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  econstructor; eauto. apply senv_preserved.
   econstructor; eauto. simpl.
   replace (map
            (Locmap.setlist (map R (loc_result (ef_sig ef)))
@@ -2314,9 +2289,9 @@ Proof.
   exploit sig_function_translated; eauto. intros SIG.
   exists (LTL.Callstate nil tf (Locmap.init Vundef) m0); split.
   econstructor; eauto.
-  eapply Genv.init_mem_transf_partial; eauto.
+  eapply (Genv.init_mem_transf_partial TRANSF); eauto.
   rewrite symbols_preserved.
-  rewrite (transform_partial_program_main _ _ TRANSF).  auto.
+  rewrite (match_program_main TRANSF).  auto.
   congruence.
   constructor; auto.
   constructor. rewrite SIG; rewrite H3; auto.
@@ -2334,12 +2309,15 @@ Proof.
   econstructor. simpl; reflexivity.
   unfold loc_result in RES; rewrite H in RES. simpl in RES. inv RES. inv H3; auto.
 Qed.
-
+ 
 Lemma wt_prog: wt_program prog.
 Proof.
-  red; intros. exploit transform_partial_program_succeeds; eauto.
-  intros [tfd TF]. destruct f; simpl in *.
-- monadInv TF. unfold transf_function in EQ.
+  red; intros. 
+  exploit list_forall2_in_left. eexact (proj1 TRANSF). eauto. 
+  intros ([i' gd] & A & B & C). simpl in *; subst i'.
+  inv C. destruct f; simpl in *.
+- monadInv H2.  
+  unfold transf_function in EQ.
   destruct (type_function f) as [env|] eqn:TF; try discriminate.
   econstructor. eapply type_function_correct; eauto.
 - constructor.
@@ -2350,7 +2328,7 @@ Theorem transf_program_correct:
 Proof.
   set (ms := fun s s' => wt_state s /\ match_states s s').
   eapply forward_simulation_plus with (match_states := ms).
-- exact public_preserved.
+- apply senv_preserved.
 - intros. exploit initial_states_simulation; eauto. intros [st2 [A B]].
   exists st2; split; auto. split; auto.
   apply wt_initial_state with (p := prog); auto. exact wt_prog.
diff --git a/backend/CMlexer.mll b/backend/CMlexer.mll
index 82769924..c82f5401 100644
--- a/backend/CMlexer.mll
+++ b/backend/CMlexer.mll
@@ -121,6 +121,7 @@ rule token = parse
   | "-"    { MINUS }
   | "->"    { MINUSGREATER }
   | "-f"    { MINUSF }
+  | "-s"    { MINUSS }
   | "-l"    { MINUSL }
   | "%"    { PERCENT }
   | "%l"    { PERCENTL }
@@ -128,6 +129,7 @@ rule token = parse
   | "%u"    { PERCENTU }
   | "+"    { PLUS }
   | "+f"    { PLUSF }
+  | "+s"    { PLUSS }
   | "+l"    { PLUSL }
   | "}"    { RBRACE }
   | "}}"    { RBRACERBRACE }
@@ -138,13 +140,16 @@ rule token = parse
   | ";"    { SEMICOLON }
   | "/"    { SLASH }
   | "/f"    { SLASHF }
+  | "/s"    { SLASHS }
   | "/l"    { SLASHL }
   | "/lu"    { SLASHLU }
   | "/u"    { SLASHU }
   | "single" { SINGLE }
+  | "singleofint" { SINGLEOFINT }
   | "stack"    { STACK }
   | "*" { STAR }
   | "*f"    { STARF }
+  | "*s"    { STARS }
   | "*l"    { STARL }
   | "switch"    { SWITCH }
   | "switchl"    { SWITCHL }
diff --git a/backend/CMparser.mly b/backend/CMparser.mly
index 5109749d..7fa6500a 100644
--- a/backend/CMparser.mly
+++ b/backend/CMparser.mly
@@ -331,6 +331,7 @@ let mkmatch expr cases =
 %token MATCH
 %token MINUS
 %token MINUSF
+%token MINUSS
 %token MINUSL
 %token MINUSGREATER
 %token PERCENT
@@ -339,6 +340,7 @@ let mkmatch expr cases =
 %token PERCENTLU
 %token PLUS
 %token PLUSF
+%token PLUSS
 %token PLUSL
 %token RBRACE
 %token RBRACERBRACE
@@ -348,14 +350,17 @@ let mkmatch expr cases =
 %token RPAREN
 %token SEMICOLON
 %token SINGLE
+%token SINGLEOFINT
 %token SLASH
 %token SLASHF
+%token SLASHS
 %token SLASHU
 %token SLASHL
 %token SLASHLU
 %token STACK
 %token STAR
 %token STARF
+%token STARS
 %token STARL
 %token <string> STRINGLIT
 %token SWITCH
@@ -376,9 +381,9 @@ let mkmatch expr cases =
 %left AMPERSAND AMPERSANDL
 %left EQUALEQUAL BANGEQUAL LESS LESSEQUAL GREATER GREATEREQUAL EQUALEQUALU BANGEQUALU LESSU LESSEQUALU GREATERU GREATEREQUALU EQUALEQUALF BANGEQUALF LESSF LESSEQUALF GREATERF GREATEREQUALF EQUALEQUALL BANGEQUALL LESSL LESSEQUALL GREATERL GREATEREQUALL EQUALEQUALLU BANGEQUALLU LESSLU LESSEQUALLU GREATERLU GREATEREQUALLU
 %left LESSLESS GREATERGREATER GREATERGREATERU LESSLESSL GREATERGREATERL GREATERGREATERLU
-%left PLUS PLUSF PLUSL MINUS MINUSF MINUSL
-%left STAR SLASH PERCENT STARF SLASHF SLASHU PERCENTU STARL SLASHL SLASHLU PERCENTL PERCENTLU
-%nonassoc BANG TILDE TILDEL p_uminus ABSF INTOFFLOAT INTUOFFLOAT FLOATOFINT FLOATOFINTU INT8S INT8U INT16S INT16U FLOAT32 INTOFLONG LONGOFINT LONGOFINTU LONGOFFLOAT LONGUOFFLOAT FLOATOFLONG FLOATOFLONGU
+%left PLUS PLUSF PLUSS PLUSL MINUS MINUSF MINUSS MINUSL
+%left STAR SLASH PERCENT STARF STARS SLASHF SLASHS SLASHU PERCENTU STARL SLASHL SLASHLU PERCENTL PERCENTLU
+%nonassoc BANG TILDE TILDEL p_uminus ABSF INTOFFLOAT INTUOFFLOAT FLOATOFINT FLOATOFINTU SINGLEOFINT INT8S INT8U INT16S INT16U FLOAT32 FLOAT64 INTOFLONG LONGOFINT LONGOFINTU LONGOFFLOAT LONGUOFFLOAT FLOATOFLONG FLOATOFLONGU
 %left LPAREN
 
 /* Entry point */
@@ -580,10 +585,12 @@ expr:
   | AMPERSAND INTLIT                            { Rconst(Oaddrstack(coqint_of_camlint $2)) }
   | MINUS expr    %prec p_uminus                { Runop(Onegint, $2) }
   | MINUSF expr   %prec p_uminus                { Runop(Onegf, $2) }
+  | MINUSS expr   %prec p_uminus                { Runop(Onegfs, $2) }
   | ABSF expr                                   { Runop(Oabsf, $2) }
   | INTOFFLOAT expr                             { Runop(Ointoffloat, $2) }
   | INTUOFFLOAT expr                            { Runop(Ointuoffloat, $2) }
   | FLOATOFINT expr                             { Runop(Ofloatofint, $2) }
+  | SINGLEOFINT expr                            { Runop(Osingleofint, $2) }
   | FLOATOFINTU expr                            { Runop(Ofloatofintu, $2) }
   | TILDE expr                                  { Runop(Onotint, $2) }
   | BANG expr                                   { Rbinop(Ocmpu Ceq, $2, intconst 0l) }
@@ -592,6 +599,7 @@ expr:
   | INT16S expr                                 { Runop(Ocast16signed, $2) }
   | INT16U expr                                 { Runop(Ocast16unsigned, $2) }
   | FLOAT32 expr                                { Runop(Osingleoffloat, $2) }
+  | FLOAT64 expr                                { Runop(Ofloatofsingle, $2) }
   | MINUSL expr %prec p_uminus                  { Runop(Onegl, $2) }
   | TILDEL expr                                 { Runop(Onotl, $2) }
   | INTOFLONG expr                              { Runop(Ointoflong, $2) }
@@ -628,9 +636,13 @@ expr:
   | expr GREATERGREATERL expr                   { Rbinop(Oshrl, $1, $3) }
   | expr GREATERGREATERLU expr                  { Rbinop(Oshrlu, $1, $3) }
   | expr PLUSF expr                             { Rbinop(Oaddf, $1, $3) }
+  | expr PLUSS expr                             { Rbinop(Oaddfs, $1, $3) }
   | expr MINUSF expr                            { Rbinop(Osubf, $1, $3) }
+  | expr MINUSS expr                            { Rbinop(Osubfs, $1, $3) }
   | expr STARF expr                             { Rbinop(Omulf, $1, $3) }
+  | expr STARS expr                             { Rbinop(Omulfs, $1, $3) }
   | expr SLASHF expr                            { Rbinop(Odivf, $1, $3) }
+  | expr SLASHS expr                            { Rbinop(Odivfs, $1, $3) }
   | expr EQUALEQUAL expr                        { Rbinop(Ocmp Ceq, $1, $3) }
   | expr BANGEQUAL expr                         { Rbinop(Ocmp Cne, $1, $3) }
   | expr LESS expr                              { Rbinop(Ocmp Clt, $1, $3) }
diff --git a/backend/CSE.v b/backend/CSE.v
index 63dadbc7..d6b89557 100644
--- a/backend/CSE.v
+++ b/backend/CSE.v
@@ -13,22 +13,11 @@
 (** Common subexpression elimination over RTL.  This optimization
   proceeds by value numbering over extended basic blocks. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import ValueDomain.
-Require Import ValueAnalysis.
-Require Import CSEdomain.
-Require Import Kildall.
-Require Import CombineOp.
+Require Import Coqlib Maps Errors Integers Floats Lattice Kildall.
+Require Import AST Linking.
+Require Import Values Memory.
+Require Import Op Registers RTL.
+Require Import ValueDomain ValueAnalysis CSEdomain CombineOp.
 
 (** The idea behind value numbering algorithms is to associate
   abstract identifiers (``value numbers'') to the contents of registers
@@ -451,7 +440,8 @@ Module Solver := BBlock_solver(Numbering).
 
   For builtin invocations [Ibuiltin], we have three strategies:
 - Forget all equations.  This is appropriate for builtins that can be
-  turned into function calls ([EF_external], [EF_malloc], [EF_free]).
+  turned into function calls
+  ([EF_external], [EF_runtime], [EF_malloc], [EF_free]).
 - Forget equations involving loads but keep equations over registers.
   This is appropriate for builtins that can modify memory,
   e.g. volatile stores, or [EF_builtin]
@@ -481,7 +471,7 @@ Definition transfer (f: function) (approx: PMap.t VA.t) (pc: node) (before: numb
           empty_numbering
       | Ibuiltin ef args res s =>
           match ef with
-          | EF_external _ _ | EF_malloc | EF_free | EF_inline_asm _ _ _ =>
+          | EF_external _ _ | EF_runtime _ _ | EF_malloc | EF_free | EF_inline_asm _ _ _ =>
               empty_numbering
           | EF_builtin _ _ | EF_vstore _ =>
               set_res_unknown (kill_all_loads before) res
@@ -582,5 +572,5 @@ Definition transf_fundef (rm: romem) (f: fundef) : res fundef :=
   AST.transf_partial_fundef (transf_function rm) f.
 
 Definition transf_program (p: program) : res program :=
-  transform_partial_program (transf_fundef (romem_for_program p)) p.
+  transform_partial_program (transf_fundef (romem_for p)) p.
 
diff --git a/backend/CSEproof.v b/backend/CSEproof.v
index 07c7008d..2c144249 100644
--- a/backend/CSEproof.v
+++ b/backend/CSEproof.v
@@ -12,28 +12,21 @@
 
 (** Correctness proof for common subexpression elimination. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Errors.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import Kildall.
-Require Import ValueDomain.
-Require Import ValueAOp.
-Require Import ValueAnalysis.
-Require Import CSEdomain.
-Require Import CombineOp.
-Require Import CombineOpproof.
-Require Import CSE.
+Require Import Coqlib Maps Errors Integers Floats Lattice Kildall.
+Require Import AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Registers RTL.
+Require Import ValueDomain ValueAOp ValueAnalysis.
+Require Import CSEdomain CombineOp CombineOpproof CSE.
+
+Definition match_prog (prog tprog: RTL.program) :=
+  match_program (fun cu f tf => transf_fundef (romem_for cu) f = OK tf) eq prog tprog.
+
+Lemma transf_program_match:
+  forall prog tprog, transf_program prog = OK tprog -> match_prog prog tprog.
+Proof.
+  intros. eapply match_transform_partial_program_contextual; eauto.
+Qed.
 
 (** * Soundness of operations over value numberings *)
 
@@ -809,37 +802,32 @@ Section PRESERVATION.
 
 Variable prog: program.
 Variable tprog : program.
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
-Let rm := romem_for_program prog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof (Genv.find_symbol_transf_partial (transf_fundef rm) prog TRANSF).
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof (Genv.public_symbol_transf_partial (transf_fundef rm) prog TRANSF).
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof (Genv.find_var_info_transf_partial (transf_fundef rm) prog TRANSF).
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall (v: val) (f: RTL.fundef),
   Genv.find_funct ge v = Some f ->
-  exists tf, Genv.find_funct tge v = Some tf /\ transf_fundef rm f = OK tf.
-Proof (Genv.find_funct_transf_partial (transf_fundef rm) prog TRANSF).
+  exists cu tf, Genv.find_funct tge v = Some tf /\ transf_fundef (romem_for cu) f = OK tf /\ linkorder cu prog.
+Proof (Genv.find_funct_match TRANSF).
 
 Lemma funct_ptr_translated:
   forall (b: block) (f: RTL.fundef),
   Genv.find_funct_ptr ge b = Some f ->
-  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef rm f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial (transf_fundef rm) prog TRANSF).
+  exists cu tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef (romem_for cu) f = OK tf /\ linkorder cu prog.
+Proof (Genv.find_funct_ptr_match TRANSF).
 
 Lemma sig_preserved:
-  forall f tf, transf_fundef rm f = OK tf -> funsig tf = funsig f.
+  forall rm f tf, transf_fundef rm f = OK tf -> funsig tf = funsig f.
 Proof.
   unfold transf_fundef; intros. destruct f; monadInv H; auto.
   unfold transf_function in EQ.
@@ -887,7 +875,9 @@ Lemma find_function_translated:
   forall ros rs fd rs',
   find_function ge ros rs = Some fd ->
   regs_lessdef rs rs' ->
-  exists tfd, find_function tge ros rs' = Some tfd /\ transf_fundef rm fd = OK tfd.
+  exists cu tfd, find_function tge ros rs' = Some tfd
+              /\ transf_fundef (romem_for cu) fd = OK tfd
+              /\ linkorder cu prog.
 Proof.
   unfold find_function; intros; destruct ros.
 - specialize (H0 r). inv H0.
@@ -914,12 +904,16 @@ Qed.
   the numbering at [pc] (returned by the static analysis) is satisfiable.
 *)
 
+Definition analyze (cu: program) (f: function) :=
+  CSE.analyze f (vanalyze (romem_for cu) f).
+
 Inductive match_stackframes: list stackframe -> list stackframe -> Prop :=
   | match_stackframes_nil:
       match_stackframes nil nil
   | match_stackframes_cons:
-      forall res sp pc rs f approx s rs' s'
-           (ANALYZE: analyze f (vanalyze rm f) = Some approx)
+      forall res sp pc rs f s rs' s' cu approx
+           (LINK: linkorder cu prog)
+           (ANALYZE: analyze cu f = Some approx)
            (SAT: forall v m, exists valu, numbering_holds valu ge sp (rs#res <- v) m approx!!pc)
            (RLD: regs_lessdef rs rs')
            (STACKS: match_stackframes s s'),
@@ -929,8 +923,9 @@ Inductive match_stackframes: list stackframe -> list stackframe -> Prop :=
 
 Inductive match_states: state -> state -> Prop :=
   | match_states_intro:
-      forall s sp pc rs m s' rs' m' f approx
-             (ANALYZE: analyze f (vanalyze rm f) = Some approx)
+      forall s sp pc rs m s' rs' m' f cu approx
+             (LINK: linkorder cu prog)
+             (ANALYZE: analyze cu f = Some approx)
              (SAT: exists valu, numbering_holds valu ge sp rs m approx!!pc)
              (RLD: regs_lessdef rs rs')
              (MEXT: Mem.extends m m')
@@ -938,18 +933,19 @@ Inductive match_states: state -> state -> Prop :=
       match_states (State s f sp pc rs m)
                    (State s' (transf_function' f approx) sp pc rs' m')
   | match_states_call:
-      forall s f tf args m s' args' m',
-      match_stackframes s s' ->
-      transf_fundef rm f = OK tf ->
-      Val.lessdef_list args args' ->
-      Mem.extends m m' ->
+      forall s f tf args m s' args' m' cu
+             (LINK: linkorder cu prog)
+             (STACKS: match_stackframes s s')
+             (TFD: transf_fundef (romem_for cu) f = OK tf)
+             (ARGS: Val.lessdef_list args args')
+             (MEXT: Mem.extends m m'),
       match_states (Callstate s f args m)
                    (Callstate s' tf args' m')
   | match_states_return:
-      forall s s' v v' m m',
-      match_stackframes s s' ->
-      Val.lessdef v v' ->
-      Mem.extends m m' ->
+      forall s s' v v' m m'
+             (STACK: match_stackframes s s')
+             (RES: Val.lessdef v v')
+             (MEXT: Mem.extends m m'),
       match_states (Returnstate s v m)
                    (Returnstate s' v' m').
 
@@ -1076,28 +1072,28 @@ Proof.
   econstructor; eauto.
   eapply analysis_correct_1; eauto. simpl; auto.
   unfold transfer; rewrite H.
-  inv SOUND.
+  InvSoundState.
   eapply add_store_result_hold; eauto.
   eapply kill_loads_after_store_holds; eauto.
 
 - (* Icall *)
-  exploit find_function_translated; eauto. intros [tf [FIND' TRANSF']].
+  exploit find_function_translated; eauto. intros (cu' & tf & FIND' & TRANSF' & LINK').
   econstructor; split.
   eapply exec_Icall; eauto.
-  apply sig_preserved; auto.
-  econstructor; eauto.
+  eapply sig_preserved; eauto.
   econstructor; eauto.
+  eapply match_stackframes_cons with (cu := cu); eauto.
   intros. eapply analysis_correct_1; eauto. simpl; auto.
   unfold transfer; rewrite H.
   exists (fun _ => Vundef); apply empty_numbering_holds.
   apply regs_lessdef_regs; auto.
 
 - (* Itailcall *)
-  exploit find_function_translated; eauto. intros [tf [FIND' TRANSF']].
+  exploit find_function_translated; eauto. intros (cu' & tf & FIND' & TRANSF' & LINK').
   exploit Mem.free_parallel_extends; eauto. intros [m'' [A B]].
   econstructor; split.
   eapply exec_Itailcall; eauto.
-  apply sig_preserved; auto.
+  eapply sig_preserved; eauto.
   econstructor; eauto.
   apply regs_lessdef_regs; auto.
 
@@ -1109,8 +1105,7 @@ Proof.
   econstructor; split.
   eapply exec_Ibuiltin; eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto.
   eapply analysis_correct_1; eauto. simpl; auto.
 * unfold transfer; rewrite H.
@@ -1125,6 +1120,7 @@ Proof.
   destruct ef.
   + apply CASE1.
   + apply CASE3.
+  + apply CASE1.
   + apply CASE2; inv H1; auto.
   + apply CASE3.
   + apply CASE1.
@@ -1133,7 +1129,7 @@ Proof.
     simpl in H1. inv H1.
     exists valu.
     apply set_res_unknown_holds.
-    inv SOUND. unfold vanalyze, rm; rewrite AN.
+    InvSoundState. unfold vanalyze; rewrite AN.
     assert (pmatch bc bsrc osrc (aaddr_arg (VA.State ae am) a0))
     by (eapply aaddr_arg_sound_1; eauto).
     assert (pmatch bc bdst odst (aaddr_arg (VA.State ae am) a1))
@@ -1179,8 +1175,8 @@ Proof.
   destruct or; simpl; auto.
 
 - (* internal function *)
-  monadInv H6. unfold transf_function in EQ.
-  destruct (analyze f (vanalyze rm f)) as [approx|] eqn:?; inv EQ.
+  monadInv TFD. unfold transf_function in EQ. fold (analyze cu f) in EQ.
+  destruct (analyze cu f) as [approx|] eqn:?; inv EQ.
   exploit Mem.alloc_extends; eauto. apply Zle_refl. apply Zle_refl.
   intros (m'' & A & B).
   econstructor; split.
@@ -1190,17 +1186,16 @@ Proof.
   apply init_regs_lessdef; auto.
 
 - (* external function *)
-  monadInv H6.
+  monadInv TFD.
   exploit external_call_mem_extends; eauto.
   intros (v' & m1' & P & Q & R & S).
   econstructor; split.
   eapply exec_function_external; eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto.
 
 - (* return *)
-  inv H2.
+  inv STACK.
   econstructor; split.
   eapply exec_return; eauto.
   econstructor; eauto.
@@ -1212,22 +1207,22 @@ Lemma transf_initial_states:
   exists st2, initial_state tprog st2 /\ match_states st1 st2.
 Proof.
   intros. inversion H.
-  exploit funct_ptr_translated; eauto. intros [tf [A B]].
+  exploit funct_ptr_translated; eauto. intros (cu & tf & A & B & C).
   exists (Callstate nil tf nil m0); split.
   econstructor; eauto.
-  eapply Genv.init_mem_transf_partial; eauto.
+  eapply (Genv.init_mem_match TRANSF); eauto.
   replace (prog_main tprog) with (prog_main prog).
   rewrite symbols_preserved. eauto.
-  symmetry. eapply transform_partial_program_main; eauto.
-  rewrite <- H3. apply sig_preserved; auto.
-  constructor. constructor. auto. auto. apply Mem.extends_refl.
+  symmetry. eapply match_program_main; eauto.
+  rewrite <- H3. eapply sig_preserved; eauto.
+  econstructor. eauto. constructor. auto. auto. apply Mem.extends_refl.
 Qed.
 
 Lemma transf_final_states:
   forall st1 st2 r,
   match_states st1 st2 -> final_state st1 r -> final_state st2 r.
 Proof.
-  intros. inv H0. inv H. inv H5. inv H3. constructor.
+  intros. inv H0. inv H. inv RES. inv STACK. constructor.
 Qed.
 
 Theorem transf_program_correct:
@@ -1235,7 +1230,7 @@ Theorem transf_program_correct:
 Proof.
   eapply forward_simulation_step with
     (match_states := fun s1 s2 => sound_state prog s1 /\ match_states s1 s2).
-- eexact public_preserved.
+- apply senv_preserved.
 - intros. exploit transf_initial_states; eauto. intros [s2 [A B]].
   exists s2. split. auto. split. apply sound_initial; auto. auto.
 - intros. destruct H. eapply transf_final_states; eauto.
diff --git a/backend/CleanupLabels.v b/backend/CleanupLabels.v
index 759201b2..303fcb64 100644
--- a/backend/CleanupLabels.v
+++ b/backend/CleanupLabels.v
@@ -20,10 +20,8 @@
   better-looking, the present pass removes labels that cannot be
   branched to. *)
 
-Require Import FSets.
-Require FSetAVL.
-Require Import Coqlib.
-Require Import Ordered.
+Require Import FSets FSetAVL.
+Require Import Coqlib Ordered.
 Require Import Linear.
 
 Module Labelset := FSetAVL.Make(OrderedPositive).
diff --git a/backend/CleanupLabelsproof.v b/backend/CleanupLabelsproof.v
index 6f33c9c2..a498a654 100644
--- a/backend/CleanupLabelsproof.v
+++ b/backend/CleanupLabelsproof.v
@@ -12,68 +12,51 @@
 
 (** Correctness proof for clean-up of labels *)
 
-Require Import Coqlib.
-Require Import Ordered.
 Require Import FSets.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Locations.
-Require Import Linear.
+Require Import Coqlib Ordered Integers.
+Require Import AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Locations Linear.
 Require Import CleanupLabels.
 
 Module LabelsetFacts := FSetFacts.Facts(Labelset).
 
+Definition match_prog (p tp: Linear.program) :=
+  match_program (fun ctx f tf => tf = transf_fundef f) eq p tp.
+
+Lemma transf_program_match:
+  forall p, match_prog p (transf_program p).
+Proof.
+  intros. eapply match_transform_program; eauto.
+Qed.
+
 Section CLEANUP.
 
-Variable prog: program.
-Let tprog := transf_program prog.
+Variables prog tprog: program.
+Hypothesis TRANSL: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
-  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intros; unfold ge, tge, tprog, transf_program.
-  apply Genv.find_symbol_transf.
-Qed.
+  forall id,
+  Genv.find_symbol tge id = Genv.find_symbol ge id.
+Proof (Genv.find_symbol_transf TRANSL).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  intros; unfold ge, tge, tprog, transf_program.
-  apply Genv.public_symbol_transf.
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intros; unfold ge, tge, tprog, transf_program.
-  apply Genv.find_var_info_transf.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_transf TRANSL).
 
 Lemma functions_translated:
-  forall (v: val) (f: fundef),
+  forall v f,
   Genv.find_funct ge v = Some f ->
   Genv.find_funct tge v = Some (transf_fundef f).
-Proof.
-  intros.
-  exact (Genv.find_funct_transf transf_fundef _ _ H).
-Qed.
+Proof (Genv.find_funct_transf TRANSL).
 
 Lemma function_ptr_translated:
-  forall (b: block) (f: fundef),
-  Genv.find_funct_ptr ge b = Some f ->
-  Genv.find_funct_ptr tge b = Some (transf_fundef f).
-Proof.
-  intros.
-  exact (Genv.find_funct_ptr_transf transf_fundef _ _ H).
-Qed.
+  forall v f,
+  Genv.find_funct_ptr ge v = Some f ->
+  Genv.find_funct_ptr tge v = Some (transf_fundef f).
+Proof (Genv.find_funct_ptr_transf TRANSL).
 
 Lemma sig_function_translated:
   forall f,
@@ -293,8 +276,7 @@ Proof.
   left; econstructor; split.
   econstructor.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved.  exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   eauto.
   econstructor; eauto with coqlib.
 (* Llabel *)
@@ -333,8 +315,7 @@ Proof.
   econstructor; eauto with coqlib.
 (* external function *)
   left; econstructor; split.
-  econstructor; eauto. eapply external_call_symbols_preserved'; eauto.
-  exact symbols_preserved.  exact public_preserved.  exact varinfo_preserved.
+  econstructor; eauto. eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   econstructor; eauto with coqlib.
 (* return *)
   inv H3. inv H1. left; econstructor; split.
@@ -349,8 +330,8 @@ Proof.
   intros. inv H.
   econstructor; split.
   eapply initial_state_intro with (f := transf_fundef f).
-  eapply Genv.init_mem_transf; eauto.
-  rewrite symbols_preserved; eauto.
+  eapply (Genv.init_mem_transf TRANSL); eauto.
+  rewrite (match_program_main TRANSL), symbols_preserved; eauto.
   apply function_ptr_translated; auto.
   rewrite sig_function_translated. auto.
   constructor; auto. constructor.
@@ -367,7 +348,7 @@ Theorem transf_program_correct:
   forward_simulation (Linear.semantics prog) (Linear.semantics tprog).
 Proof.
   eapply forward_simulation_opt.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   eexact transf_step_correct.
diff --git a/backend/Constprop.v b/backend/Constprop.v
index 5ca69183..4de80b7a 100644
--- a/backend/Constprop.v
+++ b/backend/Constprop.v
@@ -14,21 +14,11 @@
   performed at RTL level.  It proceeds by a standard dataflow analysis
   and the corresponding code rewriting. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Op.
-Require Machregs.
-Require Import Registers.
-Require Import RTL.
-Require Import Lattice.
-Require Import Kildall.
-Require Import Liveness.
-Require Import ValueDomain.
-Require Import ValueAOp.
-Require Import ValueAnalysis.
+Require Import Coqlib Maps Integers Floats Lattice Kildall.
+Require Import AST Linking.
+Require Compopts Machregs.
+Require Import Op Registers RTL.
+Require Import Liveness ValueDomain ValueAOp ValueAnalysis.
 Require Import ConstpropOp.
 
 (** The code transformation builds on the results of the static analysis
@@ -231,5 +221,5 @@ Definition transf_fundef (rm: romem) (fd: fundef) : fundef :=
   AST.transf_fundef (transf_function rm) fd.
 
 Definition transf_program (p: program) : program :=
-  let rm := romem_for_program p in
+  let rm := romem_for p in
   transform_program (transf_fundef rm) p.
diff --git a/backend/Constpropproof.v b/backend/Constpropproof.v
index ad9068ab..4e76c641 100644
--- a/backend/Constpropproof.v
+++ b/backend/Constpropproof.v
@@ -12,35 +12,30 @@
 
 (** Correctness proof for constant propagation. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Compopts.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Events.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import Lattice.
-Require Import Kildall.
-Require Import ValueDomain.
-Require Import ValueAOp.
-Require Import ValueAnalysis.
-Require Import ConstpropOp.
-Require Import Constprop.
-Require Import ConstpropOpproof.
+Require Import Coqlib Maps Integers Floats Lattice Kildall.
+Require Import AST Linking.
+Require Import Values Events Memory Globalenvs Smallstep.
+Require Compopts Machregs.
+Require Import Op Registers RTL.
+Require Import Liveness ValueDomain ValueAOp ValueAnalysis.
+Require Import ConstpropOp ConstpropOpproof Constprop.
+
+Definition match_prog (prog tprog: program) :=
+  match_program (fun cu f tf => tf = transf_fundef (romem_for cu) f) eq prog tprog.
+
+Lemma transf_program_match:
+  forall prog, match_prog prog (transf_program prog).
+Proof.
+  intros. eapply match_transform_program_contextual. auto.
+Qed.
 
 Section PRESERVATION.
 
 Variable prog: program.
-Let tprog := transf_program prog.
+Variable tprog: program.
+Hypothesis TRANSL: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
-Let rm := romem_for_program prog.
 
 (** * Correctness of the code transformation *)
 
@@ -49,45 +44,32 @@ Let rm := romem_for_program prog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intros; unfold ge, tge, tprog, transf_program.
-  apply Genv.find_symbol_transf.
-Qed.
-
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  intros; unfold ge, tge, tprog, transf_program.
-  apply Genv.public_symbol_transf.
-Qed.
+Proof (Genv.find_symbol_match TRANSL).
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intros; unfold ge, tge, tprog, transf_program.
-  apply Genv.find_var_info_transf.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSL).
 
 Lemma functions_translated:
   forall (v: val) (f: fundef),
   Genv.find_funct ge v = Some f ->
-  Genv.find_funct tge v = Some (transf_fundef rm f).
+  exists cunit, Genv.find_funct tge v = Some (transf_fundef (romem_for cunit) f) /\ linkorder cunit prog.
 Proof.
-  intros.
-  exact (Genv.find_funct_transf (transf_fundef rm) _ _ H).
+  intros. exploit (Genv.find_funct_match TRANSL); eauto. 
+  intros (cu & tf & A & B & C). subst tf. exists cu; auto.
 Qed.
 
 Lemma function_ptr_translated:
   forall (b: block) (f: fundef),
   Genv.find_funct_ptr ge b = Some f ->
-  Genv.find_funct_ptr tge b = Some (transf_fundef rm f).
+  exists cunit, Genv.find_funct_ptr tge b = Some (transf_fundef (romem_for cunit) f) /\ linkorder cunit prog.
 Proof.
-  intros.
-  exact (Genv.find_funct_ptr_transf (transf_fundef rm) _ _ H).
+  intros. exploit (Genv.find_funct_ptr_match TRANSL); eauto. 
+  intros (cu & tf & A & B & C). subst tf. exists cu; auto.
 Qed.
 
 Lemma sig_function_translated:
-  forall f,
+  forall rm f,
   funsig (transf_fundef rm f) = funsig f.
 Proof.
   intros. destruct f; reflexivity.
@@ -110,12 +92,17 @@ Lemma transf_ros_correct:
   ematch bc rs ae ->
   find_function ge ros rs = Some f ->
   regs_lessdef rs rs' ->
-  find_function tge (transf_ros ae ros) rs' = Some (transf_fundef rm f).
+  exists cunit, 
+     find_function tge (transf_ros ae ros) rs' = Some (transf_fundef (romem_for cunit) f)
+  /\ linkorder cunit prog.
 Proof.
   intros until rs'; intros GE EM FF RLD. destruct ros; simpl in *.
 - (* function pointer *)
   generalize (EM r); fold (areg ae r); intro VM. generalize (RLD r); intro LD.
-  assert (DEFAULT: find_function tge (inl _ r) rs' = Some (transf_fundef rm f)).
+  assert (DEFAULT:
+    exists cunit, 
+       find_function tge (inl _ r) rs' = Some (transf_fundef (romem_for cunit) f)
+    /\ linkorder cunit prog).
   {
     simpl. inv LD. apply functions_translated; auto. rewrite <- H0 in FF; discriminate.
   }
@@ -162,35 +149,45 @@ Proof.
     eapply vmatch_ptr_stk; eauto.
 Qed.
 
-Inductive match_pc (f: function) (ae: AE.t): nat -> node -> node -> Prop :=
+Inductive match_pc (f: function) (rs: regset) (m: mem): nat -> node -> node -> Prop :=
   | match_pc_base: forall n pc,
-      match_pc f ae n pc pc
+      match_pc f rs m n pc pc
   | match_pc_nop: forall n pc s pcx,
       f.(fn_code)!pc = Some (Inop s) ->
-      match_pc f ae n s pcx ->
-      match_pc f ae (S n) pc pcx
-  | match_pc_cond: forall n pc cond args s1 s2 b pcx,
+      match_pc f rs m n s pcx ->
+      match_pc f rs m (S n) pc pcx
+  | match_pc_cond: forall n pc cond args s1 s2 pcx,
       f.(fn_code)!pc = Some (Icond cond args s1 s2) ->
-      resolve_branch (eval_static_condition cond (aregs ae args)) = Some b ->
-      match_pc f ae n (if b then s1 else s2) pcx ->
-      match_pc f ae (S n) pc pcx.
+      (forall b,
+        eval_condition cond rs##args m = Some b ->
+        match_pc f rs m n (if b then s1 else s2) pcx) ->
+      match_pc f rs m (S n) pc pcx.
 
 Lemma match_successor_rec:
-  forall f ae n pc, match_pc f ae n pc (successor_rec n f ae pc).
+  forall f rs m bc ae,
+  ematch bc rs ae ->
+  forall n pc,
+  match_pc f rs m n pc (successor_rec n f ae pc).
 Proof.
   induction n; simpl; intros.
 - apply match_pc_base.
 - destruct (fn_code f)!pc as [[]|] eqn:INSTR; try apply match_pc_base.
-  eapply match_pc_nop; eauto.
-  destruct (resolve_branch (eval_static_condition c (aregs ae l))) as [b|] eqn:COND.
-  eapply match_pc_cond; eauto.
-  apply match_pc_base.
++ eapply match_pc_nop; eauto.
++ destruct (resolve_branch (eval_static_condition c (aregs ae l))) as [b|] eqn:STATIC;
+  try apply match_pc_base.
+  eapply match_pc_cond; eauto. intros b' DYNAMIC.
+  assert (b = b').
+  { eapply resolve_branch_sound; eauto. 
+    rewrite <- DYNAMIC. apply eval_static_condition_sound with bc. 
+    apply aregs_sound; auto. }
+  subst b'. apply IHn. 
 Qed.
 
 Lemma match_successor:
-  forall f ae pc, match_pc f ae num_iter pc (successor f ae pc).
+  forall f rs m bc ae pc,
+  ematch bc rs ae -> match_pc f rs m num_iter pc (successor f ae pc).
 Proof.
-  unfold successor; intros. apply match_successor_rec.
+  intros. eapply match_successor_rec; eauto.
 Qed.
 
 Lemma builtin_arg_reduction_correct:
@@ -300,29 +297,31 @@ Qed.
 
 Inductive match_stackframes: stackframe -> stackframe -> Prop :=
    match_stackframe_intro:
-      forall res sp pc rs f rs',
+      forall res sp pc rs f rs' cu,
+      linkorder cu prog ->
       regs_lessdef rs rs' ->
     match_stackframes
         (Stackframe res f sp pc rs)
-        (Stackframe res (transf_function rm f) sp pc rs').
+        (Stackframe res (transf_function (romem_for cu) f) sp pc rs').
 
 Inductive match_states: nat -> state -> state -> Prop :=
   | match_states_intro:
-      forall s sp pc rs m f s' pc' rs' m' bc ae n
-           (MATCH: ematch bc rs ae)
+      forall s sp pc rs m f s' pc' rs' m' cu n
+           (LINK: linkorder cu prog)
            (STACKS: list_forall2 match_stackframes s s')
-           (PC: match_pc f ae n pc pc')
+           (PC: match_pc f rs m n pc pc')
            (REGS: regs_lessdef rs rs')
            (MEM: Mem.extends m m'),
       match_states n (State s f sp pc rs m)
-                    (State s' (transf_function rm f) sp pc' rs' m')
+                    (State s' (transf_function (romem_for cu) f) sp pc' rs' m')
   | match_states_call:
-      forall s f args m s' args' m'
+      forall s f args m s' args' m' cu
+           (LINK: linkorder cu prog)
            (STACKS: list_forall2 match_stackframes s s')
            (ARGS: Val.lessdef_list args args')
            (MEM: Mem.extends m m'),
       match_states O (Callstate s f args m)
-                     (Callstate s' (transf_fundef rm f) args' m')
+                     (Callstate s' (transf_fundef (romem_for cu) f) args' m')
   | match_states_return:
       forall s v m s' v' m'
            (STACKS: list_forall2 match_stackframes s s')
@@ -333,21 +332,19 @@ Inductive match_states: nat -> state -> state -> Prop :=
                      (Returnstate s' v' m').
 
 Lemma match_states_succ:
-  forall s f sp pc rs m s' rs' m',
-  sound_state prog (State s f sp pc rs m) ->
+  forall s f sp pc rs m s' rs' m' cu,
+  linkorder cu prog ->
   list_forall2 match_stackframes s s' ->
   regs_lessdef rs rs' ->
   Mem.extends m m' ->
   match_states O (State s f sp pc rs m)
-                 (State s' (transf_function rm f) sp pc rs' m').
+                 (State s' (transf_function (romem_for cu) f) sp pc rs' m').
 Proof.
-  intros. inv H.
-  apply match_states_intro with (bc := bc) (ae := ae); auto.
-  constructor.
+  intros. apply match_states_intro; auto. constructor. 
 Qed.
 
 Lemma transf_instr_at:
-  forall f pc i,
+  forall rm f pc i,
   f.(fn_code)!pc = Some i ->
   (transf_function rm f).(fn_code)!pc = Some(transf_instr f (analyze rm f) rm pc i).
 Proof.
@@ -357,8 +354,8 @@ Qed.
 Ltac TransfInstr :=
   match goal with
   | H1: (PTree.get ?pc (fn_code ?f) = Some ?instr),
-    H2: (analyze (romem_for_program prog) ?f)#?pc = VA.State ?ae ?am |- _ =>
-      fold rm in H2; generalize (transf_instr_at _ _ _ H1); unfold transf_instr; rewrite H2
+    H2: (analyze ?rm ?f)#?pc = VA.State ?ae ?am |- _ =>
+      generalize (transf_instr_at rm _ _ _ H1); unfold transf_instr; rewrite H2
   end.
 
 (** The proof of simulation proceeds by case analysis on the transition
@@ -367,38 +364,38 @@ Ltac TransfInstr :=
 Lemma transf_step_correct:
   forall s1 t s2,
   step ge s1 t s2 ->
-  forall n1 s1' (SS1: sound_state prog s1) (SS2: sound_state prog s2) (MS: match_states n1 s1 s1'),
+  forall n1 s1' (SS: sound_state prog s1) (MS: match_states n1 s1 s1'),
   (exists n2, exists s2', step tge s1' t s2' /\ match_states n2 s2 s2')
   \/ (exists n2, n2 < n1 /\ t = E0 /\ match_states n2 s2 s1')%nat.
 Proof.
-  induction 1; intros; inv SS1; inv MS; try (inv PC; try congruence).
+  induction 1; intros; inv MS; try InvSoundState; try (inv PC; try congruence).
 
-  (* Inop, preserved *)
+- (* Inop, preserved *)
   rename pc'0 into pc. TransfInstr; intros.
   left; econstructor; econstructor; split.
   eapply exec_Inop; eauto.
   eapply match_states_succ; eauto.
 
-  (* Inop, skipped over *)
+- (* Inop, skipped over *)
   assert (s0 = pc') by congruence. subst s0.
   right; exists n; split. omega. split. auto.
-  apply match_states_intro with bc0 ae0; auto.
+  apply match_states_intro; auto.
 
-  (* Iop *)
+- (* Iop *)
   rename pc'0 into pc. TransfInstr.
   set (a := eval_static_operation op (aregs ae args)).
   set (ae' := AE.set res a ae).
   assert (VMATCH: vmatch bc v a) by (eapply eval_static_operation_sound; eauto with va).
   assert (MATCH': ematch bc (rs#res <- v) ae') by (eapply ematch_update; eauto).
   destruct (const_for_result a) as [cop|] eqn:?; intros.
-  (* constant is propagated *)
++ (* constant is propagated *)
   exploit const_for_result_correct; eauto. intros (v' & A & B).
   left; econstructor; econstructor; split.
   eapply exec_Iop; eauto.
-  apply match_states_intro with bc ae'; auto.
-  apply match_successor.
+  apply match_states_intro; auto.
+  eapply match_successor; eauto.
   apply set_reg_lessdef; auto.
-  (* operator is strength-reduced *)
++ (* operator is strength-reduced *)
   assert(OP:
      let (op', args') := op_strength_reduction op args (aregs ae args) in
      exists v',
@@ -413,24 +410,24 @@ Proof.
   left; econstructor; econstructor; split.
   eapply exec_Iop; eauto.
   erewrite eval_operation_preserved. eexact EV''. exact symbols_preserved.
-  apply match_states_intro with bc ae'; auto.
-  apply match_successor.
+  apply match_states_intro; auto.
+  eapply match_successor; eauto.
   apply set_reg_lessdef; auto. eapply Val.lessdef_trans; eauto.
 
-  (* Iload *)
+- (* Iload *)
   rename pc'0 into pc. TransfInstr.
   set (aa := eval_static_addressing addr (aregs ae args)).
   assert (VM1: vmatch bc a aa) by (eapply eval_static_addressing_sound; eauto with va).
-  set (av := loadv chunk rm am aa).
+  set (av := loadv chunk (romem_for cu) am aa).
   assert (VM2: vmatch bc v av) by (eapply loadv_sound; eauto).
   destruct (const_for_result av) as [cop|] eqn:?; intros.
-  (* constant-propagated *)
++ (* constant-propagated *)
   exploit const_for_result_correct; eauto. intros (v' & A & B).
   left; econstructor; econstructor; split.
   eapply exec_Iop; eauto.
   eapply match_states_succ; eauto.
   apply set_reg_lessdef; auto.
-  (* strength-reduced *)
++ (* strength-reduced *)
   assert (ADDR:
      let (addr', args') := addr_strength_reduction addr args (aregs ae args) in
      exists a',
@@ -449,7 +446,7 @@ Proof.
   eapply exec_Iload; eauto.
   eapply match_states_succ; eauto. apply set_reg_lessdef; auto.
 
-  (* Istore *)
+- (* Istore *)
   rename pc'0 into pc. TransfInstr.
   assert (ADDR:
      let (addr', args') := addr_strength_reduction addr args (aregs ae args) in
@@ -469,9 +466,9 @@ Proof.
   eapply exec_Istore; eauto.
   eapply match_states_succ; eauto.
 
-  (* Icall *)
+- (* Icall *)
   rename pc'0 into pc.
-  exploit transf_ros_correct; eauto. intro FIND'.
+  exploit transf_ros_correct; eauto. intros (cu' & FIND & LINK').
   TransfInstr; intro.
   left; econstructor; econstructor; split.
   eapply exec_Icall; eauto. apply sig_function_translated; auto.
@@ -479,17 +476,17 @@ Proof.
   econstructor; eauto.
   apply regs_lessdef_regs; auto.
 
-  (* Itailcall *)
+- (* Itailcall *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [A B]].
-  exploit transf_ros_correct; eauto. intros FIND'.
+  exploit transf_ros_correct; eauto. intros (cu' & FIND & LINK').
   TransfInstr; intro.
   left; econstructor; econstructor; split.
   eapply exec_Itailcall; eauto. apply sig_function_translated; auto.
   constructor; auto.
   apply regs_lessdef_regs; auto.
 
-  (* Ibuiltin *)
-  rename pc'0 into pc. clear MATCH. TransfInstr; intros.
+- (* Ibuiltin *)
+  rename pc'0 into pc. TransfInstr; intros.
 Opaque builtin_strength_reduction.
   exploit builtin_strength_reduction_correct; eauto. intros (vargs' & P & Q).
   exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)).
@@ -500,13 +497,12 @@ Opaque builtin_strength_reduction.
   left; econstructor; econstructor; split.
   eapply exec_Ibuiltin; eauto.
   eapply eval_builtin_args_preserved. eexact symbols_preserved. eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   eapply match_states_succ; eauto.
   apply set_res_lessdef; auto.
 
-  (* Icond, preserved *)
-  rename pc' into pc. TransfInstr.
+- (* Icond, preserved *)
+  rename pc'0 into pc. TransfInstr.
   set (ac := eval_static_condition cond (aregs ae args)).
   assert (C: cmatch (eval_condition cond rs ## args m) ac)
   by (eapply eval_static_condition_sound; eauto with va).
@@ -514,7 +510,7 @@ Opaque builtin_strength_reduction.
   generalize (cond_strength_reduction_correct bc ae rs m EM cond args (aregs ae args) (refl_equal _)).
   destruct (cond_strength_reduction cond args (aregs ae args)) as [cond' args'].
   intros EV1 TCODE.
-  left; exists O; exists (State s' (transf_function rm f) (Vptr sp0 Int.zero) (if b then ifso else ifnot) rs' m'); split.
+  left; exists O; exists (State s' (transf_function (romem_for cu) f) (Vptr sp0 Int.zero) (if b then ifso else ifnot) rs' m'); split.
   destruct (resolve_branch ac) eqn: RB.
   assert (b0 = b) by (eapply resolve_branch_sound; eauto). subst b0.
   destruct b; eapply exec_Inop; eauto.
@@ -522,20 +518,15 @@ Opaque builtin_strength_reduction.
   eapply eval_condition_lessdef with (vl1 := rs##args'); eauto. eapply regs_lessdef_regs; eauto. congruence.
   eapply match_states_succ; eauto.
 
-  (* Icond, skipped over *)
+- (* Icond, skipped over *)
   rewrite H1 in H; inv H.
-  set (ac := eval_static_condition cond (aregs ae0 args)) in *.
-  assert (C: cmatch (eval_condition cond rs ## args m) ac)
-  by (eapply eval_static_condition_sound; eauto with va).
-  rewrite H0 in C.
-  assert (b0 = b) by (eapply resolve_branch_sound; eauto). subst b0.
-  right; exists n; split. omega. split. auto.
+  right; exists n; split. omega. split. auto. 
   econstructor; eauto.
 
-  (* Ijumptable *)
+- (* Ijumptable *)
   rename pc'0 into pc.
-  assert (A: (fn_code (transf_function rm f))!pc = Some(Ijumptable arg tbl)
-             \/ (fn_code (transf_function rm f))!pc = Some(Inop pc')).
+  assert (A: (fn_code (transf_function (romem_for cu) f))!pc = Some(Ijumptable arg tbl)
+             \/ (fn_code (transf_function (romem_for cu) f))!pc = Some(Inop pc')).
   { TransfInstr.
     destruct (areg ae arg) eqn:A; auto.
     generalize (EM arg). fold (areg ae arg); rewrite A.
@@ -543,23 +534,20 @@ Opaque builtin_strength_reduction.
     rewrite H1. auto. }
   assert (rs'#arg = Vint n).
   { generalize (REGS arg). rewrite H0. intros LD; inv LD; auto. }
-  left; exists O; exists (State s' (transf_function rm f) (Vptr sp0 Int.zero) pc' rs' m'); split.
+  left; exists O; exists (State s' (transf_function (romem_for cu) f) (Vptr sp0 Int.zero) pc' rs' m'); split.
   destruct A. eapply exec_Ijumptable; eauto. eapply exec_Inop; eauto.
   eapply match_states_succ; eauto.
 
-  (* Ireturn *)
+- (* Ireturn *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [A B]].
   left; exists O; exists (Returnstate s' (regmap_optget or Vundef rs') m2'); split.
   eapply exec_Ireturn; eauto. TransfInstr; auto.
   constructor; auto.
   destruct or; simpl; auto.
 
-  (* internal function *)
+- (* internal function *)
   exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl.
   intros [m2' [A B]].
-  assert (X: exists bc ae, ematch bc (init_regs args (fn_params f)) ae).
-  { inv SS2. exists bc0; exists ae; auto. }
-  destruct X as (bc1 & ae1 & MATCH).
   simpl. unfold transf_function.
   left; exists O; econstructor; split.
   eapply exec_function_internal; simpl; eauto.
@@ -567,19 +555,15 @@ Opaque builtin_strength_reduction.
   constructor.
   apply init_regs_lessdef; auto.
 
-  (* external function *)
+- (* external function *)
   exploit external_call_mem_extends; eauto.
   intros [v' [m2' [A [B [C D]]]]].
   simpl. left; econstructor; econstructor; split.
   eapply exec_function_external; eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   constructor; auto.
 
-  (* return *)
-  assert (X: exists bc ae, ematch bc (rs#res <- vres) ae).
-  { inv SS2. exists bc0; exists ae; auto. }
-  destruct X as (bc1 & ae1 & MATCH).
+- (* return *)
   inv H4. inv H1.
   left; exists O; econstructor; split.
   eapply exec_return; eauto.
@@ -591,15 +575,15 @@ Lemma transf_initial_states:
   exists n, exists st2, initial_state tprog st2 /\ match_states n st1 st2.
 Proof.
   intros. inversion H.
-  exploit function_ptr_translated; eauto. intro FIND.
-  exists O; exists (Callstate nil (transf_fundef rm f) nil m0); split.
+  exploit function_ptr_translated; eauto. intros (cu & FIND & LINK).
+  exists O; exists (Callstate nil (transf_fundef (romem_for cu) f) nil m0); split.
   econstructor; eauto.
-  apply Genv.init_mem_transf; auto.
+  apply (Genv.init_mem_match TRANSL); auto.
   replace (prog_main tprog) with (prog_main prog).
   rewrite symbols_preserved. eauto.
-  reflexivity.
+  symmetry; eapply match_program_main; eauto.
   rewrite <- H3. apply sig_function_translated.
-  constructor. constructor. constructor. apply Mem.extends_refl.
+  constructor. auto. constructor. constructor. apply Mem.extends_refl.
 Qed.
 
 Lemma transf_final_states:
@@ -615,9 +599,7 @@ Qed.
 Theorem transf_program_correct:
   forward_simulation (RTL.semantics prog) (RTL.semantics tprog).
 Proof.
-  apply Forward_simulation with
-     (fsim_order := lt)
-     (fsim_match_states := fun n s1 s2 => sound_state prog s1 /\ match_states n s1 s2).
+  apply Forward_simulation with lt (fun n s1 s2 => sound_state prog s1 /\ match_states n s1 s2); constructor.
 - apply lt_wf.
 - simpl; intros. exploit transf_initial_states; eauto. intros (n & st2 & A & B).
   exists n, st2; intuition. eapply sound_initial; eauto.
@@ -629,7 +611,7 @@ Proof.
   intros [ [n2 [s2' [A B]]] | [n2 [A [B C]]]].
   exists n2; exists s2'; split; auto. left; apply plus_one; auto.
   exists n2; exists s2; split; auto. right; split; auto. subst t; apply star_refl.
-- eexact public_preserved.
+- apply senv_preserved.
 Qed.
 
 End PRESERVATION.
diff --git a/backend/Deadcode.v b/backend/Deadcode.v
index fa99915d..e5b2ce3a 100644
--- a/backend/Deadcode.v
+++ b/backend/Deadcode.v
@@ -12,22 +12,10 @@
 
 (** Elimination of unneeded computations over RTL. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Memory.
-Require Import Registers.
-Require Import Op.
-Require Import RTL.
-Require Import Lattice.
-Require Import Kildall.
-Require Import ValueDomain.
-Require Import ValueAnalysis.
-Require Import NeedDomain.
-Require Import NeedOp.
+Require Import Coqlib Maps Errors Integers Floats Lattice Kildall.
+Require Import AST Linking.
+Require Import Memory Registers Op RTL.
+Require Import ValueDomain ValueAnalysis NeedDomain NeedOp.
 
 (** * Part 1: the static analysis *)
 
@@ -205,10 +193,8 @@ Definition transf_instr (approx: PMap.t VA.t) (an: PMap.t NA.t)
       instr
   end.
 
-Definition vanalyze := ValueAnalysis.analyze.
-
 Definition transf_function (rm: romem) (f: function) : res function :=
-  let approx := vanalyze rm f in
+  let approx := ValueAnalysis.analyze rm f in
   match analyze approx f with
   | Some an =>
       OK {| fn_sig := f.(fn_sig);
@@ -220,10 +206,9 @@ Definition transf_function (rm: romem) (f: function) : res function :=
       Error (msg "Neededness analysis failed")
   end.
 
-
 Definition transf_fundef (rm: romem) (fd: fundef) : res fundef :=
   AST.transf_partial_fundef (transf_function rm) fd.
 
 Definition transf_program (p: program) : res program :=
-  transform_partial_program (transf_fundef (romem_for_program p)) p.
+  transform_partial_program (transf_fundef (romem_for p)) p.
 
diff --git a/backend/Deadcodeproof.v b/backend/Deadcodeproof.v
index 6bbf0ae7..72881b94 100644
--- a/backend/Deadcodeproof.v
+++ b/backend/Deadcodeproof.v
@@ -12,28 +12,20 @@
 
 (** Elimination of unneeded computations over RTL: correctness proof. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import IntvSets.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Events.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import Lattice.
-Require Import Kildall.
-Require Import ValueDomain.
-Require Import ValueAnalysis.
-Require Import NeedDomain.
-Require Import NeedOp.
-Require Import Deadcode.
+Require Import Coqlib Maps Errors Integers Floats Lattice Kildall.
+Require Import AST Linking.
+Require Import Values Memory Globalenvs Events Smallstep.
+Require Import Registers Op RTL.
+Require Import ValueDomain ValueAnalysis NeedDomain NeedOp Deadcode.
+
+Definition match_prog (prog tprog: RTL.program) :=
+  match_program (fun cu f tf => transf_fundef (romem_for cu) f = OK tf) eq prog tprog.
+
+Lemma transf_program_match:
+  forall prog tprog, transf_program prog = OK tprog -> match_prog prog tprog.
+Proof.
+  intros. eapply match_transform_partial_program_contextual; eauto.
+Qed.
 
 (** * Relating the memory states *)
 
@@ -378,75 +370,61 @@ Section PRESERVATION.
 
 Variable prog: program.
 Variable tprog: program.
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
-Let rm := romem_for_program prog.
 
 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_fundef rm).
-  exact TRANSF.
-Qed.
-
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  intro. unfold ge, tge.
-  apply Genv.public_symbol_transf_partial with (transf_fundef rm).
-  exact TRANSF.
-Qed.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intro. unfold ge, tge.
-  apply Genv.find_var_info_transf_partial with (transf_fundef rm).
-  exact TRANSF.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall (v: val) (f: RTL.fundef),
   Genv.find_funct ge v = Some f ->
-  exists tf,
-  Genv.find_funct tge v = Some tf /\ transf_fundef rm f = OK tf.
-Proof (Genv.find_funct_transf_partial (transf_fundef rm) _ TRANSF).
+  exists cu tf,
+  Genv.find_funct tge v = Some tf /\ transf_fundef (romem_for cu) f = OK tf /\ linkorder cu prog.
+Proof (Genv.find_funct_match TRANSF).
 
 Lemma function_ptr_translated:
   forall (b: block) (f: RTL.fundef),
   Genv.find_funct_ptr ge b = Some f ->
-  exists tf,
-  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef rm f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial (transf_fundef rm) _ TRANSF).
+  exists cu tf,
+  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef (romem_for cu) f = OK tf /\ linkorder cu prog.
+Proof (Genv.find_funct_ptr_match TRANSF).
 
 Lemma sig_function_translated:
-  forall f tf,
+  forall rm f tf,
   transf_fundef rm f = OK tf ->
   funsig tf = funsig f.
 Proof.
   intros; destruct f; monadInv H.
   unfold transf_function in EQ.
-  destruct (analyze (vanalyze rm f) f); inv EQ; auto.
+  destruct (analyze (ValueAnalysis.analyze rm f) f); inv EQ; auto.
   auto.
 Qed.
 
 Lemma stacksize_translated:
-  forall f tf,
+  forall rm f tf,
   transf_function rm f = OK tf -> tf.(fn_stacksize) = f.(fn_stacksize).
 Proof.
-  unfold transf_function; intros. destruct (analyze (vanalyze rm f) f); inv H; auto.
+  unfold transf_function; intros. destruct (analyze (ValueAnalysis.analyze rm f) f); inv H; auto.
 Qed.
 
+Definition vanalyze (cu: program) (f: function) :=
+  ValueAnalysis.analyze (romem_for cu) f.
+
 Lemma transf_function_at:
-  forall f tf an pc instr,
-  transf_function rm f = OK tf ->
-  analyze (vanalyze rm f) f = Some an ->
+  forall cu f tf an pc instr,
+  transf_function (romem_for cu) f = OK tf ->
+  analyze (vanalyze cu f) f = Some an ->
   f.(fn_code)!pc = Some instr ->
-  tf.(fn_code)!pc = Some(transf_instr (vanalyze rm f) an pc instr).
+  tf.(fn_code)!pc = Some(transf_instr (vanalyze cu f) an pc instr).
 Proof.
-  intros. unfold transf_function in H. rewrite H0 in H. inv H; simpl.
+  intros. unfold transf_function in H. unfold vanalyze in H0. rewrite H0 in H. inv H; simpl.
   rewrite PTree.gmap. rewrite H1; auto.
 Qed.
 
@@ -475,7 +453,10 @@ Lemma find_function_translated:
   forall ros rs fd trs ne,
   find_function ge ros rs = Some fd ->
   eagree rs trs (add_ros_need_all ros ne) ->
-  exists tfd, find_function tge ros trs = Some tfd /\ transf_fundef rm fd = OK tfd.
+  exists cu tfd,
+     find_function tge ros trs = Some tfd
+  /\ transf_fundef (romem_for cu) fd = OK tfd
+  /\ linkorder cu prog.
 Proof.
   intros. destruct ros as [r|id]; simpl in *.
 - assert (LD: Val.lessdef rs#r trs#r) by eauto with na. inv LD.
@@ -489,30 +470,33 @@ Qed.
 
 Inductive match_stackframes: stackframe -> stackframe -> Prop :=
   | match_stackframes_intro:
-      forall res f sp pc e tf te an
-        (FUN: transf_function rm f = OK tf)
-        (ANL: analyze (vanalyze rm f) f = Some an)
+      forall res f sp pc e tf te cu an
+        (LINK: linkorder cu prog)
+        (FUN: transf_function (romem_for cu) f = OK tf)
+        (ANL: analyze (vanalyze cu f) f = Some an)
         (RES: forall v tv,
               Val.lessdef v tv ->
               eagree (e#res <- v) (te#res<- tv)
-                     (fst (transfer f (vanalyze rm f) pc an!!pc))),
+                     (fst (transfer f (vanalyze cu f) pc an!!pc))),
       match_stackframes (Stackframe res f (Vptr sp Int.zero) pc e)
                         (Stackframe res tf (Vptr sp Int.zero) pc te).
 
 Inductive match_states: state -> state -> Prop :=
   | match_regular_states:
-      forall s f sp pc e m ts tf te tm an
+      forall s f sp pc e m ts tf te tm cu an
         (STACKS: list_forall2 match_stackframes s ts)
-        (FUN: transf_function rm f = OK tf)
-        (ANL: analyze (vanalyze rm f) f = Some an)
-        (ENV: eagree e te (fst (transfer f (vanalyze rm f) pc an!!pc)))
-        (MEM: magree m tm (nlive ge sp (snd (transfer f (vanalyze rm f) pc an!!pc)))),
+        (LINK: linkorder cu prog)
+        (FUN: transf_function (romem_for cu) f = OK tf)
+        (ANL: analyze (vanalyze cu f) f = Some an)
+        (ENV: eagree e te (fst (transfer f (vanalyze cu f) pc an!!pc)))
+        (MEM: magree m tm (nlive ge sp (snd (transfer f (vanalyze cu f) pc an!!pc)))),
       match_states (State s f (Vptr sp Int.zero) pc e m)
                    (State ts tf (Vptr sp Int.zero) pc te tm)
   | match_call_states:
-      forall s f args m ts tf targs tm
+      forall s f args m ts tf targs tm cu
         (STACKS: list_forall2 match_stackframes s ts)
-        (FUN: transf_fundef rm f = OK tf)
+        (LINK: linkorder cu prog)
+        (FUN: transf_fundef (romem_for cu) f = OK tf)
         (ARGS: Val.lessdef_list args targs)
         (MEM: Mem.extends m tm),
       match_states (Callstate s f args m)
@@ -528,21 +512,22 @@ Inductive match_states: state -> state -> Prop :=
 (** [match_states] and CFG successors *)
 
 Lemma analyze_successors:
-  forall f an pc instr pc',
-  analyze (vanalyze rm f) f = Some an ->
+  forall cu f an pc instr pc',
+  analyze (vanalyze cu f) f = Some an ->
   f.(fn_code)!pc = Some instr ->
   In pc' (successors_instr instr) ->
-  NA.ge an!!pc (transfer f (vanalyze rm f) pc' an!!pc').
+  NA.ge an!!pc (transfer f (vanalyze cu f) pc' an!!pc').
 Proof.
   intros. eapply DS.fixpoint_solution; eauto.
   intros. unfold transfer; rewrite H2. destruct a. apply DS.L.eq_refl.
 Qed.
 
 Lemma match_succ_states:
-  forall s f sp pc e m ts tf te tm an pc' instr ne nm
+  forall s f sp pc e m ts tf te tm an pc' cu instr ne nm
+    (LINK: linkorder cu prog)
     (STACKS: list_forall2 match_stackframes s ts)
-    (FUN: transf_function rm f = OK tf)
-    (ANL: analyze (vanalyze rm f) f = Some an)
+    (FUN: transf_function (romem_for cu) f = OK tf)
+    (ANL: analyze (vanalyze cu f) f = Some an)
     (INSTR: f.(fn_code)!pc = Some instr)
     (SUCC: In pc' (successors_instr instr))
     (ANPC: an!!pc = (ne, nm))
@@ -720,7 +705,7 @@ Ltac TransfInstr :=
   | [INSTR: (fn_code _)!_ = Some _,
      FUN: transf_function _ _ = OK _,
      ANL: analyze _ _ = Some _ |- _ ] =>
-       generalize (transf_function_at _ _ _ _ _ FUN ANL INSTR);
+       generalize (transf_function_at _ _ _ _ _ _ FUN ANL INSTR);
        intro TI;
        unfold transf_instr in TI
   end.
@@ -825,7 +810,7 @@ Ltac UseTransfer :=
 
 - (* store *)
   TransfInstr; UseTransfer.
-  destruct (nmem_contains nm (aaddressing (vanalyze rm f) # pc addr args)
+  destruct (nmem_contains nm (aaddressing (vanalyze cu f) # pc addr args)
              (size_chunk chunk)) eqn:CONTAINS.
 + (* preserved *)
   simpl in *.
@@ -854,39 +839,41 @@ Ltac UseTransfer :=
 
 - (* call *)
   TransfInstr; UseTransfer.
-  exploit find_function_translated; eauto 2 with na. intros (tfd & A & B).
+  exploit find_function_translated; eauto 2 with na. intros (cu' & tfd & A & B & C).
   econstructor; split.
-  eapply exec_Icall; eauto. apply sig_function_translated; auto.
-  constructor.
-  constructor; auto. econstructor; eauto.
+  eapply exec_Icall; eauto. eapply sig_function_translated; eauto.
+  eapply match_call_states with (cu := cu'); eauto.
+  constructor; auto. eapply match_stackframes_intro with (cu := cu); eauto.
   intros.
   edestruct analyze_successors; eauto. simpl; eauto.
   eapply eagree_ge; eauto. rewrite ANPC. simpl.
   apply eagree_update; eauto with na.
-  auto. eauto 2 with na. eapply magree_extends; eauto. apply nlive_all.
+  eauto 2 with na.
+  eapply magree_extends; eauto. apply nlive_all.
 
 - (* tailcall *)
   TransfInstr; UseTransfer.
-  exploit find_function_translated; eauto 2 with na. intros (tfd & A & B).
+  exploit find_function_translated; eauto 2 with na. intros (cu' & tfd & A & B & L).
   exploit magree_free. eauto. eauto. instantiate (1 := nlive ge stk nmem_all).
   intros; eapply nlive_dead_stack; eauto.
   intros (tm' & C & D).
   econstructor; split.
-  eapply exec_Itailcall; eauto. apply sig_function_translated; auto.
+  eapply exec_Itailcall; eauto. eapply sig_function_translated; eauto.
   erewrite stacksize_translated by eauto. eexact C.
-  constructor; eauto 2 with na. eapply magree_extends; eauto. apply nlive_all.
+  eapply match_call_states with (cu := cu'); eauto 2 with na.
+  eapply magree_extends; eauto. apply nlive_all.
 
 - (* builtin *)
   TransfInstr; UseTransfer. revert ENV MEM TI.
-  functional induction (transfer_builtin (vanalyze rm f)#pc ef args res ne nm);
+  functional induction (transfer_builtin (vanalyze cu f)#pc ef args res ne nm);
   simpl in *; intros.
 + (* volatile load *)
   inv H0. inv H6. rename b1 into v1.
   destruct (transfer_builtin_arg All
               (kill_builtin_res res ne,
-              nmem_add nm (aaddr_arg (vanalyze rm f) # pc a1)
+              nmem_add nm (aaddr_arg (vanalyze cu f) # pc a1)
                 (size_chunk chunk)) a1) as (ne1, nm1) eqn: TR.
-  inversion SS; subst. exploit transfer_builtin_arg_sound; eauto.
+  InvSoundState. exploit transfer_builtin_arg_sound; eauto.
   intros (tv1 & A & B & C & D).
   inv H1. simpl in B. inv B.
   assert (X: exists tvres, volatile_load ge chunk tm b ofs t tvres /\ Val.lessdef vres tvres).
@@ -904,9 +891,8 @@ Ltac UseTransfer :=
   eapply exec_Ibuiltin; eauto.
   apply eval_builtin_args_preserved with (ge1 := ge). exact symbols_preserved.
   constructor. eauto. constructor.
-  eapply external_call_symbols_preserved.
+  eapply external_call_symbols_preserved. apply senv_preserved.
   constructor. simpl. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
   eapply match_succ_states; eauto. simpl; auto.
   apply eagree_set_res; auto.
   eapply magree_monotone; eauto. intros. apply incl_nmem_add; auto.
@@ -915,7 +901,7 @@ Ltac UseTransfer :=
   destruct (transfer_builtin_arg (store_argument chunk)
               (kill_builtin_res res ne, nm) a2) as (ne2, nm2) eqn: TR2.
   destruct (transfer_builtin_arg All (ne2, nm2) a1) as (ne1, nm1) eqn: TR1.
-  inversion SS; subst.
+  InvSoundState.
   exploit transfer_builtin_arg_sound. eexact H4. eauto. eauto. eauto. eauto. eauto.
   intros (tv1 & A1 & B1 & C1 & D1).
   exploit transfer_builtin_arg_sound. eexact H3. eauto. eauto. eauto. eauto. eauto.
@@ -926,21 +912,21 @@ Ltac UseTransfer :=
   eapply exec_Ibuiltin; eauto.
   apply eval_builtin_args_preserved with (ge1 := ge). exact symbols_preserved.
   constructor. eauto. constructor. eauto. constructor.
-  eapply external_call_symbols_preserved. simpl; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved. apply senv_preserved.
+  simpl; eauto.
   eapply match_succ_states; eauto. simpl; auto.
   apply eagree_set_res; auto.
 + (* memcpy *)
   rewrite e1 in TI.
   inv H0. inv H6. inv H7. rename b1 into v1. rename b0 into v2.
-  set (adst := aaddr_arg (vanalyze rm f) # pc dst) in *.
-  set (asrc := aaddr_arg (vanalyze rm f) # pc src) in *.
+  set (adst := aaddr_arg (vanalyze cu f) # pc dst) in *.
+  set (asrc := aaddr_arg (vanalyze cu f) # pc src) in *.
   destruct (transfer_builtin_arg All
               (kill_builtin_res res ne,
                nmem_add (nmem_remove nm adst sz) asrc sz) dst)
            as (ne2, nm2) eqn: TR2.
   destruct (transfer_builtin_arg All (ne2, nm2) src) as (ne1, nm1) eqn: TR1.
-  inversion SS; subst.
+  InvSoundState.
   exploit transfer_builtin_arg_sound. eexact H3. eauto. eauto. eauto. eauto. eauto.
   intros (tv1 & A1 & B1 & C1 & D1).
   exploit transfer_builtin_arg_sound. eexact H4. eauto. eauto. eauto. eauto. eauto.
@@ -948,7 +934,7 @@ Ltac UseTransfer :=
   inv H1.
   exploit magree_loadbytes. eauto. eauto.
   intros. eapply nlive_add; eauto.
-  unfold asrc, vanalyze, rm; rewrite AN; eapply aaddr_arg_sound_1; eauto.
+  unfold asrc, vanalyze; rewrite AN; eapply aaddr_arg_sound_1; eauto.
   intros (tbytes & P & Q).
   exploit magree_storebytes_parallel.
   eapply magree_monotone. eexact D2.
@@ -957,7 +943,7 @@ Ltac UseTransfer :=
   eauto.
   instantiate (1 := nlive ge sp0 nm).
   intros. eapply nlive_remove; eauto.
-  unfold adst, vanalyze, rm; rewrite AN; eapply aaddr_arg_sound_1; eauto.
+  unfold adst, vanalyze; rewrite AN; eapply aaddr_arg_sound_1; eauto.
   erewrite Mem.loadbytes_length in H1 by eauto.
   rewrite nat_of_Z_eq in H1 by omega. auto.
   eauto.
@@ -966,51 +952,49 @@ Ltac UseTransfer :=
   eapply exec_Ibuiltin; eauto.
   apply eval_builtin_args_preserved with (ge1 := ge). exact symbols_preserved.
   constructor. eauto. constructor. eauto. constructor.
-  eapply external_call_symbols_preserved. simpl.
+  eapply external_call_symbols_preserved. apply senv_preserved.
   simpl in B1; inv B1. simpl in B2; inv B2. econstructor; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
   eapply match_succ_states; eauto. simpl; auto.
   apply eagree_set_res; auto.
 + (* memcpy eliminated *)
   rewrite e1 in TI.
   inv H0. inv H6. inv H7. rename b1 into v1. rename b0 into v2.
-  set (adst := aaddr_arg (vanalyze rm f) # pc dst) in *.
-  set (asrc := aaddr_arg (vanalyze rm f) # pc src) in *.
+  set (adst := aaddr_arg (vanalyze cu f) # pc dst) in *.
+  set (asrc := aaddr_arg (vanalyze cu f) # pc src) in *.
   inv H1.
   econstructor; split.
   eapply exec_Inop; eauto.
   eapply match_succ_states; eauto. simpl; auto.
   destruct res; auto. apply eagree_set_undef; auto.
   eapply magree_storebytes_left; eauto.
-  exploit aaddr_arg_sound. eauto. eauto.
+  exploit aaddr_arg_sound; eauto. 
   intros (bc & A & B & C).
   intros. eapply nlive_contains; eauto.
   erewrite Mem.loadbytes_length in H0 by eauto.
   rewrite nat_of_Z_eq in H0 by omega. auto.
 + (* annot *)
   destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x1) as (ne1, nm1) eqn:TR.
-  inversion SS; subst.
+  InvSoundState.
   exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D).
   inv H1.
   econstructor; split.
   eapply exec_Ibuiltin; eauto.
   apply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. simpl; constructor.
-  eapply eventval_list_match_lessdef; eauto 2 with na.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved. apply senv_preserved.
+  constructor. eapply eventval_list_match_lessdef; eauto 2 with na.
   eapply match_succ_states; eauto. simpl; auto.
   apply eagree_set_res; auto.
 + (* annot val *)
   destruct (transfer_builtin_args (kill_builtin_res res ne, nm) _x1) as (ne1, nm1) eqn:TR.
-  inversion SS; subst.
+  InvSoundState.
   exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D).
   inv H1. inv B. inv H6.
   econstructor; split.
   eapply exec_Ibuiltin; eauto.
   apply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. simpl; constructor.
+  eapply external_call_symbols_preserved. apply senv_preserved.
+  constructor.
   eapply eventval_match_lessdef; eauto 2 with na.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
   eapply match_succ_states; eauto. simpl; auto.
   apply eagree_set_res; auto.
 + (* debug *)
@@ -1027,7 +1011,7 @@ Ltac UseTransfer :=
   }
   clear y TI.
   destruct (transfer_builtin_args (kill_builtin_res res ne, nmem_all) _x0) as (ne1, nm1) eqn:TR.
-  inversion SS; subst.
+  InvSoundState.
   exploit transfer_builtin_args_sound; eauto. intros (tvl & A & B & C & D).
   exploit external_call_mem_extends; eauto 2 with na.
   eapply magree_extends; eauto. intros. apply nlive_all.
@@ -1035,8 +1019,7 @@ Ltac UseTransfer :=
   econstructor; split.
   eapply exec_Ibuiltin; eauto.
   apply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved. apply senv_preserved. eauto.
   eapply match_succ_states; eauto. simpl; auto.
   apply eagree_set_res; auto.
   eapply mextends_agree; eauto.
@@ -1071,8 +1054,8 @@ Ltac UseTransfer :=
   eapply magree_extends; eauto. apply nlive_all.
 
 - (* internal function *)
-  monadInv FUN. generalize EQ. unfold transf_function. intros EQ'.
-  destruct (analyze (vanalyze rm f) f) as [an|] eqn:AN; inv EQ'.
+  monadInv FUN. generalize EQ. unfold transf_function. fold (vanalyze cu f). intros EQ'.
+  destruct (analyze (vanalyze cu f) f) as [an|] eqn:AN; inv EQ'.
   exploit Mem.alloc_extends; eauto. apply Zle_refl. apply Zle_refl.
   intros (tm' & A & B).
   econstructor; split.
@@ -1087,8 +1070,7 @@ Ltac UseTransfer :=
   simpl in FUN. inv FUN.
   econstructor; split.
   econstructor; eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto.
 
 - (* return *)
@@ -1103,14 +1085,15 @@ Lemma transf_initial_states:
   exists st2, initial_state tprog st2 /\ match_states st1 st2.
 Proof.
   intros. inversion H.
-  exploit function_ptr_translated; eauto. intros (tf & A & B).
+  exploit function_ptr_translated; eauto. intros (cu & tf & A & B & C).
   exists (Callstate nil tf nil m0); split.
   econstructor; eauto.
-  eapply Genv.init_mem_transf_partial; eauto.
-  rewrite (transform_partial_program_main _ _ TRANSF).
+  eapply (Genv.init_mem_match TRANSF); eauto.
+  replace (prog_main tprog) with (prog_main prog). 
   rewrite symbols_preserved. eauto.
-  rewrite <- H3. apply sig_function_translated; auto.
-  constructor. constructor. auto. constructor. apply Mem.extends_refl.
+  symmetry; eapply match_program_main; eauto.
+  rewrite <- H3. eapply sig_function_translated; eauto.
+  econstructor; eauto. constructor. apply Mem.extends_refl.
 Qed.
 
 Lemma transf_final_states:
@@ -1128,7 +1111,7 @@ Proof.
   intros.
   apply forward_simulation_step with
      (match_states := fun s1 s2 => sound_state prog s1 /\ match_states s1 s2).
-- exact public_preserved.
+- apply senv_preserved.
 - simpl; intros. exploit transf_initial_states; eauto. intros [st2 [A B]].
   exists st2; intuition. eapply sound_initial; eauto.
 - simpl; intros. destruct H. eapply transf_final_states; eauto.
diff --git a/backend/Debugvar.v b/backend/Debugvar.v
index dcc4327a..5d31831a 100644
--- a/backend/Debugvar.v
+++ b/backend/Debugvar.v
@@ -13,18 +13,9 @@
 (** Computation of live ranges for local variables that carry
     debugging information. *)
 
-Require Import Coqlib.
-Require Import Axioms.
-Require Import Maps.
-Require Import Iteration.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Errors.
-Require Import Machregs.
-Require Import Locations.
-Require Import Conventions.
-Require Import Linear.
+Require Import Axioms Coqlib Maps Iteration Errors.
+Require Import Integers Floats AST.
+Require Import Machregs Locations Conventions Linear.
 
 (** A debug info is a [builtin_arg loc] expression that safely evaluates
    in any context. *)
diff --git a/backend/Debugvarproof.v b/backend/Debugvarproof.v
index 73e32103..110c0f26 100644
--- a/backend/Debugvarproof.v
+++ b/backend/Debugvarproof.v
@@ -12,28 +12,23 @@
 
 (** Correctness proof for the [Debugvar] pass. *)
 
-Require Import Coqlib.
-Require Import Axioms.
-Require Import Maps.
-Require Import Iteration.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Errors.
-Require Import Machregs.
-Require Import Locations.
-Require Import Conventions.
-Require Import Linear.
+Require Import Axioms Coqlib Maps Iteration Errors.
+Require Import Integers Floats AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Machregs Locations Conventions Op Linear.
 Require Import Debugvar.
 
 (** * Relational characterization of the transformation *)
 
+Definition match_prog (p tp: program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
+
 Inductive match_code: code -> code -> Prop :=
   | match_code_nil:
       match_code nil nil
@@ -294,38 +289,32 @@ Section PRESERVATION.
 Variable prog: program.
 Variable tprog: program.
 
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
+Lemma symbols_preserved:
+  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof (Genv.find_symbol_match TRANSF).
+
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
+
 Lemma functions_translated:
-  forall v f,
+  forall (v: val) (f: fundef),
   Genv.find_funct ge v = Some f ->
   exists tf,
   Genv.find_funct tge v = Some tf /\ transf_fundef f = OK tf.
-Proof (Genv.find_funct_transf_partial transf_fundef _ TRANSF).
+Proof (Genv.find_funct_transf_partial TRANSF).
 
 Lemma function_ptr_translated:
-  forall v f,
-  Genv.find_funct_ptr ge v = Some f ->
+  forall (b: block) (f: fundef),
+  Genv.find_funct_ptr ge b = Some f ->
   exists tf,
-  Genv.find_funct_ptr tge v = Some tf /\ transf_fundef f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
-
-Lemma symbols_preserved:
-  forall id,
-  Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof (Genv.find_symbol_transf_partial transf_fundef _ TRANSF).
-
-Lemma public_preserved:
-  forall id,
-  Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof (Genv.public_symbol_transf_partial transf_fundef _ TRANSF).
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof (Genv.find_var_info_transf_partial transf_fundef _ TRANSF).
+  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf.
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
 
 Lemma sig_preserved:
   forall f tf,
@@ -488,8 +477,7 @@ Proof.
   eapply plus_left.
   econstructor; eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   apply eval_add_delta_ranges. traceEq.
   constructor; auto.
 - (* label *)
@@ -530,8 +518,7 @@ Proof.
 - (* external function *)
   monadInv H8. econstructor; split.
   apply plus_one. econstructor; eauto.
-  eapply external_call_symbols_preserved'. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   constructor; auto.
 - (* return *)
   inv H3. inv H1.
@@ -547,10 +534,8 @@ Proof.
   intros. inversion H.
   exploit function_ptr_translated; eauto. intros [tf [A B]].
   exists (Callstate nil tf (Locmap.init Vundef) m0); split.
-  econstructor; eauto. eapply Genv.init_mem_transf_partial; eauto.
-  replace (prog_main tprog) with (prog_main prog).
-  rewrite symbols_preserved. eauto.
-  symmetry. apply (transform_partial_program_main transf_fundef _ TRANSF).
+  econstructor; eauto. eapply (Genv.init_mem_transf_partial TRANSF); eauto.
+  rewrite (match_program_main TRANSF), symbols_preserved. auto.
   rewrite <- H3. apply sig_preserved. auto.
   constructor. constructor. auto.
 Qed.
@@ -566,7 +551,7 @@ Theorem transf_program_correct:
   forward_simulation (semantics prog) (semantics tprog).
 Proof.
   eapply forward_simulation_plus.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   eexact transf_step_correct.
diff --git a/backend/Inlining.v b/backend/Inlining.v
index 566ab27c..5c8f4419 100644
--- a/backend/Inlining.v
+++ b/backend/Inlining.v
@@ -12,15 +12,9 @@
 
 (** RTL function inlining *)
 
-Require Import Coqlib.
-Require Import Wfsimpl.
-Require Import Errors.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
+Require Import Coqlib Wfsimpl Maps Errors Integers.
+Require Import AST Linking.
+Require Import Op Registers RTL.
 
 (** ** Environment of inlinable functions *)
 
diff --git a/backend/Inliningproof.v b/backend/Inliningproof.v
index ad861543..91f4a3f5 100644
--- a/backend/Inliningproof.v
+++ b/backend/Inliningproof.v
@@ -12,63 +12,50 @@
 
 (** RTL function inlining: semantic preservation *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Events.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import Inlining.
-Require Import Inliningspec.
-Require Import RTL.
+Require Import Coqlib Wfsimpl Maps Errors Integers.
+Require Import AST Linking Values Memory Globalenvs Events Smallstep.
+Require Import Op Registers RTL.
+Require Import Inlining Inliningspec.
+
+Definition match_prog (prog tprog: program) :=
+  match_program (fun cunit f tf => transf_fundef (funenv_program cunit) f = OK tf) eq prog tprog.
+
+Lemma transf_program_match:
+  forall prog tprog, transf_program prog = OK tprog -> match_prog prog tprog.
+Proof.
+  intros. eapply match_transform_partial_program_contextual; eauto.
+Qed.
 
 Section INLINING.
 
 Variable prog: program.
 Variable tprog: program.
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
-Let fenv := funenv_program prog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intros. apply Genv.find_symbol_transf_partial with (transf_fundef fenv); auto.
-Qed.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  intros. apply Genv.public_symbol_transf_partial with (transf_fundef fenv); auto.
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intros. apply Genv.find_var_info_transf_partial with (transf_fundef fenv); auto.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall (v: val) (f: fundef),
   Genv.find_funct ge v = Some f ->
-  exists f', Genv.find_funct tge v = Some f' /\ transf_fundef fenv f = OK f'.
-Proof (Genv.find_funct_transf_partial (transf_fundef fenv) _ TRANSF).
+  exists cu f', Genv.find_funct tge v = Some f' /\ transf_fundef (funenv_program cu) f = OK f' /\ linkorder cu prog.
+Proof (Genv.find_funct_match TRANSF).
 
 Lemma function_ptr_translated:
   forall (b: block) (f: fundef),
   Genv.find_funct_ptr ge b = Some f ->
-  exists f', Genv.find_funct_ptr tge b = Some f' /\ transf_fundef fenv f = OK f'.
-Proof (Genv.find_funct_ptr_transf_partial (transf_fundef fenv) _ TRANSF).
+  exists cu f', Genv.find_funct_ptr tge b = Some f' /\ transf_fundef (funenv_program cu) f = OK f' /\ linkorder cu prog.
+Proof (Genv.find_funct_ptr_match TRANSF).
 
 Lemma sig_function_translated:
-  forall f f', transf_fundef fenv f = OK f' -> funsig f' = funsig f.
+  forall cu f f', transf_fundef (funenv_program cu) f = OK f' -> funsig f' = funsig f.
 Proof.
   intros. destruct f; Errors.monadInv H.
   exploit transf_function_spec; eauto. intros SP; inv SP. auto.
@@ -382,24 +369,39 @@ Lemma find_function_agree:
   find_function ge ros rs = Some fd ->
   agree_regs F ctx rs rs' ->
   match_globalenvs F bound ->
-  exists fd',
-  find_function tge (sros ctx ros) rs' = Some fd' /\ transf_fundef fenv fd = OK fd'.
+  exists cu fd',
+  find_function tge (sros ctx ros) rs' = Some fd' /\ transf_fundef (funenv_program cu) fd = OK fd' /\ linkorder cu prog.
 Proof.
   intros. destruct ros as [r | id]; simpl in *.
-  (* register *)
-  assert (rs'#(sreg ctx r) = rs#r).
-    exploit Genv.find_funct_inv; eauto. intros [b EQ].
+- (* register *)
+  assert (EQ: rs'#(sreg ctx r) = rs#r).
+  { exploit Genv.find_funct_inv; eauto. intros [b EQ].
     assert (A: Val.inject F rs#r rs'#(sreg ctx r)). eapply agree_val_reg; eauto.
     rewrite EQ in A; inv A.
     inv H1. rewrite DOMAIN in H5. inv H5. auto.
     apply FUNCTIONS with fd.
     rewrite EQ in H; rewrite Genv.find_funct_find_funct_ptr in H. auto.
-  rewrite H2. eapply functions_translated; eauto.
-  (* symbol *)
+  }
+  rewrite EQ. eapply functions_translated; eauto.
+- (* symbol *)
   rewrite symbols_preserved. destruct (Genv.find_symbol ge id); try discriminate.
   eapply function_ptr_translated; eauto.
 Qed.
 
+Lemma find_inlined_function:
+  forall fenv id rs fd f,
+  fenv_compat prog fenv ->
+  find_function ge (inr id) rs = Some fd ->
+  fenv!id = Some f ->
+  fd = Internal f.
+Proof.
+  intros.
+  apply H in H1. apply Genv.find_def_symbol in H1. destruct H1 as (b & A & B).
+  simpl in H0. unfold ge, fundef in H0. rewrite A in H0.
+  rewrite <- Genv.find_funct_ptr_iff in B.
+  congruence.
+Qed. 
+
 (** Translation of builtin arguments. *)
 
 Lemma tr_builtin_arg:
@@ -465,8 +467,9 @@ Inductive match_stacks (F: meminj) (m m': mem):
         (MG: match_globalenvs F bound1)
         (BELOW: Ple bound1 bound),
       match_stacks F m m' nil nil bound
-  | match_stacks_cons: forall res f sp pc rs stk f' sp' rs' stk' bound ctx
+  | match_stacks_cons: forall res f sp pc rs stk f' sp' rs' stk' bound fenv ctx
         (MS: match_stacks_inside F m m' stk stk' f' ctx sp' rs')
+        (COMPAT: fenv_compat prog fenv)
         (FB: tr_funbody fenv f'.(fn_stacksize) ctx f f'.(fn_code))
         (AG: agree_regs F ctx rs rs')
         (SP: F sp = Some(sp', ctx.(dstk)))
@@ -498,8 +501,9 @@ with match_stacks_inside (F: meminj) (m m': mem):
         (RET: ctx.(retinfo) = None)
         (DSTK: ctx.(dstk) = 0),
       match_stacks_inside F m m' stk stk' f' ctx sp' rs'
-  | match_stacks_inside_inlined: forall res f sp pc rs stk stk' f' ctx sp' rs' ctx'
+  | match_stacks_inside_inlined: forall res f sp pc rs stk stk' f' fenv ctx sp' rs' ctx'
         (MS: match_stacks_inside F m m' stk stk' f' ctx' sp' rs')
+        (COMPAT: fenv_compat prog fenv)
         (FB: tr_funbody fenv f'.(fn_stacksize) ctx' f f'.(fn_code))
         (AG: agree_regs F ctx' rs rs')
         (SP: F sp = Some(sp', ctx'.(dstk)))
@@ -597,7 +601,7 @@ Proof.
   intros. apply IMAGE with delta. eapply INJ; eauto. eapply Plt_le_trans; eauto.
   auto. auto.
   (* cons *)
-  apply match_stacks_cons with (ctx := ctx); auto.
+  apply match_stacks_cons with (fenv := fenv) (ctx := ctx); auto.
   eapply match_stacks_inside_invariant; eauto.
   intros; eapply INJ; eauto; xomega.
   intros; eapply PERM1; eauto; xomega.
@@ -623,7 +627,7 @@ Proof.
   intros; eapply PERM2; eauto; xomega.
   intros; eapply PERM3; eauto; xomega.
   (* inlined *)
-  apply match_stacks_inside_inlined with (ctx' := ctx'); auto.
+  apply match_stacks_inside_inlined with (fenv := fenv) (ctx' := ctx'); auto.
   apply IHmatch_stacks_inside; auto.
   intros. apply RS. red in BELOW. xomega.
   apply agree_regs_incr with F; auto.
@@ -825,7 +829,7 @@ Proof.
 Qed.
 
 Lemma match_stacks_inside_inlined_tailcall:
-  forall F m m' stk stk' f' ctx sp' rs' ctx' f,
+  forall fenv F m m' stk stk' f' ctx sp' rs' ctx' f,
   match_stacks_inside F m m' stk stk' f' ctx sp' rs' ->
   context_below ctx ctx' ->
   context_stack_tailcall ctx f ctx' ->
@@ -849,9 +853,10 @@ Qed.
 
 (** ** Relating states *)
 
-Inductive match_states: state -> state -> Prop :=
-  | match_regular_states: forall stk f sp pc rs m stk' f' sp' rs' m' F ctx
+Inductive match_states: RTL.state -> RTL.state -> Prop :=
+  | match_regular_states: forall stk f sp pc rs m stk' f' sp' rs' m' F fenv ctx
         (MS: match_stacks_inside F m m' stk stk' f' ctx sp' rs')
+        (COMPAT: fenv_compat prog fenv)
         (FB: tr_funbody fenv f'.(fn_stacksize) ctx f f'.(fn_code))
         (AG: agree_regs F ctx rs rs')
         (SP: F sp = Some(sp', ctx.(dstk)))
@@ -862,15 +867,17 @@ Inductive match_states: state -> state -> Prop :=
         (SSZ2: forall ofs, Mem.perm m' sp' ofs Max Nonempty -> 0 <= ofs <= f'.(fn_stacksize)),
       match_states (State stk f (Vptr sp Int.zero) pc rs m)
                    (State stk' f' (Vptr sp' Int.zero) (spc ctx pc) rs' m')
-  | match_call_states: forall stk fd args m stk' fd' args' m' F
+  | match_call_states: forall stk fd args m stk' fd' args' m' cunit F
         (MS: match_stacks F m m' stk stk' (Mem.nextblock m'))
-        (FD: transf_fundef fenv fd = OK fd')
+        (LINK: linkorder cunit prog)
+        (FD: transf_fundef (funenv_program cunit) fd = OK fd')
         (VINJ: Val.inject_list F args args')
         (MINJ: Mem.inject F m m'),
       match_states (Callstate stk fd args m)
                    (Callstate stk' fd' args' m')
-  | match_call_regular_states: forall stk f vargs m stk' f' sp' rs' m' F ctx ctx' pc' pc1' rargs
+  | match_call_regular_states: forall stk f vargs m stk' f' sp' rs' m' F fenv ctx ctx' pc' pc1' rargs
         (MS: match_stacks_inside F m m' stk stk' f' ctx sp' rs')
+        (COMPAT: fenv_compat prog fenv)
         (FB: tr_funbody fenv f'.(fn_stacksize) ctx f f'.(fn_code))
         (BELOW: context_below ctx' ctx)
         (NOP: f'.(fn_code)!pc' = Some(Inop pc1'))
@@ -904,7 +911,7 @@ Inductive match_states: state -> state -> Prop :=
 
 (** ** Forward simulation *)
 
-Definition measure (S: state) : nat :=
+Definition measure (S: RTL.state) : nat :=
   match S with
   | State _ _ _ _ _ _ => 1%nat
   | Callstate _ _ _ _ => 0%nat
@@ -912,7 +919,7 @@ Definition measure (S: state) : nat :=
   end.
 
 Lemma tr_funbody_inv:
-  forall sz cts f c pc i,
+  forall fenv sz cts f c pc i,
   tr_funbody fenv sz cts f c -> f.(fn_code)!pc = Some i -> tr_instr fenv sz cts pc i c.
 Proof.
   intros. inv H. eauto.
@@ -927,13 +934,13 @@ Theorem step_simulation:
 Proof.
   induction 1; intros; inv MS.
 
-(* nop *)
+- (* nop *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
   left; econstructor; split.
   eapply plus_one. eapply exec_Inop; eauto.
   econstructor; eauto.
 
-(* op *)
+- (* op *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
   exploit eval_operation_inject.
     eapply match_stacks_inside_globals; eauto.
@@ -948,7 +955,7 @@ Proof.
   apply match_stacks_inside_set_reg; auto.
   apply agree_set_reg; auto.
 
-(* load *)
+- (* load *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
   exploit eval_addressing_inject.
     eapply match_stacks_inside_globals; eauto.
@@ -965,7 +972,7 @@ Proof.
   apply match_stacks_inside_set_reg; auto.
   apply agree_set_reg; auto.
 
-(* store *)
+- (* store *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
   exploit eval_addressing_inject.
     eapply match_stacks_inside_globals; eauto.
@@ -989,22 +996,19 @@ Proof.
   intros; eapply Mem.perm_store_1; eauto.
   intros. eapply SSZ2. eapply Mem.perm_store_2; eauto.
 
-(* call *)
+- (* call *)
   exploit match_stacks_inside_globalenvs; eauto. intros [bound G].
-  exploit find_function_agree; eauto. intros [fd' [A B]].
+  exploit find_function_agree; eauto. intros (cu & fd' & A & B & C).
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
-(* not inlined *)
++ (* not inlined *)
   left; econstructor; split.
   eapply plus_one. eapply exec_Icall; eauto.
   eapply sig_function_translated; eauto.
   econstructor; eauto.
   eapply match_stacks_cons; eauto.
   eapply agree_val_regs; eauto.
-(* inlined *)
-  assert (fd = Internal f0).
-    simpl in H0. destruct (Genv.find_symbol ge id) as [b|] eqn:?; try discriminate.
-    exploit (funenv_program_compat prog); eauto. intros.
-    unfold ge in H0. congruence.
++ (* inlined *)
+  assert (EQ: fd = Internal f0) by (eapply find_inlined_function; eauto).
   subst fd.
   right; split. simpl; omega. split. auto.
   econstructor; eauto.
@@ -1013,13 +1017,13 @@ Proof.
   apply agree_val_regs_gen; auto.
   red; intros; apply PRIV. destruct H16. omega.
 
-(* tailcall *)
+- (* tailcall *)
   exploit match_stacks_inside_globalenvs; eauto. intros [bound G].
-  exploit find_function_agree; eauto. intros [fd' [A B]].
+  exploit find_function_agree; eauto. intros (cu & fd' & A & B & C).
   assert (PRIV': range_private F m' m'0 sp' (dstk ctx) f'.(fn_stacksize)).
-    eapply range_private_free_left; eauto. inv FB. rewrite <- H4. auto.
+  { eapply range_private_free_left; eauto. inv FB. rewrite <- H4. auto. }
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
-(* within the original function *)
++ (* within the original function *)
   inv MS0; try congruence.
   assert (X: { m1' | Mem.free m'0 sp' 0 (fn_stacksize f') = Some m1'}).
     apply Mem.range_perm_free. red; intros.
@@ -1044,7 +1048,7 @@ Proof.
   intros. rewrite DSTK in PRIV'. exploit (PRIV' (ofs + delta)). omega. intros [P Q].
   eelim Q; eauto. replace (ofs + delta - delta) with ofs by omega.
   apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem.
-(* turned into a call *)
++ (* turned into a call *)
   left; econstructor; split.
   eapply plus_one. eapply exec_Icall; eauto.
   eapply sig_function_translated; eauto.
@@ -1054,11 +1058,8 @@ Proof.
     intros. eapply Mem.perm_free_3; eauto.
   eapply agree_val_regs; eauto.
   eapply Mem.free_left_inject; eauto.
-(* inlined *)
-  assert (fd = Internal f0).
-    simpl in H0. destruct (Genv.find_symbol ge id) as [b|] eqn:?; try discriminate.
-    exploit (funenv_program_compat prog); eauto. intros.
-    unfold ge in H0. congruence.
++ (* inlined *)
+  assert (EQ: fd = Internal f0) by (eapply find_inlined_function; eauto).
   subst fd.
   right; split. simpl; omega. split. auto.
   econstructor; eauto.
@@ -1071,7 +1072,7 @@ Proof.
     assert (dstk ctx <= dstk ctx'). red in H14; rewrite H14. apply align_le. apply min_alignment_pos.
     omega.
 
-(* builtin *)
+- (* builtin *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
   exploit match_stacks_inside_globalenvs; eauto. intros [bound MG].
   exploit tr_builtin_args; eauto. intros (vargs' & P & Q).
@@ -1080,14 +1081,13 @@ Proof.
   intros [F1 [v1 [m1' [A [B [C [D [E [J K]]]]]]]]].
   left; econstructor; split.
   eapply plus_one. eapply exec_Ibuiltin; eauto.
-    eapply external_call_symbols_preserved; eauto.
-    exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+    eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor.
     eapply match_stacks_inside_set_res.
     eapply match_stacks_inside_extcall with (F1 := F) (F2 := F1) (m1 := m) (m1' := m'0); eauto.
     intros; eapply external_call_max_perm; eauto.
     intros; eapply external_call_max_perm; eauto.
-  auto.
+  auto. eauto. auto.
   destruct res; simpl; [apply agree_set_reg;auto|idtac|idtac]; eapply agree_regs_incr; eauto.
   auto. auto.
   eapply external_call_valid_block; eauto.
@@ -1096,7 +1096,7 @@ Proof.
   auto.
   intros. apply SSZ2. eapply external_call_max_perm; eauto.
 
-(* cond *)
+- (* cond *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
   assert (eval_condition cond rs'##(sregs ctx args) m' = Some b).
     eapply eval_condition_inject; eauto. eapply agree_val_regs; eauto.
@@ -1104,7 +1104,7 @@ Proof.
   eapply plus_one. eapply exec_Icond; eauto.
   destruct b; econstructor; eauto.
 
-(* jumptable *)
+- (* jumptable *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
   assert (Val.inject F rs#arg rs'#(sreg ctx arg)). eapply agree_val_reg; eauto.
   rewrite H0 in H2; inv H2.
@@ -1113,9 +1113,9 @@ Proof.
   rewrite list_nth_z_map. rewrite H1. simpl; reflexivity.
   econstructor; eauto.
 
-(* return *)
+- (* return *)
   exploit tr_funbody_inv; eauto. intros TR; inv TR.
-  (* not inlined *)
++ (* not inlined *)
   inv MS0; try congruence.
   assert (X: { m1' | Mem.free m'0 sp' 0 (fn_stacksize f') = Some m1'}).
     apply Mem.range_perm_free. red; intros.
@@ -1144,7 +1144,7 @@ Proof.
   eelim B; eauto. replace (ofs + delta - delta) with ofs by omega.
   apply Mem.perm_max with k. apply Mem.perm_implies with p; auto with mem.
 
-  (* inlined *)
++ (* inlined *)
   right. split. simpl. omega. split. auto.
   econstructor; eauto.
   eapply match_stacks_inside_invariant; eauto.
@@ -1153,42 +1153,45 @@ Proof.
   eapply Mem.free_left_inject; eauto.
   inv FB. rewrite H4 in PRIV. eapply range_private_free_left; eauto.
 
-(* internal function, not inlined *)
-  assert (A: exists f', tr_function fenv f f' /\ fd' = Internal f').
-    Errors.monadInv FD. exists x. split; auto. eapply transf_function_spec; eauto.
-  destruct A as [f' [TR EQ]]. inversion TR; subst.
+- (* internal function, not inlined *)
+  assert (A: exists f', tr_function cunit f f' /\ fd' = Internal f').
+  { Errors.monadInv FD. exists x. split; auto. eapply transf_function_spec; eauto. }
+  destruct A as [f' [TR1 EQ]].
+  assert (TR: tr_function prog f f').
+  { eapply tr_function_linkorder; eauto. }
+  inversion TR; subst.
   exploit Mem.alloc_parallel_inject. eauto. eauto. apply Zle_refl.
-    instantiate (1 := fn_stacksize f'). inv H0. xomega.
+    instantiate (1 := fn_stacksize f'). inv H1. xomega.
   intros [F' [m1' [sp' [A [B [C [D E]]]]]]].
   left; econstructor; split.
   eapply plus_one. eapply exec_function_internal; eauto.
-  rewrite H5. econstructor.
+  rewrite H6. econstructor.
   instantiate (1 := F'). apply match_stacks_inside_base.
   assert (SP: sp' = Mem.nextblock m'0) by (eapply Mem.alloc_result; eauto).
   rewrite <- SP in MS0.
   eapply match_stacks_invariant; eauto.
     intros. destruct (eq_block b1 stk).
-    subst b1. rewrite D in H7; inv H7. subst b2. eelim Plt_strict; eauto.
-    rewrite E in H7; auto.
+    subst b1. rewrite D in H8; inv H8. subst b2. eelim Plt_strict; eauto.
+    rewrite E in H8; auto.
     intros. exploit Mem.perm_alloc_inv. eexact H. eauto.
     destruct (eq_block b1 stk); intros; auto.
-    subst b1. rewrite D in H7; inv H7. subst b2. eelim Plt_strict; eauto.
+    subst b1. rewrite D in H8; inv H8. subst b2. eelim Plt_strict; eauto.
     intros. eapply Mem.perm_alloc_1; eauto.
     intros. exploit Mem.perm_alloc_inv. eexact A. eauto.
     rewrite dec_eq_false; auto.
-  auto. auto. auto.
-  rewrite H4. apply agree_regs_init_regs. eauto. auto. inv H0; auto. congruence. auto.
+  auto. auto. auto. eauto. auto.
+  rewrite H5. apply agree_regs_init_regs. eauto. auto. inv H1; auto. congruence. auto.
   eapply Mem.valid_new_block; eauto.
   red; intros. split.
-  eapply Mem.perm_alloc_2; eauto. inv H0; xomega.
+  eapply Mem.perm_alloc_2; eauto. inv H1; xomega.
   intros; red; intros. exploit Mem.perm_alloc_inv. eexact H. eauto.
   destruct (eq_block b stk); intros.
-  subst. rewrite D in H8; inv H8. inv H0; xomega.
-  rewrite E in H8; auto. eelim Mem.fresh_block_alloc. eexact A. eapply Mem.mi_mappedblocks; eauto.
+  subst. rewrite D in H9; inv H9. inv H1; xomega.
+  rewrite E in H9; auto. eelim Mem.fresh_block_alloc. eexact A. eapply Mem.mi_mappedblocks; eauto.
   auto.
   intros. exploit Mem.perm_alloc_inv; eauto. rewrite dec_eq_true. omega.
 
-(* internal function, inlined *)
+- (* internal function, inlined *)
   inversion FB; subst.
   exploit Mem.alloc_left_mapped_inject.
     eauto.
@@ -1218,13 +1221,13 @@ Proof.
   eapply match_stacks_inside_alloc_left; eauto.
   eapply match_stacks_inside_invariant; eauto.
   omega.
-  auto.
+  eauto. auto.
   apply agree_regs_incr with F; auto.
   auto. auto. auto.
   rewrite H2. eapply range_private_alloc_left; eauto.
   auto. auto.
 
-(* external function *)
+- (* external function *)
   exploit match_stacks_globalenvs; eauto. intros [bound MG].
   exploit external_call_mem_inject; eauto.
     eapply match_globalenvs_preserves_globals; eauto.
@@ -1232,8 +1235,7 @@ Proof.
   simpl in FD. inv FD.
   left; econstructor; split.
   eapply plus_one. eapply exec_function_external; eauto.
-    eapply external_call_symbols_preserved; eauto.
-    exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+    eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor.
     eapply match_stacks_bound with (Mem.nextblock m'0).
     eapply match_stacks_extcall with (F1 := F) (F2 := F1) (m1 := m) (m1' := m'0); eauto.
@@ -1243,43 +1245,38 @@ Proof.
     eapply external_call_nextblock; eauto.
     auto. auto.
 
-(* return fron noninlined function *)
+- (* return fron noninlined function *)
   inv MS0.
-  (* normal case *)
++ (* normal case *)
   left; econstructor; split.
   eapply plus_one. eapply exec_return.
   econstructor; eauto.
   apply match_stacks_inside_set_reg; auto.
   apply agree_set_reg; auto.
-  (* untailcall case *)
++ (* untailcall case *)
   inv MS; try congruence.
   rewrite RET in RET0; inv RET0.
-(*
-  assert (rpc = pc). unfold spc in H0; unfold node in *; xomega.
-  assert (res0 = res). unfold sreg in H1; unfold reg in *; xomega.
-  subst rpc res0.
-*)
   left; econstructor; split.
   eapply plus_one. eapply exec_return.
   eapply match_regular_states.
   eapply match_stacks_inside_set_reg; eauto.
-  auto.
+  eauto. auto.
   apply agree_set_reg; auto.
   auto. auto. auto.
   red; intros. destruct (zlt ofs (dstk ctx)). apply PAD; omega. apply PRIV; omega.
   auto. auto.
 
-(* return from inlined function *)
+- (* return from inlined function *)
   inv MS0; try congruence. rewrite RET0 in RET; inv RET.
   unfold inline_return in AT.
   assert (PRIV': range_private F m m' sp' (dstk ctx' + mstk ctx') f'.(fn_stacksize)).
     red; intros. destruct (zlt ofs (dstk ctx)). apply PAD. omega. apply PRIV. omega.
   destruct or.
-  (* with a result *)
++ (* with a result *)
   left; econstructor; split.
   eapply plus_one. eapply exec_Iop; eauto. simpl. reflexivity.
   econstructor; eauto. apply match_stacks_inside_set_reg; auto. apply agree_set_reg; auto.
-  (* without a result *)
++ (* without a result *)
   left; econstructor; split.
   eapply plus_one. eapply exec_Inop; eauto.
   econstructor; eauto. subst vres. apply agree_set_reg_undef'; auto.
@@ -1289,13 +1286,13 @@ Lemma transf_initial_states:
   forall st1, initial_state prog st1 -> exists st2, initial_state tprog st2 /\ match_states st1 st2.
 Proof.
   intros. inv H.
-  exploit function_ptr_translated; eauto. intros [tf [FIND TR]].
+  exploit function_ptr_translated; eauto. intros (cu & tf & FIND & TR & LINK).
   exists (Callstate nil tf nil m0); split.
   econstructor; eauto.
-    unfold transf_program in TRANSF. eapply Genv.init_mem_transf_partial; eauto.
-    rewrite symbols_preserved.
-    rewrite (transform_partial_program_main _ _ TRANSF).  auto.
-    rewrite <- H3. apply sig_function_translated; auto.
+    eapply (Genv.init_mem_match TRANSF); eauto.
+    rewrite symbols_preserved. replace (prog_main tprog) with (prog_main prog). auto.
+    symmetry; eapply match_program_main; eauto.
+    rewrite <- H3. eapply sig_function_translated; eauto.
   econstructor; eauto.
   instantiate (1 := Mem.flat_inj (Mem.nextblock m0)).
   apply match_stacks_nil with (Mem.nextblock m0).
@@ -1322,7 +1319,7 @@ Theorem transf_program_correct:
   forward_simulation (semantics prog) (semantics tprog).
 Proof.
   eapply forward_simulation_star.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   eexact step_simulation.
diff --git a/backend/Inliningspec.v b/backend/Inliningspec.v
index ba62313f..23770cb7 100644
--- a/backend/Inliningspec.v
+++ b/backend/Inliningspec.v
@@ -12,64 +12,60 @@
 
 (** RTL function inlining: relational specification *)
 
-Require Import Coqlib.
-Require Import Wfsimpl.
-Require Import Errors.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Globalenvs.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
+Require Import Coqlib Wfsimpl Maps Errors Integers.
+Require Import AST Linking.
+Require Import Op Registers RTL.
 Require Import Inlining.
 
 (** ** Soundness of function environments. *)
 
-(** A (compile-time) function environment is compatible with a
-  (run-time) global environment if the following condition holds. *)
+(** A compile-time function environment is compatible with a whole
+  program if the following condition holds. *)
 
-Definition fenv_compat (ge: genv) (fenv: funenv) : Prop :=
-  forall id b f,
-  fenv!id = Some f -> Genv.find_symbol ge id = Some b ->
-  Genv.find_funct_ptr ge b = Some (Internal f).
+Definition fenv_compat (p: program) (fenv: funenv) : Prop :=
+  forall id f,
+  fenv!id = Some f -> (prog_defmap p)!id = Some (Gfun (Internal f)).
 
-Remark add_globdef_compat:
-  forall ge fenv idg,
-  fenv_compat ge fenv ->
-  fenv_compat (Genv.add_global ge idg) (Inlining.add_globdef fenv idg).
+Lemma funenv_program_compat:
+  forall p, fenv_compat p (funenv_program p).
 Proof.
-  intros. destruct idg as [id gd]. red; simpl; intros.
-  unfold Genv.find_symbol in H1; simpl in H1.
-  unfold Genv.find_funct_ptr; simpl.
-  rewrite PTree.gsspec in H1. destruct (peq id0 id).
-  (* same *)
-  subst id0. inv H1. destruct gd. destruct f0.
-  destruct (should_inline id f0).
-  rewrite PTree.gss in H0. rewrite PTree.gss. inv H0; auto.
-  rewrite PTree.grs in H0; discriminate.
-  rewrite PTree.grs in H0; discriminate.
-  rewrite PTree.grs in H0; discriminate.
-  (* different *)
-  destruct gd. rewrite PTree.gso. eapply H; eauto.
-  destruct f0. destruct (should_inline id f0).
-  rewrite PTree.gso in H0; auto.
-  rewrite PTree.gro in H0; auto.
-  rewrite PTree.gro in H0; auto.
-  red; intros; subst b. eelim Plt_strict. eapply Genv.genv_symb_range; eauto.
-  rewrite PTree.gro in H0; auto. eapply H; eauto.
+  set (P := fun (dm: PTree.t (globdef fundef unit)) (fenv: funenv) =>
+              forall id f,
+              fenv!id = Some f -> dm!id = Some (Gfun (Internal f))).
+  assert (REMOVE: forall dm fenv id g,
+             P dm fenv ->
+             P (PTree.set id g dm) (PTree.remove id fenv)).
+  { unfold P; intros. rewrite PTree.grspec in H0. destruct (PTree.elt_eq id0 id).
+    discriminate.
+    rewrite PTree.gso; auto.
+  }
+  assert (ADD: forall dm fenv idg,
+             P dm fenv ->
+             P (PTree.set (fst idg) (snd idg) dm) (add_globdef fenv idg)).
+  { intros dm fenv [id g]; simpl; intros.
+    destruct g as [ [f|ef] | v]; auto.
+    destruct (should_inline id f); auto.
+    red; intros. rewrite ! PTree.gsspec in *.
+    destruct (peq id0 id); auto. inv H0; auto.
+  }
+  assert (REC: forall l dm fenv,
+            P dm fenv ->
+            P (fold_left (fun x idg => PTree.set (fst idg) (snd idg) x) l dm)
+              (fold_left add_globdef l fenv)).
+  { induction l; simpl; intros. 
+  - auto.
+  - apply IHl. apply ADD; auto. 
+  }
+  intros. apply REC. red; intros.  rewrite PTree.gempty in H; discriminate.
 Qed.
 
-Lemma funenv_program_compat:
-  forall p, fenv_compat (Genv.globalenv p) (funenv_program p).
+Lemma fenv_compat_linkorder:
+  forall cunit prog fenv,
+  linkorder cunit prog -> fenv_compat cunit fenv -> fenv_compat prog fenv.
 Proof.
-  intros.
-  unfold Genv.globalenv, funenv_program.
-  assert (forall gl ge fenv,
-         fenv_compat ge fenv ->
-         fenv_compat (Genv.add_globals ge gl) (fold_left add_globdef gl fenv)).
-    induction gl; simpl; intros. auto. apply IHgl. apply add_globdef_compat; auto.
-  apply H. red; intros. rewrite PTree.gempty in H0; discriminate.
+  intros; red; intros. apply H0 in H1. 
+  destruct (prog_defmap_linkorder _ _ _ _ H H1) as (gd' & P & Q). 
+  inv Q. inv H3. auto.
 Qed.
 
 (** ** Properties of shifting *)
@@ -684,29 +680,45 @@ Qed.
 
 End INLINING_BODY_SPEC.
 
+End INLINING_SPEC.
+
 (** ** Relational specification of the translation of a function *)
 
-Inductive tr_function: function -> function -> Prop :=
-  | tr_function_intro: forall f f' ctx,
-      tr_funbody f'.(fn_stacksize) ctx f f'.(fn_code) ->
+Inductive tr_function: program -> function -> function -> Prop :=
+  | tr_function_intro: forall p fenv f f' ctx,
+      fenv_compat p fenv ->
+      tr_funbody fenv f'.(fn_stacksize) ctx f f'.(fn_code) ->
       ctx.(dstk) = 0 ->
       ctx.(retinfo) = None ->
       f'.(fn_sig) = f.(fn_sig) ->
       f'.(fn_params) = sregs ctx f.(fn_params) ->
       f'.(fn_entrypoint) = spc ctx f.(fn_entrypoint) ->
       0 <= fn_stacksize f' < Int.max_unsigned ->
-      tr_function f f'.
+      tr_function p f f'.
+
+Lemma tr_function_linkorder:
+  forall cunit prog f f',
+  linkorder cunit prog ->
+  tr_function cunit f f' ->
+  tr_function prog f f'.
+Proof.
+  intros. inv H0. econstructor; eauto. eapply fenv_compat_linkorder; eauto. 
+Qed.
 
 Lemma transf_function_spec:
-  forall f f', transf_function fenv f = OK f' -> tr_function f f'.
+  forall cunit f f',
+  transf_function (funenv_program cunit) f = OK f' ->
+  tr_function cunit f f'.
 Proof.
   intros. unfold transf_function in H.
+  set (fenv := funenv_program cunit) in *.
   destruct (expand_function fenv f initstate) as [ctx s i] eqn:?.
   destruct (zlt (st_stksize s) Int.max_unsigned); inv H.
   monadInv Heqr. set (ctx := initcontext x x0 (max_reg_function f) (fn_stacksize f)) in *.
 Opaque initstate.
   destruct INCR3. inversion EQ1. inversion EQ.
-  apply tr_function_intro with ctx; auto.
+  apply tr_function_intro with fenv ctx; auto.
+  apply funenv_program_compat.
   eapply expand_cfg_spec with (fe := fenv); eauto.
     red; auto.
     unfold ctx; rewrite <- H1; rewrite <- H2; rewrite <- H3; simpl. xomega.
@@ -718,5 +730,3 @@ Opaque initstate.
   simpl. split; auto. destruct INCR2. destruct INCR1. destruct INCR0. destruct INCR.
   simpl. change 0 with (st_stksize initstate). omega.
 Qed.
-
-End INLINING_SPEC.
diff --git a/backend/Linearize.v b/backend/Linearize.v
index 68c2b32f..2cfa4d3c 100644
--- a/backend/Linearize.v
+++ b/backend/Linearize.v
@@ -12,19 +12,9 @@
 
 (** Linearization of the control-flow graph: translation from LTL to Linear *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import Ordered.
-Require Import FSets.
-Require FSetAVL.
-Require Import AST.
-Require Import Errors.
-Require Import Op.
-Require Import Locations.
-Require Import LTL.
-Require Import Linear.
-Require Import Kildall.
-Require Import Lattice.
+Require Import FSets FSetAVL.
+Require Import Coqlib Maps Ordered Errors Lattice Kildall.
+Require Import AST Op Locations LTL Linear.
 
 Open Scope error_monad_scope.
 
diff --git a/backend/Linearizeproof.v b/backend/Linearizeproof.v
index 65258b2d..16717365 100644
--- a/backend/Linearizeproof.v
+++ b/backend/Linearizeproof.v
@@ -13,32 +13,29 @@
 (** Correctness proof for code linearization *)
 
 Require Import FSets.
-Require Import Coqlib.
-Require Import Maps.
-Require Import Ordered.
-Require Import Lattice.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Errors.
-Require Import Smallstep.
-Require Import Op.
-Require Import Locations.
-Require Import LTL.
-Require Import Linear.
+Require Import Coqlib Maps Ordered Errors Lattice Kildall Integers.
+Require Import AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Locations LTL Linear.
 Require Import Linearize.
 
 Module NodesetFacts := FSetFacts.Facts(Nodeset).
 
+Definition match_prog (p: LTL.program) (tp: Linear.program) :=
+  match_program (fun ctx f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
+
 Section LINEARIZATION.
 
 Variable prog: LTL.program.
 Variable tprog: Linear.program.
 
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
@@ -48,28 +45,23 @@ Lemma functions_translated:
   Genv.find_funct ge v = Some f ->
   exists tf,
   Genv.find_funct tge v = Some tf /\ transf_fundef f = OK tf.
-Proof (Genv.find_funct_transf_partial transf_fundef _ TRANSF).
+Proof (Genv.find_funct_transf_partial TRANSF).
 
 Lemma function_ptr_translated:
   forall v f,
   Genv.find_funct_ptr ge v = Some f ->
   exists tf,
   Genv.find_funct_ptr tge v = Some tf /\ transf_fundef f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
 
 Lemma symbols_preserved:
   forall id,
   Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof (Genv.find_symbol_transf_partial transf_fundef _ TRANSF).
-
-Lemma public_preserved:
-  forall id,
-  Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof (Genv.public_symbol_transf_partial transf_fundef _ TRANSF).
+Proof (Genv.find_symbol_transf_partial TRANSF).
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof (Genv.find_var_info_transf_partial transf_fundef _ TRANSF).
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_transf_partial TRANSF).
 
 Lemma sig_preserved:
   forall f tf,
@@ -645,8 +637,7 @@ Proof.
   left; econstructor; split. simpl.
   apply plus_one. eapply exec_Lbuiltin; eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto.
 
   (* Lbranch *)
@@ -703,8 +694,7 @@ Proof.
   (* external function *)
   monadInv H8. left; econstructor; split.
   apply plus_one. eapply exec_function_external; eauto.
-  eapply external_call_symbols_preserved'; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   econstructor; eauto.
 
   (* return *)
@@ -721,10 +711,9 @@ Proof.
   intros. inversion H.
   exploit function_ptr_translated; eauto. intros [tf [A B]].
   exists (Callstate nil tf (Locmap.init Vundef) m0); split.
-  econstructor; eauto. eapply Genv.init_mem_transf_partial; eauto.
-  replace (prog_main tprog) with (prog_main prog).
+  econstructor; eauto. eapply (Genv.init_mem_transf_partial TRANSF); eauto.
+  rewrite (match_program_main TRANSF).
   rewrite symbols_preserved. eauto.
-  symmetry. apply (transform_partial_program_main transf_fundef _ TRANSF).
   rewrite <- H3. apply sig_preserved. auto.
   constructor. constructor. auto.
 Qed.
@@ -740,7 +729,7 @@ Theorem transf_program_correct:
   forward_simulation (LTL.semantics prog) (Linear.semantics tprog).
 Proof.
   eapply forward_simulation_star.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   eexact transf_step_correct.
diff --git a/backend/PrintCminor.ml b/backend/PrintCminor.ml
index 5e686b55..d50e07a3 100644
--- a/backend/PrintCminor.ml
+++ b/backend/PrintCminor.ml
@@ -147,9 +147,9 @@ let rec expr p (prec, e) =
   | Econst(Ointconst n) ->
       fprintf p "%ld" (camlint_of_coqint n)
   | Econst(Ofloatconst f) ->
-      fprintf p "%F" (camlfloat_of_coqfloat f)
+      fprintf p "%.15F" (camlfloat_of_coqfloat f)
   | Econst(Osingleconst f) ->
-      fprintf p "%Ff" (camlfloat_of_coqfloat32 f)
+      fprintf p "%.15Ff" (camlfloat_of_coqfloat32 f)
   | Econst(Olongconst n) ->
       fprintf p "%LdLL" (camlint64_of_coqint n)
   | Econst(Oaddrsymbol(id, ofs)) ->
@@ -325,8 +325,8 @@ let print_init_data p = function
   | Init_int16 i -> fprintf p "int16 %ld" (camlint_of_coqint i)
   | Init_int32 i -> fprintf p "%ld" (camlint_of_coqint i)
   | Init_int64 i -> fprintf p "%LdLL" (camlint64_of_coqint i)
-  | Init_float32 f -> fprintf p "float32 %F" (camlfloat_of_coqfloat f)
-  | Init_float64 f -> fprintf p "%F" (camlfloat_of_coqfloat f)
+  | Init_float32 f -> fprintf p "float32 %.15F" (camlfloat_of_coqfloat f)
+  | Init_float64 f -> fprintf p "%.15F" (camlfloat_of_coqfloat f)
   | Init_space i -> fprintf p "[%ld]" (camlint_of_coqint i)
   | Init_addrof(id,off) -> fprintf p "%ld(\"%s\")" (camlint_of_coqint off) (extern_atom id)
 
diff --git a/backend/RTLgenproof.v b/backend/RTLgenproof.v
index f458de8b..ace822fd 100644
--- a/backend/RTLgenproof.v
+++ b/backend/RTLgenproof.v
@@ -12,23 +12,10 @@
 
 (** Correctness proof for RTL generation. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Smallstep.
-Require Import Globalenvs.
-Require Import Switch.
-Require Import Registers.
-Require Import Cminor.
-Require Import Op.
-Require Import CminorSel.
-Require Import RTL.
-Require Import RTLgen.
-Require Import RTLgenspec.
+Require Import Coqlib Maps AST Linking.
+Require Import Integers Values Memory Events Smallstep Globalenvs.
+Require Import Switch Registers Cminor Op CminorSel RTL.
+Require Import RTLgen RTLgenspec.
 
 (** * Correspondence between Cminor environments and RTL register sets *)
 
@@ -361,11 +348,20 @@ Qed.
 
 Require Import Errors.
 
+Definition match_prog (p: CminorSel.program) (tp: RTL.program) :=
+  match_program (fun cu f tf => transl_fundef f = Errors.OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transl_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. apply match_transform_partial_program; auto.
+Qed.
+
 Section CORRECTNESS.
 
 Variable prog: CminorSel.program.
 Variable tprog: RTL.program.
-Hypothesis TRANSL: transl_program prog = OK tprog.
+Hypothesis TRANSL: match_prog prog tprog.
 
 Let ge : CminorSel.genv := Genv.globalenv prog.
 Let tge : RTL.genv := Genv.globalenv tprog.
@@ -376,12 +372,7 @@ Let tge : RTL.genv := Genv.globalenv tprog.
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
 Proof
-  (Genv.find_symbol_transf_partial transl_fundef _ TRANSL).
-
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof
-  (Genv.public_symbol_transf_partial transl_fundef _ TRANSL).
+  (Genv.find_symbol_transf_partial TRANSL).
 
 Lemma function_ptr_translated:
   forall (b: block) (f: CminorSel.fundef),
@@ -389,7 +380,7 @@ Lemma function_ptr_translated:
   exists tf,
   Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = OK tf.
 Proof
-  (Genv.find_funct_ptr_transf_partial transl_fundef _ TRANSL).
+  (Genv.find_funct_ptr_transf_partial TRANSL).
 
 Lemma functions_translated:
   forall (v: val) (f: CminorSel.fundef),
@@ -397,7 +388,7 @@ Lemma functions_translated:
   exists tf,
   Genv.find_funct tge v = Some tf /\ transl_fundef f = OK tf.
 Proof
-  (Genv.find_funct_transf_partial transl_fundef _ TRANSL).
+  (Genv.find_funct_transf_partial TRANSL).
 
 Lemma sig_transl_function:
   forall (f: CminorSel.fundef) (tf: RTL.fundef),
@@ -414,10 +405,10 @@ Proof.
   intro. inversion H. reflexivity.
 Qed.
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
+Lemma senv_preserved:
+  Senv.equiv (Genv.to_senv ge) (Genv.to_senv tge).
 Proof
-  (Genv.find_var_info_transf_partial transl_fundef _ TRANSL).
+  (Genv.senv_transf_partial TRANSL).
 
 (** Correctness of the code generated by [add_move]. *)
 
@@ -720,8 +711,7 @@ Proof.
   change (rs1#rd <- v') with (regmap_setres (BR rd) v' rs1).
   eapply exec_Ibuiltin; eauto.
   eapply eval_builtin_args_trivial.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   reflexivity.
 (* Match-env *)
   split. eauto with rtlg.
@@ -754,8 +744,7 @@ Proof.
   eapply star_left. eapply exec_Icall; eauto.
   simpl. rewrite symbols_preserved. rewrite H. eauto. auto.
   eapply star_left. eapply exec_function_external.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   apply star_one. apply exec_return.
   reflexivity. reflexivity. reflexivity.
 (* Match-env *)
@@ -1422,8 +1411,7 @@ Proof.
   left. eapply plus_right. eexact E.
   eapply exec_Ibuiltin. eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved. apply senv_preserved. eauto.
   traceEq.
   econstructor; eauto. constructor.
   eapply match_env_update_res; eauto.
@@ -1540,8 +1528,7 @@ Proof.
   edestruct external_call_mem_extends as [tvres [tm' [A [B [C D]]]]]; eauto.
   econstructor; split.
   left; apply plus_one. eapply exec_function_external; eauto.
-  eapply external_call_symbols_preserved. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   constructor; auto.
 
   (* return *)
@@ -1559,9 +1546,9 @@ Proof.
   induction 1.
   exploit function_ptr_translated; eauto. intros [tf [A B]].
   econstructor; split.
-  econstructor. apply (Genv.init_mem_transf_partial _ _ TRANSL); eauto.
-  rewrite (transform_partial_program_main _ _ TRANSL). fold tge.
-  rewrite symbols_preserved. eauto.
+  econstructor. apply (Genv.init_mem_transf_partial TRANSL); eauto.
+  replace (prog_main tprog) with (prog_main prog). rewrite symbols_preserved; eauto.
+  symmetry; eapply match_program_main; eauto.
   eexact A.
   rewrite <- H2. apply sig_transl_function; auto.
   constructor. auto. constructor.
@@ -1579,7 +1566,7 @@ Theorem transf_program_correct:
   forward_simulation (CminorSel.semantics prog) (RTL.semantics tprog).
 Proof.
   eapply forward_simulation_star_wf with (order := lt_state).
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transl_initial_states.
   eexact transl_final_states.
   apply lt_state_wf.
diff --git a/backend/Renumberproof.v b/backend/Renumberproof.v
index f4d9cca3..7cda9425 100644
--- a/backend/Renumberproof.v
+++ b/backend/Renumberproof.v
@@ -12,21 +12,24 @@
 
 (** Postorder renumbering of RTL control-flow graphs. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import Postorder.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
-Require Import Renumber.
+Require Import Coqlib Maps Postorder.
+Require Import AST Linking.
+Require Import Values Memory Globalenvs Events Smallstep.
+Require Import Op Registers RTL Renumber.
+
+Definition match_prog (p tp: RTL.program) :=
+  match_program (fun ctx f tf => tf = transf_fundef f) eq p tp.
+
+Lemma transf_program_match:
+  forall p, match_prog p (transf_program p).
+Proof.
+  intros. eapply match_transform_program; eauto.
+Qed.
 
 Section PRESERVATION.
 
-Variable prog: program.
-Let tprog := transf_program prog.
+Variables prog tprog: program.
+Hypothesis TRANSL: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
@@ -34,27 +37,22 @@ Lemma functions_translated:
   forall v f,
   Genv.find_funct ge v = Some f ->
   Genv.find_funct tge v = Some (transf_fundef f).
-Proof (@Genv.find_funct_transf _ _ _ transf_fundef prog).
+Proof (Genv.find_funct_transf TRANSL).
 
 Lemma function_ptr_translated:
   forall v f,
   Genv.find_funct_ptr ge v = Some f ->
   Genv.find_funct_ptr tge v = Some (transf_fundef f).
-Proof (@Genv.find_funct_ptr_transf _ _ _ transf_fundef prog).
+Proof (Genv.find_funct_ptr_transf TRANSL).
 
 Lemma symbols_preserved:
   forall id,
   Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof (@Genv.find_symbol_transf _ _ _ transf_fundef prog).
-
-Lemma public_preserved:
-  forall id,
-  Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof (@Genv.public_symbol_transf _ _ _ transf_fundef prog).
+Proof (Genv.find_symbol_transf TRANSL).
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof (@Genv.find_var_info_transf _ _ _ transf_fundef prog).
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_transf TRANSL).
 
 Lemma sig_preserved:
   forall f, funsig (transf_fundef f) = funsig f.
@@ -199,8 +197,7 @@ Proof.
   econstructor; split.
   eapply exec_Ibuiltin; eauto.
     eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-    eapply external_call_symbols_preserved; eauto.
-    exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+    eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   constructor; auto. eapply reach_succ; eauto. simpl; auto.
 (* cond *)
   econstructor; split.
@@ -224,8 +221,7 @@ Proof.
 (* external function *)
   econstructor; split.
   eapply exec_function_external; eauto.
-    eapply external_call_symbols_preserved; eauto.
-    exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+    eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   constructor; auto.
 (* return *)
   inv STACKS. inv H1.
@@ -240,8 +236,8 @@ Lemma transf_initial_states:
 Proof.
   intros. inv H. econstructor; split.
   econstructor.
-    eapply Genv.init_mem_transf; eauto.
-    simpl. rewrite symbols_preserved. eauto.
+    eapply (Genv.init_mem_transf TRANSL); eauto.
+    rewrite symbols_preserved. rewrite (match_program_main TRANSL). eauto.
     eapply function_ptr_translated; eauto.
     rewrite <- H3; apply sig_preserved.
   constructor. constructor.
@@ -257,7 +253,7 @@ Theorem transf_program_correct:
   forward_simulation (RTL.semantics prog) (RTL.semantics tprog).
 Proof.
   eapply forward_simulation_step.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   exact step_simulation.
diff --git a/backend/SelectLongproof.v b/backend/SelectLongproof.v
index 35d53215..f15015e8 100644
--- a/backend/SelectLongproof.v
+++ b/backend/SelectLongproof.v
@@ -14,6 +14,7 @@
 
 Require Import String.
 Require Import Coqlib.
+Require Import Maps.
 Require Import AST.
 Require Import Errors.
 Require Import Integers.
@@ -36,7 +37,7 @@ Open Local Scope string_scope.
 
 Definition external_implements (name: string) (sg: signature) (vargs: list val) (vres: val) : Prop :=
   forall F V (ge: Genv.t F V) m,
-  external_call (EF_external name sg) ge vargs m E0 vres m.
+  external_call (EF_runtime name sg) ge vargs m E0 vres m.
 
 Definition builtin_implements (name: string) (sg: signature) (vargs: list val) (vres: val) : Prop :=
   forall F V (ge: Genv.t F V) m,
@@ -61,32 +62,32 @@ Axiom i64_helpers_correct :
  /\ (forall x y, external_implements "__i64_shr" sig_li_l (x::y::nil) (Val.shrlu x y))
  /\ (forall x y, external_implements "__i64_sar" sig_li_l (x::y::nil) (Val.shrl x y)).
 
-Definition helper_declared {F V: Type} (ge: Genv.t (AST.fundef F) V) (id: ident) (name: string) (sg: signature) : Prop :=
-  exists b, Genv.find_symbol ge id = Some b
-         /\ Genv.find_funct_ptr ge b = Some (External (EF_external name sg)).
-
-Definition helper_functions_declared {F V: Type} (ge: Genv.t (AST.fundef F) V) (hf: helper_functions) : Prop :=
-     helper_declared ge hf.(i64_dtos) "__i64_dtos" sig_f_l
-  /\ helper_declared ge hf.(i64_dtou) "__i64_dtou" sig_f_l
-  /\ helper_declared ge hf.(i64_stod) "__i64_stod" sig_l_f
-  /\ helper_declared ge hf.(i64_utod) "__i64_utod" sig_l_f
-  /\ helper_declared ge hf.(i64_stof) "__i64_stof" sig_l_s
-  /\ helper_declared ge hf.(i64_utof) "__i64_utof" sig_l_s
-  /\ helper_declared ge hf.(i64_sdiv) "__i64_sdiv" sig_ll_l
-  /\ helper_declared ge hf.(i64_udiv) "__i64_udiv" sig_ll_l
-  /\ helper_declared ge hf.(i64_smod) "__i64_smod" sig_ll_l
-  /\ helper_declared ge hf.(i64_umod) "__i64_umod" sig_ll_l
-  /\ helper_declared ge hf.(i64_shl) "__i64_shl" sig_li_l
-  /\ helper_declared ge hf.(i64_shr) "__i64_shr" sig_li_l
-  /\ helper_declared ge hf.(i64_sar) "__i64_sar" sig_li_l.
+Definition helper_declared {F V: Type} (p: AST.program (AST.fundef F) V) (id: ident) (name: string) (sg: signature) : Prop :=
+  (prog_defmap p)!id = Some (Gfun (External (EF_runtime name sg))).
+
+Definition helper_functions_declared {F V: Type} (p: AST.program (AST.fundef F) V) (hf: helper_functions) : Prop :=
+     helper_declared p hf.(i64_dtos) "__i64_dtos" sig_f_l
+  /\ helper_declared p hf.(i64_dtou) "__i64_dtou" sig_f_l
+  /\ helper_declared p hf.(i64_stod) "__i64_stod" sig_l_f
+  /\ helper_declared p hf.(i64_utod) "__i64_utod" sig_l_f
+  /\ helper_declared p hf.(i64_stof) "__i64_stof" sig_l_s
+  /\ helper_declared p hf.(i64_utof) "__i64_utof" sig_l_s
+  /\ helper_declared p hf.(i64_sdiv) "__i64_sdiv" sig_ll_l
+  /\ helper_declared p hf.(i64_udiv) "__i64_udiv" sig_ll_l
+  /\ helper_declared p hf.(i64_smod) "__i64_smod" sig_ll_l
+  /\ helper_declared p hf.(i64_umod) "__i64_umod" sig_ll_l
+  /\ helper_declared p hf.(i64_shl) "__i64_shl" sig_li_l
+  /\ helper_declared p hf.(i64_shr) "__i64_shr" sig_li_l
+  /\ helper_declared p hf.(i64_sar) "__i64_sar" sig_li_l.
 
 (** * Correctness of the instruction selection functions for 64-bit operators *)
 
 Section CMCONSTR.
 
-Variable ge: genv.
+Variable prog: program.
 Variable hf: helper_functions.
-Hypothesis HELPERS: helper_functions_declared ge hf.
+Hypothesis HELPERS: helper_functions_declared prog hf.
+Let ge := Genv.globalenv prog.
 Variable sp: val.
 Variable e: env.
 Variable m: mem.
@@ -97,17 +98,20 @@ Ltac DeclHelper := red in HELPERS; decompose [Logic.and] HELPERS; eauto.
 Lemma eval_helper:
   forall le id name sg args vargs vres,
   eval_exprlist ge sp e m le args vargs ->
-  helper_declared ge id name sg  ->
+  helper_declared prog id name sg  ->
   external_implements name sg vargs vres ->
   eval_expr ge sp e m le (Eexternal id sg args) vres.
 Proof.
-  intros. destruct H0 as (b & P & Q). econstructor; eauto.
+  intros.
+  red in H0. apply Genv.find_def_symbol in H0. destruct H0 as (b & P & Q).
+  rewrite <- Genv.find_funct_ptr_iff in Q. 
+  econstructor; eauto.
 Qed.
 
 Corollary eval_helper_1:
   forall le id name sg arg1 varg1 vres,
   eval_expr ge sp e m le arg1 varg1 ->
-  helper_declared ge id name sg  ->
+  helper_declared prog id name sg  ->
   external_implements name sg (varg1::nil) vres ->
   eval_expr ge sp e m le (Eexternal id sg (arg1 ::: Enil)) vres.
 Proof.
@@ -118,7 +122,7 @@ Corollary eval_helper_2:
   forall le id name sg arg1 arg2 varg1 varg2 vres,
   eval_expr ge sp e m le arg1 varg1 ->
   eval_expr ge sp e m le arg2 varg2 ->
-  helper_declared ge id name sg  ->
+  helper_declared prog id name sg  ->
   external_implements name sg (varg1::varg2::nil) vres ->
   eval_expr ge sp e m le (Eexternal id sg (arg1 ::: arg2 ::: Enil)) vres.
 Proof.
@@ -845,7 +849,7 @@ Qed.
 Lemma eval_binop_long:
   forall id name sem le a b x y z,
   (forall p q, x = Vlong p -> y = Vlong q -> z = Vlong (sem p q)) ->
-  helper_declared ge id name sig_ll_l ->
+  helper_declared prog id name sig_ll_l ->
   external_implements name sig_ll_l (x::y::nil) z ->
   eval_expr ge sp e m le a x ->
   eval_expr ge sp e m le b y ->
diff --git a/backend/Selection.v b/backend/Selection.v
index dcefdd1c..02b37c48 100644
--- a/backend/Selection.v
+++ b/backend/Selection.v
@@ -69,6 +69,8 @@ Definition store (chunk: memory_chunk) (e1 e2: expr) :=
 
 Section SELECTION.
 
+Definition globdef := AST.globdef Cminor.fundef unit.
+Variable defmap: PTree.t globdef.
 Variable hf: helper_functions.
 
 Definition sel_constant (cst: Cminor.constant) : expr :=
@@ -194,17 +196,13 @@ Definition expr_is_addrof_ident (e: Cminor.expr) : option ident :=
   | _ => None
   end.
 
-Definition classify_call (ge: Cminor.genv) (e: Cminor.expr) : call_kind :=
+Definition classify_call (e: Cminor.expr) : call_kind :=
   match expr_is_addrof_ident e with
   | None => Call_default
   | Some id =>
-      match Genv.find_symbol ge id with
-      | None => Call_imm id
-      | Some b =>
-          match Genv.find_funct_ptr ge b with
-          | Some(External ef) => if ef_inline ef then Call_builtin ef else Call_imm id
-          | _ => Call_imm id
-          end
+      match defmap!id with
+      | Some(Gfun(External ef)) => if ef_inline ef then Call_builtin ef else Call_imm id
+      | _ => Call_imm id
       end
   end.
 
@@ -279,13 +277,13 @@ Definition sel_switch_long :=
 
 (** Conversion from Cminor statements to Cminorsel statements. *)
 
-Fixpoint sel_stmt (ge: Cminor.genv) (s: Cminor.stmt) : res stmt :=
+Fixpoint sel_stmt (s: Cminor.stmt) : res stmt :=
   match s with
   | Cminor.Sskip => OK Sskip
   | Cminor.Sassign id e => OK (Sassign id (sel_expr e))
   | Cminor.Sstore chunk addr rhs => OK (store chunk (sel_expr addr) (sel_expr rhs))
   | Cminor.Scall optid sg fn args =>
-      OK (match classify_call ge fn with
+      OK (match classify_call fn with
       | Call_default => Scall optid sg (inl _ (sel_expr fn)) (sel_exprlist args)
       | Call_imm id  => Scall optid sg (inr _ id) (sel_exprlist args)
       | Call_builtin ef => Sbuiltin (sel_builtin_res optid) ef
@@ -296,20 +294,20 @@ Fixpoint sel_stmt (ge: Cminor.genv) (s: Cminor.stmt) : res stmt :=
       OK (Sbuiltin (sel_builtin_res optid) ef
                    (sel_builtin_args args (Machregs.builtin_constraints ef)))
   | Cminor.Stailcall sg fn args =>
-      OK (match classify_call ge fn with
+      OK (match classify_call fn with
       | Call_imm id  => Stailcall sg (inr _ id) (sel_exprlist args)
       | _            => Stailcall sg (inl _ (sel_expr fn)) (sel_exprlist args)
       end)
   | Cminor.Sseq s1 s2 =>
-      do s1' <- sel_stmt ge s1; do s2' <- sel_stmt ge s2;
+      do s1' <- sel_stmt s1; do s2' <- sel_stmt s2;
       OK (Sseq s1' s2')
   | Cminor.Sifthenelse e ifso ifnot =>
-      do ifso' <- sel_stmt ge ifso; do ifnot' <- sel_stmt ge ifnot;
+      do ifso' <- sel_stmt ifso; do ifnot' <- sel_stmt ifnot;
       OK (Sifthenelse (condexpr_of_expr (sel_expr e)) ifso' ifnot')
   | Cminor.Sloop body =>
-      do body' <- sel_stmt ge body; OK (Sloop body')
+      do body' <- sel_stmt body; OK (Sloop body')
   | Cminor.Sblock body =>
-      do body' <- sel_stmt ge body; OK (Sblock body')
+      do body' <- sel_stmt body; OK (Sblock body')
   | Cminor.Sexit n => OK (Sexit n)
   | Cminor.Sswitch false e cases dfl =>
       let t := compile_switch Int.modulus dfl cases in
@@ -324,14 +322,14 @@ Fixpoint sel_stmt (ge: Cminor.genv) (s: Cminor.stmt) : res stmt :=
   | Cminor.Sreturn None => OK (Sreturn None)
   | Cminor.Sreturn (Some e) => OK (Sreturn (Some (sel_expr e)))
   | Cminor.Slabel lbl body =>
-      do body' <- sel_stmt ge body; OK (Slabel lbl body')
+      do body' <- sel_stmt body; OK (Slabel lbl body')
   | Cminor.Sgoto lbl => OK (Sgoto lbl)
   end.
 
 (** Conversion of functions. *)
 
-Definition sel_function (ge: Cminor.genv) (f: Cminor.function) : res function :=
-  do body' <- sel_stmt ge f.(Cminor.fn_body);
+Definition sel_function (f: Cminor.function) : res function :=
+  do body' <- sel_stmt f.(Cminor.fn_body);
   OK (mkfunction
         f.(Cminor.fn_sig)
         f.(Cminor.fn_params)
@@ -339,41 +337,36 @@ Definition sel_function (ge: Cminor.genv) (f: Cminor.function) : res function :=
         f.(Cminor.fn_stackspace)
         body').
 
-Definition sel_fundef (ge: Cminor.genv) (f: Cminor.fundef) : res fundef :=
-  transf_partial_fundef (sel_function ge) f.
+Definition sel_fundef (f: Cminor.fundef) : res fundef :=
+  transf_partial_fundef sel_function f.
 
 End SELECTION.
 
 (** Setting up the helper functions. *)
 
-Definition globdef := AST.globdef Cminor.fundef unit.
-
 (** We build a partial mapping from global identifiers to their definitions,
   restricting ourselves to the globals we are interested in, namely
-  the external function declarations whose name starts with "__i64_".
+  the external function declarations that are marked as runtime library
+  helpers. 
   This ensures that the mapping remains small and that [lookup_helper]
   below is efficient. *)
 
 Definition globdef_of_interest (gd: globdef) : bool :=
   match gd with
-  | Gfun (External (EF_external name sg)) => String.prefix "__i64_" name
+  | Gfun (External (EF_runtime name sg)) => true
   | _ => false
   end.
 
-Definition record_globdef (globs: PTree.t globdef) (id_gd: ident * globdef) :=
-  let (id, gd) := id_gd in
-  if globdef_of_interest gd
-  then PTree.set id gd globs
-  else PTree.remove id globs.
-
-Definition record_globdefs (p: Cminor.program) : PTree.t globdef :=
-  List.fold_left record_globdef p.(prog_defs) (PTree.empty _).
+Definition record_globdefs (defmap: PTree.t globdef) : PTree.t globdef :=
+  PTree.fold 
+    (fun m id gd => if globdef_of_interest gd then PTree.set id gd m else m)
+    defmap (PTree.empty globdef).
 
 Definition lookup_helper_aux
      (name: String.string) (sg: signature) (res: option ident)
      (id: ident) (gd: globdef) :=
   match gd with
-  | Gfun (External (EF_external name' sg')) =>
+  | Gfun (External (EF_runtime name' sg')) =>
       if String.string_dec name name' && signature_eq sg sg'
       then Some id
       else res
@@ -389,8 +382,8 @@ Definition lookup_helper (globs: PTree.t globdef)
 
 Local Open Scope string_scope.
 
-Definition get_helpers (p: Cminor.program) : res helper_functions :=
-  let globs := record_globdefs p in
+Definition get_helpers (defmap: PTree.t globdef) : res helper_functions :=
+  let globs := record_globdefs defmap in
   do i64_dtos <- lookup_helper globs "__i64_dtos" sig_f_l ;
   do i64_dtou <- lookup_helper globs "__i64_dtou" sig_f_l ;
   do i64_stod <- lookup_helper globs "__i64_stod" sig_l_f ;
@@ -412,6 +405,7 @@ Definition get_helpers (p: Cminor.program) : res helper_functions :=
 (** Conversion of programs. *)
 
 Definition sel_program (p: Cminor.program) : res program :=
-  do hf <- get_helpers p;
-  transform_partial_program (sel_fundef hf (Genv.globalenv p)) p.
+  let dm := prog_defmap p in
+  do hf <- get_helpers dm;
+  transform_partial_program (sel_fundef dm hf) p.
 
diff --git a/backend/Selectionproof.v b/backend/Selectionproof.v
index 8051df59..aad3add4 100644
--- a/backend/Selectionproof.v
+++ b/backend/Selectionproof.v
@@ -15,6 +15,7 @@
 Require Import Coqlib.
 Require Import Maps.
 Require Import AST.
+Require Import Linking.
 Require Import Errors.
 Require Import Integers.
 Require Import Values.
@@ -37,6 +38,92 @@ Require Import SelectLongproof.
 Local Open Scope cminorsel_scope.
 Local Open Scope error_monad_scope.
 
+(** * Relational specification of instruction selection *)
+
+Definition match_fundef (cunit: Cminor.program) (f: Cminor.fundef) (tf: CminorSel.fundef) : Prop :=
+  exists hf, helper_functions_declared cunit hf /\ sel_fundef (prog_defmap cunit) hf f = OK tf.
+
+Definition match_prog (p: Cminor.program) (tp: CminorSel.program) :=
+  match_program match_fundef eq p tp.
+
+(** Processing of helper functions *)
+
+Lemma record_globdefs_sound:
+  forall dm id gd, (record_globdefs dm)!id = Some gd -> dm!id = Some gd.
+Proof.
+  intros. 
+  set (f := fun m id gd => if globdef_of_interest gd then PTree.set id gd m else m) in *.
+  set (P := fun m m' => m'!id = Some gd -> m!id = Some gd).
+  assert (X: P dm (PTree.fold f dm (PTree.empty _))).
+  { apply PTree_Properties.fold_rec.
+  - unfold P; intros. rewrite <- H0; auto.
+  - red. rewrite ! PTree.gempty. auto.
+  - unfold P; intros. rewrite PTree.gsspec. unfold f in H3. 
+    destruct (globdef_of_interest v).
+    + rewrite PTree.gsspec in H3. destruct (peq id k); auto.
+    + apply H2 in H3. destruct (peq id k). congruence. auto. }
+  apply X. auto.
+Qed.
+
+Lemma lookup_helper_correct_1:
+  forall globs name sg id,
+  lookup_helper globs name sg = OK id ->
+  globs!id = Some (Gfun (External (EF_runtime name sg))).
+Proof.
+  intros.
+  set (P := fun (m: PTree.t globdef) res => res = Some id -> m!id = Some(Gfun(External (EF_runtime name sg)))).
+  assert (P globs (PTree.fold (lookup_helper_aux name sg) globs None)).
+  { apply PTree_Properties.fold_rec; red; intros.
+  - rewrite <- H0. apply H1; auto.
+  - discriminate.
+  - assert (EITHER: k = id /\ v = Gfun (External (EF_runtime name sg))
+                \/  a = Some id).
+    { unfold lookup_helper_aux in H3. destruct v; auto. destruct f; auto. destruct e; auto.
+      destruct (String.string_dec name name0); auto.
+      destruct (signature_eq sg sg0); auto.
+      inversion H3. left; split; auto. repeat f_equal; auto. }
+    destruct EITHER as [[X Y] | X].
+    subst k v. apply PTree.gss.
+    apply H2 in X. rewrite PTree.gso by congruence. auto.
+  }
+  red in H0. unfold lookup_helper in H.
+  destruct (PTree.fold (lookup_helper_aux name sg) globs None); inv H. auto.
+Qed.
+
+Lemma lookup_helper_correct:
+  forall p name sg id,
+  lookup_helper (record_globdefs (prog_defmap p)) name sg = OK id ->
+  helper_declared p id name sg.
+Proof.
+  intros. apply lookup_helper_correct_1 in H. apply record_globdefs_sound in H. auto.
+Qed.
+
+Lemma get_helpers_correct:
+  forall p hf,
+  get_helpers (prog_defmap p) = OK hf -> helper_functions_declared p hf.
+Proof.
+  intros. monadInv H. red; simpl. auto 20 using lookup_helper_correct.
+Qed.
+
+Theorem transf_program_match:
+  forall p tp, sel_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. monadInv H. 
+  eapply match_transform_partial_program_contextual. eexact EQ0.
+  intros. exists x; split; auto. apply get_helpers_correct; auto.
+Qed.
+
+Lemma helper_functions_declared_linkorder:
+  forall (p p': Cminor.program) hf,
+  helper_functions_declared p hf -> linkorder p p' -> helper_functions_declared p' hf.
+Proof.
+  intros. 
+  assert (X: forall id name sg, helper_declared p id name sg -> helper_declared p' id name sg).
+  { unfold helper_declared; intros.
+    destruct (prog_defmap_linkorder _ _ _ _ H0 H1) as (gd & P & Q). 
+    inv Q. inv H3. auto. }
+  red in H. decompose [Logic.and] H; clear H. red; auto 20.
+Qed.
 
 (** * Correctness of the instruction selection functions for expressions *)
 
@@ -46,75 +133,68 @@ Variable prog: Cminor.program.
 Variable tprog: CminorSel.program.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
-Variable hf: helper_functions.
-Hypothesis HELPERS: helper_functions_declared ge hf.
-Hypothesis TRANSFPROG: transform_partial_program (sel_fundef hf ge) prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intros. eapply Genv.find_symbol_transf_partial; eauto.
-Qed.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  intros. eapply Genv.public_symbol_transf_partial; eauto.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv (Genv.to_senv ge) (Genv.to_senv tge).
+Proof (Genv.senv_match TRANSF).
 
 Lemma function_ptr_translated:
   forall (b: block) (f: Cminor.fundef),
   Genv.find_funct_ptr ge b = Some f ->
-  exists tf, Genv.find_funct_ptr tge b = Some tf /\ sel_fundef hf ge f = OK tf.
-Proof.
-  intros. eapply Genv.find_funct_ptr_transf_partial; eauto.
-Qed.
+  exists cu tf, Genv.find_funct_ptr tge b = Some tf /\ match_fundef cu f tf /\ linkorder cu prog.
+Proof (Genv.find_funct_ptr_match TRANSF).
 
 Lemma functions_translated:
   forall (v v': val) (f: Cminor.fundef),
   Genv.find_funct ge v = Some f ->
   Val.lessdef v v' ->
-  exists tf, Genv.find_funct tge v' = Some tf /\ sel_fundef hf ge f = OK tf.
+  exists cu tf, Genv.find_funct tge v' = Some tf /\ match_fundef cu f tf /\ linkorder cu prog.
 Proof.
   intros. inv H0.
-  eapply Genv.find_funct_transf_partial; eauto.
-  simpl in H. discriminate.
+  eapply Genv.find_funct_match; eauto. 
+  discriminate.
 Qed.
 
 Lemma sig_function_translated:
-  forall f tf, sel_fundef hf ge f = OK tf -> funsig tf = Cminor.funsig f.
+  forall cu f tf, match_fundef cu f tf -> funsig tf = Cminor.funsig f.
 Proof.
-  intros. destruct f; monadInv H; auto. monadInv EQ. auto.
+  intros. destruct H as (hf & P & Q). destruct f; monadInv Q; auto. monadInv EQ; auto.
 Qed.
 
 Lemma stackspace_function_translated:
-  forall f tf, sel_function hf ge f = OK tf -> fn_stackspace tf = Cminor.fn_stackspace f.
+  forall dm hf f tf, sel_function dm hf f = OK tf -> fn_stackspace tf = Cminor.fn_stackspace f.
 Proof.
   intros. monadInv H. auto.
 Qed.
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
+Lemma helper_functions_preserved:
+  forall hf, helper_functions_declared prog hf -> helper_functions_declared tprog hf.
 Proof.
-  intros; eapply Genv.find_var_info_transf_partial; eauto.
+  assert (X: forall id name sg, helper_declared prog id name sg -> helper_declared tprog id name sg).
+  { unfold helper_declared; intros. 
+    generalize (match_program_defmap _ _ _ _ _ TRANSF id).
+    unfold Cminor.fundef; rewrite H; intros R; inv R. inv H2.
+    destruct H4 as (cu & A & B). monadInv B. auto. }
+  unfold helper_functions_declared; intros. decompose [Logic.and] H; clear H. auto 20. 
 Qed.
 
-Lemma helper_declared_preserved:
-  forall id name sg, helper_declared ge id name sg -> helper_declared tge id name sg.
-Proof.
-  intros id name sg (b & A & B).
-  exploit function_ptr_translated; eauto. simpl. intros (tf & P & Q). inv Q.
-  exists b; split; auto. rewrite symbols_preserved. auto.
-Qed.
+Section CMCONSTR.
+
+Variable cunit: Cminor.program.
+Variable hf: helper_functions.
+Hypothesis LINK: linkorder cunit prog.
+Hypothesis HF: helper_functions_declared cunit hf.
 
-Let HELPERS': helper_functions_declared tge hf.
+Let HF': helper_functions_declared tprog hf.
 Proof.
-  red in HELPERS; decompose [Logic.and] HELPERS.
-  red. auto 20 using helper_declared_preserved.
+  apply helper_functions_preserved. eapply helper_functions_declared_linkorder; eauto.
 Qed.
 
-Section CMCONSTR.
-
 Variable sp: val.
 Variable e: env.
 Variable m: mem.
@@ -172,6 +252,7 @@ Lemma eval_sel_unop:
   forall le op a1 v1 v,
   eval_expr tge sp e m le a1 v1 ->
   eval_unop op v1 = Some v ->
+  
   exists v', eval_expr tge sp e m le (sel_unop hf op a1) v' /\ Val.lessdef v v'.
 Proof.
   destruct op; simpl; intros; FuncInv; try subst v.
@@ -276,26 +357,30 @@ Proof.
 Qed.
 
 Lemma classify_call_correct:
-  forall sp e m a v fd,
+  forall unit sp e m a v fd,
+  linkorder unit prog ->
   Cminor.eval_expr ge sp e m a v ->
   Genv.find_funct ge v = Some fd ->
-  match classify_call ge a with
+  match classify_call (prog_defmap unit) a with
   | Call_default => True
   | Call_imm id => exists b, Genv.find_symbol ge id = Some b /\ v = Vptr b Int.zero
   | Call_builtin ef => fd = External ef
   end.
 Proof.
   unfold classify_call; intros.
-  destruct (expr_is_addrof_ident a) as [id|] eqn:?.
+  destruct (expr_is_addrof_ident a) as [id|] eqn:EA; auto.
   exploit expr_is_addrof_ident_correct; eauto. intros EQ; subst a.
-  inv H. inv H2.
-  destruct (Genv.find_symbol ge id) as [b|] eqn:?.
-  rewrite Genv.find_funct_find_funct_ptr in H0.
-  rewrite H0.
-  destruct fd. exists b; auto.
-  destruct (ef_inline e0). auto. exists b; auto.
-  simpl in H0. discriminate.
-  auto.
+  inv H0. inv H3.
+  destruct (Genv.find_symbol ge id) as [b|] eqn:FS; try discriminate.
+  rewrite Genv.find_funct_find_funct_ptr in H1. 
+  assert (DFL: exists b1, Genv.find_symbol ge id = Some b1 /\ Vptr b Int.zero = Vptr b1 Int.zero) by (exists b; auto).
+  unfold globdef; destruct (prog_defmap unit)!id as [[[f|ef] |gv] |] eqn:G; auto.
+  destruct (ef_inline ef) eqn:INLINE; auto.
+  destruct (prog_defmap_linkorder _ _ _ _ H G) as (gd & P & Q).
+  inv Q. inv H2. 
+- apply Genv.find_def_symbol in P. destruct P as (b' & X & Y). fold ge in X, Y. 
+  rewrite <- Genv.find_funct_ptr_iff in Y. congruence.
+- simpl in INLINE. discriminate.
 Qed.
 
 (** Translation of [switch] statements *)
@@ -547,6 +632,13 @@ Qed.
 
 (** Semantic preservation for expressions. *)
 
+Section EXPRESSIONS.
+
+Variable cunit: Cminor.program.
+Variable hf: helper_functions.
+Hypothesis LINK: linkorder cunit prog.
+Hypothesis HF: helper_functions_declared cunit hf.
+
 Lemma sel_expr_correct:
   forall sp e m a v,
   Cminor.eval_expr ge sp e m a v ->
@@ -576,7 +668,7 @@ Proof.
   exploit IHeval_expr1; eauto. intros [v1' [A B]].
   exploit IHeval_expr2; eauto. intros [v2' [C D]].
   exploit eval_binop_lessdef; eauto. intros [v' [E F]].
-  exploit eval_sel_binop. eexact A. eexact C. eauto. intros [v'' [P Q]].
+  exploit eval_sel_binop. eexact LINK. eexact HF. eexact A. eexact C. eauto. intros [v'' [P Q]].
   exists v''; split; eauto. eapply Val.lessdef_trans; eauto.
   (* Eload *)
   exploit IHeval_expr; eauto. intros [vaddr' [A B]].
@@ -641,51 +733,89 @@ Proof.
   intros. destruct oid; simpl; auto. apply set_var_lessdef; auto.
 Qed.
 
+End EXPRESSIONS.
+
 (** Semantic preservation for functions and statements. *)
 
-Inductive match_cont: Cminor.cont -> CminorSel.cont -> Prop :=
-  | match_cont_stop:
-      match_cont Cminor.Kstop Kstop
-  | match_cont_seq: forall s s' k k',
-      sel_stmt hf ge s = OK s' ->
-      match_cont k k' ->
-      match_cont (Cminor.Kseq s k) (Kseq s' k')
-  | match_cont_block: forall k k',
-      match_cont k k' ->
-      match_cont (Cminor.Kblock k) (Kblock k')
-  | match_cont_call: forall id f sp e k f' e' k',
-      sel_function hf ge f = OK f' ->
-      match_cont k k' -> env_lessdef e e' ->
-      match_cont (Cminor.Kcall id f sp e k) (Kcall id f' sp e' k').
+(*
+Inductive match_call_cont: Cminor.cont -> CminorSel.cont -> Prop :=
+  | match_call_cont_stop:
+      match_call_cont Cminor.Kstop Kstop
+  | match_call_cont_call: forall cunit hf id f sp e k f' e' k',
+      linkorder cunit prog ->
+      helper_functions_declared cunit hf ->
+      sel_function (prog_defmap cunit) hf f = OK f' ->
+      match_cont cunit hf k k' -> env_lessdef e e' ->
+      match_call_cont (Cminor.Kcall id f sp e k) (Kcall id f' sp e' k')
+
+with match_cont: Cminor.program -> helper_functions -> Cminor.cont -> CminorSel.cont -> Prop :=
+  | match_cont_stop: forall cunit hf,
+      match_cont cunit hf Cminor.Kstop Kstop
+  | match_cont_seq: forall cunit hf s s' k k',
+      sel_stmt (prog_defmap cunit) hf s = OK s' ->
+      match_cont cunit hf k k' ->
+      match_cont cunit hf (Cminor.Kseq s k) (Kseq s' k')
+  | match_cont_block: forall cunit hf k k',
+      match_cont cunit hf k k' ->
+      match_cont cunit hf (Cminor.Kblock k) (Kblock k')
+  | match_cont_call: forall cunit hf id f sp e k f' e' k',
+      match_call_cont (Cminor.Kcall id f sp e k) (Kcall id f' sp e' k') ->
+      match_cont cunit hf (Cminor.Kcall id f sp e k) (Kcall id f' sp e' k').
+*)
+
+Inductive match_cont: Cminor.program -> helper_functions -> Cminor.cont -> CminorSel.cont -> Prop :=
+  | match_cont_stop: forall cunit hf,
+      match_cont cunit hf Cminor.Kstop Kstop
+  | match_cont_seq: forall cunit hf s s' k k',
+      sel_stmt (prog_defmap cunit) hf s = OK s' ->
+      match_cont cunit hf k k' ->
+      match_cont cunit hf (Cminor.Kseq s k) (Kseq s' k')
+  | match_cont_block: forall cunit hf k k',
+      match_cont cunit hf k k' ->
+      match_cont cunit hf (Cminor.Kblock k) (Kblock k')
+  | match_cont_call: forall cunit' hf' cunit hf id f sp e k f' e' k',
+      linkorder cunit prog ->
+      helper_functions_declared cunit hf ->
+      sel_function (prog_defmap cunit) hf f = OK f' ->
+      match_cont cunit hf k k' -> env_lessdef e e' ->
+      match_cont cunit' hf' (Cminor.Kcall id f sp e k) (Kcall id f' sp e' k').
+
+Definition match_call_cont (k: Cminor.cont) (k': CminorSel.cont) : Prop :=
+  forall cunit hf, match_cont cunit hf k k'.
 
 Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
-  | match_state: forall f f' s k s' k' sp e m e' m'
-        (TF: sel_function hf ge f = OK f')
-        (TS: sel_stmt hf ge s = OK s')
-        (MC: match_cont k k')
+  | match_state: forall cunit hf f f' s k s' k' sp e m e' m'
+        (LINK: linkorder cunit prog)
+        (HF: helper_functions_declared cunit hf)
+        (TF: sel_function (prog_defmap cunit) hf f = OK f')
+        (TS: sel_stmt (prog_defmap cunit) hf s = OK s')
+        (MC: match_cont cunit hf k k')
         (LD: env_lessdef e e')
         (ME: Mem.extends m m'),
       match_states
         (Cminor.State f s k sp e m)
         (State f' s' k' sp e' m')
-  | match_callstate: forall f f' args args' k k' m m'
-        (TF: sel_fundef hf ge f = OK f')
-        (MC: match_cont k k')
+  | match_callstate: forall cunit f f' args args' k k' m m'
+        (LINK: linkorder cunit prog)
+        (TF: match_fundef cunit f f')
+        (MC: match_call_cont k k')
         (LD: Val.lessdef_list args args')
         (ME: Mem.extends m m'),
       match_states
         (Cminor.Callstate f args k m)
         (Callstate f' args' k' m')
   | match_returnstate: forall v v' k k' m m'
-        (MC: match_cont k k')
+        (MC: match_call_cont k k')
         (LD: Val.lessdef v v')
         (ME: Mem.extends m m'),
       match_states
         (Cminor.Returnstate v k m)
         (Returnstate v' k' m')
-  | match_builtin_1: forall ef args args' optid f sp e k m al f' e' k' m'
-        (TF: sel_function hf ge f = OK f')
-        (MC: match_cont k k')
+  | match_builtin_1: forall cunit hf ef args args' optid f sp e k m al f' e' k' m'
+        (LINK: linkorder cunit prog)
+        (HF: helper_functions_declared cunit hf)
+        (TF: sel_function (prog_defmap cunit) hf f = OK f')
+        (MC: match_cont cunit hf k k')
         (LDA: Val.lessdef_list args args')
         (LDE: env_lessdef e e')
         (ME: Mem.extends m m')
@@ -693,9 +823,11 @@ Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
       match_states
         (Cminor.Callstate (External ef) args (Cminor.Kcall optid f sp e k) m)
         (State f' (Sbuiltin (sel_builtin_res optid) ef al) k' sp e' m')
-  | match_builtin_2: forall v v' optid f sp e k m f' e' m' k'
-        (TF: sel_function hf ge f = OK f')
-        (MC: match_cont k k')
+  | match_builtin_2: forall cunit hf v v' optid f sp e k m f' e' m' k'
+        (LINK: linkorder cunit prog)
+        (HF: helper_functions_declared cunit hf)
+        (TF: sel_function (prog_defmap cunit) hf f = OK f')
+        (MC: match_cont cunit hf k k')
         (LDV: Val.lessdef v v')
         (LDE: env_lessdef e e')
         (ME: Mem.extends m m'),
@@ -703,19 +835,50 @@ Inductive match_states: Cminor.state -> CminorSel.state -> Prop :=
         (Cminor.Returnstate v (Cminor.Kcall optid f sp e k) m)
         (State f' Sskip k' sp (set_builtin_res (sel_builtin_res optid) v' e') m').
 
+(*
+Remark call_cont_commut_1:
+  forall cunit hf k k', match_cont cunit hf k k' ->
+  forall cunit' hf', match_cont cunit' hf' (Cminor.call_cont k) (call_cont k').
+Proof.
+  induction 1; simpl; auto; intros; econstructor; eauto.
+Qed.
+
+Remark call_cont_commut_2:
+  forall cunit hf k k', match_cont cunit hf k k' -> match_cont cunit hf (Cminor.call_cont k) (call_cont k').
+Proof.
+  intros. eapply call_cont_commut_1; eauto.
+Qed.
+*)
+
 Remark call_cont_commut:
-  forall k k', match_cont k k' -> match_cont (Cminor.call_cont k) (call_cont k').
+  forall cunit hf k k', match_cont cunit hf k k' -> match_call_cont (Cminor.call_cont k) (call_cont k').
 Proof.
-  induction 1; simpl; auto. constructor. constructor; auto.
+  induction 1; simpl; auto; red; intros; econstructor; eauto.
+Qed.
+
+Remark match_is_call_cont:
+  forall cunit hf k k', match_cont cunit hf k k' -> Cminor.is_call_cont k -> match_call_cont k k'.
+Proof.
+  destruct 1; intros; try contradiction; red; intros; econstructor; eauto.
+Qed.
+
+Remark match_call_cont_cont:
+  forall k k', match_call_cont k k' -> exists cunit hf, match_cont cunit hf k k'.
+Proof.
+  intros. refine (let cunit : Cminor.program := _ in _). 
+  econstructor. apply nil. apply nil. apply xH.
+  refine (let hf : helper_functions := _ in _).
+  econstructor; apply xH.
+  exists cunit, hf; auto.
 Qed.
 
 Remark find_label_commut:
-  forall lbl s k s' k',
-  match_cont k k' ->
-  sel_stmt hf ge s = OK s' ->
+  forall cunit hf lbl s k s' k',
+  match_cont cunit hf k k' ->
+  sel_stmt (prog_defmap cunit) hf s = OK s' ->
   match Cminor.find_label lbl s k, find_label lbl s' k' with
   | None, None => True
-  | Some(s1, k1), Some(s1', k1') => sel_stmt hf ge s1 = OK s1' /\ match_cont k1 k1'
+  | Some(s1, k1), Some(s1', k1') => sel_stmt (prog_defmap cunit) hf s1 = OK s1' /\ match_cont cunit hf k1 k1'
   | _, _ => False
   end.
 Proof.
@@ -723,9 +886,9 @@ Proof.
 (* store *)
   unfold store. destruct (addressing m (sel_expr hf e)); simpl; auto.
 (* call *)
-  destruct (classify_call ge e); simpl; auto.
+  destruct (classify_call (prog_defmap cunit) e); simpl; auto.
 (* tailcall *)
-  destruct (classify_call ge e); simpl; auto.
+  destruct (classify_call (prog_defmap cunit) e); simpl; auto.
 (* seq *)
   exploit (IHs1 (Cminor.Kseq s2 k)). constructor; eauto. eauto.
   destruct (Cminor.find_label lbl s1 (Cminor.Kseq s2 k)) as [[sx kx] | ];
@@ -767,48 +930,50 @@ Lemma sel_step_correct:
 Proof.
   induction 1; intros T1 ME; inv ME; try (monadInv TS).
 - (* skip seq *)
-  inv MC. left; econstructor; split. econstructor. constructor; auto.
+  inv MC. left; econstructor; split. econstructor. econstructor; eauto.
 - (* skip block *)
-  inv MC. left; econstructor; split. econstructor. constructor; auto.
+  inv MC. left; econstructor; split. econstructor. econstructor; eauto.
 - (* skip call *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [A B]].
   left; econstructor; split.
   econstructor. inv MC; simpl in H; simpl; auto.
   eauto.
   erewrite stackspace_function_translated; eauto.
-  constructor; auto.
+  econstructor; eauto. eapply match_is_call_cont; eauto.
 - (* assign *)
   exploit sel_expr_correct; eauto. intros [v' [A B]].
   left; econstructor; split.
   econstructor; eauto.
-  constructor; auto. apply set_var_lessdef; auto.
+  econstructor; eauto. apply set_var_lessdef; auto.
 - (* store *)
-  exploit sel_expr_correct. eexact H. eauto. eauto. intros [vaddr' [A B]].
-  exploit sel_expr_correct. eexact H0. eauto. eauto. intros [v' [C D]].
+  exploit sel_expr_correct. eauto. eauto. eexact H. eauto. eauto. intros [vaddr' [A B]].
+  exploit sel_expr_correct. eauto. eauto. eexact H0. eauto. eauto. intros [v' [C D]].
   exploit Mem.storev_extends; eauto. intros [m2' [P Q]].
   left; econstructor; split.
   eapply eval_store; eauto.
-  constructor; auto.
+  econstructor; eauto.
 - (* Scall *)
   exploit classify_call_correct; eauto.
-  destruct (classify_call ge a) as [ | id | ef].
+  destruct (classify_call (prog_defmap cunit) a) as [ | id | ef].
 + (* indirect *)
   exploit sel_expr_correct; eauto. intros [vf' [A B]].
   exploit sel_exprlist_correct; eauto. intros [vargs' [C D]].
-  exploit functions_translated; eauto. intros (fd' & U & V).
+  exploit functions_translated; eauto. intros (cunit' & fd' & U & V & W).
   left; econstructor; split.
   econstructor; eauto. econstructor; eauto.
-  apply sig_function_translated; auto.
-  constructor; auto. constructor; auto.
+  eapply sig_function_translated; eauto.
+  eapply match_callstate with (cunit := cunit'); eauto.
+  red; intros. eapply match_cont_call with (cunit := cunit); eauto. 
 + (* direct *)
   intros [b [U V]].
   exploit sel_exprlist_correct; eauto. intros [vargs' [C D]].
-  exploit functions_translated; eauto. intros (fd' & X & Y).
+  exploit functions_translated; eauto. intros (cunit' & fd' & X & Y & Z).
   left; econstructor; split.
   econstructor; eauto.
   subst vf. econstructor; eauto. rewrite symbols_preserved; eauto.
-  apply sig_function_translated; auto.
-  constructor; auto. constructor; auto.
+  eapply sig_function_translated; eauto.
+  eapply match_callstate with (cunit := cunit'); eauto.
+  red; intros; eapply match_cont_call with (cunit := cunit); eauto. 
 + (* turned into Sbuiltin *)
   intros EQ. subst fd.
   exploit sel_builtin_args_correct; eauto. intros [vargs' [C D]].
@@ -819,43 +984,44 @@ Proof.
   erewrite <- stackspace_function_translated in P by eauto.
   exploit sel_expr_correct; eauto. intros [vf' [A B]].
   exploit sel_exprlist_correct; eauto. intros [vargs' [C D]].
-  exploit functions_translated; eauto. intros [fd' [E F]].
+  exploit functions_translated; eauto. intros (cunit' & fd' & E & F & G).
   left; econstructor; split.
-  exploit classify_call_correct; eauto.
-  destruct (classify_call ge a) as [ | id | ef]; intros.
-  econstructor; eauto. econstructor; eauto. apply sig_function_translated; auto.
+  exploit classify_call_correct. eexact LINK. eauto. eauto. 
+  destruct (classify_call (prog_defmap cunit)) as [ | id | ef]; intros.
+  econstructor; eauto. econstructor; eauto. eapply sig_function_translated; eauto.
   destruct H2 as [b [U V]]. subst vf. inv B.
-  econstructor; eauto. econstructor; eauto. rewrite symbols_preserved; eauto. apply sig_function_translated; auto.
-  econstructor; eauto. econstructor; eauto. apply sig_function_translated; auto.
-  constructor; auto. apply call_cont_commut; auto.
+  econstructor; eauto. econstructor; eauto. rewrite symbols_preserved; eauto. eapply sig_function_translated; eauto.
+  econstructor; eauto. econstructor; eauto. eapply sig_function_translated; eauto.
+  eapply match_callstate with (cunit := cunit'); eauto.
+  eapply call_cont_commut; eauto.
 - (* Sbuiltin *)
   exploit sel_builtin_args_correct; eauto. intros [vargs' [P Q]].
   exploit external_call_mem_extends; eauto.
   intros [vres' [m2 [A [B [C D]]]]].
   left; econstructor; split.
-  econstructor. eauto. eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
-  constructor; auto. apply sel_builtin_res_correct; auto.
+  econstructor. eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+  econstructor; eauto. apply sel_builtin_res_correct; auto.
 - (* Seq *)
   left; econstructor; split.
-  constructor. constructor; auto. constructor; auto.
+  constructor.
+  econstructor; eauto. constructor; auto.
 - (* Sifthenelse *)
   exploit sel_expr_correct; eauto. intros [v' [A B]].
   assert (Val.bool_of_val v' b). inv B. auto. inv H0.
   left; exists (State f' (if b then x else x0) k' sp e' m'); split.
   econstructor; eauto. eapply eval_condexpr_of_expr; eauto.
-  constructor; auto. destruct b; auto.
+  econstructor; eauto. destruct b; auto.
 - (* Sloop *)
-  left; econstructor; split. constructor. constructor; auto.
+  left; econstructor; split. constructor. econstructor; eauto.
   constructor; auto. simpl; rewrite EQ; auto.
 - (* Sblock *)
-  left; econstructor; split. constructor. constructor; auto. constructor; auto.
+  left; econstructor; split. constructor. econstructor; eauto. constructor; auto.
 - (* Sexit seq *)
-  inv MC. left; econstructor; split. constructor. constructor; auto.
+  inv MC. left; econstructor; split. constructor. econstructor; eauto.
 - (* Sexit0 block *)
-  inv MC. left; econstructor; split. constructor. constructor; auto.
+  inv MC. left; econstructor; split. constructor. econstructor; eauto.
 - (* SexitS block *)
-  inv MC. left; econstructor; split. constructor. constructor; auto.
+  inv MC. left; econstructor; split. constructor. econstructor; eauto.
 - (* Sswitch *)
   inv H0; simpl in TS.
 + set (ct := compile_switch Int.modulus default cases) in *.
@@ -863,69 +1029,70 @@ Proof.
   exploit sel_expr_correct; eauto. intros [v' [A B]]. inv B.
   left; econstructor; split.
   econstructor. eapply sel_switch_int_correct; eauto.
-  constructor; auto.
+  econstructor; eauto.
 + set (ct := compile_switch Int64.modulus default cases) in *.
   destruct (validate_switch Int64.modulus default cases ct) eqn:VALID; inv TS.
   exploit sel_expr_correct; eauto. intros [v' [A B]]. inv B.
   left; econstructor; split.
   econstructor. eapply sel_switch_long_correct; eauto.
-  constructor; auto.
+  econstructor; eauto.
 - (* Sreturn None *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]].
   erewrite <- stackspace_function_translated in P by eauto.
   left; econstructor; split.
   econstructor. simpl; eauto.
-  constructor; auto. apply call_cont_commut; auto.
+  econstructor; eauto. eapply call_cont_commut; eauto.
 - (* Sreturn Some *)
   exploit Mem.free_parallel_extends; eauto. intros [m2' [P Q]].
   erewrite <- stackspace_function_translated in P by eauto.
   exploit sel_expr_correct; eauto. intros [v' [A B]].
   left; econstructor; split.
   econstructor; eauto.
-  constructor; auto. apply call_cont_commut; auto.
+  econstructor; eauto. eapply call_cont_commut; eauto.
 - (* Slabel *)
-  left; econstructor; split. constructor. constructor; auto.
+  left; econstructor; split. constructor. econstructor; eauto.
 - (* Sgoto *)
-  assert (sel_stmt hf ge (Cminor.fn_body f) = OK (fn_body f')).
+  assert (sel_stmt (prog_defmap cunit) hf (Cminor.fn_body f) = OK (fn_body f')).
   { monadInv TF; simpl; auto. }
-  exploit (find_label_commut lbl (Cminor.fn_body f) (Cminor.call_cont k)).
-    apply call_cont_commut; eauto. eauto.
+  exploit (find_label_commut cunit hf lbl (Cminor.fn_body f) (Cminor.call_cont k)).
+    eapply call_cont_commut; eauto. eauto.
   rewrite H.
   destruct (find_label lbl (fn_body f') (call_cont k'0))
   as [[s'' k'']|] eqn:?; intros; try contradiction.
   destruct H1.
   left; econstructor; split.
   econstructor; eauto.
-  constructor; auto.
+  econstructor; eauto.
 - (* internal function *)
+  destruct TF as (hf & HF & TF). specialize (MC cunit hf). 
   monadInv TF. generalize EQ; intros TF; monadInv TF.
   exploit Mem.alloc_extends. eauto. eauto. apply Zle_refl. apply Zle_refl.
   intros [m2' [A B]].
   left; econstructor; split.
   econstructor; simpl; eauto.
-  constructor; simpl; auto. apply set_locals_lessdef. apply set_params_lessdef; auto.
+  econstructor; simpl; eauto. apply set_locals_lessdef. apply set_params_lessdef; auto.
 - (* external call *)
+  destruct TF as (hf & HF & TF). 
   monadInv TF.
   exploit external_call_mem_extends; eauto.
   intros [vres' [m2 [A [B [C D]]]]].
   left; econstructor; split.
-  econstructor. eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
-  constructor; auto.
+  econstructor. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+  econstructor; eauto.
 - (* external call turned into a Sbuiltin *)
   exploit external_call_mem_extends; eauto.
   intros [vres' [m2 [A [B [C D]]]]].
   left; econstructor; split.
-  econstructor. eauto. eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
-  constructor; auto.
+  econstructor. eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+  econstructor; eauto.
 - (* return *)
+  apply match_call_cont_cont in MC. destruct MC as (cunit0 & hf0 & MC). 
   inv MC.
   left; econstructor; split.
   econstructor.
-  constructor; auto. destruct optid; simpl; auto. apply set_var_lessdef; auto.
+  econstructor; eauto. destruct optid; simpl; auto. apply set_var_lessdef; auto.
 - (* return of an external call turned into a Sbuiltin *)
-  right; split. simpl; omega. split. auto. constructor; auto.
+  right; split. simpl; omega. split. auto. econstructor; eauto.
   apply sel_builtin_res_correct; auto.
 Qed.
 
@@ -933,118 +1100,49 @@ Lemma sel_initial_states:
   forall S, Cminor.initial_state prog S ->
   exists R, initial_state tprog R /\ match_states S R.
 Proof.
-  induction 1.
-  exploit function_ptr_translated; eauto. intros (f' & A & B).
+  destruct 1.
+  exploit function_ptr_translated; eauto. intros (cu & f' & A & B & C).
   econstructor; split.
   econstructor.
-  eapply Genv.init_mem_transf_partial; eauto.
-  simpl. fold tge. rewrite symbols_preserved.
-  erewrite transform_partial_program_main by eauto. eexact H0.
-  eauto.
-  rewrite <- H2. apply sig_function_translated; auto.
-  constructor; auto. constructor. apply Mem.extends_refl.
+  eapply (Genv.init_mem_match TRANSF); eauto.
+  rewrite (match_program_main TRANSF). fold tge. rewrite symbols_preserved. eauto.
+  eexact A.
+  rewrite <- H2. eapply sig_function_translated; eauto.
+  econstructor; eauto. red; intros; constructor. apply Mem.extends_refl.
 Qed.
 
 Lemma sel_final_states:
   forall S R r,
   match_states S R -> Cminor.final_state S r -> final_state R r.
 Proof.
-  intros. inv H0. inv H. inv MC. inv LD. constructor.
-Qed.
-
-End PRESERVATION.
-
-(** Processing of helper functions *)
-
-Lemma record_globdefs_sound:
-  forall p id fd,
-  (record_globdefs p)!id = Some (Gfun fd) ->
-  exists b, Genv.find_symbol (Genv.globalenv p) id = Some b
-         /\ Genv.find_funct_ptr (Genv.globalenv p) b = Some fd.
-Proof.
-  intros until fd.
-  set (P := fun (m: PTree.t globdef) (ge: Genv.t Cminor.fundef unit) =>
-               m!id = Some (Gfun fd) ->
-               exists b, Genv.find_symbol ge id = Some b
-                      /\ Genv.find_funct_ptr ge b = Some fd).
-  assert (REC: forall gl m ge,
-             P m ge ->
-             P (fold_left record_globdef gl m) (Genv.add_globals ge gl)).
-  {
-    induction gl; simpl; intros.
-  - auto.
-  - apply IHgl. red. destruct a as [id1 gd1]; simpl; intros.
-    unfold Genv.find_symbol; simpl. rewrite PTree.gsspec. destruct (peq id id1).
-    + subst id1. exists (Genv.genv_next ge); split; auto.
-      replace gd1 with (@Gfun Cminor.fundef unit fd).
-      unfold Genv.find_funct_ptr; simpl. apply PTree.gss.
-      destruct (globdef_of_interest gd1).
-      rewrite PTree.gss in H0; congruence.
-      rewrite PTree.grs in H0; congruence.
-    + assert (m!id = Some (Gfun fd)).
-      { destruct (globdef_of_interest gd1).
-        rewrite PTree.gso in H0; auto.
-        rewrite PTree.gro in H0; auto. }
-      exploit H; eauto. intros (b & A & B).
-      exists b; split; auto. unfold Genv.find_funct_ptr; simpl.
-      destruct gd1; auto. rewrite PTree.gso; auto.
-      apply Plt_ne. eapply Genv.genv_symb_range; eauto.
-  }
-  eapply REC. red; intros. rewrite PTree.gempty in H; discriminate.
-Qed.
-
-Lemma lookup_helper_correct_1:
-  forall globs name sg id,
-  lookup_helper globs name sg = OK id ->
-  globs!id = Some (Gfun (External (EF_external name sg))).
-Proof.
-  intros.
-  set (P := fun (m: PTree.t globdef) res => res = Some id -> m!id = Some(Gfun(External (EF_external name sg)))).
-  assert (P globs (PTree.fold (lookup_helper_aux name sg) globs None)).
-  { apply PTree_Properties.fold_rec; red; intros.
-  - rewrite <- H0. apply H1; auto.
-  - discriminate.
-  - assert (EITHER: k = id /\ v = Gfun (External (EF_external name sg))
-                \/  a = Some id).
-    { unfold lookup_helper_aux in H3. destruct v; auto. destruct f; auto. destruct e; auto.
-      destruct (String.string_dec name name0); auto.
-      destruct (signature_eq sg sg0); auto.
-      inversion H3. left; split; auto. repeat f_equal; auto. }
-    destruct EITHER as [[X Y] | X].
-    subst k v. apply PTree.gss.
-    apply H2 in X. rewrite PTree.gso by congruence. auto.
-  }
-  red in H0. unfold lookup_helper in H.
-  destruct (PTree.fold (lookup_helper_aux name sg) globs None); inv H. auto.
+  intros. inv H0. inv H.
+  apply match_call_cont_cont in MC. destruct MC as (cunit0 & hf0 & MC). 
+  inv MC. inv LD. constructor.
 Qed.
 
-Lemma lookup_helper_correct:
-  forall p name sg id,
-  lookup_helper (record_globdefs p) name sg = OK id ->
-  helper_declared (Genv.globalenv p) id name sg.
+Theorem transf_program_correct:
+  forward_simulation (Cminor.semantics prog) (CminorSel.semantics tprog).
 Proof.
-  intros. apply lookup_helper_correct_1 in H. apply record_globdefs_sound in H. auto.
+  apply forward_simulation_opt with (match_states := match_states) (measure := measure).
+  apply senv_preserved. 
+  apply sel_initial_states; auto.
+  apply sel_final_states; auto.
+  apply sel_step_correct; auto.
 Qed.
 
-Theorem get_helpers_correct:
-  forall p hf,
-  get_helpers p = OK hf -> helper_functions_declared (Genv.globalenv p) hf.
-Proof.
-  intros. monadInv H. red; simpl. auto 20 using lookup_helper_correct.
-Qed.
+End PRESERVATION.
 
-(** All together *)
+(** ** Commutation with linking *)
 
-Theorem transf_program_correct:
-  forall prog tprog,
-  sel_program prog = OK tprog ->
-  forward_simulation (Cminor.semantics prog) (CminorSel.semantics tprog).
+Instance TransfSelectionLink : TransfLink match_prog.
 Proof.
-  intros. unfold sel_program in H.
-  destruct (get_helpers prog) as [hf|] eqn:G; simpl in H; try discriminate.
-  apply forward_simulation_opt with (match_states := match_states prog tprog hf) (measure := measure).
-  eapply public_preserved; eauto.
-  apply sel_initial_states; auto.
-  apply sel_final_states; auto.
-  apply sel_step_correct; auto. eapply get_helpers_correct; eauto.
+  red; intros. destruct (link_linkorder _ _ _ H) as [LO1 LO2].
+  eapply link_match_program; eauto.
+  intros. elim H3; intros hf1 [A1 B1]. elim H4; intros hf2 [A2 B2].
+Local Transparent Linker_fundef.
+  simpl in *. destruct f1, f2; simpl in *; monadInv B1; monadInv B2; simpl.
+- discriminate.
+- destruct e; inv H2. econstructor; eauto.
+- destruct e; inv H2. econstructor; eauto.
+- destruct (external_function_eq e e0); inv H2. econstructor; eauto. 
 Qed.
diff --git a/backend/Stacking.v b/backend/Stacking.v
index ab67e213..cf797a11 100644
--- a/backend/Stacking.v
+++ b/backend/Stacking.v
@@ -12,18 +12,10 @@
 
 (** Layout of activation records; translation from Linear to Mach. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Op.
-Require Import Locations.
-Require Import Linear.
-Require Import Bounds.
-Require Import Mach.
-Require Import Conventions.
-Require Import Stacklayout.
-Require Import Lineartyping.
+Require Import Coqlib Errors.
+Require Import Integers AST.
+Require Import Op Locations Linear Mach.
+Require Import Bounds Conventions Stacklayout Lineartyping.
 
 (** * Layout of activation records *)
 
diff --git a/backend/Stackingproof.v b/backend/Stackingproof.v
index 8becb773..a76fdbba 100644
--- a/backend/Stackingproof.v
+++ b/backend/Stackingproof.v
@@ -14,26 +14,22 @@
 
 (** This file proves semantic preservation for the [Stacking] pass. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Op.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Locations.
-Require Import LTL.
-Require Import Linear.
-Require Import Lineartyping.
-Require Import Mach.
-Require Import Bounds.
-Require Import Conventions.
-Require Import Stacklayout.
+Require Import Coqlib Errors.
+Require Import Integers AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import LTL Op Locations Linear Mach.
+Require Import Bounds Conventions Stacklayout Lineartyping.
 Require Import Stacking.
 
+Definition match_prog (p: Linear.program) (tp: Mach.program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
+
 (** * Properties of frame offsets *)
 
 Lemma typesize_typesize:
@@ -61,11 +57,10 @@ Let step := Mach.step return_address_offset.
 
 Variable prog: Linear.program.
 Variable tprog: Mach.program.
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
-
 Section FRAME_PROPERTIES.
 
 Variable f: Linear.function.
@@ -2261,44 +2256,26 @@ Qed.
 (** Preservation / translation of global symbols and functions. *)
 
 Lemma symbols_preserved:
-  forall id, Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall id, Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.public_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_var_info_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall v f,
   Genv.find_funct ge v = Some f ->
   exists tf,
   Genv.find_funct tge v = Some tf /\ transf_fundef f = OK tf.
-Proof
-  (Genv.find_funct_transf_partial transf_fundef _ TRANSF).
+Proof (Genv.find_funct_transf_partial TRANSF).
 
 Lemma function_ptr_translated:
-  forall v f,
-  Genv.find_funct_ptr ge v = Some f ->
+  forall b f,
+  Genv.find_funct_ptr ge b = Some f ->
   exists tf,
-  Genv.find_funct_ptr tge v = Some tf /\ transf_fundef f = OK tf.
-Proof
-  (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
+  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf.
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
 
 Lemma sig_preserved:
   forall f tf, transf_fundef f = OK tf -> Mach.funsig tf = Linear.funsig f.
@@ -2749,8 +2726,7 @@ Proof.
   econstructor; split.
   apply plus_one. econstructor; eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto with coqlib.
   eapply match_stack_change_extcall; eauto.
   apply Plt_Ple. change (Mem.valid_block m sp0). eapply agree_valid_linear; eauto.
@@ -2858,8 +2834,7 @@ Proof.
   intros [j' [res' [m1' [A [B [C [D [E [F G]]]]]]]]].
   econstructor; split.
   apply plus_one. eapply exec_function_external; eauto.
-  eapply external_call_symbols_preserved'; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   econstructor; eauto.
   apply match_stacks_change_bounds with (Mem.nextblock m) (Mem.nextblock m'0).
   inv H0; inv A. eapply match_stack_change_extcall; eauto. apply Ple_refl. apply Ple_refl.
@@ -2884,8 +2859,8 @@ Proof.
   exploit function_ptr_translated; eauto. intros [tf [FIND TR]].
   econstructor; split.
   econstructor.
-  eapply Genv.init_mem_transf_partial; eauto.
-  rewrite (transform_partial_program_main _ _ TRANSF).
+  eapply (Genv.init_mem_transf_partial TRANSF); eauto.
+  rewrite (match_program_main TRANSF).
   rewrite symbols_preserved. eauto.
   econstructor; eauto.
   eapply Genv.initmem_inject; eauto.
@@ -2913,9 +2888,10 @@ Qed.
 Lemma wt_prog:
   forall i fd, In (i, Gfun fd) prog.(prog_defs) -> wt_fundef fd.
 Proof.
-  intros. exploit transform_partial_program_succeeds; eauto.
-  intros [tfd TF]. destruct fd; simpl in *.
-- monadInv TF. unfold transf_function in EQ.
+  intros.
+  exploit list_forall2_in_left. eexact (proj1 TRANSF). eauto.
+  intros ([i' g] & P & Q & R). simpl in *. inv R. destruct fd; simpl in *.
+- monadInv H2. unfold transf_function in EQ.
   destruct (wt_function f). auto. discriminate.
 - auto.
 Qed.
@@ -2925,7 +2901,7 @@ Theorem transf_program_correct:
 Proof.
   set (ms := fun s s' => wt_state s /\ match_states s s').
   eapply forward_simulation_plus with (match_states := ms).
-- exact public_preserved.
+- apply senv_preserved.
 - intros. exploit transf_initial_states; eauto. intros [st2 [A B]].
   exists st2; split; auto. split; auto.
   apply wt_initial_state with (prog := prog); auto. exact wt_prog.
diff --git a/backend/Tailcall.v b/backend/Tailcall.v
index e8ce9e25..939abeea 100644
--- a/backend/Tailcall.v
+++ b/backend/Tailcall.v
@@ -12,13 +12,7 @@
 
 (** Recognition of tail calls. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Registers.
-Require Import Op.
-Require Import RTL.
-Require Import Conventions.
+Require Import Coqlib Maps AST Registers Op RTL Conventions.
 
 (** An [Icall] instruction that stores its result in register [rreg]
   can be turned into a tail call if:
@@ -95,8 +89,7 @@ Definition transf_instr (f: function) (pc: node) (instr: instruction) :=
   end.
 
 (** A function is transformed only if its stack block is empty,
-  as explained above.  Moreover, we can turn tail calls off
-  using a compilation option. *)
+    as explained above.  *)
 
 Definition transf_function (f: function) : function :=
   if zeq f.(fn_stacksize) 0
diff --git a/backend/Tailcallproof.v b/backend/Tailcallproof.v
index 7e7b7b53..793dc861 100644
--- a/backend/Tailcallproof.v
+++ b/backend/Tailcallproof.v
@@ -12,20 +12,9 @@
 
 (** Recognition of tail calls: correctness proof *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Op.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Registers.
-Require Import RTL.
-Require Import Conventions.
-Require Import Tailcall.
+Require Import Coqlib Maps Integers AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Registers RTL Conventions Tailcall.
 
 (** * Syntactic properties of the code transformation *)
 
@@ -212,36 +201,42 @@ Qed.
 
 (** * Proof of semantic preservation *)
 
+Definition match_prog (p tp: RTL.program) :=
+  match_program (fun cu f tf => tf = transf_fundef f) eq p tp.
+
+Lemma transf_program_match:
+  forall p, match_prog p (transf_program p).
+Proof.
+  intros. apply match_transform_program; auto.
+Qed.
+
 Section PRESERVATION.
 
-Variable prog: program.
-Let tprog := transf_program prog.
+Variable prog tprog: program.
+Hypothesis TRANSL: match_prog prog tprog.
+
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof (Genv.find_symbol_transf transf_fundef prog).
-
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof (Genv.public_symbol_transf transf_fundef prog).
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof (Genv.find_var_info_transf transf_fundef prog).
+Proof (Genv.find_symbol_transf TRANSL).
 
 Lemma functions_translated:
   forall (v: val) (f: RTL.fundef),
   Genv.find_funct ge v = Some f ->
   Genv.find_funct tge v = Some (transf_fundef f).
-Proof (@Genv.find_funct_transf _ _ _ transf_fundef prog).
+Proof (Genv.find_funct_transf TRANSL).
 
 Lemma funct_ptr_translated:
   forall (b: block) (f: RTL.fundef),
   Genv.find_funct_ptr ge b = Some f ->
   Genv.find_funct_ptr tge b = Some (transf_fundef f).
-Proof (@Genv.find_funct_ptr_transf _ _ _ transf_fundef prog).
+Proof (Genv.find_funct_ptr_transf TRANSL).
+
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_transf TRANSL).
 
 Lemma sig_preserved:
   forall f, funsig (transf_fundef f) = funsig f.
@@ -409,15 +404,15 @@ Lemma transf_step_correct:
 Proof.
   induction 1; intros; inv MS; EliminatedInstr.
 
-(* nop *)
+- (* nop *)
   TransfInstr. left. econstructor; split.
   eapply exec_Inop; eauto. constructor; auto.
-(* eliminated nop *)
+- (* eliminated nop *)
   assert (s0 = pc') by congruence. subst s0.
   right. split. simpl. omega. split. auto.
   econstructor; eauto.
 
-(* op *)
+- (* op *)
   TransfInstr.
   assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto.
   exploit eval_operation_lessdef; eauto.
@@ -426,12 +421,12 @@ Proof.
   eapply exec_Iop; eauto.  rewrite <- EVAL'.
   apply eval_operation_preserved. exact symbols_preserved.
   econstructor; eauto. apply set_reg_lessdef; auto.
-(* eliminated move *)
+- (* eliminated move *)
   rewrite H1 in H. clear H1. inv H.
   right. split. simpl. omega. split. auto.
   econstructor; eauto. simpl in H0. rewrite PMap.gss. congruence.
 
-(* load *)
+- (* load *)
   TransfInstr.
   assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto.
   exploit eval_addressing_lessdef; eauto.
@@ -443,7 +438,7 @@ Proof.
   apply eval_addressing_preserved. exact symbols_preserved. eauto.
   econstructor; eauto. apply set_reg_lessdef; auto.
 
-(* store *)
+- (* store *)
   TransfInstr.
   assert (Val.lessdef_list (rs##args) (rs'##args)). apply regs_lessdef_regs; auto.
   exploit eval_addressing_lessdef; eauto.
@@ -456,10 +451,10 @@ Proof.
   destruct a; simpl in H1; try discriminate.
   econstructor; eauto.
 
-(* call *)
+- (* call *)
   exploit find_function_translated; eauto. intro FIND'.
   TransfInstr.
-(* call turned tailcall *)
++ (* call turned tailcall *)
   assert ({ m'' | Mem.free m' sp0 0 (fn_stacksize (transf_function f)) = Some m''}).
     apply Mem.range_perm_free. rewrite stacksize_preserved. rewrite H7.
     red; intros; omegaContradiction.
@@ -469,13 +464,13 @@ Proof.
   constructor. eapply match_stackframes_tail; eauto. apply regs_lessdef_regs; auto.
   eapply Mem.free_right_extends; eauto.
   rewrite stacksize_preserved. rewrite H7. intros. omegaContradiction.
-(* call that remains a call *)
++ (* call that remains a call *)
   left. exists (Callstate (Stackframe res (transf_function f) (Vptr sp0 Int.zero) pc' rs' :: s')
                           (transf_fundef fd) (rs'##args) m'); split.
   eapply exec_Icall; eauto. apply sig_preserved.
   constructor. constructor; auto. apply regs_lessdef_regs; auto. auto.
 
-(* tailcall *)
+- (* tailcall *)
   exploit find_function_translated; eauto. intro FIND'.
   exploit Mem.free_parallel_extends; eauto. intros [m'1 [FREE EXT]].
   TransfInstr.
@@ -484,7 +479,7 @@ Proof.
   rewrite stacksize_preserved; auto.
   constructor. auto.  apply regs_lessdef_regs; auto. auto.
 
-(* builtin *)
+- (* builtin *)
   TransfInstr.
   exploit (@eval_builtin_args_lessdef _ ge (fun r => rs#r) (fun r => rs'#r)); eauto.
   intros (vargs' & P & Q).
@@ -493,25 +488,24 @@ Proof.
   left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) pc' (regmap_setres res v' rs') m'1); split.
   eapply exec_Ibuiltin; eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto. apply set_res_lessdef; auto.
 
-(* cond *)
+- (* cond *)
   TransfInstr.
   left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) (if b then ifso else ifnot) rs' m'); split.
   eapply exec_Icond; eauto.
   apply eval_condition_lessdef with (rs##args) m; auto. apply regs_lessdef_regs; auto.
   constructor; auto.
 
-(* jumptable *)
+- (* jumptable *)
   TransfInstr.
   left. exists (State s' (transf_function f) (Vptr sp0 Int.zero) pc' rs' m'); split.
   eapply exec_Ijumptable; eauto.
   generalize (RLD arg). rewrite H0. intro. inv H2. auto.
   constructor; auto.
 
-(* return *)
+- (* return *)
   exploit Mem.free_parallel_extends; eauto. intros [m'1 [FREE EXT]].
   TransfInstr.
   left. exists (Returnstate s' (regmap_optget or Vundef rs') m'1); split.
@@ -520,21 +514,21 @@ Proof.
   destruct or; simpl. apply RLD. constructor.
   auto.
 
-(* eliminated return None *)
+- (* eliminated return None *)
   assert (or = None) by congruence. subst or.
   right. split. simpl. omega. split. auto.
   constructor. auto.
   simpl. constructor.
   eapply Mem.free_left_extends; eauto.
 
-(* eliminated return Some *)
+- (* eliminated return Some *)
   assert (or = Some r) by congruence. subst or.
   right. split. simpl. omega. split. auto.
   constructor. auto.
   simpl. auto.
   eapply Mem.free_left_extends; eauto.
 
-(* internal call *)
+- (* internal call *)
   exploit Mem.alloc_extends; eauto.
     instantiate (1 := 0). omega.
     instantiate (1 := fn_stacksize f). omega.
@@ -549,22 +543,21 @@ Proof.
   rewrite EQ2. rewrite EQ3. constructor; auto.
   apply regs_lessdef_init_regs. auto.
 
-(* external call *)
+- (* external call *)
   exploit external_call_mem_extends; eauto.
   intros [res' [m2' [A [B [C D]]]]].
   left. exists (Returnstate s' res' m2'); split.
   simpl. econstructor; eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   constructor; auto.
 
-(* returnstate *)
+- (* returnstate *)
   inv H2.
-(* synchronous return in both programs *)
++ (* synchronous return in both programs *)
   left. econstructor; split.
   apply exec_return.
   constructor; auto. apply set_reg_lessdef; auto.
-(* return instr in source program, eliminated because of tailcall *)
++ (* return instr in source program, eliminated because of tailcall *)
   right. split. unfold measure. simpl length.
   change (S (length s) * (niter + 2))%nat
    with ((niter + 2) + (length s) * (niter + 2))%nat.
@@ -581,10 +574,10 @@ Proof.
   intros. inv H.
   exploit funct_ptr_translated; eauto. intro FIND.
   exists (Callstate nil (transf_fundef f) nil m0); split.
-  econstructor; eauto. apply Genv.init_mem_transf. auto.
+  econstructor; eauto. apply (Genv.init_mem_transf TRANSL). auto.
   replace (prog_main tprog) with (prog_main prog).
   rewrite symbols_preserved. eauto.
-  reflexivity.
+  symmetry; eapply match_program_main; eauto. 
   rewrite <- H3. apply sig_preserved.
   constructor. constructor. constructor. apply Mem.extends_refl.
 Qed.
@@ -604,7 +597,7 @@ Theorem transf_program_correct:
   forward_simulation (RTL.semantics prog) (RTL.semantics tprog).
 Proof.
   eapply forward_simulation_opt with (measure := measure); eauto.
-  eexact public_preserved.
+  apply senv_preserved. 
   eexact transf_initial_states.
   eexact transf_final_states.
   exact transf_step_correct.
@@ -612,4 +605,3 @@ Qed.
 
 End PRESERVATION.
 
-
diff --git a/backend/Tunneling.v b/backend/Tunneling.v
index fa7ff787..3374d5b4 100644
--- a/backend/Tunneling.v
+++ b/backend/Tunneling.v
@@ -12,9 +12,7 @@
 
 (** Branch tunneling (optimization of branches to branches). *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import UnionFind.
+Require Import Coqlib Maps UnionFind.
 Require Import AST.
 Require Import LTL.
 
diff --git a/backend/Tunnelingproof.v b/backend/Tunnelingproof.v
index 22f0521e..4f1f8143 100644
--- a/backend/Tunnelingproof.v
+++ b/backend/Tunnelingproof.v
@@ -12,20 +12,21 @@
 
 (** Correctness proof for the branch tunneling optimization. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import UnionFind.
-Require Import AST.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Locations.
-Require Import LTL.
+Require Import Coqlib Maps UnionFind.
+Require Import AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Locations LTL.
 Require Import Tunneling.
 
+Definition match_prog (p tp: program) :=
+  match_program (fun ctx f tf => tf = tunnel_fundef f) eq p tp.
+
+Lemma transf_program_match:
+  forall p, match_prog p (tunnel_program p).
+Proof.
+  intros. eapply match_transform_program; eauto.
+Qed.
+
 (** * Properties of the branch map computed using union-find. *)
 
 (** A variant of [record_goto] that also incrementally computes a measure [f: node -> nat]
@@ -138,8 +139,8 @@ Qed.
 
 Section PRESERVATION.
 
-Variable prog: program.
-Let tprog := tunnel_program prog.
+Variables prog tprog: program.
+Hypothesis TRANSL: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
@@ -147,27 +148,22 @@ Lemma functions_translated:
   forall v f,
   Genv.find_funct ge v = Some f ->
   Genv.find_funct tge v = Some (tunnel_fundef f).
-Proof (@Genv.find_funct_transf _ _ _ tunnel_fundef prog).
+Proof (Genv.find_funct_transf TRANSL).
 
 Lemma function_ptr_translated:
   forall v f,
   Genv.find_funct_ptr ge v = Some f ->
   Genv.find_funct_ptr tge v = Some (tunnel_fundef f).
-Proof (@Genv.find_funct_ptr_transf _ _ _ tunnel_fundef prog).
+Proof (Genv.find_funct_ptr_transf TRANSL).
 
 Lemma symbols_preserved:
   forall id,
   Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof (@Genv.find_symbol_transf _ _ _ tunnel_fundef prog).
-
-Lemma public_preserved:
-  forall id,
-  Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof (@Genv.public_symbol_transf _ _ _ tunnel_fundef prog).
+Proof (Genv.find_symbol_transf TRANSL).
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof (@Genv.find_var_info_transf _ _ _ tunnel_fundef prog).
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_transf TRANSL).
 
 Lemma sig_preserved:
   forall f, funsig (tunnel_fundef f) = funsig f.
@@ -340,8 +336,7 @@ Proof.
   left; simpl; econstructor; split.
   eapply exec_Lbuiltin; eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved. eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved. apply senv_preserved. eauto.
   econstructor; eauto.
 
   (* Lbranch (preserved) *)
@@ -372,8 +367,7 @@ Proof.
   (* external function *)
   left; simpl; econstructor; split.
   eapply exec_function_external; eauto.
-  eapply external_call_symbols_preserved'; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   simpl. econstructor; eauto.
   (* return *)
   inv H3. inv H1.
@@ -389,8 +383,8 @@ Proof.
   intros. inversion H.
   exists (Callstate nil (tunnel_fundef f) (Locmap.init Vundef) m0); split.
   econstructor; eauto.
-  apply Genv.init_mem_transf; auto.
-  change (prog_main tprog) with (prog_main prog).
+  apply (Genv.init_mem_transf TRANSL); auto.
+  rewrite (match_program_main TRANSL).
   rewrite symbols_preserved. eauto.
   apply function_ptr_translated; auto.
   rewrite <- H3. apply sig_preserved.
@@ -408,7 +402,7 @@ Theorem transf_program_correct:
   forward_simulation (LTL.semantics prog) (LTL.semantics tprog).
 Proof.
   eapply forward_simulation_opt.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   eexact tunnel_step_correct.
diff --git a/backend/Unusedglob.v b/backend/Unusedglob.v
index 8725c9af..916e111b 100644
--- a/backend/Unusedglob.v
+++ b/backend/Unusedglob.v
@@ -12,16 +12,9 @@
 
 (** Elimination of unreferenced static definitions *)
 
-Require Import FSets.
-Require Import Coqlib.
-Require Import Ordered.
-Require Import Maps.
-Require Import Iteration.
-Require Import AST.
-Require Import Errors.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
+Require Import FSets Coqlib Maps Ordered Iteration Errors.
+Require Import AST Linking.
+Require Import Op Registers RTL.
 
 Local Open Scope string_scope.
 
@@ -90,6 +83,15 @@ Definition add_ref_definition (pm: prog_map) (id: ident) (w: workset): workset :
   | Some (Gvar gv) => add_ref_globvar gv w
   end.
 
+(** The initial workset is composed of all public definitions of the compilation unit,
+    plus the "main" entry point. *)
+
+Definition initial_workset (p: program): workset :=
+  add_workset p.(prog_main)
+    (List.fold_left (fun w id => add_workset id w)
+                    p.(prog_public)
+                    {| w_seen := IS.empty; w_todo := nil |}).
+
 (** Traversal of the dependency graph. *)
 
 Definition iter_step (pm: prog_map) (w: workset) : IS.t + workset :=
@@ -100,20 +102,7 @@ Definition iter_step (pm: prog_map) (w: workset) : IS.t + workset :=
       inr _ (add_ref_definition pm id {| w_seen := w.(w_seen); w_todo := rem |})
   end.
 
-Definition initial_workset (p: program): workset :=
-  add_workset p.(prog_main)
-    (List.fold_left (fun w id => add_workset id w)
-                    p.(prog_public)
-                    {| w_seen := IS.empty; w_todo := nil |}).
-
-Definition add_def_prog_map (pm: prog_map) (id_df: ident * globdef fundef unit) : prog_map :=
-  PTree.set (fst id_df) (snd id_df) pm.
-
-Definition program_map (p: program) : prog_map :=
-  List.fold_left add_def_prog_map p.(prog_defs) (PTree.empty _).
-
-Definition used_globals (p: program) : option IS.t :=
-  let pm := program_map p in
+Definition used_globals (p: program) (pm: prog_map) : option IS.t :=
   PrimIter.iterate _ _ (iter_step pm) (initial_workset p).
 
 (** * Elimination of unreferenced global definitions *)
@@ -130,12 +119,23 @@ Fixpoint filter_globdefs (used: IS.t) (accu defs: list (ident * globdef fundef u
       else filter_globdefs used accu defs'
   end.
 
+(** To ensure compatibility with linking, we must ensure that all the
+  global names referenced are defined in the compilation unit, with
+  the possible exception of the [prog_main] name. *)
+
+Definition global_defined (p: program) (pm: prog_map) (id: ident) : bool :=
+  match pm!id with Some _ => true | None => ident_eq id (prog_main p) end.
+
 Definition transform_program (p: program) : res program :=
-  match used_globals p with
+  let pm := prog_defmap p in
+  match used_globals p pm with
   | None => Error (msg "Unusedglob: analysis failed")
   | Some used =>
-      OK {| prog_defs := filter_globdefs used nil (List.rev p.(prog_defs));
-            prog_public := p.(prog_public);
-            prog_main := p.(prog_main) |}
+      if IS.for_all (global_defined p pm) used then
+        OK {| prog_defs := filter_globdefs used nil (List.rev p.(prog_defs));
+              prog_public := p.(prog_public);
+              prog_main := p.(prog_main) |}
+      else
+        Error (msg "Unusedglob: reference to undefined global")
   end.
 
diff --git a/backend/Unusedglobproof.v b/backend/Unusedglobproof.v
index 7c1b60a9..bb40a2d3 100644
--- a/backend/Unusedglobproof.v
+++ b/backend/Unusedglobproof.v
@@ -12,28 +12,67 @@
 
 (** Elimination of unreferenced static definitions *)
 
-Require Import FSets.
-Require Import Coqlib.
-Require Import Ordered.
-Require Import Maps.
-Require Import Iteration.
-Require Import AST.
-Require Import Errors.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Events.
-Require Import Smallstep.
-Require Import Op.
-Require Import Registers.
-Require Import RTL.
+Require Import FSets Coqlib Maps Ordered Iteration Errors.
+Require Import AST Linking.
+Require Import Integers Values Memory Globalenvs Events Smallstep.
+Require Import Op Registers RTL.
 Require Import Unusedglob.
 
 Module ISF := FSetFacts.Facts(IS).
 Module ISP := FSetProperties.Properties(IS).
 
-(** * Properties of the analysis *)
+(** * Relational specification of the transformation *)
+
+(** The transformed program is obtained from the original program
+  by keeping only the global definitions that belong to a given
+  set [u] of names.  *)
+
+Record match_prog_1 (u: IS.t) (p tp: program) : Prop := {
+  match_prog_main:
+    tp.(prog_main) = p.(prog_main);
+  match_prog_public:
+    tp.(prog_public) = p.(prog_public);
+  match_prog_def:
+    forall id,
+       (prog_defmap tp)!id = if IS.mem id u then (prog_defmap p)!id else None;
+  match_prog_unique:
+    list_norepet (prog_defs_names tp)
+}.
+
+(** This set [u] (as "used") must be closed under references, and
+  contain the entry point and the public identifiers of the program. *)
+
+Definition ref_function (f: function) (id: ident) : Prop :=
+  exists pc i, f.(fn_code)!pc = Some i /\ In id (ref_instruction i).
+
+Definition ref_fundef (fd: fundef) (id: ident) : Prop :=
+  match fd with Internal f => ref_function f id | External ef => False end.
+
+Definition ref_init (il: list init_data) (id: ident) : Prop :=
+  exists ofs, In (Init_addrof id ofs) il.
+
+Definition ref_def (gd: globdef fundef unit) (id: ident) : Prop :=
+  match gd with
+  | Gfun fd => ref_fundef fd id
+  | Gvar gv => ref_init gv.(gvar_init) id
+  end.
+
+Record valid_used_set (p: program) (u: IS.t) : Prop := {
+  used_closed: forall id gd id',
+    IS.In id u -> (prog_defmap p)!id = Some gd -> ref_def gd id' ->
+    IS.In id' u;
+  used_main:
+    IS.In p.(prog_main) u;
+  used_public: forall id,
+    In id p.(prog_public) -> IS.In id u;
+  used_defined: forall id,
+    IS.In id u -> In id (prog_defs_names p) \/ id = p.(prog_main)
+}.
+
+Definition match_prog (p tp: program) : Prop :=
+  exists u: IS.t, valid_used_set p u /\ match_prog_1 u p tp.
+
+(** * Properties of the static analysis *)
 
 (** Monotonic evolution of the workset. *)
 
@@ -123,7 +162,7 @@ Proof.
   eapply workset_incl_trans. 2: apply add_workset_incl.
   generalize {| w_seen := IS.empty; w_todo := nil |}. induction (prog_public p); simpl; intros.
   apply workset_incl_refl.
-  eapply workset_incl_trans. eapply add_workset_incl. eapply IHl.
+  eapply workset_incl_trans. apply add_workset_incl. apply IHl.
 Qed.
 
 (** Soundness properties for functions that add identifiers to the workset *)
@@ -148,9 +187,6 @@ Proof.
   apply IHl; auto.
 Qed.
 
-Definition ref_function (f: function) (id: ident) : Prop :=
-  exists pc i, f.(fn_code)!pc = Some i /\ In id (ref_instruction i).
-
 Lemma seen_add_ref_function:
   forall id f w,
   ref_function f id -> IS.In id (add_ref_function f w).
@@ -164,15 +200,6 @@ Proof.
     apply H1. exists pc, i; auto.
 Qed.
 
-Definition ref_fundef (fd: fundef) (id: ident) : Prop :=
-  match fd with Internal f => ref_function f id | External ef => False end.
-
-Definition ref_def (gd: globdef fundef unit) (id: ident) : Prop :=
-  match gd with
-  | Gfun fd => ref_fundef fd id
-  | Gvar gv => exists ofs, List.In (Init_addrof id ofs) gv.(gvar_init)
-  end.
-
 Lemma seen_add_ref_definition:
   forall pm id gd id' w,
   pm!id = Some gd -> ref_def gd id' -> IS.In id' (add_ref_definition pm id w).
@@ -198,7 +225,7 @@ Qed.
 Lemma seen_main_initial_workset:
   forall p, IS.In p.(prog_main) (initial_workset p).
 Proof.
-  unfold initial_workset; intros. apply seen_add_workset.
+  intros. apply seen_add_workset.
 Qed.
 
 Lemma seen_public_initial_workset:
@@ -217,19 +244,14 @@ Proof.
   apply H0. auto.
 Qed.
 
-(** * Semantic preservation *)
+(** * Correctness of the transformation with respect to the relational specification *)
 
-Section SOUNDNESS.
-Variable p: program.
-Variable tp: program.
-Hypothesis TRANSF: transform_program p = OK tp.
-Let ge := Genv.globalenv p.
-Let tge := Genv.globalenv tp.
-
-Let pm := program_map p.
+(** Correctness of the dependency graph traversal. *)
 
+Section ANALYSIS.
 
-(** Correctness of the dependency graph traversal. *)
+Variable p: program.
+Let pm := prog_defmap p.
 
 Definition workset_invariant (w: workset) : Prop :=
   forall id gd id',
@@ -264,7 +286,7 @@ Proof.
 Qed.
 
 Theorem used_globals_sound:
-  forall u, used_globals p = Some u -> used_set_closed u.
+  forall u, used_globals p pm = Some u -> used_set_closed u.
 Proof.
   unfold used_globals; intros. eapply PrimIter.iterate_prop with (P := workset_invariant); eauto.
 - intros. apply iter_step_invariant; auto.
@@ -275,7 +297,7 @@ Proof.
 Qed.
 
 Theorem used_globals_incl:
-  forall u, used_globals p = Some u -> IS.Subset (initial_workset p) u.
+  forall u, used_globals p pm = Some u -> IS.Subset (initial_workset p) u.
 Proof.
   unfold used_globals; intros.
   eapply PrimIter.iterate_prop with (P := fun (w: workset) => IS.Subset (initial_workset p) w); eauto.
@@ -286,35 +308,34 @@ Proof.
 - red; auto.
 Qed.
 
-Definition used: IS.t :=
-  match used_globals p with Some u => u | None => IS.empty end.
-
-Remark USED_GLOBALS: used_globals p = Some used.
+Corollary used_globals_valid:
+  forall u,
+  used_globals p pm = Some u ->
+  IS.for_all (global_defined p pm) u = true ->
+  valid_used_set p u.
 Proof.
-  unfold used. unfold transform_program in TRANSF. destruct (used_globals p). auto. discriminate.
+  intros. constructor.
+- intros. eapply used_globals_sound; eauto. 
+- eapply used_globals_incl; eauto. apply seen_main_initial_workset.
+- intros. eapply used_globals_incl; eauto. apply seen_public_initial_workset; auto.
+- intros. apply ISF.for_all_iff in H0.
++ red in H0. apply H0 in H1. unfold global_defined in H1. 
+  destruct pm!id as [g|] eqn:E.
+* left. change id with (fst (id,g)). apply in_map. apply in_prog_defmap; auto.
+* InvBooleans; auto.
++ hnf. simpl; intros; congruence.
 Qed.
 
-Definition kept (id: ident) : Prop := IS.In id used.
+End ANALYSIS.
 
-Theorem kept_closed:
-  forall id gd id',
-  kept id -> pm!id = Some gd -> ref_def gd id' -> kept id'.
-Proof.
-  intros. assert (UC: used_set_closed used) by (apply used_globals_sound; apply USED_GLOBALS).
-  eapply UC; eauto.
-Qed.
+(** Properties of the elimination of unused global definitions. *)
 
-Theorem kept_main:
-  kept p.(prog_main).
-Proof.
-  unfold kept. eapply used_globals_incl; eauto. apply USED_GLOBALS. apply seen_main_initial_workset.
-Qed.
+Section TRANSFORMATION.
 
-Theorem kept_public:
-  forall id, In id p.(prog_public) -> kept id.
-Proof.
-  intros. unfold kept. eapply used_globals_incl; eauto. apply USED_GLOBALS. apply seen_public_initial_workset; auto.
-Qed.
+Variable p: program.
+Variable used: IS.t.
+
+Let add_def (m: prog_map) idg := PTree.set (fst idg) (snd idg) m.
 
 Remark filter_globdefs_accu:
   forall defs accu1 accu2 u,
@@ -333,98 +354,154 @@ Proof.
   intros. rewrite <- filter_globdefs_accu. auto.
 Qed.
 
-Theorem transform_program_charact:
-  forall id, (program_map tp)!id = if IS.mem id used then pm!id else None.
+Lemma filter_globdefs_map_1:
+  forall id l u m1,
+  IS.mem id u = false ->
+  m1!id = None ->
+  (fold_left add_def (filter_globdefs u nil l) m1)!id = None.
 Proof.
-  intros.
-  assert (X: forall l u m1 m2,
-             IS.In id u ->
-             m1!id = m2!id ->
-             (fold_left add_def_prog_map (filter_globdefs u nil l) m1)!id =
-             (fold_left add_def_prog_map (List.rev l) m2)!id).
-  {
-    induction l; simpl; intros.
-    auto.
-    destruct a as [id1 gd1]. rewrite fold_left_app. simpl.
-    destruct (IS.mem id1 u) eqn:MEM.
-    rewrite filter_globdefs_nil. rewrite fold_left_app. simpl.
-    unfold add_def_prog_map at 1 3. simpl.
-    rewrite ! PTree.gsspec. destruct (peq id id1). auto.
-    apply IHl; auto. apply IS.remove_2; auto.
-    unfold add_def_prog_map at 2. simpl. rewrite PTree.gso. apply IHl; auto.
-    red; intros; subst id1.
-    assert (IS.mem id u = true) by (apply IS.mem_1; auto). congruence.
-  }
-  assert (Y: forall l u m1,
-             IS.mem id u = false ->
-             m1!id = None ->
-             (fold_left add_def_prog_map (filter_globdefs u nil l) m1)!id = None).
-  {
-    induction l; simpl; intros.
-    auto.
-    destruct a as [id1 gd1].
-    destruct (IS.mem id1 u) eqn:MEM.
-    rewrite filter_globdefs_nil. rewrite fold_left_app. simpl.
-    unfold add_def_prog_map at 1. simpl. rewrite PTree.gso by congruence. eapply IHl; eauto.
-    rewrite ISF.remove_b. rewrite H; auto.
-    eapply IHl; eauto.
-  }
-  unfold pm, program_map.
-  unfold transform_program in TRANSF; rewrite USED_GLOBALS in TRANSF. inversion TRANSF.
-  simpl. destruct (IS.mem id used) eqn: MEM.
-  erewrite X. rewrite List.rev_involutive. eauto. apply IS.mem_2; auto. auto.
-  apply Y. auto. apply PTree.gempty.
-Qed.
-
-(** Program map and Genv operations *)
-
-Definition genv_progmap_match (ge: genv) (pm: prog_map) : Prop :=
-  forall id,
-  match Genv.find_symbol ge id with
-  | None => pm!id = None
-  | Some b =>
-      match pm!id with
-      | None => False
-      | Some (Gfun fd) => Genv.find_funct_ptr ge b = Some fd
-      | Some (Gvar gv) => Genv.find_var_info ge b = Some gv
-      end
-  end.
+  induction l as [ | [id1 gd1] l]; simpl; intros.
+- auto.
+- destruct (IS.mem id1 u) eqn:MEM.
++ rewrite filter_globdefs_nil. rewrite fold_left_app. simpl.
+  unfold add_def at 1. simpl. rewrite PTree.gso by congruence. eapply IHl; eauto.
+  rewrite ISF.remove_b. rewrite H; auto.
++ eapply IHl; eauto.
+Qed.
 
-Lemma genv_program_map:
-  forall p, genv_progmap_match (Genv.globalenv p) (program_map p).
+Lemma filter_globdefs_map_2:
+  forall id l u m1 m2,
+  IS.mem id u = true ->
+  m1!id = m2!id ->
+  (fold_left add_def (filter_globdefs u nil l) m1)!id = (fold_left add_def (List.rev l) m2)!id.
 Proof.
-  intros. unfold Genv.globalenv, program_map.
-  assert (REC: forall defs g m,
-               genv_progmap_match g m ->
-               genv_progmap_match (Genv.add_globals g defs) (fold_left add_def_prog_map defs m)).
-  {
-    induction defs; simpl; intros.
-    auto.
-    apply IHdefs. red; intros. specialize (H id).
-    destruct a as [id1 [fd|gv]];
-    unfold Genv.add_global, Genv.find_symbol, Genv.find_funct_ptr, Genv.find_var_info, add_def_prog_map in *;
-    simpl.
-  - rewrite PTree.gsspec. destruct (peq id id1); subst.
-    + rewrite ! PTree.gss. auto.
-    + destruct (Genv.genv_symb g)!id as [b|] eqn:S; rewrite PTree.gso by auto.
-      * rewrite PTree.gso. auto. apply Plt_ne. eapply Genv.genv_symb_range; eauto.
-      * auto.
-  - rewrite PTree.gsspec. destruct (peq id id1); subst.
-    + rewrite ! PTree.gss. auto.
-    + destruct (Genv.genv_symb g)!id as [b|] eqn:S; rewrite PTree.gso by auto.
-      * rewrite PTree.gso. auto. apply Plt_ne. eapply Genv.genv_symb_range; eauto.
-      * auto.
-  }
-  apply REC. red; intros. unfold Genv.find_symbol, Genv.empty_genv; simpl. rewrite ! PTree.gempty; auto.
+  induction l as [ | [id1 gd1] l]; simpl; intros.
+- auto.
+- rewrite fold_left_app. simpl.
+  destruct (IS.mem id1 u) eqn:MEM.
++ rewrite filter_globdefs_nil. rewrite fold_left_app. simpl.
+  unfold add_def at 1 3. simpl.
+  rewrite ! PTree.gsspec. destruct (peq id id1). auto.
+  apply IHl; auto.
+  apply IS.mem_1. apply IS.remove_2; auto. apply IS.mem_2; auto.
++ unfold add_def at 2. simpl. rewrite PTree.gso by congruence. apply IHl; auto.
 Qed.
 
-Lemma transform_program_kept:
-  forall id b, Genv.find_symbol tge id = Some b -> kept id.
+Lemma filter_globdefs_map:
+  forall id u defs,
+  (PTree_Properties.of_list (filter_globdefs u nil (List.rev defs)))! id =
+  if IS.mem id u then (PTree_Properties.of_list defs)!id else None.
 Proof.
-  intros. generalize (genv_program_map tp id). fold tge; rewrite H.
-  rewrite transform_program_charact. intros. destruct (IS.mem id used) eqn:U.
-  unfold kept; apply IS.mem_2; auto.
-  contradiction.
+  intros. unfold PTree_Properties.of_list. fold prog_map. unfold PTree.elt. fold add_def.
+  destruct (IS.mem id u) eqn:MEM.
+- erewrite filter_globdefs_map_2. rewrite List.rev_involutive. reflexivity. 
+  auto. auto.
+- apply filter_globdefs_map_1. auto. apply PTree.gempty.
+Qed.
+
+Lemma filter_globdefs_domain:
+  forall id l u,
+  In id (map fst (filter_globdefs u nil l)) -> IS.In id u /\ In id (map fst l).
+Proof.
+  induction l as [ | [id1 gd1] l]; simpl; intros.
+- tauto.
+- destruct (IS.mem id1 u) eqn:MEM.
++ rewrite filter_globdefs_nil, map_app, in_app_iff in H. destruct H.
+  apply IHl in H. rewrite ISF.remove_iff in H. tauto.
+  simpl in H. destruct H; try tauto. subst id1. split; auto. apply IS.mem_2; auto.
++ apply IHl in H. tauto.
+Qed.
+
+Lemma filter_globdefs_unique_names:
+  forall l u, list_norepet (map fst (filter_globdefs u nil l)).
+Proof.
+  induction l as [ | [id1 gd1] l]; simpl; intros.
+- constructor.
+- destruct (IS.mem id1 u) eqn:MEM; auto.
+  rewrite filter_globdefs_nil, map_app. simpl.
+  apply list_norepet_append; auto. 
+  constructor. simpl; tauto. constructor.
+  red; simpl; intros. destruct H0; try tauto. subst y.
+  apply filter_globdefs_domain in H. rewrite ISF.remove_iff in H. intuition.
+Qed.
+
+End TRANSFORMATION.
+
+Theorem transf_program_match:
+  forall p tp, transform_program p = OK tp -> match_prog p tp.
+Proof.
+  unfold transform_program; intros p tp TR. set (pm := prog_defmap p) in *.
+  destruct (used_globals p pm) as [u|] eqn:U; try discriminate.
+  destruct (IS.for_all (global_defined p pm) u) eqn:DEF; inv TR.
+  exists u; split. 
+  apply used_globals_valid; auto.
+  constructor; simpl; auto.
+  intros. unfold prog_defmap; simpl. apply filter_globdefs_map.
+  apply filter_globdefs_unique_names. 
+Qed.
+
+(** * Semantic preservation *)
+
+Section SOUNDNESS.
+
+Variable p: program.
+Variable tp: program.
+Variable used: IS.t.
+Hypothesis USED_VALID: valid_used_set p used.
+Hypothesis TRANSF: match_prog_1 used p tp.
+Let ge := Genv.globalenv p.
+Let tge := Genv.globalenv tp.
+Let pm := prog_defmap p.
+
+Definition kept (id: ident) : Prop := IS.In id used.
+
+Lemma kept_closed:
+  forall id gd id',
+  kept id -> pm!id = Some gd -> ref_def gd id' -> kept id'.
+Proof.
+  intros. eapply used_closed; eauto.
+Qed.
+
+Lemma kept_main:
+  kept p.(prog_main).
+Proof.
+  eapply used_main; eauto.
+Qed.
+
+Lemma kept_public:
+  forall id, In id p.(prog_public) -> kept id.
+Proof.
+  intros. eapply used_public; eauto.
+Qed.
+
+(** Relating [Genv.find_symbol] operations in the original and transformed program *)
+
+Lemma transform_find_symbol_1:
+  forall id b,
+  Genv.find_symbol ge id = Some b -> kept id -> exists b', Genv.find_symbol tge id = Some b'.
+Proof.
+  intros. 
+  assert (A: exists g, (prog_defmap p)!id = Some g).
+  { apply prog_defmap_dom. eapply Genv.find_symbol_inversion; eauto. }
+  destruct A as (g & P).
+  apply Genv.find_symbol_exists with g.
+  apply in_prog_defmap.
+  erewrite match_prog_def by eauto. rewrite IS.mem_1 by auto. auto.
+Qed.
+
+Lemma transform_find_symbol_2:
+  forall id b,
+  Genv.find_symbol tge id = Some b -> kept id /\ exists b', Genv.find_symbol ge id = Some b'.
+Proof.
+  intros. 
+  assert (A: exists g, (prog_defmap tp)!id = Some g).
+  { apply prog_defmap_dom. eapply Genv.find_symbol_inversion; eauto. }
+  destruct A as (g & P).
+  erewrite match_prog_def in P by eauto. 
+  destruct (IS.mem id used) eqn:U; try discriminate.
+  split. apply IS.mem_2; auto. 
+  apply Genv.find_symbol_exists with g.
+  apply in_prog_defmap. auto.
 Qed.
 
 (** Injections that preserve used globals. *)
@@ -439,16 +516,13 @@ Record meminj_preserves_globals (f: meminj) : Prop := {
   symbols_inject_3: forall id b',
     Genv.find_symbol tge id = Some b' ->
     exists b, Genv.find_symbol ge id = Some b /\ f b = Some(b', 0);
-  funct_ptr_inject: forall b b' delta fd,
-    f b = Some(b', delta) -> Genv.find_funct_ptr ge b = Some fd ->
-    Genv.find_funct_ptr tge b' = Some fd /\ delta = 0 /\
-    (forall id, ref_fundef fd id -> kept id);
-  var_info_inject: forall b b' delta gv,
-    f b = Some(b', delta) -> Genv.find_var_info ge b = Some gv ->
-    Genv.find_var_info tge b' = Some gv /\ delta = 0;
-  var_info_rev_inject: forall b b' delta gv,
-    f b = Some(b', delta) -> Genv.find_var_info tge b' = Some gv ->
-    Genv.find_var_info ge b = Some gv /\ delta = 0
+  defs_inject: forall b b' delta gd,
+    f b = Some(b', delta) -> Genv.find_def ge b = Some gd ->
+    Genv.find_def tge b' = Some gd /\ delta = 0 /\
+    (forall id, ref_def gd id -> kept id);
+  defs_rev_inject: forall b b' delta gd,
+    f b = Some(b', delta) -> Genv.find_def tge b' = Some gd ->
+    Genv.find_def ge b = Some gd /\ delta = 0
 }.
 
 Definition init_meminj : meminj :=
@@ -462,6 +536,14 @@ Definition init_meminj : meminj :=
     | None => None
     end.
 
+Remark init_meminj_eq:
+  forall id b b',
+  Genv.find_symbol ge id = Some b -> Genv.find_symbol tge id = Some b' ->
+  init_meminj b = Some(b', 0).
+Proof.
+  intros. unfold init_meminj. erewrite Genv.find_invert_symbol by eauto. rewrite H0. auto.
+Qed.
+
 Remark init_meminj_invert:
   forall b b' delta,
   init_meminj b = Some(b', delta) ->
@@ -480,44 +562,26 @@ Proof.
 - exploit init_meminj_invert; eauto. intros (A & id1 & B & C).
   assert (id1 = id) by (eapply (Genv.genv_vars_inj ge); eauto). subst id1.
   auto.
-- unfold init_meminj. erewrite Genv.find_invert_symbol by eauto. apply IS.mem_1 in H.
-  generalize (genv_program_map p id) (genv_program_map tp id). fold ge; fold tge; fold pm.
-  rewrite transform_program_charact. rewrite H, H0.
-  destruct (Genv.find_symbol tge id) as [b'|]; intros.
-  exists b'; auto. rewrite H2 in H1; contradiction.
-- generalize (genv_program_map tp id). fold tge. rewrite H. intros.
-  destruct (program_map tp)!id as [gd|] eqn:PM; try contradiction.
-  generalize (transform_program_charact id). rewrite PM.
-  destruct (IS.mem id used) eqn:USED; intros; try discriminate.
-  generalize (genv_program_map p id). fold ge; fold pm.
-  destruct (Genv.find_symbol ge id) as [b|] eqn:FS; intros; try congruence.
-  exists b; split; auto. unfold init_meminj.
-  erewrite Genv.find_invert_symbol by eauto. rewrite H. auto.
+- exploit transform_find_symbol_1; eauto. intros (b' & F). exists b'; split; auto.
+  eapply init_meminj_eq; eauto.
+- exploit transform_find_symbol_2; eauto. intros (K & b & F). 
+  exists b; split; auto. eapply init_meminj_eq; eauto.
+- exploit init_meminj_invert; eauto. intros (A & id & B & C).
+  assert (kept id) by (eapply transform_find_symbol_2; eauto).
+  assert (pm!id = Some gd).
+  { unfold pm; rewrite Genv.find_def_symbol. exists b; auto. }
+  assert ((prog_defmap tp)!id = Some gd).
+  { erewrite match_prog_def by eauto. rewrite IS.mem_1 by auto. auto. }
+  rewrite Genv.find_def_symbol in H3. destruct H3 as (b1 & P & Q).
+  fold tge in P. replace b' with b1 by congruence. split; auto. split; auto. 
+  intros. eapply kept_closed; eauto.
 - exploit init_meminj_invert; eauto. intros (A & id & B & C).
-  generalize (genv_program_map p id) (genv_program_map tp id). fold ge; fold tge; fold pm.
-  rewrite transform_program_charact. rewrite B, C. intros.
-  destruct (IS.mem id used) eqn:KEPT; try contradiction.
-  destruct (pm!id) as [gd|] eqn:PM; try contradiction.
-  destruct gd as [fd'|gv'].
-  + assert (fd' = fd) by congruence. subst fd'. split. auto. split. auto.
-    intros. eapply kept_closed; eauto. red; apply IS.mem_2; auto.
-  + assert (b <> b) by (eapply Genv.genv_funs_vars; eassumption). congruence.
-- exploit init_meminj_invert; eauto. intros (A & id & B & C). split; auto.
-  generalize (genv_program_map p id) (genv_program_map tp id). fold ge; fold tge; fold pm.
-  rewrite transform_program_charact. rewrite B, C. intros.
-  destruct (IS.mem id used); try contradiction.
-  destruct (pm!id) as [gd|]; try contradiction.
-  destruct gd as [fd'|gv'].
-  + assert (b <> b) by (eapply Genv.genv_funs_vars; eassumption). congruence.
-  + congruence.
-- exploit init_meminj_invert; eauto. intros (A & id & B & C). split; auto.
-  generalize (genv_program_map p id) (genv_program_map tp id). fold ge; fold tge; fold pm.
-  rewrite transform_program_charact. rewrite B, C. intros.
-  destruct (IS.mem id used); try contradiction.
-  destruct (pm!id) as [gd|]; try contradiction.
-  destruct gd as [fd'|gv'].
-  + assert (b' <> b') by (eapply Genv.genv_funs_vars; eassumption). congruence.
-  + congruence.
+  assert ((prog_defmap tp)!id = Some gd).
+  { rewrite Genv.find_def_symbol. exists b'; auto. }
+  erewrite match_prog_def in H1 by eauto.
+  destruct (IS.mem id used); try discriminate.
+  rewrite Genv.find_def_symbol in H1. destruct H1 as (b1 & P & Q).
+  fold ge in P. replace b with b1 by congruence. auto.
 Qed.
 
 Lemma globals_symbols_inject:
@@ -527,28 +591,33 @@ Proof.
   assert (E1: Genv.genv_public ge = p.(prog_public)).
   { apply Genv.globalenv_public. }
   assert (E2: Genv.genv_public tge = p.(prog_public)).
-  { unfold tge; rewrite Genv.globalenv_public.
-    unfold transform_program in TRANSF. rewrite USED_GLOBALS in TRANSF. inversion TRANSF. auto. }
+  { unfold tge; rewrite Genv.globalenv_public. eapply match_prog_public; eauto. }
   split; [|split;[|split]]; intros.
   + simpl; unfold Genv.public_symbol; rewrite E1, E2.
     destruct (Genv.find_symbol tge id) as [b'|] eqn:TFS.
     exploit symbols_inject_3; eauto. intros (b & FS & INJ). rewrite FS. auto.
     destruct (Genv.find_symbol ge id) as [b|] eqn:FS; auto.
     destruct (in_dec ident_eq id (prog_public p)); simpl; auto.
-    exploit symbols_inject_2; eauto. apply kept_public; auto.
+    exploit symbols_inject_2; eauto.
+    eapply kept_public; eauto.
     intros (b' & TFS' & INJ). congruence.
   + eapply symbols_inject_1; eauto.
   + simpl in *; unfold Genv.public_symbol in H0.
     destruct (Genv.find_symbol ge id) as [b|] eqn:FS; try discriminate.
     rewrite E1 in H0.
     destruct (in_dec ident_eq id (prog_public p)); try discriminate. inv H1.
-    exploit symbols_inject_2; eauto. apply kept_public; auto.
+    exploit symbols_inject_2; eauto.
+    eapply kept_public; eauto.
     intros (b' & A & B); exists b'; auto.
   + simpl. unfold Genv.block_is_volatile.
     destruct (Genv.find_var_info ge b1) as [gv|] eqn:V1.
-    exploit var_info_inject; eauto. intros [A B]. rewrite A. auto.
+    rewrite Genv.find_var_info_iff in V1.
+    exploit defs_inject; eauto. intros (A & B & C).
+    rewrite <- Genv.find_var_info_iff in A. rewrite A; auto.
     destruct (Genv.find_var_info tge b2) as [gv|] eqn:V2; auto.
-    exploit var_info_rev_inject; eauto. intros [A B]. congruence.
+    rewrite Genv.find_var_info_iff in V2.
+    exploit defs_rev_inject; eauto. intros (A & B). 
+    rewrite <- Genv.find_var_info_iff in A. congruence.
 Qed.
 
 Lemma symbol_address_inject:
@@ -661,12 +730,10 @@ Proof.
     exists b'; auto.
   + exploit symbols_inject_3; eauto. intros (b & A & B).
     exists b; auto.
-  + eapply funct_ptr_inject; eauto. apply SAME; auto.
-    eapply Genv.genv_funs_range; eauto.
-  + eapply var_info_inject; eauto. apply SAME; auto.
-    eapply Genv.genv_vars_range; eauto.
-  + eapply var_info_rev_inject; eauto. apply SAME'; auto.
-    eapply Genv.genv_vars_range; eauto.
+  + eapply defs_inject; eauto. apply SAME; auto.
+    eapply Genv.genv_defs_range; eauto.
+  + eapply defs_rev_inject; eauto. apply SAME'; auto.
+    eapply Genv.genv_defs_range; eauto.
 - econstructor; eauto.
   apply IHmatch_stacks.
   intros. exploit H1; eauto. intros [A B]. split; eapply Ple_trans; eauto.
@@ -738,11 +805,15 @@ Proof.
 - exploit Genv.find_funct_inv; eauto. intros (b & R). rewrite R in H0.
   rewrite Genv.find_funct_find_funct_ptr in H0.
   specialize (H1 r). rewrite R in H1. inv H1.
-  exploit funct_ptr_inject; eauto. intros (A & B & C).
+  rewrite Genv.find_funct_ptr_iff in H0.  
+  exploit defs_inject; eauto. intros (A & B & C).
+  rewrite <- Genv.find_funct_ptr_iff in A. 
   rewrite B; auto.
 - destruct (Genv.find_symbol ge id) as [b|] eqn:FS; try discriminate.
   exploit symbols_inject_2; eauto. intros (tb & P & Q). rewrite P.
-  exploit funct_ptr_inject; eauto. intros (A & B & C).
+  rewrite Genv.find_funct_ptr_iff in H0.  
+  exploit defs_inject; eauto. intros (A & B & C).
+  rewrite <- Genv.find_funct_ptr_iff in A. 
   auto.
 Qed.
 
@@ -973,285 +1044,159 @@ Qed.
 
 (** Relating initial memory states *)
 
-Remark init_meminj_no_overlap:
-  forall m, Mem.meminj_no_overlap init_meminj m.
+(*
+Remark genv_find_def_exists:
+  forall (F V: Type) (p: AST.program F V) b,
+  Plt b (Genv.genv_next (Genv.globalenv p)) ->
+  exists gd, Genv.find_def (Genv.globalenv p) b = Some gd.
 Proof.
-  intros; red; intros.
-  exploit init_meminj_invert. eexact H0. intros (A1 & id1 & B1 & C1).
-  exploit init_meminj_invert. eexact H1. intros (A2 & id2 & B2 & C2).
-  left; red; intros; subst b2'.
-  assert (id1 = id2) by (eapply Genv.genv_vars_inj; eauto).
-  congruence.
+  intros until b.
+  set (P := fun (g: Genv.t F V) =>
+        Plt b (Genv.genv_next g) -> exists gd, (Genv.genv_defs g)!b = Some gd).
+  assert (forall l g, P g -> P (Genv.add_globals g l)).
+  { induction l as [ | [id1 g1] l]; simpl; intros.
+  - auto.
+  - apply IHl. unfold Genv.add_global, P; simpl. intros LT. apply Plt_succ_inv in LT. destruct LT.
+  + rewrite PTree.gso. apply H; auto. apply Plt_ne; auto. 
+  + rewrite H0. rewrite PTree.gss. exists g1; auto. }
+  apply H. red; simpl; intros. exfalso; xomega.
 Qed.
+*)
 
-Lemma store_zeros_unmapped_inj:
-  forall m1 b1 i n m1',
-  store_zeros m1 b1 i n = Some m1' ->
-  forall m2,
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj b1 = None ->
-  Mem.mem_inj init_meminj m1' m2.
-Proof.
-  intros until m1'. functional induction (store_zeros m1 b1 i n); intros.
-  inv H. auto.
-  eapply IHo; eauto. eapply Mem.store_unmapped_inj; eauto.
-  discriminate.
-Qed.
-
-Lemma store_zeros_mapped_inj:
-  forall m1 b1 i n m1',
-  store_zeros m1 b1 i n = Some m1' ->
-  forall m2 b2,
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj b1 = Some(b2, 0) ->
-  exists m2', store_zeros m2 b2 i n = Some m2' /\ Mem.mem_inj init_meminj m1' m2'.
-Proof.
-  intros until m1'. functional induction (store_zeros m1 b1 i n); intros.
-  inv H. exists m2; split; auto. rewrite store_zeros_equation, e; auto.
-  exploit Mem.store_mapped_inj; eauto. apply init_meminj_no_overlap. instantiate (1 := Vzero); constructor.
-  intros (m2' & A & B). rewrite Zplus_0_r in A.
-  exploit IHo; eauto. intros (m3' & C & D).
-  exists m3'; split; auto. rewrite store_zeros_equation, e, A, C; auto.
-  discriminate.
-Qed.
-
-Lemma store_init_data_unmapped_inj:
-  forall m1 b1 i id m1' m2,
-  Genv.store_init_data ge m1 b1 i id = Some m1' ->
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj b1 = None ->
-  Mem.mem_inj init_meminj m1' m2.
-Proof.
-  intros. destruct id; simpl in H; try (eapply Mem.store_unmapped_inj; now eauto).
-  inv H; auto.
-  destruct (Genv.find_symbol ge i0); try discriminate. eapply Mem.store_unmapped_inj; now eauto.
-Qed.
-
-Lemma store_init_data_mapped_inj:
-  forall m1 b1 i init m1' b2 m2,
-  Genv.store_init_data ge m1 b1 i init = Some m1' ->
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj b1 = Some(b2, 0) ->
-  (forall id ofs, init = Init_addrof id ofs -> kept id) ->
-  exists m2', Genv.store_init_data tge m2 b2 i init = Some m2' /\ Mem.mem_inj init_meminj m1' m2'.
-Proof.
-  intros. replace i with (i + 0) by omega. pose proof (init_meminj_no_overlap m1).
-  destruct init; simpl in *; try (eapply Mem.store_mapped_inj; now eauto).
-  inv H. exists m2; auto.
-  destruct (Genv.find_symbol ge i0) as [bi|] eqn:FS1; try discriminate.
-  exploit symbols_inject_2. eapply init_meminj_preserves_globals. eapply H2; eauto. eauto.
-  intros (bi' & A & B). rewrite A. eapply Mem.store_mapped_inj; eauto.
-  econstructor; eauto. rewrite Int.add_zero; auto.
+Lemma init_meminj_invert_strong:
+  forall b b' delta,
+  init_meminj b = Some(b', delta) ->
+  delta = 0 /\
+  exists id gd,
+     Genv.find_symbol ge id = Some b
+  /\ Genv.find_symbol tge id = Some b'
+  /\ Genv.find_def ge b = Some gd
+  /\ Genv.find_def tge b' = Some gd
+  /\ (forall i, ref_def gd i -> kept i).
+Proof.
+  intros. exploit init_meminj_invert; eauto. intros (A & id & B & C). 
+  assert (exists gd, (prog_defmap p)!id = Some gd).
+  { apply prog_defmap_dom. eapply Genv.find_symbol_inversion; eauto. }
+  destruct H0 as [gd DM]. rewrite Genv.find_def_symbol in DM.
+  destruct DM as (b'' & P & Q). fold ge in P. rewrite P in B; inv B.
+  fold ge in Q. exploit defs_inject. apply init_meminj_preserves_globals.
+  eauto. eauto. intros (X & _ & Y). 
+  split. auto. exists id, gd; auto. 
 Qed.
 
- Lemma store_init_data_list_unmapped_inj:
-  forall initlist m1 b1 i m1' m2,
-  Genv.store_init_data_list ge m1 b1 i initlist = Some m1' ->
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj b1 = None ->
-  Mem.mem_inj init_meminj m1' m2.
-Proof.
-  induction initlist; simpl; intros.
-- inv H; auto.
-- destruct (Genv.store_init_data ge m1 b1 i a) as [m1''|] eqn:ST; try discriminate.
-  eapply IHinitlist; eauto. eapply store_init_data_unmapped_inj; eauto.
-Qed.
-
-Lemma store_init_data_list_mapped_inj:
-  forall initlist m1 b1 i m1' b2 m2,
-  Genv.store_init_data_list ge m1 b1 i initlist = Some m1' ->
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj b1 = Some(b2, 0) ->
-  (forall id ofs, In (Init_addrof id ofs) initlist -> kept id) ->
-  exists m2', Genv.store_init_data_list tge m2 b2 i initlist = Some m2' /\ Mem.mem_inj init_meminj m1' m2'.
-Proof.
-  induction initlist; simpl; intros.
-- inv H. exists m2; auto.
-- destruct (Genv.store_init_data ge m1 b1 i a) as [m1''|] eqn:ST; try discriminate.
-  exploit store_init_data_mapped_inj; eauto. intros (m2'' & A & B).
-  exploit IHinitlist; eauto. intros (m2' & C & D).
-  exists m2'; split; auto. rewrite A; auto.
-Qed.
-
-Lemma alloc_global_unmapped_inj:
-  forall m1 id g m1' m2,
-  Genv.alloc_global ge m1 (id, g) = Some m1' ->
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj (Mem.nextblock m1) = None ->
-  Mem.mem_inj init_meminj m1' m2.
-Proof.
-  unfold Genv.alloc_global; intros. destruct g as [fd|gv].
-- destruct (Mem.alloc m1 0 1) as (m1a, b) eqn:ALLOC.
-  exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1.
-  eapply Mem.drop_unmapped_inj with (m1 := m1a); eauto.
-  eapply Mem.alloc_left_unmapped_inj; eauto.
-- set (sz := Genv.init_data_list_size (gvar_init gv)) in *.
-  destruct (Mem.alloc m1 0 sz) as (m1a, b) eqn:ALLOC.
-  destruct (store_zeros m1a b 0 sz) as [m1b|] eqn: STZ; try discriminate.
-  destruct (Genv.store_init_data_list ge m1b b 0 (gvar_init gv)) as [m1c|] eqn:ST; try discriminate.
-  exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1.
-  eapply Mem.drop_unmapped_inj with (m1 := m1c); eauto.
-  eapply store_init_data_list_unmapped_inj with (m1 := m1b); eauto.
-  eapply store_zeros_unmapped_inj with (m1 := m1a); eauto.
-  eapply Mem.alloc_left_unmapped_inj; eauto.
-Qed.
-
-Lemma alloc_global_mapped_inj:
-  forall m1 id g m1' m2,
-  Genv.alloc_global ge m1 (id, g) = Some m1' ->
-  Mem.mem_inj init_meminj m1 m2 ->
-  init_meminj (Mem.nextblock m1) = Some(Mem.nextblock m2, 0) ->
-  (forall id, ref_def g id -> kept id) ->
-  exists m2',
-    Genv.alloc_global tge m2 (id, g) = Some m2' /\ Mem.mem_inj init_meminj m1' m2'.
-Proof.
-  unfold Genv.alloc_global; intros. destruct g as [fd|gv].
-- destruct (Mem.alloc m1 0 1) as (m1a, b1) eqn:ALLOC.
-  exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1.
-  destruct (Mem.alloc m2 0 1) as (m2a, b2) eqn:ALLOC2.
-  exploit Mem.alloc_result; eauto. intros EQ2. rewrite <- EQ2 in H1.
-  assert (Mem.mem_inj init_meminj m1a m2a).
-  { eapply Mem.alloc_left_mapped_inj with (b1 := b1) (b2 := b2) (delta := 0).
-    eapply Mem.alloc_right_inj; eauto.
-    eauto.
-    eauto with mem.
-    red; intros; apply Z.divide_0_r.
-    intros. apply Mem.perm_implies with Freeable; auto with mem.
-    eapply Mem.perm_alloc_2; eauto. omega.
-    auto.
-  }
-  exploit Mem.drop_mapped_inj; eauto. apply init_meminj_no_overlap.
-- set (sz := Genv.init_data_list_size (gvar_init gv)) in *.
-  destruct (Mem.alloc m1 0 sz) as (m1a, b1) eqn:ALLOC.
-  destruct (store_zeros m1a b1 0 sz) as [m1b|] eqn: STZ; try discriminate.
-  destruct (Genv.store_init_data_list ge m1b b1 0 (gvar_init gv)) as [m1c|] eqn:ST; try discriminate.
-  exploit Mem.alloc_result; eauto. intros EQ. rewrite <- EQ in H1.
-  destruct (Mem.alloc m2 0 sz) as (m2a, b2) eqn:ALLOC2.
-  exploit Mem.alloc_result; eauto. intros EQ2. rewrite <- EQ2 in H1.
-  assert (Mem.mem_inj init_meminj m1a m2a).
-  { eapply Mem.alloc_left_mapped_inj with (b1 := b1) (b2 := b2) (delta := 0).
-    eapply Mem.alloc_right_inj; eauto.
-    eauto.
-    eauto with mem.
-    red; intros; apply Z.divide_0_r.
-    intros. apply Mem.perm_implies with Freeable; auto with mem.
-    eapply Mem.perm_alloc_2; eauto. omega.
-    auto.
-  }
-  exploit store_zeros_mapped_inj; eauto. intros (m2b & A & B).
-  exploit store_init_data_list_mapped_inj; eauto.
-  intros. apply H2. red. exists ofs; auto. intros (m2c & C & D).
-  exploit Mem.drop_mapped_inj; eauto. apply init_meminj_no_overlap. intros (m2' & E & F).
-  exists m2'; split; auto. rewrite ! Zplus_0_r in E. rewrite A, C, E. auto.
-Qed.
-
-Lemma alloc_globals_app:
-  forall F V (g: Genv.t F V) defs1 m defs2,
-  Genv.alloc_globals g m (defs1 ++ defs2) =
-  match Genv.alloc_globals g m defs1 with
-  | None => None
-  | Some m1 => Genv.alloc_globals g m1 defs2
-  end.
+Section INIT_MEM.
+
+Variables m tm: mem.
+Hypothesis IM: Genv.init_mem p = Some m.
+Hypothesis TIM: Genv.init_mem tp = Some tm.
+
+Lemma bytes_of_init_inject:
+  forall il,
+  (forall id, ref_init il id -> kept id) ->
+  list_forall2 (memval_inject init_meminj) (Genv.bytes_of_init_data_list ge il) (Genv.bytes_of_init_data_list tge il).
 Proof.
-  induction defs1; simpl; intros. auto.
-  destruct (Genv.alloc_global g m a); auto.
+  induction il as [ | i1 il]; simpl; intros.
+- constructor.
+- apply list_forall2_app.
++ destruct i1; simpl; try (apply inj_bytes_inject). 
+  induction (Z.to_nat z); simpl; constructor. constructor. auto.
+  destruct (Genv.find_symbol ge i) as [b|] eqn:FS.
+  assert (kept i). { apply H. red. exists i0; auto with coqlib. }
+  exploit symbols_inject_2. apply init_meminj_preserves_globals. eauto. eauto. 
+  intros (b' & A & B). rewrite A. apply inj_value_inject.
+  econstructor; eauto. symmetry; apply Int.add_zero.
+  destruct (Genv.find_symbol tge i) as [b'|] eqn:FS'.
+  exploit symbols_inject_3. apply init_meminj_preserves_globals. eauto.
+  intros (b & A & B). congruence.
+  apply repeat_Undef_inject_self with (n := 4%nat). 
++ apply IHil. intros id [ofs IN]. apply H. exists ofs; auto with coqlib.
 Qed.
 
-Lemma alloc_globals_snoc:
-  forall F V (g: Genv.t F V) m defs1 id_def,
-  Genv.alloc_globals g m (defs1 ++ id_def :: nil) =
-  match Genv.alloc_globals g m defs1 with
-  | None => None
-  | Some m1 => Genv.alloc_global g m1 id_def
-  end.
+Lemma Mem_getN_forall2:
+  forall (P: memval -> memval -> Prop) c1 c2 i n p,
+  list_forall2 P (Mem.getN n p c1) (Mem.getN n p c2) ->
+  p <= i -> i < p + Z.of_nat n ->
+  P (ZMap.get i c1) (ZMap.get i c2).
 Proof.
-  intros. rewrite alloc_globals_app.
-  destruct (Genv.alloc_globals g m defs1); auto. unfold Genv.alloc_globals.
-  destruct (Genv.alloc_global g m0 id_def); auto.
-Qed.
-
-Lemma alloc_globals_inj:
-  forall pubs defs m1 u g1 g2,
-  Genv.alloc_globals ge Mem.empty (List.rev defs) = Some m1 ->
-  g1 = Genv.add_globals (Genv.empty_genv _ _ pubs) (List.rev defs) ->
-  g2 = Genv.add_globals (Genv.empty_genv _ _ pubs) (filter_globdefs u nil defs) ->
-  Mem.nextblock m1 = Genv.genv_next g1 ->
-  (forall id, IS.In id u -> Genv.find_symbol g1 id = Genv.find_symbol ge id) ->
-  (forall id, IS.In id u -> Genv.find_symbol g2 id = Genv.find_symbol tge id) ->
-  (forall b id, Genv.find_symbol ge id = Some b -> Plt b (Mem.nextblock m1) -> kept id -> IS.In id u) ->
-  (forall id, IS.In id u -> (fold_left add_def_prog_map (List.rev defs) (PTree.empty _))!id = pm!id) ->
-  exists m2,
-     Genv.alloc_globals tge Mem.empty (filter_globdefs u nil defs) = Some m2
-  /\ Mem.nextblock m2 = Genv.genv_next g2
-  /\ Mem.mem_inj init_meminj m1 m2.
-Proof.
-  induction defs; simpl; intros until g2; intros ALLOC GE1 GE2 NEXT1 SYMB1 SYMB2 SYMB3 PROGMAP.
-- inv ALLOC. exists Mem.empty. intuition auto. constructor; intros.
-  eelim Mem.perm_empty; eauto.
-  exploit init_meminj_invert; eauto. intros [A B]. subst delta. apply Z.divide_0_r.
-  eelim Mem.perm_empty; eauto.
-- rewrite Genv.add_globals_app in GE1. simpl in GE1.
-  set (g1' := Genv.add_globals (Genv.empty_genv fundef unit pubs) (rev defs)) in *.
-  rewrite alloc_globals_snoc in ALLOC.
-  destruct (Genv.alloc_globals ge Mem.empty (rev defs)) as [m1'|] eqn:ALLOC1'; try discriminate.
-  exploit Genv.alloc_global_nextblock; eauto. intros NEXTBLOCK1.
-  assert (NEXTGE1: Genv.genv_next g1 = Pos.succ (Genv.genv_next g1')) by (rewrite GE1; reflexivity).
-  assert (NEXT1': Mem.nextblock m1' = Genv.genv_next g1') by (unfold block in *; xomega).
-  rewrite fold_left_app in PROGMAP. simpl in PROGMAP.
-  destruct a as [id gd]. unfold add_def_prog_map at 1 in PROGMAP. simpl in PROGMAP.
-  destruct (IS.mem id u) eqn:MEM.
-  + rewrite filter_globdefs_nil in *. rewrite alloc_globals_snoc.
-    rewrite Genv.add_globals_app in GE2. simpl in GE2.
-    set (g2' := Genv.add_globals (Genv.empty_genv fundef unit pubs) (filter_globdefs (IS.remove id u) nil defs)) in *.
-    assert (NEXTGE2: Genv.genv_next g2 = Pos.succ (Genv.genv_next g2')) by (rewrite GE2; reflexivity).
-    assert (FS1: Genv.find_symbol ge id = Some (Mem.nextblock m1')).
-    { rewrite <- SYMB1 by (apply IS.mem_2; auto).
-      rewrite GE1. unfold Genv.find_symbol; simpl. rewrite PTree.gss. congruence. }
-    exploit (IHdefs m1' (IS.remove id u) g1' g2'); eauto.
-      intros. rewrite ISF.remove_iff in H; destruct H.
-      rewrite <- SYMB1 by auto. rewrite GE1. unfold Genv.find_symbol; simpl.
-      rewrite PTree.gso; auto.
-      intros. rewrite ISF.remove_iff in H; destruct H.
-      rewrite <- SYMB2 by auto. rewrite GE2. unfold Genv.find_symbol; simpl.
-      rewrite PTree.gso; auto.
-      intros. rewrite ISF.remove_iff. destruct (ident_eq id id0).
-      subst id0. rewrite FS1 in H. inv H. eelim Plt_strict; eauto.
-      exploit SYMB3. eexact H. unfold block in *; xomega. auto. tauto.
-      intros. rewrite ISF.remove_iff in H; destruct H.
-      rewrite <- PROGMAP by auto. rewrite PTree.gso by auto. auto.
-    intros (m2' & A & B & C). fold g2' in B.
-    assert (FS2: Genv.find_symbol tge id = Some (Mem.nextblock m2')).
-    { rewrite <- SYMB2 by (apply IS.mem_2; auto).
-      rewrite GE2. unfold Genv.find_symbol; simpl. rewrite PTree.gss. congruence. }
-    assert (INJ: init_meminj (Mem.nextblock m1') = Some (Mem.nextblock m2', 0)).
-    { apply Genv.find_invert_symbol in FS1. unfold init_meminj. rewrite FS1, FS2. auto. }
-    exploit alloc_global_mapped_inj. eexact ALLOC. eexact C. exact INJ.
-    intros. apply kept_closed with id gd. eapply transform_program_kept; eauto.
-    rewrite <- PROGMAP by (apply IS.mem_2; auto). apply PTree.gss. auto.
-    intros (m2 & D & E).
-    exploit Genv.alloc_global_nextblock; eauto. intros NEXTBLOCK2.
-    exists m2; split. rewrite A, D. auto.
-    split. unfold block in *; xomega.
-    auto.
-  + exploit (IHdefs m1' u g1' g2); auto.
-    intros. rewrite <- SYMB1 by auto. rewrite GE1.
-    unfold Genv.find_symbol; simpl. rewrite PTree.gso; auto.
-    red; intros; subst id0. apply IS.mem_1 in H. congruence.
-    intros. eapply SYMB3; eauto. unfold block in *; xomega.
-    intros. rewrite <- PROGMAP by auto. rewrite PTree.gso; auto.
-    apply IS.mem_1 in H. congruence.
-    intros (m2 & A & B & C).
-    assert (NOTINJ: init_meminj (Mem.nextblock m1') = None).
-    { destruct (init_meminj (Mem.nextblock m1')) as [[b' delta]|] eqn:J; auto.
-      exploit init_meminj_invert; eauto. intros (U & id1 & V & W).
-      exploit SYMB3; eauto. unfold block in *; xomega.
-      eapply transform_program_kept; eauto.
-      intros P.
-      revert V. rewrite <- SYMB1, GE1 by auto. unfold Genv.find_symbol; simpl.
-      rewrite PTree.gsspec. rewrite NEXT1'. destruct (peq id1 id); intros Q.
-      subst id1. apply IS.mem_1 in P. congruence.
-      eelim Plt_strict. eapply Genv.genv_symb_range; eauto. }
-    exists m2; intuition auto. eapply alloc_global_unmapped_inj; eauto.
+  induction n; simpl Mem.getN; intros.
+- simpl in H1. omegaContradiction.
+- inv H. rewrite inj_S in H1. destruct (zeq i p0).
++ congruence.
++ apply IHn with (p0 + 1); auto. omega. omega.
+Qed. 
+
+Lemma init_mem_inj_1:
+  Mem.mem_inj init_meminj m tm.
+Proof.
+  intros; constructor; intros.
+- exploit init_meminj_invert_strong; eauto. intros (A & id & gd & B & C & D & E & F).
+  exploit (Genv.init_mem_characterization_gen p); eauto.
+  exploit (Genv.init_mem_characterization_gen tp); eauto.
+  destruct gd as [f|v].
++ intros (P2 & Q2) (P1 & Q1).
+  apply Q1 in H0. destruct H0. subst.
+  apply Mem.perm_cur. auto.
++ intros (P2 & Q2 & R2 & S2) (P1 & Q1 & R1 & S1).
+  apply Q1 in H0. destruct H0. subst.
+  apply Mem.perm_cur. eapply Mem.perm_implies; eauto. 
+  apply P2. omega.
+- exploit init_meminj_invert; eauto. intros (A & id & B & C). 
+  subst delta. apply Zdivide_0.
+- exploit init_meminj_invert_strong; eauto. intros (A & id & gd & B & C & D & E & F).
+  exploit (Genv.init_mem_characterization_gen p); eauto.
+  exploit (Genv.init_mem_characterization_gen tp); eauto.
+  destruct gd as [f|v].
++ intros (P2 & Q2) (P1 & Q1).
+  apply Q1 in H0. destruct H0; discriminate.
++ intros (P2 & Q2 & R2 & S2) (P1 & Q1 & R1 & S1).
+  apply Q1 in H0. destruct H0.
+  assert (NO: gvar_volatile v = false).
+  { unfold Genv.perm_globvar in H1. destruct (gvar_volatile v); auto. inv H1. }
+Local Transparent Mem.loadbytes.
+  generalize (S1 NO). unfold Mem.loadbytes. destruct Mem.range_perm_dec; intros E1; inv E1.
+  generalize (S2 NO). unfold Mem.loadbytes. destruct Mem.range_perm_dec; intros E2; inv E2.
+  rewrite Zplus_0_r.
+  apply Mem_getN_forall2 with (p := 0) (n := nat_of_Z (init_data_list_size (gvar_init v))).
+  rewrite H3, H4. apply bytes_of_init_inject. auto. 
+  omega. 
+  rewrite nat_of_Z_eq by (apply init_data_list_size_pos). omega. 
+Qed.
+
+Lemma init_mem_inj_2:
+  Mem.inject init_meminj m tm.
+Proof.
+  constructor; intros.
+- apply init_mem_inj_1.
+- destruct (init_meminj b) as [[b' delta]|] eqn:INJ; auto.
+  elim H. exploit init_meminj_invert; eauto. intros (A & id & B & C). 
+  eapply Genv.find_symbol_not_fresh; eauto.
+- exploit init_meminj_invert; eauto. intros (A & id & B & C). 
+  eapply Genv.find_symbol_not_fresh; eauto.
+- red; intros.
+  exploit init_meminj_invert. eexact H0. intros (A1 & id1 & B1 & C1).
+  exploit init_meminj_invert. eexact H1. intros (A2 & id2 & B2 & C2).
+  destruct (ident_eq id1 id2). congruence. left; eapply Genv.global_addresses_distinct; eauto.
+- exploit init_meminj_invert; eauto. intros (A & id & B & C). subst delta.
+  split. omega. generalize (Int.unsigned_range_2 ofs). omega.
+Qed.
+
+End INIT_MEM.
+
+Lemma init_mem_exists:
+  forall m, Genv.init_mem p = Some m ->
+  exists tm, Genv.init_mem tp = Some tm.
+Proof.
+  intros. apply Genv.init_mem_exists.
+  intros. 
+  assert (P: (prog_defmap tp)!id = Some (Gvar v)).
+  { eapply prog_defmap_norepet; eauto. eapply match_prog_unique; eauto. }
+  rewrite (match_prog_def _ _ _ TRANSF) in P. destruct (IS.mem id used) eqn:U; try discriminate.
+  exploit Genv.init_mem_inversion; eauto. apply in_prog_defmap; eauto. intros [AL FV].
+  split. auto.
+  intros. exploit FV; eauto. intros (b & FS).
+  apply transform_find_symbol_1 with b; auto.
+  apply kept_closed with id (Gvar v). 
+  apply IS.mem_2; auto. auto. red. red. exists o; auto.
 Qed.
 
 Theorem init_mem_inject:
@@ -1260,40 +1205,25 @@ Theorem init_mem_inject:
   exists f tm, Genv.init_mem tp = Some tm /\ Mem.inject f m tm /\ meminj_preserves_globals f.
 Proof.
   intros.
-  unfold transform_program in TRANSF; rewrite USED_GLOBALS in TRANSF; injection TRANSF. intros EQ.
-  destruct (alloc_globals_inj (prog_public p) (List.rev (prog_defs p)) m used ge tge) as (tm & A & B & C).
-  rewrite rev_involutive; auto.
-  rewrite rev_involutive; auto.
-  unfold tge; rewrite <- EQ; auto.
-  symmetry. apply Genv.init_mem_genv_next; auto.
-  auto. auto. auto.
-  intros. rewrite rev_involutive. auto.
-  assert (D: Genv.init_mem tp = Some tm).
-  { unfold Genv.init_mem. fold tge. rewrite <- EQ. exact A. }
-  pose proof (init_meminj_preserves_globals).
-  exists init_meminj, tm; intuition auto.
-  constructor; intros.
-  + auto.
-  + destruct (init_meminj b) as [[b1 delta1]|] eqn:INJ; auto.
-    exploit init_meminj_invert; eauto. intros (P & id & Q & R).
-    elim H1. eapply Genv.find_symbol_not_fresh; eauto.
-  + exploit init_meminj_invert; eauto. intros (P & id & Q & R).
-    eapply Genv.find_symbol_not_fresh; eauto.
-  + apply init_meminj_no_overlap.
-  + exploit init_meminj_invert; eauto. intros (P & id & Q & R).
-    split. omega. generalize (Int.unsigned_range_2 ofs). omega.
+  exploit init_mem_exists; eauto. intros [tm INIT].
+  exists init_meminj, tm.
+  split. auto. 
+  split. eapply init_mem_inj_2; eauto. 
+  apply init_meminj_preserves_globals. 
 Qed.
 
 Lemma transf_initial_states:
   forall S1, initial_state p S1 -> exists S2, initial_state tp S2 /\ match_states S1 S2.
 Proof.
   intros. inv H. exploit init_mem_inject; eauto. intros (j & tm & A & B & C).
-  exploit symbols_inject_2. eauto. apply kept_main. eexact H1. intros (tb & P & Q).
-  exploit funct_ptr_inject. eauto. eexact Q. exact H2.
+  exploit symbols_inject_2. eauto. eapply kept_main. eexact H1. intros (tb & P & Q).
+  rewrite Genv.find_funct_ptr_iff in H2. 
+  exploit defs_inject. eauto. eexact Q. exact H2.
   intros (R & S & T).
+  rewrite <- Genv.find_funct_ptr_iff in R.
   exists (Callstate nil f nil tm); split.
   econstructor; eauto.
-    fold tge. unfold transform_program in TRANSF; rewrite USED_GLOBALS in TRANSF; inversion TRANSF; auto.
+  fold tge. erewrite match_prog_main by eauto. auto.
   econstructor; eauto.
   constructor. auto.
   erewrite <- Genv.init_mem_genv_next by eauto. apply Ple_refl.
@@ -1307,7 +1237,7 @@ Proof.
   intros. inv H0. inv H. inv STACKS. inv RESINJ. constructor.
 Qed.
 
-Theorem transf_program_correct:
+Lemma transf_program_correct_1:
   forward_simulation (semantics p) (semantics tp).
 Proof.
   intros.
@@ -1319,3 +1249,175 @@ Proof.
 Qed.
 
 End SOUNDNESS.
+
+Theorem transf_program_correct:
+  forall p tp, match_prog p tp -> forward_simulation (semantics p) (semantics tp).
+Proof.
+  intros p tp (used & A & B).  apply transf_program_correct_1 with used; auto.
+Qed.
+
+(** * Commutation with linking *)
+
+Remark link_def_either:
+  forall (gd1 gd2 gd: globdef fundef unit),
+  link_def gd1 gd2 = Some gd -> gd = gd1 \/ gd = gd2.
+Proof with (try discriminate).
+  intros until gd.
+Local Transparent Linker_def Linker_fundef Linker_varinit Linker_vardef Linker_unit.
+  destruct gd1 as [f1|v1], gd2 as [f2|v2]...
+(* Two fundefs *)
+  destruct f1 as [f1|ef1], f2 as [f2|ef2]; simpl...
+  destruct ef2; intuition congruence.
+  destruct ef1; intuition congruence.
+  destruct (external_function_eq ef1 ef2); intuition congruence.
+(* Two vardefs *)
+  simpl. unfold link_vardef. destruct v1 as [info1 init1 ro1 vo1], v2 as [info2 init2 ro2 vo2]; simpl.
+  destruct (link_varinit init1 init2) as [init|] eqn:LI...
+  destruct (eqb ro1 ro2) eqn:RO...
+  destruct (eqb vo1 vo2) eqn:VO...
+  simpl. 
+  destruct info1, info2.
+  assert (EITHER: init = init1 \/ init = init2).
+  { revert LI. unfold link_varinit. 
+    destruct (classify_init init1), (classify_init init2); intro EQ; inv EQ; auto.
+    destruct (zeq sz (Z.max sz0 0 + 0)); inv H0; auto.
+    destruct (zeq sz (init_data_list_size il)); inv H0; auto.
+    destruct (zeq sz (init_data_list_size il)); inv H0; auto. }
+  apply eqb_prop in RO. apply eqb_prop in VO. 
+  intro EQ; inv EQ. destruct EITHER; subst init; auto.
+Qed.
+
+Remark used_not_defined:
+  forall p used id,
+  valid_used_set p used ->
+  (prog_defmap p)!id = None ->
+  IS.mem id used = false \/ id = prog_main p.
+Proof.
+  intros. destruct (IS.mem id used) eqn:M; auto.
+  exploit used_defined; eauto using IS.mem_2. intros [A|A]; auto.
+  apply prog_defmap_dom in A. destruct A as [g E]; congruence.
+Qed.
+
+Remark used_not_defined_2:
+  forall p used id,
+  valid_used_set p used ->
+  id <> prog_main p ->
+  (prog_defmap p)!id = None ->
+  ~IS.In id used.
+Proof.
+  intros. exploit used_not_defined; eauto. intros [A|A].
+  red; intros; apply IS.mem_1 in H2; congruence.
+  congruence.
+Qed.
+
+Lemma link_valid_used_set:
+  forall p1 p2 p used1 used2,
+  link p1 p2 = Some p ->
+  valid_used_set p1 used1 ->
+  valid_used_set p2 used2 ->
+  valid_used_set p (IS.union used1 used2).
+Proof.
+  intros until used2; intros L V1 V2.
+  destruct (link_prog_inv _ _ _ L) as (X & Y & Z).
+  rewrite Z; clear Z; constructor.
+- intros. rewrite ISF.union_iff in H. rewrite ISF.union_iff.
+  rewrite prog_defmap_elements, PTree.gcombine in H0.
+  destruct (prog_defmap p1)!id as [gd1|] eqn:GD1;
+  destruct (prog_defmap p2)!id as [gd2|] eqn:GD2;
+  simpl in H0; try discriminate.
++ (* common definition *)
+  exploit Y; eauto. intros (PUB1 & PUB2 & _).
+  exploit link_def_either; eauto. intros [EQ|EQ]; subst gd.
+* left. eapply used_closed. eexact V1. eapply used_public. eexact V1. eauto. eauto. auto. 
+* right. eapply used_closed. eexact V2. eapply used_public. eexact V2. eauto. eauto. auto.
++ (* left definition *)
+  inv H0. destruct (ISP.In_dec id used1).
+* left; eapply used_closed; eauto.
+* assert (IS.In id used2) by tauto.
+  exploit used_defined. eexact V2. eauto. intros [A|A].
+  exploit prog_defmap_dom; eauto. intros [g E]; congruence.
+  elim n. rewrite A, <- X. eapply used_main; eauto.
++ (* right definition *)
+  inv H0. destruct (ISP.In_dec id used2).
+* right; eapply used_closed; eauto.
+* assert (IS.In id used1) by tauto.
+  exploit used_defined. eexact V1. eauto. intros [A|A].
+  exploit prog_defmap_dom; eauto. intros [g E]; congruence.
+  elim n. rewrite A, X. eapply used_main; eauto.
++ (* no definition *)
+  auto.
+- simpl. rewrite ISF.union_iff; left; eapply used_main; eauto.
+- simpl. intros id. rewrite in_app_iff, ISF.union_iff. 
+  intros [A|A]; [left|right]; eapply used_public; eauto.
+- intros. rewrite ISF.union_iff in H.
+  destruct (ident_eq id (prog_main p1)).
++ right; assumption.
++ assert (E: exists g, link_prog_merge (prog_defmap p1)!id (prog_defmap p2)!id = Some g).
+  { destruct (prog_defmap p1)!id as [gd1|] eqn:GD1;
+    destruct (prog_defmap p2)!id as [gd2|] eqn:GD2; simpl.
+  * apply Y with id; auto.
+  * exists gd1; auto.
+  * exists gd2; auto.
+  * eapply used_not_defined_2 in GD1; eauto. eapply used_not_defined_2 in GD2; eauto.
+    tauto.
+    congruence.
+  }
+  destruct E as [g LD].
+  left. unfold prog_defs_names; simpl.
+  change id with (fst (id, g)). apply in_map. apply PTree.elements_correct.
+  rewrite PTree.gcombine; auto.
+Qed.
+
+Theorem link_match_program:
+  forall p1 p2 tp1 tp2 p,
+  link p1 p2 = Some p ->
+  match_prog p1 tp1 -> match_prog p2 tp2 ->
+  exists tp, link tp1 tp2 = Some tp /\ match_prog p tp.
+Proof.
+  intros. destruct H0 as (used1 & A1 & B1). destruct H1 as (used2 & A2 & B2).
+  destruct (link_prog_inv _ _ _ H) as (U & V & W).
+  econstructor; split. 
+- apply link_prog_succeeds.
++ rewrite (match_prog_main _ _ _ B1), (match_prog_main _ _ _ B2). auto.
++ intros. 
+  rewrite (match_prog_def _ _ _ B1) in H0.
+  rewrite (match_prog_def _ _ _ B2) in H1.
+  destruct (IS.mem id used1) eqn:U1; try discriminate.
+  destruct (IS.mem id used2) eqn:U2; try discriminate.
+  edestruct V as (X & Y & gd & Z); eauto.
+  split. rewrite (match_prog_public _ _ _ B1); auto. 
+  split. rewrite (match_prog_public _ _ _ B2); auto.
+  congruence.
+- exists (IS.union used1 used2); split.
++ eapply link_valid_used_set; eauto.
++ rewrite W. constructor; simpl; intros.
+* eapply match_prog_main; eauto.
+* rewrite (match_prog_public _ _ _ B1), (match_prog_public _ _ _ B2). auto.
+* rewrite ! prog_defmap_elements, !PTree.gcombine by auto.
+  rewrite (match_prog_def _ _ _ B1 id), (match_prog_def _ _ _ B2 id).
+  rewrite ISF.union_b.
+{
+  destruct (prog_defmap p1)!id as [gd1|] eqn:GD1;
+  destruct (prog_defmap p2)!id as [gd2|] eqn:GD2.
+- (* both defined *)
+  exploit V; eauto. intros (PUB1 & PUB2 & _). 
+  assert (EQ1: IS.mem id used1 = true) by (apply IS.mem_1; eapply used_public; eauto).
+  assert (EQ2: IS.mem id used2 = true) by (apply IS.mem_1; eapply used_public; eauto).
+  rewrite EQ1, EQ2; auto.
+- (* left defined *)
+  exploit used_not_defined; eauto. intros [A|A].
+  rewrite A, orb_false_r. destruct (IS.mem id used1); auto.
+  replace (IS.mem id used1) with true. destruct (IS.mem id used2); auto.
+  symmetry. apply IS.mem_1. rewrite A, <- U. eapply used_main; eauto.
+- (* right defined *)
+  exploit used_not_defined. eexact A1. eauto. intros [A|A].
+  rewrite A, orb_false_l. destruct (IS.mem id used2); auto.
+  replace (IS.mem id used2) with true. destruct (IS.mem id used1); auto.
+  symmetry. apply IS.mem_1. rewrite A, U. eapply used_main; eauto.
+- (* none defined *)
+  destruct (IS.mem id used1), (IS.mem id used2); auto.
+}
+* intros. apply PTree.elements_keys_norepet. 
+Qed.
+
+Instance TransfSelectionLink : TransfLink match_prog := link_match_program.
diff --git a/backend/ValueAnalysis.v b/backend/ValueAnalysis.v
index 979f8c0e..a4d34279 100644
--- a/backend/ValueAnalysis.v
+++ b/backend/ValueAnalysis.v
@@ -10,24 +10,11 @@
 (*                                                                     *)
 (* *********************************************************************)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import Compopts.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Events.
-Require Import Lattice.
-Require Import Kildall.
-Require Import Registers.
-Require Import Op.
-Require Import RTL.
-Require Import ValueDomain.
-Require Import ValueAOp.
-Require Import Liveness.
+Require Import Coqlib Maps Integers Floats Lattice Kildall.
+Require Import Compopts AST Linking.
+Require Import Values Memory Globalenvs Events.
+Require Import Registers Op RTL.
+Require Import ValueDomain ValueAOp Liveness.
 
 (** * The dataflow analysis *)
 
@@ -208,7 +195,7 @@ Fixpoint store_init_data_list (ab: ablock) (p: Z) (idl: list init_data)
                               {struct idl}: ablock :=
   match idl with
   | nil => ab
-  | id :: idl' => store_init_data_list (store_init_data ab p id) (p + Genv.init_data_size id) idl'
+  | id :: idl' => store_init_data_list (store_init_data ab p id) (p + init_data_size id) idl'
   end.
 
 (** When CompCert is used in separate compilation mode, the [gvar_init]
@@ -239,7 +226,7 @@ Definition alloc_global (rm: romem) (idg: ident * globdef fundef unit): romem :=
       else PTree.remove id rm
   end.
 
-Definition romem_for_program (p: program) : romem :=
+Definition romem_for (p: program) : romem :=
   List.fold_left alloc_global p.(prog_defs) (PTree.empty _).
 
 (** * Soundness proof *)
@@ -1045,10 +1032,9 @@ Qed.
 Section SOUNDNESS.
 
 Variable prog: program.
+Variable ge: genv.
 
-Let ge : genv := Genv.globalenv prog.
-
-Let rm := romem_for_program prog.
+Let rm := romem_for prog.
 
 Inductive sound_stack: block_classification -> list stackframe -> mem -> block -> Prop :=
   | sound_stack_nil: forall bc m bound,
@@ -1079,7 +1065,7 @@ Inductive sound_stack: block_classification -> list stackframe -> mem -> block -
         (CONTENTS: bmatch bc' m sp am.(am_stack)),
       sound_stack bc (Stackframe res f (Vptr sp Int.zero) pc e :: stk) m bound.
 
-Inductive sound_state: state -> Prop :=
+Inductive sound_state_base: state -> Prop :=
   | sound_regular_state:
       forall s f sp pc e m ae am bc
         (STK: sound_stack bc s m sp)
@@ -1089,7 +1075,7 @@ Inductive sound_state: state -> Prop :=
         (MM: mmatch bc m am)
         (GE: genv_match bc ge)
         (SP: bc sp = BCstack),
-      sound_state (State s f (Vptr sp Int.zero) pc e m)
+      sound_state_base (State s f (Vptr sp Int.zero) pc e m)
   | sound_call_state:
       forall s fd args m bc
         (STK: sound_stack bc s m (Mem.nextblock m))
@@ -1098,7 +1084,7 @@ Inductive sound_state: state -> Prop :=
         (MM: mmatch bc m mtop)
         (GE: genv_match bc ge)
         (NOSTK: bc_nostack bc),
-      sound_state (Callstate s fd args m)
+      sound_state_base (Callstate s fd args m)
   | sound_return_state:
       forall s v m bc
         (STK: sound_stack bc s m (Mem.nextblock m))
@@ -1107,7 +1093,7 @@ Inductive sound_state: state -> Prop :=
         (MM: mmatch bc m mtop)
         (GE: genv_match bc ge)
         (NOSTK: bc_nostack bc),
-      sound_state (Returnstate s v m).
+      sound_state_base (Returnstate s v m).
 
 (** Properties of the [sound_stack] invariant on call stacks. *)
 
@@ -1223,14 +1209,14 @@ Lemma sound_succ_state:
   genv_match bc ge ->
   bc sp = BCstack ->
   sound_stack bc s m' sp ->
-  sound_state (State s f (Vptr sp Int.zero) pc' e' m').
+  sound_state_base (State s f (Vptr sp Int.zero) pc' e' m').
 Proof.
   intros. exploit analyze_succ; eauto. intros (ae'' & am'' & AN & EM & MM).
   econstructor; eauto.
 Qed.
 
-Theorem sound_step:
-  forall st t st', RTL.step ge st t st' -> sound_state st -> sound_state st'.
+Theorem sound_step_base:
+  forall st t st', RTL.step ge st t st' -> sound_state_base st -> sound_state_base st'.
 Proof.
   induction 1; intros SOUND; inv SOUND.
 
@@ -1309,7 +1295,7 @@ Proof.
   (* The default case *)
   assert (DEFAULT:
             transfer f rm pc ae am = transfer_builtin_default ae am rm args res ->
-            sound_state
+            sound_state_base
                (State s f (Vptr sp0 Int.zero) pc' (regmap_setres res vres rs) m')).
   { unfold transfer_builtin_default, analyze_call; intros TR'.
   set (aargs := map (abuiltin_arg ae am rm) args) in *.
@@ -1480,6 +1466,37 @@ Qed.
 
 End SOUNDNESS.
 
+(** ** Extension to separate compilation *)
+
+(** Following Kang et al, POPL 2016, we now extend the results above 
+  to the case where only one compilation unit is analyzed, and not the
+  whole program.  *)
+
+Section LINKING.
+
+Variable prog: program.
+Let ge := Genv.globalenv prog.
+
+Inductive sound_state: state -> Prop :=
+  | sound_state_intro: forall st,
+      (forall cunit, linkorder cunit prog -> sound_state_base cunit ge st) ->
+      sound_state st.
+
+Theorem sound_step:
+  forall st t st', RTL.step ge st t st' -> sound_state st -> sound_state st'.
+Proof.
+  intros. inv H0. constructor; intros. eapply sound_step_base; eauto. 
+Qed.
+
+Remark sound_state_inv:
+  forall st cunit,
+  sound_state st -> linkorder cunit prog -> sound_state_base cunit ge st.
+Proof.
+  intros. inv H. eauto. 
+Qed.
+
+End LINKING.
+
 (** ** Soundness of the initial memory abstraction *)
 
 Section INITIAL.
@@ -1660,8 +1677,8 @@ Proof.
 Qed.
 
 Definition initial_mem_match (bc: block_classification) (m: mem) (g: genv) :=
-  forall b v,
-  Genv.find_var_info g b = Some v ->
+  forall id b v,
+  Genv.find_symbol g id = Some b -> Genv.find_var_info g b = Some v ->
   v.(gvar_volatile) = false -> v.(gvar_readonly) = true ->
   bmatch bc m b (store_init_data_list (ablock_init Pbot) 0 v.(gvar_init)).
 
@@ -1672,27 +1689,32 @@ Lemma alloc_global_match:
   Genv.alloc_global ge m idg = Some m' ->
   initial_mem_match bc m' (Genv.add_global g idg).
 Proof.
-  intros; red; intros. destruct idg as [id [fd | gv]]; simpl in *.
+  intros; red; intros. destruct idg as [id1 [fd | gv]]; simpl in *.
 - destruct (Mem.alloc m 0 1) as [m1 b1] eqn:ALLOC.
-  unfold Genv.find_var_info, Genv.add_global in H2; simpl in H2.
-  assert (Plt b (Mem.nextblock m)).
-  { rewrite <- H. eapply Genv.genv_vars_range; eauto. }
-  assert (b <> b1).
-  { apply Plt_ne. erewrite Mem.alloc_result by eauto. auto. }
+  unfold Genv.find_symbol in H2; simpl in H2.
+  unfold Genv.find_var_info, Genv.find_def in H3; simpl in H3.
+  rewrite PTree.gsspec in H2. destruct (peq id id1).
+  inv H2. rewrite PTree.gss in H3. discriminate.
+  assert (Plt b (Genv.genv_next g)) by (eapply Genv.genv_symb_range; eauto).
+  rewrite PTree.gso in H3 by (apply Plt_ne; auto). 
+  assert (Mem.valid_block m b) by (red; rewrite <- H; auto).
+  assert (b <> b1) by (apply Mem.valid_not_valid_diff with m; eauto with mem).
   apply bmatch_inv with m.
   eapply H0; eauto.
-  intros. transitivity (Mem.loadbytes m1 b ofs n).
+  intros. transitivity (Mem.loadbytes m1 b ofs n0).
   eapply Mem.loadbytes_drop; eauto.
   eapply Mem.loadbytes_alloc_unchanged; eauto.
-- set (sz := Genv.init_data_list_size (gvar_init gv)) in *.
+- set (sz := init_data_list_size (gvar_init gv)) in *.
   destruct (Mem.alloc m 0 sz) as [m1 b1] eqn:ALLOC.
   destruct (store_zeros m1 b1 0 sz) as [m2 | ] eqn:STZ; try discriminate.
   destruct (Genv.store_init_data_list ge m2 b1 0 (gvar_init gv)) as [m3 | ] eqn:SIDL; try discriminate.
-  unfold Genv.find_var_info, Genv.add_global in H2; simpl in H2.
-  rewrite PTree.gsspec in H2. destruct (peq b (Genv.genv_next g)).
-+ inversion H2; clear H2; subst v.
+  unfold Genv.find_symbol in H2; simpl in H2.
+  unfold Genv.find_var_info, Genv.find_def in H3; simpl in H3.
+  rewrite PTree.gsspec in H2. destruct (peq id id1).
++ injection H2; clear H2; intro EQ.
+  rewrite EQ, PTree.gss in H3. injection H3; clear H3; intros EQ'; subst v.
   assert (b = b1). { erewrite Mem.alloc_result by eauto. congruence. }
-  clear e. subst b.
+  clear EQ. subst b.
   apply bmatch_inv with m3.
   eapply store_init_data_list_sound; eauto.
   apply ablock_init_sound.
@@ -1701,11 +1723,11 @@ Proof.
   exploit Mem.load_alloc_same; eauto. intros EQ; subst v; constructor.
   exploit Mem.loadbytes_alloc_same; eauto with coqlib. congruence.
   intros. eapply Mem.loadbytes_drop; eauto.
-  right; right; right. unfold Genv.perm_globvar. rewrite H3, H4. constructor.
-+ assert (Plt b (Mem.nextblock m)).
-  { rewrite <- H. eapply Genv.genv_vars_range; eauto. }
-  assert (b <> b1).
-  { apply Plt_ne. erewrite Mem.alloc_result by eauto. auto. }
+  right; right; right. unfold Genv.perm_globvar. rewrite H4, H5. constructor.
++ assert (Plt b (Genv.genv_next g)) by (eapply Genv.genv_symb_range; eauto).
+  rewrite PTree.gso in H3 by (apply Plt_ne; auto). 
+  assert (Mem.valid_block m b) by (red; rewrite <- H; auto).
+  assert (b <> b1) by (apply Mem.valid_not_valid_diff with m; eauto with mem).
   apply bmatch_inv with m3.
   eapply store_init_data_list_other; eauto.
   eapply store_zeros_other; eauto.
@@ -1730,44 +1752,56 @@ Proof.
   eapply alloc_global_match; eauto.
 Qed.
 
-Definition romem_consistent (g: genv) (rm: romem) :=
-  forall id b ab,
-  Genv.find_symbol g id = Some b -> rm!id = Some ab ->
+Definition romem_consistent (defmap: PTree.t (globdef fundef unit)) (rm: romem) :=
+  forall id ab,
+  rm!id = Some ab ->
   exists v,
-     Genv.find_var_info g b = Some v
+     defmap!id = Some (Gvar v)
   /\ v.(gvar_readonly) = true
   /\ v.(gvar_volatile) = false
+  /\ definitive_initializer v.(gvar_init) = true
   /\ ab = store_init_data_list (ablock_init Pbot) 0 v.(gvar_init).
 
 Lemma alloc_global_consistent:
-  forall g rm idg,
-  romem_consistent g rm ->
-  romem_consistent (Genv.add_global g idg) (alloc_global rm idg).
+  forall dm rm idg,
+  romem_consistent dm rm ->
+  romem_consistent (PTree.set (fst idg) (snd idg) dm) (alloc_global rm idg).
+Proof.
+  intros; red; intros. destruct idg as [id1 [f1 | v1]]; simpl in *.
+- rewrite PTree.grspec in H0. destruct (PTree.elt_eq id id1); try discriminate.
+  rewrite PTree.gso by auto. apply H; auto. 
+- destruct (gvar_readonly v1 && negb (gvar_volatile v1) && definitive_initializer (gvar_init v1)) eqn:RO.
++ InvBooleans. rewrite negb_true_iff in H4.
+  rewrite PTree.gsspec in *. destruct (peq id id1).
+* inv H0. exists v1; auto.
+* apply H; auto.
++ rewrite PTree.grspec in H0. destruct (PTree.elt_eq id id1); try discriminate.
+  rewrite PTree.gso by auto. apply H; auto. 
+Qed.
+
+Lemma romem_for_consistent:
+  forall cunit, romem_consistent (prog_defmap cunit) (romem_for cunit).
 Proof.
-  intros; red; intros. destruct idg as [id1 [fd1 | v1]];
-  unfold Genv.add_global, Genv.find_symbol, Genv.find_var_info, alloc_global in *; simpl in *.
-- rewrite PTree.gsspec in H0. rewrite PTree.grspec in H1. unfold PTree.elt_eq in *.
-  destruct (peq id id1). congruence. eapply H; eauto.
-- rewrite PTree.gsspec in H0. destruct (peq id id1).
-+ inv H0. rewrite PTree.gss.
-  destruct (gvar_readonly v1 && negb (gvar_volatile v1) && definitive_initializer (gvar_init v1)) eqn:RO.
-  InvBooleans. rewrite negb_true_iff in H4.
-  rewrite PTree.gss in H1.
-  exists v1. intuition congruence.
-  rewrite PTree.grs in H1. discriminate.
-+ rewrite PTree.gso. eapply H; eauto.
-  destruct (gvar_readonly v1 && negb (gvar_volatile v1) && definitive_initializer (gvar_init v1)).
-  rewrite PTree.gso in H1; auto.
-  rewrite PTree.gro in H1; auto.
-  apply Plt_ne. eapply Genv.genv_symb_range; eauto.
+  assert (REC: forall l dm rm,
+            romem_consistent dm rm ->
+            romem_consistent (fold_left (fun m idg => PTree.set (fst idg) (snd idg) m) l dm)
+                             (fold_left alloc_global l rm)).
+  { induction l; intros; simpl; auto. apply IHl. apply alloc_global_consistent; auto. }
+  intros. apply REC.
+  red; intros. rewrite PTree.gempty in H; discriminate.
 Qed.
 
-Lemma alloc_globals_consistent:
-  forall gl g rm,
-  romem_consistent g rm ->
-  romem_consistent (Genv.add_globals g gl) (List.fold_left alloc_global gl rm).
+Lemma romem_for_consistent_2:
+  forall cunit, linkorder cunit prog -> romem_consistent (prog_defmap prog) (romem_for cunit).
 Proof.
-  induction gl; simpl; intros. auto. apply IHgl. apply alloc_global_consistent; auto.
+  intros; red; intros.
+  exploit (romem_for_consistent cunit); eauto. intros (v & DM & RO & VO & DEFN & AB).
+  destruct (prog_defmap_linkorder _ _ _ _ H DM) as (gd & P & Q).
+  assert (gd = Gvar v).
+  { inv Q. inv H2. simpl in *. f_equal. f_equal. 
+    destruct info1, info2; auto.
+    inv H3; auto; discriminate. }
+  subst gd. exists v; auto.
 Qed.
 
 End INIT.
@@ -1779,27 +1813,28 @@ Theorem initial_mem_matches:
      genv_match bc ge
   /\ bc_below bc (Mem.nextblock m)
   /\ bc_nostack bc
-  /\ romatch bc m (romem_for_program prog)
+  /\ (forall cunit, linkorder cunit prog -> romatch bc m (romem_for cunit))
   /\ (forall b, Mem.valid_block m b -> bc b <> BCinvalid).
 Proof.
   intros.
   exploit initial_block_classification; eauto. intros (bc & GE & BELOW & NOSTACK & INV & VALID).
   exists bc; splitall; auto.
+  intros.
   assert (A: initial_mem_match bc m ge).
   {
     apply alloc_globals_match with (m := Mem.empty); auto.
-    red. unfold Genv.find_var_info; simpl. intros. rewrite PTree.gempty in H0; discriminate.
-  }
-  assert (B: romem_consistent ge (romem_for_program prog)).
-  {
-    apply alloc_globals_consistent.
-    red; intros. rewrite PTree.gempty in H1; discriminate.
+    red. unfold Genv.find_symbol; simpl; intros. rewrite PTree.gempty in H1; discriminate.
   }
+  assert (B: romem_consistent (prog_defmap prog) (romem_for cunit)) by (apply romem_for_consistent_2; auto).
   red; intros.
-  exploit B; eauto. intros (v & FV & RO & NVOL & EQ).
+  exploit B; eauto. intros (v & DM & RO & NVOL & DEFN & EQ).
+  rewrite Genv.find_def_symbol in DM. destruct DM as (b1 & FS & FD).
+  rewrite <- Genv.find_var_info_iff in FD.
+  assert (b1 = b). { apply INV in H1. unfold ge in H1; congruence. }
+  subst b1.
   split. subst ab. apply store_init_data_list_summary. constructor.
   split. subst ab. eapply A; eauto.
-  unfold ge in FV; exploit Genv.init_mem_characterization; eauto.
+  exploit Genv.init_mem_characterization; eauto.
   intros (P & Q & R).
   intros; red; intros. exploit Q; eauto. intros [U V].
   unfold Genv.perm_globvar in V; rewrite RO, NVOL in V. inv V.
@@ -1814,10 +1849,10 @@ Theorem sound_initial:
 Proof.
   destruct 1.
   exploit initial_mem_matches; eauto. intros (bc & GE & BELOW & NOSTACK & RM & VALID).
-  apply sound_call_state with bc.
+  constructor; intros. apply sound_call_state with bc.
 - constructor.
 - simpl; tauto.
-- exact RM.
+- apply RM; auto.
 - apply mmatch_inj_top with m0.
   replace (inj_of_bc bc) with (Mem.flat_inj (Mem.nextblock m0)).
   eapply Genv.initmem_inject; eauto.
@@ -1833,6 +1868,12 @@ Hint Resolve areg_sound aregs_sound: va.
 
 (** * Interface with other optimizations *)
 
+Ltac InvSoundState :=
+  match goal with
+  | H1: sound_state ?prog ?st, H2: linkorder ?cunit ?prog |- _ =>
+      let S := fresh "S" in generalize (sound_state_inv _ _ _ H1 H2); intros S; inv S
+  end.
+
 Definition avalue (a: VA.t) (r: reg) : aval :=
   match a with
   | VA.Bot => Vbot
@@ -1840,14 +1881,15 @@ Definition avalue (a: VA.t) (r: reg) : aval :=
   end.
 
 Lemma avalue_sound:
-  forall prog s f sp pc e m r,
+  forall cunit prog s f sp pc e m r,
   sound_state prog (State s f (Vptr sp Int.zero) pc e m) ->
+  linkorder cunit prog ->
   exists bc,
-     vmatch bc e#r (avalue (analyze (romem_for_program prog) f)!!pc r)
+     vmatch bc e#r (avalue (analyze (romem_for cunit) f)!!pc r)
   /\ genv_match bc (Genv.globalenv prog)
   /\ bc sp = BCstack.
 Proof.
-  intros. inv H. exists bc; split; auto. rewrite AN. apply EM.
+  intros. InvSoundState. exists bc; split; auto. rewrite AN. apply EM.
 Qed.
 
 Definition aaddr (a: VA.t) (r: reg) : aptr :=
@@ -1857,16 +1899,17 @@ Definition aaddr (a: VA.t) (r: reg) : aptr :=
   end.
 
 Lemma aaddr_sound:
-  forall prog s f sp pc e m r b ofs,
+  forall cunit prog s f sp pc e m r b ofs,
   sound_state prog (State s f (Vptr sp Int.zero) pc e m) ->
+  linkorder cunit prog ->
   e#r = Vptr b ofs ->
   exists bc,
-     pmatch bc b ofs (aaddr (analyze (romem_for_program prog) f)!!pc r)
+     pmatch bc b ofs (aaddr (analyze (romem_for cunit) f)!!pc r)
   /\ genv_match bc (Genv.globalenv prog)
   /\ bc sp = BCstack.
 Proof.
-  intros. inv H. exists bc; split; auto.
-  unfold aaddr; rewrite AN. apply match_aptr_of_aval. rewrite <- H0. apply EM.
+  intros. InvSoundState. exists bc; split; auto.
+  unfold aaddr; rewrite AN. apply match_aptr_of_aval. rewrite <- H1. apply EM.
 Qed.
 
 Definition aaddressing (a: VA.t) (addr: addressing) (args: list reg) : aptr :=
@@ -1876,15 +1919,16 @@ Definition aaddressing (a: VA.t) (addr: addressing) (args: list reg) : aptr :=
   end.
 
 Lemma aaddressing_sound:
-  forall prog s f sp pc e m addr args b ofs,
+  forall cunit prog s f sp pc e m addr args b ofs,
   sound_state prog (State s f (Vptr sp Int.zero) pc e m) ->
+  linkorder cunit prog ->
   eval_addressing (Genv.globalenv prog) (Vptr sp Int.zero) addr e##args = Some (Vptr b ofs) ->
   exists bc,
-     pmatch bc b ofs (aaddressing (analyze (romem_for_program prog) f)!!pc addr args)
+     pmatch bc b ofs (aaddressing (analyze (romem_for cunit) f)!!pc addr args)
   /\ genv_match bc (Genv.globalenv prog)
   /\ bc sp = BCstack.
 Proof.
-  intros. inv H. exists bc; split; auto.
+  intros. InvSoundState. exists bc; split; auto.
   unfold aaddressing. rewrite AN. apply match_aptr_of_aval.
   eapply eval_static_addressing_sound; eauto with va.
 Qed.
@@ -1921,14 +1965,15 @@ Proof.
 Qed.
 
 Lemma aaddr_arg_sound:
-  forall prog s f sp pc e m a b ofs,
+  forall cunit prog s f sp pc e m a b ofs,
   sound_state prog (State s f (Vptr sp Int.zero) pc e m) ->
+  linkorder cunit prog ->
   eval_builtin_arg (Genv.globalenv prog) (fun r => e#r) (Vptr sp Int.zero) m a (Vptr b ofs) ->
   exists bc,
-     pmatch bc b ofs (aaddr_arg (analyze (romem_for_program prog) f)!!pc a)
+     pmatch bc b ofs (aaddr_arg (analyze (romem_for cunit) f)!!pc a)
   /\ genv_match bc (Genv.globalenv prog)
   /\ bc sp = BCstack.
 Proof.
-  intros. inv H. rewrite AN. exists bc; split; auto.
+  intros. InvSoundState. rewrite AN. exists bc; split; auto.
   eapply aaddr_arg_sound_1; eauto.
 Qed.
diff --git a/backend/ValueDomain.v b/backend/ValueDomain.v
index 048ab816..f9ccd5db 100644
--- a/backend/ValueDomain.v
+++ b/backend/ValueDomain.v
@@ -10,21 +10,12 @@
 (*                                                                     *)
 (* *********************************************************************)
 
-Require Import Coqlib.
-Require Import Zwf.
-Require Import Maps.
-Require Import Compopts.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Events.
-Require Import Lattice.
-Require Import Kildall.
-Require Import Registers.
-Require Import RTL.
+Require Import Zwf Coqlib Maps Integers Floats Lattice.
+Require Import Compopts AST.
+Require Import Values Memory Globalenvs Events.
+Require Import Registers RTL.
+
+(** The abstract domains for value analysis *)
 
 Inductive block_class : Type :=
   | BCinvalid
@@ -3814,7 +3805,8 @@ Lemma inj_of_bc_preserves_globals:
 Proof.
   intros. destruct H as [A B].
   split. intros. apply inj_of_bc_valid. rewrite A in H. congruence.
-  split. intros. apply inj_of_bc_valid. apply B. eapply Genv.genv_vars_range; eauto.
+  split. intros. apply inj_of_bc_valid. apply B.
+    rewrite Genv.find_var_info_iff in H. eapply Genv.genv_defs_range; eauto.
   intros. exploit inj_of_bc_inv; eauto. intros (P & Q & R). auto.
 Qed.
 
diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index 6eabfbf4..16e8a80d 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -1078,7 +1078,7 @@ let convertFundef loc env fd =
       a_access = Sections.Access_default;
       a_inline = fd.fd_inline && not fd.fd_vararg;  (* PR#15 *)
       a_loc = loc };
-  (id', Gfun(Csyntax.Internal
+  (id', Gfun(Ctypes.Internal
           {fn_return = ret;
            fn_callconv = convertCallconv fd.fd_vararg false fd.fd_attrib;
            fn_params = params;
@@ -1088,6 +1088,7 @@ let convertFundef loc env fd =
 (** External function declaration *)
 
 let re_builtin = Str.regexp "__builtin_"
+let re_runtime = Str.regexp "__i64_"
 
 let convertFundecl env (sto, id, ty, optinit) =
   let (args, res, cconv) =
@@ -1100,11 +1101,12 @@ let convertFundecl env (sto, id, ty, optinit) =
   let ef =
     if id.name = "malloc" then EF_malloc else
     if id.name = "free" then EF_free else
+    if Str.string_match re_runtime id.name 0 then EF_runtime(id'', sg) else
     if Str.string_match re_builtin id.name 0
     && List.mem_assoc id.name builtins.functions
     then EF_builtin(id'', sg)
     else EF_external(id'', sg) in
-  (id', Gfun(Csyntax.External(ef, args, res, cconv)))
+  (id', Gfun(Ctypes.External(ef, args, res, cconv)))
 
 (** Initializers *)
 
diff --git a/cfrontend/Cexec.v b/cfrontend/Cexec.v
index 7e966ffe..bf88e033 100644
--- a/cfrontend/Cexec.v
+++ b/cfrontend/Cexec.v
@@ -536,6 +536,7 @@ Definition do_external (ef: external_function):
   match ef with
   | EF_external name sg => do_external_function name sg ge
   | EF_builtin name sg => do_external_function name sg ge
+  | EF_runtime name sg => do_external_function name sg ge
   | EF_vload chunk => do_ef_volatile_load chunk
   | EF_vstore chunk => do_ef_volatile_store chunk
   | EF_malloc => do_ef_malloc
@@ -558,6 +559,8 @@ Proof with try congruence.
   eapply do_external_function_sound; eauto.
 (* EF_builtin *)
   eapply do_external_function_sound; eauto.
+(* EF_runtime *)
+  eapply do_external_function_sound; eauto.
 (* EF_vload *)
   unfold do_ef_volatile_load. destruct vargs... destruct v... destruct vargs...
   mydestr. destruct p as [[w'' t''] v]; mydestr.
@@ -604,6 +607,8 @@ Proof.
   eapply do_external_function_complete; eauto.
 (* EF_builtin *)
   eapply do_external_function_complete; eauto.
+(* EF_runtime *)
+  eapply do_external_function_complete; eauto.
 (* EF_vload *)
   inv H; unfold do_ef_volatile_load.
   exploit do_volatile_load_complete; eauto. intros EQ; rewrite EQ; auto.
@@ -645,11 +650,11 @@ Section EXPRS.
 Variable e: env.
 Variable w: world.
 
-Fixpoint sem_cast_arguments (vtl: list (val * type)) (tl: typelist) : option (list val) :=
+Fixpoint sem_cast_arguments (vtl: list (val * type)) (tl: typelist) (m: mem) : option (list val) :=
   match vtl, tl with
   | nil, Tnil => Some nil
   | (v1,t1)::vtl, Tcons t1' tl =>
-      do v <- sem_cast v1 t1 t1'; do vl <- sem_cast_arguments vtl tl; Some(v::vl)
+      do v <- sem_cast v1 t1 t1' m; do vl <- sem_cast_arguments vtl tl m; Some(v::vl)
   | _, _ => None
   end.
 
@@ -772,7 +777,7 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
   | RV, Ecast r1 ty =>
       match is_val r1 with
       | Some(v1, ty1) =>
-          do v <- sem_cast v1 ty1 ty;
+          do v <- sem_cast v1 ty1 ty m;
           topred (Rred "red_cast" (Eval v ty) m E0)
       | None =>
           incontext (fun x => Ecast x ty) (step_expr RV r1 m)
@@ -811,7 +816,7 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
       match is_loc l1, is_val r2 with
       | Some(b, ofs, ty1), Some(v2, ty2) =>
           check type_eq ty1 ty;
-          do v <- sem_cast v2 ty2 ty1;
+          do v <- sem_cast v2 ty2 ty1 m;
           do w',t,m' <- do_assign_loc w ty1 m b ofs v;
           topred (Rred "red_assign" (Eval v ty) m' t)
       | _, _ =>
@@ -856,7 +861,7 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
   | RV, Eparen r1 tycast ty =>
       match is_val r1 with
       | Some (v1, ty1) =>
-          do v <- sem_cast v1 ty1 tycast;
+          do v <- sem_cast v1 ty1 tycast m;
           topred (Rred "red_paren" (Eval v ty) m E0)
       | None =>
           incontext (fun x => Eparen x tycast ty) (step_expr RV r1 m)
@@ -867,7 +872,7 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
           match classify_fun tyf with
           | fun_case_f tyargs tyres cconv =>
               do fd <- Genv.find_funct ge vf;
-              do vargs <- sem_cast_arguments vtl tyargs;
+              do vargs <- sem_cast_arguments vtl tyargs m;
               check type_eq (type_of_fundef fd) (Tfunction tyargs tyres cconv);
               topred (Callred "red_call" fd vargs ty m)
           | _ => stuck
@@ -879,7 +884,7 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
   | RV, Ebuiltin ef tyargs rargs ty =>
       match is_val_list rargs with
       | Some vtl =>
-          do vargs <- sem_cast_arguments vtl tyargs;
+          do vargs <- sem_cast_arguments vtl tyargs m;
           match do_external ef w vargs m with
           | None => stuck
           | Some(w',t,v,m') => topred (Rred "red_builtin" (Eval v ty) m' t)
@@ -915,7 +920,7 @@ Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
       context RV to C ->
       imm_safe_t to (C r) m
   | imm_safe_t_callred: forall to C r m fd args ty,
-      callred ge r fd args ty ->
+      callred ge r m fd args ty ->
       context RV to C ->
       imm_safe_t to (C r) m.
 
@@ -961,7 +966,7 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
   | Ebinop op (Eval v1 ty1) (Eval v2 ty2) ty =>
       exists v, sem_binary_operation ge op v1 ty1 v2 ty2 m = Some v
   | Ecast (Eval v1 ty1) ty =>
-      exists v, sem_cast v1 ty1 ty = Some v
+      exists v, sem_cast v1 ty1 ty m = Some v
   | Eseqand (Eval v1 ty1) r2 ty =>
       exists b, bool_val v1 ty1 m = Some b
   | Eseqor (Eval v1 ty1) r2 ty =>
@@ -970,7 +975,7 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
       exists b, bool_val v1 ty1 m = Some b
   | Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty =>
       exists v, exists m', exists t, exists w',
-      ty = ty1 /\ sem_cast v2 ty2 ty1 = Some v /\ assign_loc ge ty1 m b ofs v t m' /\ possible_trace w t w'
+      ty = ty1 /\ sem_cast v2 ty2 ty1 m = Some v /\ assign_loc ge ty1 m b ofs v t m' /\ possible_trace w t w'
   | Eassignop op (Eloc b ofs ty1) (Eval v2 ty2) tyres ty =>
       exists t, exists v1, exists w',
       ty = ty1 /\ deref_loc ge ty1 m b ofs t v1 /\ possible_trace w t w'
@@ -980,18 +985,18 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
   | Ecomma (Eval v ty1) r2 ty =>
       typeof r2 = ty
   | Eparen (Eval v1 ty1) tycast ty =>
-      exists v, sem_cast v1 ty1 tycast = Some v
+      exists v, sem_cast v1 ty1 tycast m = Some v
   | Ecall (Eval vf tyf) rargs ty =>
       exprlist_all_values rargs ->
       exists tyargs tyres cconv fd vl,
          classify_fun tyf = fun_case_f tyargs tyres cconv
       /\ Genv.find_funct ge vf = Some fd
-      /\ cast_arguments rargs tyargs vl
+      /\ cast_arguments m rargs tyargs vl
       /\ type_of_fundef fd = Tfunction tyargs tyres cconv
   | Ebuiltin ef tyargs rargs ty =>
       exprlist_all_values rargs ->
       exists vargs t vres m' w',
-         cast_arguments rargs tyargs vargs
+         cast_arguments m rargs tyargs vargs
       /\ external_call ef ge vargs m t vres m'
       /\ possible_trace w t w'
   | _ => True
@@ -1028,7 +1033,7 @@ Qed.
 
 Lemma callred_invert:
   forall r fd args ty m,
-  callred ge r fd args ty ->
+  callred ge r m fd args ty ->
   invert_expr_prop r m.
 Proof.
   intros. inv H. simpl.
@@ -1124,7 +1129,7 @@ Definition reduction_ok (k: kind) (a: expr) (m: mem) (rd: reduction) : Prop :=
   match k, rd with
   | LV, Lred _ l' m' => lred ge e a m l' m'
   | RV, Rred _ r' m' t => rred ge a m t r' m' /\ exists w', possible_trace w t w'
-  | RV, Callred _ fd args tyres m' => callred ge a fd args tyres /\ m' = m
+  | RV, Callred _ fd args tyres m' => callred ge a m fd args tyres /\ m' = m
   | LV, Stuckred => ~imm_safe_t k a m
   | RV, Stuckred => ~imm_safe_t k a m
   | _, _ => False
@@ -1152,10 +1157,10 @@ Ltac monadInv :=
   end.
 
 Lemma sem_cast_arguments_sound:
-  forall rargs vtl tyargs vargs,
+  forall m rargs vtl tyargs vargs,
   is_val_list rargs = Some vtl ->
-  sem_cast_arguments vtl tyargs = Some vargs ->
-  cast_arguments rargs tyargs vargs.
+  sem_cast_arguments vtl tyargs m = Some vargs ->
+  cast_arguments m rargs tyargs vargs.
 Proof.
   induction rargs; simpl; intros.
   inv H. destruct tyargs; simpl in H0; inv H0. constructor.
@@ -1164,9 +1169,9 @@ Proof.
 Qed.
 
 Lemma sem_cast_arguments_complete:
-  forall al tyl vl,
-  cast_arguments al tyl vl ->
-  exists vtl, is_val_list al = Some vtl /\ sem_cast_arguments vtl tyl = Some vl.
+  forall m al tyl vl,
+  cast_arguments m al tyl vl ->
+  exists vtl, is_val_list al = Some vtl /\ sem_cast_arguments vtl tyl m = Some vl.
 Proof.
   induction 1.
   exists (@nil (val * type)); auto.
@@ -1396,7 +1401,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
 (* cast *)
   destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
   (* top *)
-  destruct (sem_cast v ty' ty) as [v'|] eqn:?...
+  destruct (sem_cast v ty' ty m) as [v'|] eqn:?...
   apply topred_ok; auto. split. apply red_cast; auto. exists w; constructor.
   (* depth *)
   eapply incontext_ok; eauto.
@@ -1433,7 +1438,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
   rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
   (* top *)
   destruct (type_eq ty1 ty)... subst ty1.
-  destruct (sem_cast v2 ty2 ty) as [v|] eqn:?...
+  destruct (sem_cast v2 ty2 ty m) as [v|] eqn:?...
   destruct (do_assign_loc w ty m b ofs v) as [[[w' t] m']|] eqn:?.
   exploit do_assign_loc_sound; eauto. intros [P Q].
   apply topred_ok; auto. split. apply red_assign; auto. exists w'; auto.
@@ -1478,7 +1483,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
   (* top *)
   destruct (classify_fun tyf) as [tyargs tyres cconv|] eqn:?...
   destruct (Genv.find_funct ge vf) as [fd|] eqn:?...
-  destruct (sem_cast_arguments vtl tyargs) as [vargs|] eqn:?...
+  destruct (sem_cast_arguments vtl tyargs m) as [vargs|] eqn:?...
   destruct (type_eq (type_of_fundef fd) (Tfunction tyargs tyres cconv))...
   apply topred_ok; auto. red. split; auto. eapply red_call; eauto.
   eapply sem_cast_arguments_sound; eauto.
@@ -1494,7 +1499,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
   destruct (is_val_list rargs) as [vtl | ] eqn:?.
   exploit is_val_list_all_values; eauto. intros ALLVAL.
   (* top *)
-  destruct (sem_cast_arguments vtl tyargs) as [vargs|] eqn:?...
+  destruct (sem_cast_arguments vtl tyargs m) as [vargs|] eqn:?...
   destruct (do_external ef w vargs m) as [[[[? ?] v] m'] | ] eqn:?...
   exploit do_ef_external_sound; eauto. intros [EC PT].
   apply topred_ok; auto. red. split; auto. eapply red_builtin; eauto.
@@ -1514,7 +1519,7 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
 (* paren *)
   destruct (is_val a) as [[v ty'] | ] eqn:?. rewrite (is_val_inv _ _ _ Heqo).
   (* top *)
-  destruct (sem_cast v ty' tycast) as [v'|] eqn:?...
+  destruct (sem_cast v ty' tycast m) as [v'|] eqn:?...
   apply topred_ok; auto. split. apply red_paren; auto. exists w; constructor.
   (* depth *)
   eapply incontext_ok; eauto.
@@ -1607,7 +1612,7 @@ Qed.
 
 Lemma callred_topred:
   forall a fd args ty m,
-  callred ge a fd args ty ->
+  callred ge a m fd args ty ->
   exists rule, step_expr RV a m = topred (Callred rule fd args ty m).
 Proof.
   induction 1; simpl.
@@ -1961,7 +1966,7 @@ Definition do_step (w: world) (s: state) : list transition :=
             then ret "step_for_true" (State f s (Kfor3 a2 a3 s k) e m)
             else ret "step_for_false" (State f Sskip k e m)
         | Kreturn k =>
-            do v' <- sem_cast v ty f.(fn_return);
+            do v' <- sem_cast v ty f.(fn_return) m;
             do m' <- Mem.free_list m (blocks_of_env ge e);
             ret "step_return_2" (Returnstate v' (call_cont k) m')
         | Kswitch1 sl k =>
@@ -2165,7 +2170,7 @@ Proof with (unfold ret; eauto with coqlib).
   apply extensionality; auto.
 (* callred *)
   unfold do_step; rewrite NOTVAL.
-  exploit callred_topred; eauto. instantiate (1 := m). instantiate (1 := w). instantiate (1 := e).
+  exploit callred_topred; eauto. instantiate (1 := w). instantiate (1 := e).
   intros (rule & STEP). exists rule.
   change (TR rule E0 (Callstate fd vargs (Kcall f e C ty k) m)) with (expr_final_state f k e (C, Callred rule fd vargs ty m)).
   apply in_map.
diff --git a/cfrontend/Clight.v b/cfrontend/Clight.v
index 8722da69..e6426fb8 100644
--- a/cfrontend/Clight.v
+++ b/cfrontend/Clight.v
@@ -146,9 +146,7 @@ Definition var_names (vars: list(ident * type)) : list ident :=
 (** Functions can either be defined ([Internal]) or declared as
   external functions ([External]). *)
 
-Inductive fundef : Type :=
-  | Internal: function -> fundef
-  | External: external_function -> typelist -> type -> calling_convention -> fundef.
+Definition fundef := Ctypes.fundef function.
 
 (** The type of a function definition. *)
 
@@ -163,45 +161,16 @@ Definition type_of_fundef (f: fundef) : type :=
 
 (** ** Programs *)
 
-(** A program is composed of:
+(** As defined in module [Ctypes], a program, or compilation unit, is
+  composed of:
 - a list of definitions of functions and global variables;
 - the names of functions and global variables that are public (not static);
 - the name of the function that acts as entry point ("main" function).
-- a list of definitions for structure and union names;
-- the corresponding composite environment;
-*)
-
-Record program : Type := {
-  prog_defs: list (ident * globdef fundef type);
-  prog_public: list ident;
-  prog_main: ident;
-  prog_types: list composite_definition;
-  prog_comp_env: composite_env;
-  prog_comp_env_eq: build_composite_env prog_types = OK prog_comp_env
-}.
+- a list of definitions for structure and union names
+- the corresponding composite environment
+- a proof that this environment is consistent with the definitions. *)
 
-Definition program_of_program (p: program) : AST.program fundef type :=
-  {| AST.prog_defs := p.(prog_defs);
-     AST.prog_public := p.(prog_public);
-     AST.prog_main := p.(prog_main) |}.
-
-Coercion program_of_program: program >-> AST.program.
-
-Program Definition make_program (types: list composite_definition)
-                                (defs: list (ident * globdef fundef type))
-                                (public: list ident)
-                                (main: ident): res program :=
-  match build_composite_env types with
-  | OK env =>
-      OK {| prog_defs := defs;
-            prog_public := public;
-            prog_main := main;
-            prog_types := types;
-            prog_comp_env := env;
-            prog_comp_env_eq := _ |}
-  | Error msg =>
-      Error msg
-  end.
+Definition program := Ctypes.program function.
 
 (** * Operational semantics *)
 
@@ -412,7 +381,7 @@ Inductive eval_expr: expr -> val -> Prop :=
       eval_expr (Ebinop op a1 a2 ty) v
   | eval_Ecast:   forall a ty v1 v,
       eval_expr a v1 ->
-      sem_cast v1 (typeof a) ty = Some v ->
+      sem_cast v1 (typeof a) ty m = Some v ->
       eval_expr (Ecast a ty) v
   | eval_Esizeof: forall ty1 ty,
       eval_expr (Esizeof ty1 ty) (Vint (Int.repr (sizeof ge ty1)))
@@ -464,7 +433,7 @@ Inductive eval_exprlist: list expr -> typelist -> list val -> Prop :=
       eval_exprlist nil Tnil nil
   | eval_Econs:   forall a bl ty tyl v1 v2 vl,
       eval_expr a v1 ->
-      sem_cast v1 (typeof a) ty = Some v2 ->
+      sem_cast v1 (typeof a) ty m = Some v2 ->
       eval_exprlist bl tyl vl ->
       eval_exprlist (a :: bl) (Tcons ty tyl) (v2 :: vl).
 
@@ -580,7 +549,7 @@ Inductive step: state -> trace -> state -> Prop :=
   | step_assign:   forall f a1 a2 k e le m loc ofs v2 v m',
       eval_lvalue e le m a1 loc ofs ->
       eval_expr e le m a2 v2 ->
-      sem_cast v2 (typeof a2) (typeof a1) = Some v ->
+      sem_cast v2 (typeof a2) (typeof a1) m = Some v ->
       assign_loc ge (typeof a1) m loc ofs v m' ->
       step (State f (Sassign a1 a2) k e le m)
         E0 (State f Sskip k e le m')
@@ -647,7 +616,7 @@ Inductive step: state -> trace -> state -> Prop :=
         E0 (Returnstate Vundef (call_cont k) m')
   | step_return_1: forall f a k e le m v v' m',
       eval_expr e le m a v ->
-      sem_cast v (typeof a) f.(fn_return) = Some v' ->
+      sem_cast v (typeof a) f.(fn_return) m = Some v' ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
       step (State f (Sreturn (Some a)) k e le m)
         E0 (Returnstate v' (call_cont k) m')
@@ -774,4 +743,3 @@ Proof.
   eapply external_call_trace_length; eauto.
   eapply external_call_trace_length; eauto.
 Qed.
-
diff --git a/cfrontend/ClightBigstep.v b/cfrontend/ClightBigstep.v
index ee653d50..92457586 100644
--- a/cfrontend/ClightBigstep.v
+++ b/cfrontend/ClightBigstep.v
@@ -60,11 +60,11 @@ Definition outcome_switch (out: outcome) : outcome :=
   | o => o
   end.
 
-Definition outcome_result_value (out: outcome) (t: type) (v: val) : Prop :=
+Definition outcome_result_value (out: outcome) (t: type) (v: val) (m: mem): Prop :=
   match out, t with
   | Out_normal, Tvoid => v = Vundef
   | Out_return None, Tvoid => v = Vundef
-  | Out_return (Some (v',t')), ty => ty <> Tvoid /\ sem_cast v' t' t = Some v
+  | Out_return (Some (v',t')), ty => ty <> Tvoid /\ sem_cast v' t' t m = Some v
   | _, _ => False
   end.
 
@@ -81,7 +81,7 @@ Inductive exec_stmt: env -> temp_env -> mem -> statement -> trace -> temp_env ->
   | exec_Sassign:   forall e le m a1 a2 loc ofs v2 v m',
       eval_lvalue ge e le m a1 loc ofs ->
       eval_expr ge e le m a2 v2 ->
-      sem_cast v2 (typeof a2) (typeof a1) = Some v ->
+      sem_cast v2 (typeof a2) (typeof a1) m = Some v ->
       assign_loc ge (typeof a1) m loc ofs v m' ->
       exec_stmt e le m (Sassign a1 a2)
                E0 le m' Out_normal
@@ -168,7 +168,7 @@ with eval_funcall: mem -> fundef -> list val -> trace -> mem -> val -> Prop :=
       list_norepet (var_names f.(fn_params) ++ var_names f.(fn_vars)) ->
       bind_parameters ge e m1 f.(fn_params) vargs m2 ->
       exec_stmt e (create_undef_temps f.(fn_temps)) m2 f.(fn_body) t le m3 out ->
-      outcome_result_value out f.(fn_return) vres ->
+      outcome_result_value out f.(fn_return) vres m3 ->
       Mem.free_list m3 (blocks_of_env ge e) = Some m4 ->
       eval_funcall m (Internal f) vargs t m4 vres
   | eval_funcall_external: forall m ef targs tres cconv vargs t vres m',
diff --git a/cfrontend/Cminorgen.v b/cfrontend/Cminorgen.v
index c2b59fbe..b9a28ee1 100644
--- a/cfrontend/Cminorgen.v
+++ b/cfrontend/Cminorgen.v
@@ -12,19 +12,10 @@
 
 (** Translation from Csharpminor to Cminor. *)
 
-Require Import FSets.
-Require FSetAVL.
-Require Import Orders.
-Require Mergesort.
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import Ordered.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Csharpminor.
-Require Import Cminor.
+Require Import FSets FSetAVL Orders Mergesort.
+Require Import Coqlib Maps Ordered Errors Integers Floats.
+Require Import AST Linking.
+Require Import Csharpminor Cminor.
 
 Local Open Scope string_scope.
 Local Open Scope error_monad_scope.
diff --git a/cfrontend/Cminorgenproof.v b/cfrontend/Cminorgenproof.v
index 7a5d882e..2f551d68 100644
--- a/cfrontend/Cminorgenproof.v
+++ b/cfrontend/Cminorgenproof.v
@@ -12,61 +12,54 @@
 
 (** Correctness proof for Cminor generation. *)
 
-Require Import Coq.Program.Equality.
-Require Import FSets.
-Require Import Permutation.
-Require Import Coqlib.
+Require Import Coq.Program.Equality FSets Permutation.
+Require Import FSets FSetAVL Orders Mergesort.
+Require Import Coqlib Maps Ordered Errors Integers Floats.
 Require Intv.
-Require Import Errors.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Switch.
-Require Import Csharpminor.
-Require Import Cminor.
-Require Import Cminorgen.
+Require Import AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Csharpminor Switch Cminor Cminorgen.
 
 Open Local Scope error_monad_scope.
 
+Definition match_prog (p: Csharpminor.program) (tp: Cminor.program) :=
+  match_program (fun cu f tf => transl_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transl_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. apply match_transform_partial_program; auto.
+Qed.
+
 Section TRANSLATION.
 
 Variable prog: Csharpminor.program.
 Variable tprog: program.
-Hypothesis TRANSL: transl_program prog = OK tprog.
+Hypothesis TRANSL: match_prog prog tprog.
 Let ge : Csharpminor.genv := Genv.globalenv prog.
 Let tge: genv := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof (Genv.find_symbol_transf_partial transl_fundef _ TRANSL).
+Proof (Genv.find_symbol_transf_partial TRANSL).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof (Genv.public_symbol_transf_partial transl_fundef _ TRANSL).
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_transf_partial TRANSL).
 
 Lemma function_ptr_translated:
   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_fundef f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial transl_fundef _ TRANSL).
+Proof (Genv.find_funct_ptr_transf_partial TRANSL).
 
 Lemma functions_translated:
   forall (v: val) (f: Csharpminor.fundef),
   Genv.find_funct ge v = Some f ->
   exists tf,
   Genv.find_funct tge v = Some tf /\ transl_fundef f = OK tf.
-Proof (Genv.find_funct_transf_partial transl_fundef _ TRANSL).
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof (Genv.find_var_info_transf_partial transl_fundef _ TRANSL).
+Proof (Genv.find_funct_transf_partial TRANSL).
 
 Lemma sig_preserved_body:
   forall f tf cenv size,
@@ -2029,8 +2022,7 @@ Proof.
   intros [f' [vres' [tm' [EC [VINJ [MINJ' [UNMAPPED [OUTOFREACH [INCR SEPARATED]]]]]]]]].
   left; econstructor; split.
   apply plus_one. econstructor. eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. eexact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   assert (MCS': match_callstack f' m' tm'
                  (Frame cenv tfn e le te sp lo hi :: cs)
                  (Mem.nextblock m') (Mem.nextblock tm')).
@@ -2184,8 +2176,7 @@ Opaque PTree.set.
   intros [f' [vres' [tm' [EC [VINJ [MINJ' [UNMAPPED [OUTOFREACH [INCR SEPARATED]]]]]]]]].
   left; econstructor; split.
   apply plus_one. econstructor.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. eexact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto.
   apply match_callstack_incr_bound with (Mem.nextblock m) (Mem.nextblock tm).
   eapply match_callstack_external_call; eauto.
@@ -2224,11 +2215,11 @@ Proof.
   exploit function_ptr_translated; eauto. intros [tf [FIND TR]].
   econstructor; split.
   econstructor.
-  apply (Genv.init_mem_transf_partial _ _ TRANSL). eauto.
+  apply (Genv.init_mem_transf_partial TRANSL). eauto.
   simpl. fold tge. rewrite symbols_preserved.
   replace (prog_main tprog) with (prog_main prog). eexact H0.
   symmetry. unfold transl_program in TRANSL.
-  eapply transform_partial_program_main; eauto.
+  eapply match_program_main; eauto. 
   eexact FIND.
   rewrite <- H2. apply sig_preserved; auto.
   eapply match_callstate with (f := Mem.flat_inj (Mem.nextblock m0)) (cs := @nil frame) (cenv := PTree.empty Z).
@@ -2250,7 +2241,7 @@ Theorem transl_program_correct:
   forward_simulation (Csharpminor.semantics prog) (Cminor.semantics tprog).
 Proof.
   eapply forward_simulation_star; eauto.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transl_initial_states.
   eexact transl_final_states.
   eexact transl_step_correct.
diff --git a/cfrontend/Cop.v b/cfrontend/Cop.v
index b4784028..4ac56b04 100644
--- a/cfrontend/Cop.v
+++ b/cfrontend/Cop.v
@@ -130,7 +130,7 @@ Definition classify_cast (tfrom tto: type) : classify_cast_cases :=
   | _, _ => cast_case_default
   end.
 
-(** Semantics of casts.  [sem_cast v1 t1 t2 = Some v2] if value [v1],
+(** Semantics of casts.  [sem_cast v1 t1 t2 m = Some v2] if value [v1],
   viewed with static type [t1], can be converted  to type [t2],
   resulting in value [v2].  *)
 
@@ -198,7 +198,7 @@ Definition cast_single_long (si : signedness) (f: float32) : option int64 :=
   | Unsigned => Float32.to_longu f
   end.
 
-Definition sem_cast (v: val) (t1 t2: type) : option val :=
+Definition sem_cast (v: val) (t1 t2: type) (m: mem): option val :=
   match classify_cast t1 t2 with
   | cast_case_neutral =>
       match v with
@@ -273,6 +273,7 @@ Definition sem_cast (v: val) (t1 t2: type) : option val :=
   | cast_case_p2bool =>
       match v with
       | Vint i => Some (Vint (cast_int_int IBool Signed i))
+      | Vptr b ofs => if Mem.weak_valid_pointer m b (Int.unsigned ofs) then Some Vone else None
       | _ => None
       end
   | cast_case_l2l =>
@@ -586,13 +587,13 @@ Definition sem_binarith
     (sem_long: signedness -> int64 -> int64 -> option val)
     (sem_float: float -> float -> option val)
     (sem_single: float32 -> float32 -> option val)
-    (v1: val) (t1: type) (v2: val) (t2: type) : option val :=
+    (v1: val) (t1: type) (v2: val) (t2: type) (m: mem): option val :=
   let c := classify_binarith t1 t2 in
   let t := binarith_type c in
-  match sem_cast v1 t1 t with
+  match sem_cast v1 t1 t m with
   | None => None
   | Some v1' =>
-  match sem_cast v2 t2 t with
+  match sem_cast v2 t2 t m with
   | None => None
   | Some v2' =>
   match c with
@@ -637,18 +638,22 @@ Definition classify_add (ty1: type) (ty2: type) :=
   | _, _ => add_default
   end.
 
-Definition sem_add (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_add (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type) (m: mem): option val :=
   match classify_add t1 t2 with
   | add_case_pi ty =>                 (**r pointer plus integer *)
       match v1,v2 with
       | Vptr b1 ofs1, Vint n2 =>
         Some (Vptr b1 (Int.add ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
+      | Vint n1, Vint n2 =>
+        Some (Vint (Int.add n1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
       | _,  _ => None
       end
   | add_case_ip ty =>                 (**r integer plus pointer *)
       match v1,v2 with
       | Vint n1, Vptr b2 ofs2 =>
         Some (Vptr b2 (Int.add ofs2 (Int.mul (Int.repr (sizeof cenv ty)) n1)))
+      | Vint n1, Vint n2 =>
+        Some (Vint (Int.add n2 (Int.mul (Int.repr (sizeof cenv ty)) n1)))
       | _,  _ => None
       end
   | add_case_pl ty =>                 (**r pointer plus long *)
@@ -656,6 +661,9 @@ Definition sem_add (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type)
       | Vptr b1 ofs1, Vlong n2 =>
         let n2 := Int.repr (Int64.unsigned n2) in
         Some (Vptr b1 (Int.add ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
+      | Vint n1, Vlong n2 =>
+        let n2 := Int.repr (Int64.unsigned n2) in
+        Some (Vint (Int.add n1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
       | _,  _ => None
       end
   | add_case_lp ty =>                 (**r long plus pointer *)
@@ -663,6 +671,9 @@ Definition sem_add (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type)
       | Vlong n1, Vptr b2 ofs2 =>
         let n1 := Int.repr (Int64.unsigned n1) in
         Some (Vptr b2 (Int.add ofs2 (Int.mul (Int.repr (sizeof cenv ty)) n1)))
+      | Vlong n1, Vint n2 =>
+        let n1 := Int.repr (Int64.unsigned n1) in
+        Some (Vint (Int.add n2 (Int.mul (Int.repr (sizeof cenv ty)) n1)))
       | _,  _ => None
       end
   | add_default =>
@@ -671,7 +682,7 @@ Definition sem_add (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type)
         (fun sg n1 n2 => Some(Vlong(Int64.add n1 n2)))
         (fun n1 n2 => Some(Vfloat(Float.add n1 n2)))
         (fun n1 n2 => Some(Vsingle(Float32.add n1 n2)))
-        v1 t1 v2 t2
+        v1 t1 v2 t2 m
   end.
 
 (** *** Subtraction *)
@@ -690,12 +701,14 @@ Definition classify_sub (ty1: type) (ty2: type) :=
   | _, _ => sub_default
   end.
 
-Definition sem_sub (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_sub (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type) (m:mem): option val :=
   match classify_sub t1 t2 with
   | sub_case_pi ty =>            (**r pointer minus integer *)
       match v1,v2 with
       | Vptr b1 ofs1, Vint n2 =>
           Some (Vptr b1 (Int.sub ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
+      | Vint n1, Vint n2 =>
+          Some (Vint (Int.sub n1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
       | _,  _ => None
       end
   | sub_case_pl ty =>            (**r pointer minus long *)
@@ -703,6 +716,9 @@ Definition sem_sub (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type)
       | Vptr b1 ofs1, Vlong n2 =>
           let n2 := Int.repr (Int64.unsigned n2) in
           Some (Vptr b1 (Int.sub ofs1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
+      | Vint n1, Vlong n2 =>
+          let n2 := Int.repr (Int64.unsigned n2) in
+          Some (Vint (Int.sub n1 (Int.mul (Int.repr (sizeof cenv ty)) n2)))
       | _,  _ => None
       end
   | sub_case_pp ty =>          (**r pointer minus pointer *)
@@ -722,20 +738,20 @@ Definition sem_sub (cenv: composite_env) (v1:val) (t1:type) (v2: val) (t2:type)
         (fun sg n1 n2 => Some(Vlong(Int64.sub n1 n2)))
         (fun n1 n2 => Some(Vfloat(Float.sub n1 n2)))
         (fun n1 n2 => Some(Vsingle(Float32.sub n1 n2)))
-        v1 t1 v2 t2
+        v1 t1 v2 t2 m
   end.
 
 (** *** Multiplication, division, modulus *)
 
-Definition sem_mul (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_mul (v1:val) (t1:type) (v2: val) (t2:type) (m:mem) : option val :=
   sem_binarith
     (fun sg n1 n2 => Some(Vint(Int.mul n1 n2)))
     (fun sg n1 n2 => Some(Vlong(Int64.mul n1 n2)))
     (fun n1 n2 => Some(Vfloat(Float.mul n1 n2)))
     (fun n1 n2 => Some(Vsingle(Float32.mul n1 n2)))
-    v1 t1 v2 t2.
+    v1 t1 v2 t2 m.
 
-Definition sem_div (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_div (v1:val) (t1:type) (v2: val) (t2:type) (m:mem) : option val :=
   sem_binarith
     (fun sg n1 n2 =>
       match sg with
@@ -759,9 +775,9 @@ Definition sem_div (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
       end)
     (fun n1 n2 => Some(Vfloat(Float.div n1 n2)))
     (fun n1 n2 => Some(Vsingle(Float32.div n1 n2)))
-    v1 t1 v2 t2.
+    v1 t1 v2 t2 m.
 
-Definition sem_mod (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_mod (v1:val) (t1:type) (v2: val) (t2:type) (m:mem) : option val :=
   sem_binarith
     (fun sg n1 n2 =>
       match sg with
@@ -785,31 +801,31 @@ Definition sem_mod (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
       end)
     (fun n1 n2 => None)
     (fun n1 n2 => None)
-    v1 t1 v2 t2.
+    v1 t1 v2 t2 m.
 
-Definition sem_and (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_and (v1:val) (t1:type) (v2: val) (t2:type) (m:mem) : option val :=
   sem_binarith
     (fun sg n1 n2 => Some(Vint(Int.and n1 n2)))
     (fun sg n1 n2 => Some(Vlong(Int64.and n1 n2)))
     (fun n1 n2 => None)
     (fun n1 n2 => None)
-    v1 t1 v2 t2.
+    v1 t1 v2 t2 m.
 
-Definition sem_or (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_or (v1:val) (t1:type) (v2: val) (t2:type) (m:mem) : option val :=
   sem_binarith
     (fun sg n1 n2 => Some(Vint(Int.or n1 n2)))
     (fun sg n1 n2 => Some(Vlong(Int64.or n1 n2)))
     (fun n1 n2 => None)
     (fun n1 n2 => None)
-    v1 t1 v2 t2.
+    v1 t1 v2 t2 m.
 
-Definition sem_xor (v1:val) (t1:type) (v2: val) (t2:type) : option val :=
+Definition sem_xor (v1:val) (t1:type) (v2: val) (t2:type) (m:mem) : option val :=
   sem_binarith
     (fun sg n1 n2 => Some(Vint(Int.xor n1 n2)))
     (fun sg n1 n2 => Some(Vlong(Int64.xor n1 n2)))
     (fun n1 n2 => None)
     (fun n1 n2 => None)
-    v1 t1 v2 t2.
+    v1 t1 v2 t2 m.
 
 (** *** Shifts *)
 
@@ -931,7 +947,7 @@ Definition sem_cmp (c:comparison)
             Some(Val.of_bool(Float.cmp c n1 n2)))
         (fun n1 n2 =>
             Some(Val.of_bool(Float32.cmp c n1 n2)))
-        v1 t1 v2 t2
+        v1 t1 v2 t2 m
   end.
 
 (** ** Function applications *)
@@ -988,14 +1004,14 @@ Definition sem_binary_operation
     (v1: val) (t1: type) (v2: val) (t2:type)
     (m: mem): option val :=
   match op with
-  | Oadd => sem_add cenv v1 t1 v2 t2
-  | Osub => sem_sub cenv 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 t1 v2 t2
-  | Oor  => sem_or v1 t1 v2 t2
-  | Oxor  => sem_xor v1 t1 v2 t2
+  | Oadd => sem_add cenv v1 t1 v2 t2 m
+  | Osub => sem_sub cenv v1 t1 v2 t2 m
+  | Omul => sem_mul v1 t1 v2 t2 m
+  | Omod => sem_mod v1 t1 v2 t2 m
+  | Odiv => sem_div v1 t1 v2 t2 m
+  | Oand => sem_and v1 t1 v2 t2 m
+  | Oor  => sem_or v1 t1 v2 t2 m
+  | Oxor  => sem_xor v1 t1 v2 t2 m
   | Oshl => sem_shl v1 t1 v2 t2
   | Oshr  => sem_shr v1 t1 v2 t2
   | Oeq => sem_cmp Ceq v1 t1 v2 t2 m
@@ -1006,10 +1022,10 @@ Definition sem_binary_operation
   | Oge => sem_cmp Cge v1 t1 v2 t2 m
   end.
 
-Definition sem_incrdecr (cenv: composite_env) (id: incr_or_decr) (v: val) (ty: type) :=
+Definition sem_incrdecr (cenv: composite_env) (id: incr_or_decr) (v: val) (ty: type) (m: mem) :=
   match id with
-  | Incr => sem_add cenv v ty (Vint Int.one) type_int32s
-  | Decr => sem_sub cenv v ty (Vint Int.one) type_int32s
+  | Incr => sem_add cenv v ty (Vint Int.one) type_int32s m
+  | Decr => sem_sub cenv v ty (Vint Int.one) type_int32s m
   end.
 
 Definition incrdecr_type (ty: type) :=
@@ -1074,11 +1090,11 @@ Ltac TrivialInject :=
   | _ => idtac
   end.
 
-Lemma sem_cast_inject:
+Lemma sem_cast_inj:
   forall v1 ty1 ty v tv1,
-  sem_cast v1 ty1 ty = Some v ->
+  sem_cast v1 ty1 ty m = Some v ->
   Val.inject f v1 tv1 ->
-  exists tv, sem_cast tv1 ty1 ty = Some tv /\ Val.inject f v tv.
+  exists tv, sem_cast tv1 ty1 ty m'= Some tv /\ Val.inject f v tv.
 Proof.
   unfold sem_cast; intros; destruct (classify_cast ty1 ty);
   inv H0; inv H; TrivialInject.
@@ -1087,6 +1103,8 @@ Proof.
 - destruct (cast_single_int si2 f0); inv H1; TrivialInject.
 - destruct (cast_float_long si2 f0); inv H1; TrivialInject.
 - destruct (cast_single_long si2 f0); inv H1; TrivialInject.
+- destruct (Mem.weak_valid_pointer m b1 (Int.unsigned ofs1)) eqn:VALID; inv H2.
+  erewrite weak_valid_pointer_inj by eauto. TrivialInject. 
 - destruct (ident_eq id1 id2); inv H2; TrivialInject. econstructor; eauto.
 - destruct (ident_eq id1 id2); inv H2; TrivialInject. econstructor; eauto.
 - econstructor; eauto.
@@ -1119,13 +1137,13 @@ Definition optval_self_injects (ov: option val) : Prop :=
 
 Remark sem_binarith_inject:
   forall sem_int sem_long sem_float sem_single v1 t1 v2 t2 v v1' v2',
-  sem_binarith sem_int sem_long sem_float sem_single v1 t1 v2 t2 = Some v ->
+  sem_binarith sem_int sem_long sem_float sem_single v1 t1 v2 t2 m = Some v ->
   Val.inject f v1 v1' -> Val.inject f v2 v2' ->
   (forall sg n1 n2, optval_self_injects (sem_int sg n1 n2)) ->
   (forall sg n1 n2, optval_self_injects (sem_long sg n1 n2)) ->
   (forall n1 n2, optval_self_injects (sem_float n1 n2)) ->
   (forall n1 n2, optval_self_injects (sem_single n1 n2)) ->
-  exists v', sem_binarith sem_int sem_long sem_float sem_single v1' t1 v2' t2 = Some v' /\ Val.inject f v v'.
+  exists v', sem_binarith sem_int sem_long sem_float sem_single v1' t1 v2' t2 m' = Some v' /\ Val.inject f v v'.
 Proof.
   intros.
   assert (SELF: forall ov v, ov = Some v -> optval_self_injects ov -> Val.inject f v v).
@@ -1135,10 +1153,10 @@ Proof.
   unfold sem_binarith in *.
   set (c := classify_binarith t1 t2) in *.
   set (t := binarith_type c) in *.
-  destruct (sem_cast v1 t1 t) as [w1|] eqn:C1; try discriminate.
-  destruct (sem_cast v2 t2 t) as [w2|] eqn:C2; try discriminate.
-  exploit (sem_cast_inject v1); eauto. intros (w1' & C1' & INJ1).
-  exploit (sem_cast_inject v2); eauto. intros (w2' & C2' & INJ2).
+  destruct (sem_cast v1 t1 t m) as [w1|] eqn:C1; try discriminate.
+  destruct (sem_cast v2 t2 t m) as [w2|] eqn:C2; try discriminate.
+  exploit (sem_cast_inj v1); eauto. intros (w1' & C1' & INJ1).
+  exploit (sem_cast_inj v2); eauto. intros (w2' & C2' & INJ2).
   rewrite C1'; rewrite C2'.
   destruct c; inv INJ1; inv INJ2; discriminate || eauto.
 Qed.
@@ -1202,25 +1220,25 @@ Proof.
   unfold sem_binary_operation; intros; destruct op.
 - (* add *)
   unfold sem_add in *; destruct (classify_add ty1 ty2).
-  + inv H0; inv H1; inv H. TrivialInject.
+  + inv H0; inv H1; inv H. TrivialInject. TrivialInject.
     econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  + inv H0; inv H1; inv H. TrivialInject.
+  + inv H0; inv H1; inv H. TrivialInject. TrivialInject.
     econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  + inv H0; inv H1; inv H. TrivialInject.
+  + inv H0; inv H1; inv H. TrivialInject. TrivialInject.
     econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
-  + inv H0; inv H1; inv H. TrivialInject.
+  + inv H0; inv H1; inv H. TrivialInject. TrivialInject.
     econstructor. eauto. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut.
   + eapply sem_binarith_inject; eauto; intros; exact I.
 - (* sub *)
   unfold sem_sub in *; destruct (classify_sub ty1 ty2).
-  + inv H0; inv H1; inv H. TrivialInject.
+  + inv H0; inv H1; inv H. TrivialInject. TrivialInject.
     econstructor. eauto. rewrite Int.sub_add_l. auto.
   + inv H0; inv H1; inv H. TrivialInject.
     destruct (eq_block b1 b0); try discriminate. subst b1.
     rewrite H0 in H2; inv H2. rewrite dec_eq_true.
     destruct (zlt 0 (sizeof cenv ty) && zle (sizeof cenv ty) Int.max_signed); inv H3.
     rewrite Int.sub_shifted. TrivialInject.
-  + inv H0; inv H1; inv H. TrivialInject.
+  + inv H0; inv H1; inv H. TrivialInject. TrivialInject.
     econstructor. eauto. rewrite Int.sub_add_l. auto.
   + eapply sem_binarith_inject; eauto; intros; exact I.
 - (* mul *)
@@ -1282,6 +1300,17 @@ Qed.
 
 End GENERIC_INJECTION.
 
+Lemma sem_cast_inject:
+  forall f v1 ty1 ty m v tv1 tm,
+  sem_cast v1 ty1 ty m = Some v ->
+  Val.inject f v1 tv1 ->
+  Mem.inject f m tm ->
+  exists tv, sem_cast tv1 ty1 ty tm = Some tv /\ Val.inject f v tv.
+Proof.
+  intros. eapply sem_cast_inj; eauto.
+  intros; eapply Mem.weak_valid_pointer_inject_val; eauto.
+Qed.
+
 Lemma sem_unary_operation_inject:
   forall f m m' op v1 ty1 v tv1,
   sem_unary_operation op v1 ty1 m = Some v ->
@@ -1321,20 +1350,16 @@ Qed.
 (** * Some properties of operator semantics *)
 
 (** This section collects some common-sense properties about the type
-  classification and semantic functions above.  These properties are
-  not used in the CompCert semantics preservation proofs, but increase
+  classification and semantic functions above.  Some properties are used
+  in the CompCert semantics preservation proofs.  Others are not, but increase
   confidence in the specification and its relation with the ISO C99 standard. *)
 
 (** Relation between Boolean value and casting to [_Bool] type. *)
 
 Lemma cast_bool_bool_val:
   forall v t m,
-  match sem_cast v t (Tint IBool Signed noattr), bool_val v t m with
-  | Some v', Some b => v' = Val.of_bool b
-  | Some v', None => False
-  | None, _ => True
-  end.
-Proof.
+  sem_cast v t (Tint IBool Signed noattr) m =
+  match bool_val v t m with None => None | Some b => Some(Val.of_bool b) end.
   intros.
   assert (A: classify_bool t =
     match t with
@@ -1360,8 +1385,11 @@ Proof.
   destruct (Float32.cmp Ceq f0 Float32.zero); auto.
   destruct f; auto.
   destruct (Int.eq i Int.zero); auto.
+  destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); auto.
   destruct (Int.eq i Int.zero); auto.
+  destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); auto.
   destruct (Int.eq i Int.zero); auto.
+  destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); auto.
 Qed.
 
 (** Relation between Boolean value and Boolean negation. *)
@@ -1376,6 +1404,119 @@ Proof.
   destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); auto.
 Qed.
 
+(** Properties of values obtained by casting to a given type. *)
+
+Inductive val_casted: val -> type -> Prop :=
+  | val_casted_int: forall sz si attr n,
+      cast_int_int sz si n = n ->
+      val_casted (Vint n) (Tint sz si attr)
+  | val_casted_float: forall attr n,
+       val_casted (Vfloat n) (Tfloat F64 attr)
+  | val_casted_single: forall attr n,
+       val_casted (Vsingle n) (Tfloat F32 attr)
+  | val_casted_long: forall si attr n,
+      val_casted (Vlong n) (Tlong si attr)
+  | val_casted_ptr_ptr: forall b ofs ty attr,
+      val_casted (Vptr b ofs) (Tpointer ty attr)
+  | val_casted_int_ptr: forall n ty attr,
+      val_casted (Vint n) (Tpointer ty attr)
+  | val_casted_ptr_int: forall b ofs si attr,
+      val_casted (Vptr b ofs) (Tint I32 si attr)
+  | val_casted_struct: forall id attr b ofs,
+      val_casted (Vptr b ofs) (Tstruct id attr)
+  | val_casted_union: forall id attr b ofs,
+      val_casted (Vptr b ofs) (Tunion id attr)
+  | val_casted_void: forall v,
+      val_casted v Tvoid.
+
+Remark cast_int_int_idem:
+  forall sz sg i, cast_int_int sz sg (cast_int_int sz sg i) = cast_int_int sz sg i.
+Proof.
+  intros. destruct sz; simpl; auto.
+  destruct sg; [apply Int.sign_ext_idem|apply Int.zero_ext_idem]; compute; intuition congruence.
+  destruct sg; [apply Int.sign_ext_idem|apply Int.zero_ext_idem]; compute; intuition congruence.
+  destruct (Int.eq i Int.zero); auto.
+Qed.
+
+Lemma cast_val_is_casted:
+  forall v ty ty' v' m, sem_cast v ty ty' m = Some v' -> val_casted v' ty'.
+Proof.
+  unfold sem_cast; intros. destruct ty'; simpl in *.
+- (* void *)
+  constructor.
+- (* int *)
+  destruct i; destruct ty; simpl in H; try (destruct f); try discriminate; destruct v; inv H.
+  constructor. apply (cast_int_int_idem I8 s).
+  constructor. apply (cast_int_int_idem I8 s).
+  destruct (cast_single_int s f); inv H1. constructor. apply (cast_int_int_idem I8 s).
+  destruct (cast_float_int s f); inv H1. constructor. apply (cast_int_int_idem I8 s).
+  constructor. apply (cast_int_int_idem I16 s).
+  constructor. apply (cast_int_int_idem I16 s).
+  destruct (cast_single_int s f); inv H1. constructor. apply (cast_int_int_idem I16 s).
+  destruct (cast_float_int s f); inv H1. constructor. apply (cast_int_int_idem I16 s).
+  constructor. auto.
+  constructor.
+  constructor. auto.
+  destruct (cast_single_int s f); inv H1. constructor. auto.
+  destruct (cast_float_int s f); inv H1. constructor; auto.
+  constructor; auto.
+  constructor.
+  constructor; auto.
+  constructor.
+  constructor; auto.
+  constructor.
+  constructor. simpl. destruct (Int.eq i0 Int.zero); auto.
+  constructor. simpl. destruct (Int64.eq i Int64.zero); auto.
+  constructor. simpl. destruct (Float32.cmp Ceq f Float32.zero); auto.
+  constructor. simpl. destruct (Float.cmp Ceq f Float.zero); auto.
+  constructor. simpl. destruct (Int.eq i Int.zero); auto.
+  destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); inv H1. constructor; auto.
+  constructor. simpl. destruct (Int.eq i Int.zero); auto.
+  destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); inv H1. constructor; auto.
+  constructor. simpl. destruct (Int.eq i Int.zero); auto.
+  destruct (Mem.weak_valid_pointer m b (Int.unsigned i)); inv H1. constructor; auto.
+- (* long *)
+  destruct ty; try (destruct f); try discriminate.
+  destruct v; inv H. constructor.
+  destruct v; inv H. constructor.
+  destruct v; try discriminate. destruct (cast_single_long s f); inv H. constructor.
+  destruct v; try discriminate. destruct (cast_float_long s f); inv H. constructor.
+  destruct v; inv H. constructor.
+  destruct v; inv H. constructor.
+  destruct v; inv H. constructor.
+- (* float *)
+  destruct f; destruct ty; simpl in H; try (destruct f); try discriminate; destruct v; inv H; constructor.
+- (* pointer *)
+  destruct ty; simpl in H; try discriminate; destruct v; inv H; try constructor.
+- (* array (impossible case) *)
+  discriminate.
+- (* function (impossible case) *)
+  discriminate.
+- (* structs *)
+  destruct ty; try discriminate; destruct v; try discriminate.
+  destruct (ident_eq i0 i); inv H; constructor.
+- (* unions *)
+  destruct ty; try discriminate; destruct v; try discriminate.
+  destruct (ident_eq i0 i); inv H; constructor.
+Qed.
+
+(** As a consequence, casting twice is equivalent to casting once. *)
+
+Lemma cast_val_casted:
+  forall v ty m, val_casted v ty -> sem_cast v ty ty m = Some v.
+Proof.
+  intros. inversion H; clear H; subst v ty; unfold sem_cast; simpl; auto.
+  destruct sz; congruence.
+  unfold proj_sumbool; repeat rewrite dec_eq_true; auto.
+  unfold proj_sumbool; repeat rewrite dec_eq_true; auto.
+Qed.
+
+Lemma cast_idempotent:
+  forall v ty ty' v' m, sem_cast v ty ty' m = Some v' -> sem_cast v' ty' ty' m = Some v'.
+Proof.
+  intros. apply cast_val_casted. eapply cast_val_is_casted; eauto.
+Qed.
+
 (** Relation with the arithmetic conversions of ISO C99, section 6.3.1 *)
 
 Module ArithConv.
diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v
index 539b6826..30e6200d 100644
--- a/cfrontend/Csem.v
+++ b/cfrontend/Csem.v
@@ -187,12 +187,12 @@ Fixpoint seq_of_labeled_statement (sl: labeled_statements) : statement :=
 
 (** Extract the values from a list of function arguments *)
 
-Inductive cast_arguments: exprlist -> typelist -> list val -> Prop :=
+Inductive cast_arguments (m: mem): exprlist -> typelist -> list val -> Prop :=
   | cast_args_nil:
-      cast_arguments Enil Tnil nil
+      cast_arguments m Enil Tnil nil
   | cast_args_cons: forall v ty el targ1 targs v1 vl,
-      sem_cast v ty targ1 = Some v1 -> cast_arguments el targs vl ->
-      cast_arguments (Econs (Eval v ty) el) (Tcons targ1 targs) (v1 :: vl).
+      sem_cast v ty targ1 m = Some v1 -> cast_arguments m el targs vl ->
+      cast_arguments m (Econs (Eval v ty) el) (Tcons targ1 targs) (v1 :: vl).
 
 (** ** Reduction semantics for expressions *)
 
@@ -249,7 +249,7 @@ Inductive rred: expr -> mem -> trace -> expr -> mem -> Prop :=
       rred (Ebinop op (Eval v1 ty1) (Eval v2 ty2) ty) m
         E0 (Eval v ty) m
   | red_cast: forall ty v1 ty1 m v,
-      sem_cast v1 ty1 ty = Some v ->
+      sem_cast v1 ty1 ty m = Some v ->
       rred (Ecast (Eval v1 ty1) ty) m
         E0 (Eval v ty) m
   | red_seqand_true: forall v1 ty1 r2 ty m,
@@ -279,7 +279,7 @@ Inductive rred: expr -> mem -> trace -> expr -> mem -> Prop :=
       rred (Ealignof ty1 ty) m
         E0 (Eval (Vint (Int.repr (alignof ge ty1))) ty) m
   | red_assign: forall b ofs ty1 v2 ty2 m v t m',
-      sem_cast v2 ty2 ty1 = Some v ->
+      sem_cast v2 ty2 ty1 m = Some v ->
       assign_loc ty1 m b ofs v t m' ->
       rred (Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty1) m
          t (Eval v ty1) m'
@@ -303,11 +303,11 @@ Inductive rred: expr -> mem -> trace -> expr -> mem -> Prop :=
       rred (Ecomma (Eval v ty1) r2 ty) m
         E0 r2 m
   | red_paren: forall v1 ty1 ty2 ty m v,
-      sem_cast v1 ty1 ty2 = Some v ->
+      sem_cast v1 ty1 ty2 m = Some v ->
       rred (Eparen (Eval v1 ty1) ty2 ty) m
         E0 (Eval v ty) m
   | red_builtin: forall ef tyargs el ty m vargs t vres m',
-      cast_arguments el tyargs vargs ->
+      cast_arguments m el tyargs vargs ->
       external_call ef ge vargs m t vres m' ->
       rred (Ebuiltin ef tyargs el ty) m
          t (Eval vres ty) m'.
@@ -316,13 +316,13 @@ Inductive rred: expr -> mem -> trace -> expr -> mem -> Prop :=
 (** Head reduction for function calls.
     (More exactly, identification of function calls that can reduce.) *)
 
-Inductive callred: expr -> fundef -> list val -> type -> Prop :=
-  | red_call: forall vf tyf tyargs tyres cconv el ty fd vargs,
+Inductive callred: expr -> mem -> fundef -> list val -> type -> Prop :=
+  | red_call: forall vf tyf m tyargs tyres cconv el ty fd vargs,
       Genv.find_funct ge vf = Some fd ->
-      cast_arguments el tyargs vargs ->
+      cast_arguments m el tyargs vargs ->
       type_of_fundef fd = Tfunction tyargs tyres cconv ->
       classify_fun tyf = fun_case_f tyargs tyres cconv ->
-      callred (Ecall (Eval vf tyf) el ty)
+      callred (Ecall (Eval vf tyf) el ty) m
               fd vargs ty.
 
 (** Reduction contexts.  In accordance with C's nondeterministic semantics,
@@ -429,17 +429,14 @@ Inductive imm_safe: kind -> expr -> mem -> Prop :=
       context RV to C ->
       imm_safe to (C e) m
   | imm_safe_callred: forall to C e m fd args ty,
-      callred e fd args ty ->
+      callred e m fd args ty ->
       context RV to C ->
       imm_safe to (C e) m.
 
-(* An expression is not stuck if none of the potential redexes contained within
-   is immediately stuck. *)
-(*
 Definition not_stuck (e: expr) (m: mem) : Prop :=
   forall k C e' ,
-  context k RV C -> e = C e' -> not_imm_stuck k e' m.
-*)
+  context k RV C -> e = C e' -> imm_safe k e' m.
+
 End EXPR.
 
 (** ** Transition semantics. *)
@@ -597,7 +594,7 @@ Inductive estep: state -> trace -> state -> Prop :=
           t (ExprState f (C a') k e m')
 
   | step_call: forall C f a k e m fd vargs ty,
-      callred a fd vargs ty ->
+      callred a m fd vargs ty ->
       context RV RV C ->
       estep (ExprState f (C a) k e m)
          E0 (Callstate fd vargs (Kcall f e C ty k) m)
@@ -709,7 +706,7 @@ Inductive sstep: state -> trace -> state -> Prop :=
       sstep (State f (Sreturn (Some x)) k e m)
          E0 (ExprState f x (Kreturn k) e  m)
   | step_return_2:  forall f v1 ty k e m v2 m',
-      sem_cast v1 ty f.(fn_return) = Some v2 ->
+      sem_cast v1 ty f.(fn_return) m = Some v2 ->
       Mem.free_list m (blocks_of_env e) = Some m' ->
       sstep (ExprState f (Eval v1 ty) (Kreturn k) e m)
          E0 (Returnstate v2 (call_cont k) m')
diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v
index 825a563c..40b51bd3 100644
--- a/cfrontend/Cshmgen.v
+++ b/cfrontend/Cshmgen.v
@@ -20,17 +20,9 @@
    Csharpminor's simpler control structures.
 *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import Errors.
-Require Import Integers.
-Require Import Floats.
-Require Import AST.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Clight.
-Require Import Cminor.
-Require Import Csharpminor.
+Require Import Coqlib Maps Errors Integers Floats.
+Require Import AST Linking.
+Require Import Ctypes Cop Clight Cminor Csharpminor.
 
 Open Local Scope string_scope.
 Open Local Scope error_monad_scope.
@@ -125,6 +117,18 @@ Definition make_cmp_ne_zero (e: expr) :=
   | _ => Ebinop (Ocmp Cne) e (make_intconst Int.zero)
   end.
 
+(** Variants of [sizeof] and [alignof] that check that the given type is complete. *)
+
+Definition sizeof (ce: composite_env) (t: type) : res Z :=
+  if complete_type ce t
+  then OK (Ctypes.sizeof ce t)
+  else Error (msg "incomplete type").
+
+Definition alignof (ce: composite_env) (t: type) : res Z :=
+  if complete_type ce t
+  then OK (Ctypes.alignof ce t)
+  else Error (msg "incomplete type").
+
 (** [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]. *)
 
@@ -238,16 +242,20 @@ Definition make_binarith (iop iopu fop sop lop lopu: binary_operation)
 Definition make_add (ce: composite_env) (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   match classify_add ty1 ty2 with
   | add_case_pi ty =>
-      let n := make_intconst (Int.repr (Ctypes.sizeof ce ty)) in
+      do sz <- sizeof ce ty;
+      let n := make_intconst (Int.repr sz) in
       OK (Ebinop Oadd e1 (Ebinop Omul n e2))
   | add_case_ip ty =>
-      let n := make_intconst (Int.repr (Ctypes.sizeof ce ty)) in
+      do sz <- sizeof ce ty;
+      let n := make_intconst (Int.repr sz) in
       OK (Ebinop Oadd e2 (Ebinop Omul n e1))
   | add_case_pl ty =>
-      let n := make_intconst (Int.repr (Ctypes.sizeof ce ty)) in
+      do sz <- sizeof ce ty;
+      let n := make_intconst (Int.repr sz) in
       OK (Ebinop Oadd e1 (Ebinop Omul n (Eunop Ointoflong e2)))
   | add_case_lp ty =>
-      let n := make_intconst (Int.repr (Ctypes.sizeof ce ty)) in
+      do sz <- sizeof ce ty;
+      let n := make_intconst (Int.repr sz) in
       OK (Ebinop Oadd e2 (Ebinop Omul n (Eunop Ointoflong e1)))
   | add_default =>
       make_binarith Oadd Oadd Oaddf Oaddfs Oaddl Oaddl e1 ty1 e2 ty2
@@ -256,13 +264,16 @@ Definition make_add (ce: composite_env) (e1: expr) (ty1: type) (e2: expr) (ty2:
 Definition make_sub (ce: composite_env) (e1: expr) (ty1: type) (e2: expr) (ty2: type) :=
   match classify_sub ty1 ty2 with
   | sub_case_pi ty =>
-      let n := make_intconst (Int.repr (Ctypes.sizeof ce ty)) in
+      do sz <- sizeof ce ty;
+      let n := make_intconst (Int.repr sz) in
       OK (Ebinop Osub e1 (Ebinop Omul n e2))
   | sub_case_pp ty =>
-      let n := make_intconst (Int.repr (Ctypes.sizeof ce ty)) in
+      do sz <- sizeof ce ty;
+      let n := make_intconst (Int.repr sz) in
       OK (Ebinop Odiv (Ebinop Osub e1 e2) n)
   | sub_case_pl ty =>
-      let n := make_intconst (Int.repr (Ctypes.sizeof ce ty)) in
+      do sz <- sizeof ce ty;
+      let n := make_intconst (Int.repr sz) in
       OK (Ebinop Osub e1 (Ebinop Omul n (Eunop Ointoflong e2)))
   | sub_default =>
       make_binarith Osub Osub Osubf Osubfs Osubl Osubl e1 ty1 e2 ty2
@@ -351,8 +362,9 @@ Definition make_load (addr: expr) (ty_res: type) :=
   by-copy assignment of a value of Clight type [ty]. *)
 
 Definition make_memcpy (ce: composite_env) (dst src: expr) (ty: type) :=
-  Sbuiltin None (EF_memcpy (Ctypes.sizeof ce ty) (Ctypes.alignof_blockcopy ce ty))
-                (dst :: src :: nil).
+  do sz <- sizeof ce ty;
+  OK (Sbuiltin None (EF_memcpy sz (Ctypes.alignof_blockcopy ce ty))
+                    (dst :: src :: nil)).
 
 (** [make_store addr ty rhs] stores the value of the
    Csharpminor expression [rhs] into the memory location denoted by the
@@ -362,7 +374,7 @@ Definition make_memcpy (ce: composite_env) (dst src: expr) (ty: type) :=
 Definition make_store (ce: composite_env) (addr: expr) (ty: type) (rhs: expr) :=
   match access_mode ty with
   | By_value chunk => OK (Sstore chunk addr rhs)
-  | By_copy => OK (make_memcpy ce addr rhs ty)
+  | By_copy => make_memcpy ce addr rhs ty
   | _ => Error (msg "Cshmgen.make_store")
   end.
 
@@ -457,9 +469,9 @@ Fixpoint transl_expr (ce: composite_env) (a: Clight.expr) {struct a} : res expr
       do addr <- make_field_access ce (typeof b) i tb;
       make_load addr ty
   | Clight.Esizeof ty' ty =>
-      OK(make_intconst (Int.repr (sizeof ce ty')))
+      do sz <- sizeof ce ty'; OK(make_intconst (Int.repr sz))
   | Clight.Ealignof ty' ty =>
-      OK(make_intconst (Int.repr (alignof ce ty')))
+      do al <- alignof ce ty'; OK(make_intconst (Int.repr al))
   end
 
 (** [transl_lvalue a] returns the Csharpminor code that evaluates
@@ -621,7 +633,8 @@ with transl_lbl_stmt (ce: composite_env) (tyret: type) (nbrk ncnt: nat)
 
 (*** Translation of functions *)
 
-Definition transl_var (ce: composite_env) (v: ident * type) := (fst v, sizeof ce (snd v)).
+Definition transl_var (ce: composite_env) (v: ident * type) :=
+  do sz <- sizeof ce (snd v); OK (fst v, sz).
 
 Definition signature_of_function (f: Clight.function) :=
   {| sig_args := map typ_of_type (map snd (Clight.fn_params f));
@@ -630,18 +643,19 @@ Definition signature_of_function (f: Clight.function) :=
 
 Definition transl_function (ce: composite_env) (f: Clight.function) : res function :=
   do tbody <- transl_statement ce f.(Clight.fn_return) 1%nat 0%nat (Clight.fn_body f);
+  do tvars <- mmap (transl_var ce) (Clight.fn_vars f);
   OK (mkfunction
        (signature_of_function f)
        (map fst (Clight.fn_params f))
-       (map (transl_var ce) (Clight.fn_vars f))
+       tvars
        (map fst (Clight.fn_temps f))
        tbody).
 
-Definition transl_fundef (ce: composite_env) (f: Clight.fundef) : res fundef :=
+Definition transl_fundef (ce: composite_env) (id: ident) (f: Clight.fundef) : res fundef :=
   match f with
-  | Clight.Internal g =>
+  | Internal g =>
       do tg <- transl_function ce g; OK(AST.Internal tg)
-  | Clight.External ef args res cconv =>
+  | External ef args res cconv =>
       if signature_eq (ef_sig ef) (signature_of_type args res cconv)
       then OK(AST.External ef)
       else Error(msg "Cshmgen.transl_fundef: wrong external signature")
@@ -649,7 +663,7 @@ Definition transl_fundef (ce: composite_env) (f: Clight.fundef) : res fundef :=
 
 (** ** Translation of programs *)
 
-Definition transl_globvar (ty: type) := OK tt.
+Definition transl_globvar (id: ident) (ty: type) := OK tt.
 
 Definition transl_program (p: Clight.program) : res program :=
   transform_partial_program2 (transl_fundef p.(prog_comp_env)) transl_globvar p.
diff --git a/cfrontend/Cshmgenproof.v b/cfrontend/Cshmgenproof.v
index e25e21c9..8bc97b99 100644
--- a/cfrontend/Cshmgenproof.v
+++ b/cfrontend/Cshmgenproof.v
@@ -12,24 +12,40 @@
 
 (** * Correctness of the translation from Clight to C#minor. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import AST.
-Require Import Values.
-Require Import Events.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Clight.
-Require Import Cminor.
-Require Import Csharpminor.
+Require Import Coqlib Errors Maps Integers Floats.
+Require Import AST Linking.
+Require Import Values Events Memory Globalenvs Smallstep.
+Require Import Ctypes Cop Clight Cminor Csharpminor.
 Require Import Cshmgen.
 
+(** * Relational specification of the transformation *)
+
+Inductive match_fundef (p: Clight.program) : Clight.fundef -> Csharpminor.fundef -> Prop :=
+  | match_fundef_internal: forall f tf,
+      transl_function p.(prog_comp_env) f = OK tf ->
+      match_fundef p (Ctypes.Internal f) (AST.Internal tf)
+  | match_fundef_external: forall ef args res cc,
+      ef_sig ef = signature_of_type args res cc ->
+      match_fundef p (Ctypes.External ef args res cc) (AST.External ef).
+
+Definition match_varinfo (v: type) (tv: unit) := True.
+
+Definition match_prog (p: Clight.program) (tp: Csharpminor.program) : Prop :=
+  match_program_gen match_fundef match_varinfo p p tp.
+
+Lemma transf_program_match:
+  forall p tp, transl_program p = OK tp -> match_prog p tp.
+Proof.
+  unfold transl_program; intros.
+  eapply match_transform_partial_program2. 
+  eexact H.
+- intros. destruct f; simpl in H0.
++ monadInv H0. constructor; auto.
++ destruct (signature_eq (ef_sig e) (signature_of_type t t0 c)); inv H0.
+  constructor; auto.
+- intros; red; auto.
+Qed.
+
 (** * Properties of operations over types *)
 
 Remark transl_params_types:
@@ -41,21 +57,20 @@ Qed.
 
 Lemma transl_fundef_sig1:
   forall ce f tf args res cc,
-  transl_fundef ce f = OK tf ->
+  match_fundef ce f tf ->
   classify_fun (type_of_fundef f) = fun_case_f args res cc ->
   funsig tf = signature_of_type args res cc.
 Proof.
-  intros. destruct f; simpl in *.
-  monadInv H. monadInv EQ. simpl. inversion H0.
+  intros. inv H.
+- monadInv H1. simpl. inversion H0.
   unfold signature_of_function, signature_of_type.
   f_equal. apply transl_params_types.
-  destruct (signature_eq (ef_sig e) (signature_of_type t t0 c)); inv H.
-  simpl. congruence.
+- simpl in H0. unfold funsig. congruence.
 Qed.
 
 Lemma transl_fundef_sig2:
   forall ce f tf args res cc,
-  transl_fundef ce f = OK tf ->
+  match_fundef ce f tf ->
   type_of_fundef f = Tfunction args res cc ->
   funsig tf = signature_of_type args res cc.
 Proof.
@@ -63,15 +78,73 @@ Proof.
   rewrite H0; reflexivity.
 Qed.
 
+Lemma transl_sizeof:
+  forall (cunit prog: Clight.program) t sz,
+  linkorder cunit prog ->
+  sizeof cunit.(prog_comp_env) t = OK sz ->
+  sz = Ctypes.sizeof prog.(prog_comp_env) t.
+Proof.
+  intros. destruct H.
+  unfold sizeof in H0. destruct (complete_type (prog_comp_env cunit) t) eqn:C; inv H0.
+  symmetry. apply Ctypes.sizeof_stable; auto.
+Qed.
+
+Lemma transl_alignof:
+  forall (cunit prog: Clight.program) t al,
+  linkorder cunit prog ->
+  alignof cunit.(prog_comp_env) t = OK al ->
+  al = Ctypes.alignof prog.(prog_comp_env) t.
+Proof.
+  intros. destruct H.
+  unfold alignof in H0. destruct (complete_type (prog_comp_env cunit) t) eqn:C; inv H0.
+  symmetry. apply Ctypes.alignof_stable; auto.
+Qed.
+
+Lemma transl_alignof_blockcopy:
+  forall (cunit prog: Clight.program) t sz,
+  linkorder cunit prog ->
+  sizeof cunit.(prog_comp_env) t = OK sz ->
+  sz = Ctypes.sizeof prog.(prog_comp_env) t /\
+  alignof_blockcopy cunit.(prog_comp_env) t = alignof_blockcopy prog.(prog_comp_env) t.
+Proof.
+  intros. destruct H.
+  unfold sizeof in H0. destruct (complete_type (prog_comp_env cunit) t) eqn:C; inv H0.
+  split. 
+- symmetry. apply Ctypes.sizeof_stable; auto.
+- revert C. induction t; simpl; auto;
+  destruct (prog_comp_env cunit)!i as [co|] eqn:X; try discriminate; erewrite H1 by eauto; auto.
+Qed.
+
+Lemma field_offset_stable:
+  forall (cunit prog: Clight.program) id co f,
+  linkorder cunit prog ->
+  cunit.(prog_comp_env)!id = Some co ->
+  prog.(prog_comp_env)!id = Some co /\ 
+  field_offset prog.(prog_comp_env) f (co_members co) = field_offset cunit.(prog_comp_env) f (co_members co).
+Proof.
+  intros. 
+  assert (C: composite_consistent cunit.(prog_comp_env) co).
+  { apply build_composite_env_consistent with cunit.(prog_types) id; auto.
+    apply prog_comp_env_eq. }
+  destruct H as [_ A].
+  split. auto. generalize (co_consistent_complete _ _ C).
+  unfold field_offset. generalize 0. induction (co_members co) as [ | [f1 t1] m]; simpl; intros.
+- auto.
+- InvBooleans.
+  rewrite ! (alignof_stable _ _ A) by auto.
+  rewrite ! (sizeof_stable _ _ A) by auto.
+  destruct (ident_eq f f1); eauto.
+Qed. 
+
 (** * Properties of the translation functions *)
 
 (** Transformation of expressions and statements. *)
 
 Lemma transl_expr_lvalue:
-  forall ge e le m a loc ofs ta,
+  forall ge e le m a loc ofs ce ta,
   Clight.eval_lvalue ge e le m a loc ofs ->
-  transl_expr ge a = OK ta ->
-  (exists tb, transl_lvalue ge a = OK tb /\ make_load tb (typeof a) = OK ta).
+  transl_expr ce a = OK ta ->
+  (exists tb, transl_lvalue ce a = OK tb /\ make_load tb (typeof a) = OK ta).
 Proof.
   intros until ta; intros EVAL TR. inv EVAL; simpl in TR.
   (* var local *)
@@ -140,7 +213,8 @@ Qed.
 
 Section CONSTRUCTORS.
 
-Variable ce: composite_env.
+Variables cunit prog: Clight.program.
+Hypothesis LINK: linkorder cunit prog.
 Variable ge: genv.
 
 Lemma make_intconst_correct:
@@ -255,7 +329,7 @@ Lemma make_cast_correct:
   forall e le m a b v ty1 ty2 v',
   make_cast ty1 ty2 a = OK b ->
   eval_expr ge e le m a v ->
-  sem_cast v ty1 ty2 = Some v' ->
+  sem_cast v ty1 ty2 m = Some v' ->
   eval_expr ge e le m b v'.
 Proof.
   intros. unfold make_cast, sem_cast in *;
@@ -302,6 +376,12 @@ Proof.
   econstructor; eauto with cshm.
   simpl. unfold Val.cmpu, Val.cmpu_bool, Int.cmpu.
   destruct (Int.eq i Int.zero); auto.
+  (* pointer -> bool *)
+  destruct (Mem.weak_valid_pointer m b (Int.unsigned i)) eqn:VALID; inv H2.
+  econstructor; eauto with cshm.
+  simpl. unfold Val.cmpu. simpl. rewrite Int.eq_true.
+  unfold Mem.weak_valid_pointer in VALID; rewrite VALID. 
+  auto.
   (* struct *)
   destruct (ident_eq id1 id2); inv H2; auto.
   (* union *)
@@ -394,6 +474,16 @@ Qed.
 
 Definition binary_constructor_correct
     (make: expr -> type -> expr -> type -> res expr)
+    (sem: val -> type -> val -> type -> mem -> option val): Prop :=
+  forall a tya b tyb c va vb v e le m,
+  sem va tya vb tyb m = Some v ->
+  make a tya b tyb = OK c ->
+  eval_expr ge e le m a va ->
+  eval_expr ge e le m b vb ->
+  eval_expr ge e le m c v.
+
+Definition shift_constructor_correct
+    (make: expr -> type -> expr -> type -> res expr)
     (sem: val -> type -> val -> type -> option val): Prop :=
   forall a tya b tyb c va vb v e le m,
   sem va tya vb tyb = Some v ->
@@ -433,8 +523,8 @@ Proof.
   set (cls := classify_binarith tya tyb) in *.
   set (ty := binarith_type cls) in *.
   monadInv MAKE.
-  destruct (sem_cast va tya ty) as [va'|] eqn:Ca; try discriminate.
-  destruct (sem_cast vb tyb ty) as [vb'|] eqn:Cb; try discriminate.
+  destruct (sem_cast va tya ty m) as [va'|] eqn:Ca; try discriminate.
+  destruct (sem_cast vb tyb ty m) as [vb'|] eqn:Cb; try discriminate.
   exploit make_cast_correct. eexact EQ. eauto. eauto. intros EV1'.
   exploit make_cast_correct. eexact EQ1. eauto. eauto. intros EV2'.
   destruct cls; inv EQ2; destruct va'; try discriminate; destruct vb'; try discriminate.
@@ -456,8 +546,8 @@ Proof.
   set (cls := classify_binarith tya tyb) in *.
   set (ty := binarith_type cls) in *.
   monadInv MAKE.
-  destruct (sem_cast va tya ty) as [va'|] eqn:Ca; try discriminate.
-  destruct (sem_cast vb tyb ty) as [vb'|] eqn:Cb; try discriminate.
+  destruct (sem_cast va tya ty m) as [va'|] eqn:Ca; try discriminate.
+  destruct (sem_cast vb tyb ty m) as [vb'|] eqn:Cb; try discriminate.
   exploit make_cast_correct. eexact EQ. eauto. eauto. intros EV1'.
   exploit make_cast_correct. eexact EQ1. eauto. eauto. intros EV2'.
   destruct cls; inv EQ2; destruct va'; try discriminate; destruct vb'; try discriminate.
@@ -471,27 +561,33 @@ End MAKE_BIN.
 
 Hint Extern 2 (@eq (option val) _ _) => (simpl; reflexivity) : cshm.
 
-Lemma make_add_correct: binary_constructor_correct (make_add ce) (sem_add ce).
+Lemma make_add_correct: binary_constructor_correct (make_add cunit.(prog_comp_env)) (sem_add prog.(prog_comp_env)).
 Proof.
   red; unfold make_add, sem_add;
   intros until m; intros SEM MAKE EV1 EV2;
-  destruct (classify_add tya tyb); inv MAKE.
-- destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
-- destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
-- destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
-- destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
+  destruct (classify_add tya tyb); try (monadInv MAKE).
+- rewrite (transl_sizeof _ _ _ _ LINK EQ).
+  destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
+- rewrite (transl_sizeof _ _ _ _ LINK EQ).
+  destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
+- rewrite (transl_sizeof _ _ _ _ LINK EQ).
+  destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
+- rewrite (transl_sizeof _ _ _ _ LINK EQ).
+  destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
 - eapply make_binarith_correct; eauto; intros; auto.
 Qed.
 
-Lemma make_sub_correct: binary_constructor_correct (make_sub ce) (sem_sub ce).
+Lemma make_sub_correct: binary_constructor_correct (make_sub cunit.(prog_comp_env)) (sem_sub prog.(prog_comp_env)).
 Proof.
   red; unfold make_sub, sem_sub;
   intros until m; intros SEM MAKE EV1 EV2;
-  destruct (classify_sub tya tyb); inv MAKE.
-- destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
-- destruct va; try discriminate; destruct vb; inv SEM.
+  destruct (classify_sub tya tyb); try (monadInv MAKE).
+- rewrite (transl_sizeof _ _ _ _ LINK EQ).
+  destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
+- rewrite (transl_sizeof _ _ _ _ LINK EQ).
+  destruct va; try discriminate; destruct vb; inv SEM.
   destruct (eq_block b0 b1); try discriminate.
-  set (sz := sizeof ce ty) in *.
+  set (sz := Ctypes.sizeof (prog_comp_env prog) ty) in *.
   destruct (zlt 0 sz); try discriminate.
   destruct (zle sz Int.max_signed); simpl in H0; inv H0.
   econstructor; eauto with cshm.
@@ -503,7 +599,8 @@ Proof.
   predSpec Int.eq Int.eq_spec (Int.repr sz) Int.mone.
   rewrite H0 in E; rewrite Int.signed_mone in E; omegaContradiction.
   rewrite andb_false_r; auto.
-- destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
+- rewrite (transl_sizeof _ _ _ _ LINK EQ).
+  destruct va; try discriminate; destruct vb; inv SEM; eauto with cshm.
 - eapply make_binarith_correct; eauto; intros; auto.
 Qed.
 
@@ -578,7 +675,7 @@ Proof.
   apply Int64.unsigned_repr. comput Int64.max_unsigned; omega.
 Qed.
 
-Lemma make_shl_correct: binary_constructor_correct make_shl sem_shl.
+Lemma make_shl_correct: shift_constructor_correct make_shl sem_shl.
 Proof.
   red; unfold make_shl, sem_shl, sem_shift;
   intros until m; intros SEM MAKE EV1 EV2;
@@ -597,7 +694,7 @@ Proof.
   unfold Int64.shl', Int64.shl. rewrite small_shift_amount_3; auto.
 Qed.
 
-Lemma make_shr_correct: binary_constructor_correct make_shr sem_shr.
+Lemma make_shr_correct: shift_constructor_correct make_shr sem_shr.
 Proof.
   red; unfold make_shr, sem_shr, sem_shift;
   intros until m; intros SEM MAKE EV1 EV2;
@@ -619,15 +716,9 @@ Proof.
   unfold Int64.shru', Int64.shru; rewrite small_shift_amount_3; auto.
 Qed.
 
-Lemma make_cmp_correct:
-  forall cmp a tya b tyb c va vb v e le m,
-  sem_cmp cmp va tya vb tyb m = Some v ->
-  make_cmp cmp a tya b tyb = OK c ->
-  eval_expr ge e le m a va ->
-  eval_expr ge e le m b vb ->
-  eval_expr ge e le m c v.
+Lemma make_cmp_correct: forall cmp, binary_constructor_correct (make_cmp cmp) (sem_cmp cmp).
 Proof.
-  unfold sem_cmp, make_cmp; intros until m; intros SEM MAKE EV1 EV2;
+  red; unfold sem_cmp, make_cmp; intros until m; intros SEM MAKE EV1 EV2;
   destruct (classify_cmp tya tyb).
 - inv MAKE. destruct (Val.cmpu_bool (Mem.valid_pointer m) cmp va vb) as [bv|] eqn:E;
   simpl in SEM; inv SEM.
@@ -663,8 +754,8 @@ Qed.
 
 Lemma transl_binop_correct:
   forall op a tya b tyb c va vb v e le m,
-  transl_binop ce op a tya b tyb = OK c ->
-  sem_binary_operation ce op va tya vb tyb m = Some v ->
+  transl_binop cunit.(prog_comp_env) op a tya b tyb = OK c ->
+  sem_binary_operation prog.(prog_comp_env) op va tya vb tyb m = Some v ->
   eval_expr ge e le m a va ->
   eval_expr ge e le m b vb ->
   eval_expr ge e le m c v.
@@ -706,15 +797,18 @@ Proof.
 Qed.
 
 Lemma make_memcpy_correct:
-  forall ce f dst src ty k e le m b ofs v m',
+  forall f dst src ty k e le m b ofs v m' s,
   eval_expr ge e le m dst (Vptr b ofs) ->
   eval_expr ge e le m src v ->
-  assign_loc ce ty m b ofs v m' ->
+  assign_loc prog.(prog_comp_env) ty m b ofs v m' ->
   access_mode ty = By_copy ->
-  step ge (State f (make_memcpy ce dst src ty) k e le m) E0 (State f Sskip k e le m').
+  make_memcpy cunit.(prog_comp_env) dst src ty = OK s ->
+  step ge (State f s k e le m) E0 (State f Sskip k e le m').
 Proof.
   intros. inv H1; try congruence.
-  unfold make_memcpy. change le with (set_optvar None Vundef le) at 2.
+  monadInv H3. 
+  exploit transl_alignof_blockcopy. eexact LINK. eauto. intros [A B]. rewrite A, B.
+  change le with (set_optvar None Vundef le) at 2.
   econstructor.
   econstructor. eauto. econstructor. eauto. constructor.
   econstructor; eauto.
@@ -725,10 +819,10 @@ Qed.
 
 Lemma make_store_correct:
   forall addr ty rhs code e le m b ofs v m' f k,
-  make_store ce addr ty rhs = OK code ->
+  make_store cunit.(prog_comp_env) addr ty rhs = OK code ->
   eval_expr ge e le m addr (Vptr b ofs) ->
   eval_expr ge e le m rhs v ->
-  assign_loc ce ty m b ofs v m' ->
+  assign_loc prog.(prog_comp_env) ty m b ofs v m' ->
   step ge (State f code k e le m) E0 (State f Sskip k e le m').
 Proof.
   unfold make_store. intros until k; intros MKSTORE EV1 EV2 ASSIGN.
@@ -737,8 +831,8 @@ Proof.
   rewrite H in MKSTORE; inv MKSTORE.
   econstructor; eauto.
   (* by copy *)
-  rewrite H in MKSTORE; inv MKSTORE.
-  eapply make_memcpy_correct; eauto.
+  rewrite H in MKSTORE.
+  eapply make_memcpy_correct with (b := b) (v := Vptr b' ofs'); eauto.
 Qed.
 
 End CONSTRUCTORS.
@@ -749,34 +843,30 @@ Section CORRECTNESS.
 
 Variable prog: Clight.program.
 Variable tprog: Csharpminor.program.
-Hypothesis TRANSL: transl_program prog = OK tprog.
+Hypothesis TRANSL: match_prog prog tprog.
 
 Let ge := globalenv prog.
 Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
   forall s, Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof (Genv.find_symbol_transf_partial2 (transl_fundef ge) transl_globvar _ TRANSL).
+Proof (Genv.find_symbol_match TRANSL).
 
-Lemma public_preserved:
-  forall s, Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof (Genv.public_symbol_transf_partial2 (transl_fundef ge) transl_globvar _ TRANSL).
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSL).
+
+Lemma function_ptr_translated:
+  forall v f,
+  Genv.find_funct_ptr ge v = Some f ->
+  exists cu tf, Genv.find_funct_ptr tge v = Some tf /\ match_fundef cu f tf /\ linkorder cu prog.
+Proof (Genv.find_funct_ptr_match TRANSL).
 
 Lemma functions_translated:
   forall v f,
   Genv.find_funct ge v = Some f ->
-  exists tf, Genv.find_funct tge v = Some tf /\ transl_fundef ge f = OK tf.
-Proof (Genv.find_funct_transf_partial2 (transl_fundef ge) transl_globvar _ TRANSL).
-
-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 ge f = OK tf.
-Proof (Genv.find_funct_ptr_transf_partial2 (transl_fundef ge) transl_globvar _ TRANSL).
-
-Lemma block_is_volatile_preserved:
-  forall b, Genv.block_is_volatile tge b = Genv.block_is_volatile ge b.
-Proof (Genv.block_is_volatile_transf_partial2 (transl_fundef ge) transl_globvar _ TRANSL).
+  exists cu tf, Genv.find_funct tge v = Some tf /\ match_fundef cu f tf /\ linkorder cu prog.
+Proof (Genv.find_funct_match TRANSL).
 
 (** * Matching between environments *)
 
@@ -787,7 +877,7 @@ Record match_env (e: Clight.env) (te: Csharpminor.env) : Prop :=
   mk_match_env {
     me_local:
       forall id b ty,
-      e!id = Some (b, ty) -> te!id = Some(b, sizeof ge ty);
+      e!id = Some (b, ty) -> te!id = Some(b, Ctypes.sizeof ge ty);
     me_local_inv:
       forall id b sz,
       te!id = Some (b, sz) -> exists ty, e!id = Some(b, ty)
@@ -811,13 +901,13 @@ Proof.
   intros.
   set (R := fun (x: (block * type)) (y: (block * Z)) =>
          match x, y with
-         | (b1, ty), (b2, sz) => b2 = b1 /\ sz = sizeof ge ty
+         | (b1, ty), (b2, sz) => b2 = b1 /\ sz = Ctypes.sizeof ge ty
          end).
   assert (list_forall2
             (fun i_x i_y => fst i_x = fst i_y /\ R (snd i_x) (snd i_y))
             (PTree.elements e) (PTree.elements te)).
   apply PTree.elements_canonical_order.
-  intros id [b ty] GET. exists (b, sizeof ge ty); split. eapply me_local; eauto. red; auto.
+  intros id [b ty] GET. exists (b, Ctypes.sizeof ge ty); split. eapply me_local; eauto. red; auto.
   intros id [b sz] GET. exploit me_local_inv; eauto. intros [ty EQ].
   exploit me_local; eauto. intros EQ1.
   exists (b, ty); split. auto. red; split; congruence.
@@ -853,17 +943,21 @@ Qed.
   local variables and initialization of the parameters. *)
 
 Lemma match_env_alloc_variables:
-  forall e1 m1 vars e2 m2,
-  Clight.alloc_variables ge e1 m1 vars e2 m2 ->
-  forall te1,
+  forall cunit, linkorder cunit prog ->
+  forall e1 m1 vars e2 m2, Clight.alloc_variables ge e1 m1 vars e2 m2 ->
+  forall tvars te1,
+  mmap (transl_var cunit.(prog_comp_env)) vars = OK tvars ->
   match_env e1 te1 ->
   exists te2,
-  Csharpminor.alloc_variables te1 m1 (map (transl_var ge) vars) te2 m2
+  Csharpminor.alloc_variables te1 m1 tvars te2 m2
   /\ match_env e2 te2.
 Proof.
-  induction 1; intros; simpl.
-  exists te1; split. constructor. auto.
-  exploit (IHalloc_variables (PTree.set id (b1, sizeof ge ty) te1)).
+  induction 2; simpl; intros.
+- inv H0. exists te1; split. constructor. auto.
+- monadInv H2. monadInv EQ. simpl in *. 
+  exploit transl_sizeof. eexact H. eauto. intros SZ; rewrite SZ. 
+  exploit (IHalloc_variables x0 (PTree.set id (b1, Ctypes.sizeof ge ty) te1)).
+  auto.
   constructor.
     (* me_local *)
     intros until ty0. repeat rewrite PTree.gsspec.
@@ -893,6 +987,16 @@ Proof.
   destruct a as [id ty]. destruct vals; try discriminate. auto.
 Qed.
 
+Lemma transl_vars_names:
+  forall ce vars tvars,
+  mmap (transl_var ce) vars = OK tvars ->
+  map fst tvars = var_names vars.
+Proof.
+  intros. exploit mmap_inversion; eauto. generalize vars tvars. induction 1; simpl.
+- auto.
+- monadInv H0. simpl; congruence.
+Qed.
+
 (** * Proof of semantic preservation *)
 
 (** ** Semantic preservation for expressions *)
@@ -919,6 +1023,8 @@ Qed.
 
 Section EXPR.
 
+Variable cunit: Clight.program.
+Hypothesis LINK: linkorder cunit prog.
 Variable e: Clight.env.
 Variable le: temp_env.
 Variable m: mem.
@@ -928,11 +1034,11 @@ Hypothesis MENV: match_env e te.
 Lemma transl_expr_lvalue_correct:
   (forall a v,
    Clight.eval_expr ge e le m a v ->
-   forall ta (TR: transl_expr ge a = OK ta) ,
+   forall ta (TR: transl_expr cunit.(prog_comp_env) a = OK ta) ,
    Csharpminor.eval_expr tge te le m ta v)
 /\(forall a b ofs,
    Clight.eval_lvalue ge e le m a b ofs ->
-   forall ta (TR: transl_lvalue ge a = OK ta),
+   forall ta (TR: transl_lvalue cunit.(prog_comp_env) a = OK ta),
    Csharpminor.eval_expr tge te le m ta (Vptr b ofs)).
 Proof.
   apply eval_expr_lvalue_ind; intros; try (monadInv TR).
@@ -955,9 +1061,9 @@ Proof.
 (* cast *)
   eapply make_cast_correct; eauto.
 (* sizeof *)
-  apply make_intconst_correct.
+  rewrite (transl_sizeof _ _ _ _ LINK EQ). apply make_intconst_correct.
 (* alignof *)
-  apply make_intconst_correct.
+  rewrite (transl_alignof _ _ _ _ LINK EQ). apply make_intconst_correct.
 (* rvalue out of lvalue *)
   exploit transl_expr_lvalue; eauto. intros [tb [TRLVAL MKLOAD]].
   eapply make_load_correct; eauto.
@@ -971,11 +1077,13 @@ Proof.
 (* deref *)
   simpl in TR. eauto.
 (* field struct *)
-  change (prog_comp_env prog) with (genv_cenv ge) in EQ0.
-  unfold make_field_access in EQ0; rewrite H1, H2 in EQ0; monadInv EQ0.
+  unfold make_field_access in EQ0. rewrite H1 in EQ0. 
+  destruct (prog_comp_env cunit)!id as [co'|] eqn:CO; monadInv EQ0.
+  exploit field_offset_stable. eexact LINK. eauto. instantiate (1 := i). intros [A B].
+  rewrite <- B in EQ1. 
   eapply eval_Ebinop; eauto.
   apply make_intconst_correct.
-  simpl. congruence.
+  simpl. unfold ge in *; simpl in *. congruence.
 (* field union *)
   unfold make_field_access in EQ0; rewrite H1 in EQ0; monadInv EQ0.
   auto.
@@ -984,21 +1092,21 @@ Qed.
 Lemma transl_expr_correct:
    forall a v,
    Clight.eval_expr ge e le m a v ->
-   forall ta, transl_expr ge a = OK ta ->
+   forall ta, transl_expr cunit.(prog_comp_env) a = OK ta ->
    Csharpminor.eval_expr tge te le m ta v.
 Proof (proj1 transl_expr_lvalue_correct).
 
 Lemma transl_lvalue_correct:
    forall a b ofs,
    Clight.eval_lvalue ge e le m a b ofs ->
-   forall ta, transl_lvalue ge a = OK ta ->
+   forall ta, transl_lvalue cunit.(prog_comp_env) a = OK ta ->
    Csharpminor.eval_expr tge te le m ta (Vptr b ofs).
 Proof (proj2 transl_expr_lvalue_correct).
 
 Lemma transl_arglist_correct:
   forall al tyl vl,
   Clight.eval_exprlist ge e le m al tyl vl ->
-  forall tal, transl_arglist ge al tyl = OK tal ->
+  forall tal, transl_arglist cunit.(prog_comp_env) al tyl = OK tal ->
   Csharpminor.eval_exprlist tge te le m tal vl.
 Proof.
   induction 1; intros.
@@ -1052,71 +1160,75 @@ Proof.
   apply star_refl.
 Qed.
 
-Inductive match_cont: type -> nat -> nat -> Clight.cont -> Csharpminor.cont -> Prop :=
-  | match_Kstop: forall tyret nbrk ncnt,
-      match_cont tyret nbrk ncnt Clight.Kstop Kstop
-  | match_Kseq: forall tyret nbrk ncnt s k ts tk,
-      transl_statement ge tyret nbrk ncnt s = OK ts ->
-      match_cont tyret nbrk ncnt k tk ->
-      match_cont tyret nbrk ncnt
+Inductive match_cont: composite_env -> type -> nat -> nat -> Clight.cont -> Csharpminor.cont -> Prop :=
+  | match_Kstop: forall ce tyret nbrk ncnt,
+      match_cont tyret ce nbrk ncnt Clight.Kstop Kstop
+  | match_Kseq: forall ce tyret nbrk ncnt s k ts tk,
+      transl_statement ce tyret nbrk ncnt s = OK ts ->
+      match_cont ce tyret nbrk ncnt k tk ->
+      match_cont ce tyret nbrk ncnt
                  (Clight.Kseq s k)
                  (Kseq ts tk)
-  | match_Kloop1: forall tyret s1 s2 k ts1 ts2 nbrk ncnt tk,
-      transl_statement ge tyret 1%nat 0%nat s1 = OK ts1 ->
-      transl_statement ge tyret 0%nat (S ncnt) s2 = OK ts2 ->
-      match_cont tyret nbrk ncnt k tk ->
-      match_cont tyret 1%nat 0%nat
+  | match_Kloop1: forall ce tyret s1 s2 k ts1 ts2 nbrk ncnt tk,
+      transl_statement ce tyret 1%nat 0%nat s1 = OK ts1 ->
+      transl_statement ce tyret 0%nat (S ncnt) s2 = OK ts2 ->
+      match_cont ce tyret nbrk ncnt k tk ->
+      match_cont ce tyret 1%nat 0%nat
                  (Clight.Kloop1 s1 s2 k)
                  (Kblock (Kseq ts2 (Kseq (Sloop (Sseq (Sblock ts1) ts2)) (Kblock tk))))
-  | match_Kloop2: forall tyret s1 s2 k ts1 ts2 nbrk ncnt tk,
-      transl_statement ge tyret 1%nat 0%nat s1 = OK ts1 ->
-      transl_statement ge tyret 0%nat (S ncnt) s2 = OK ts2 ->
-      match_cont tyret nbrk ncnt k tk ->
-      match_cont tyret 0%nat (S ncnt)
+  | match_Kloop2: forall ce tyret s1 s2 k ts1 ts2 nbrk ncnt tk,
+      transl_statement ce tyret 1%nat 0%nat s1 = OK ts1 ->
+      transl_statement ce tyret 0%nat (S ncnt) s2 = OK ts2 ->
+      match_cont ce tyret nbrk ncnt k tk ->
+      match_cont ce tyret 0%nat (S ncnt)
                  (Clight.Kloop2 s1 s2 k)
                  (Kseq (Sloop (Sseq (Sblock ts1) ts2)) (Kblock tk))
-  | match_Kswitch: forall tyret nbrk ncnt k tk,
-      match_cont tyret nbrk ncnt k tk ->
-      match_cont tyret 0%nat (S ncnt)
+  | match_Kswitch: forall ce tyret nbrk ncnt k tk,
+      match_cont ce tyret nbrk ncnt k tk ->
+      match_cont ce tyret 0%nat (S ncnt)
                  (Clight.Kswitch k)
                  (Kblock tk)
-  | match_Kcall_some: forall tyret nbrk ncnt nbrk' ncnt' f e k id tf te le tk,
-      transl_function ge f = OK tf ->
+  | match_Kcall: forall ce tyret nbrk ncnt nbrk' ncnt' f e k id tf te le tk cu,
+      linkorder cu prog ->
+      transl_function cu.(prog_comp_env) f = OK tf ->
       match_env e te ->
-      match_cont (Clight.fn_return f) nbrk' ncnt' k tk ->
-      match_cont tyret nbrk ncnt
+      match_cont cu.(prog_comp_env) (Clight.fn_return f) nbrk' ncnt' k tk ->
+      match_cont ce tyret nbrk ncnt
                  (Clight.Kcall id f e le k)
                  (Kcall id tf te le tk).
 
 Inductive match_states: Clight.state -> Csharpminor.state -> Prop :=
   | match_state:
-      forall f nbrk ncnt s k e le m tf ts tk te ts' tk'
-          (TRF: transl_function ge f = OK tf)
-          (TR: transl_statement ge (Clight.fn_return f) nbrk ncnt s = OK ts)
+      forall f nbrk ncnt s k e le m tf ts tk te ts' tk' cu
+          (LINK: linkorder cu prog)
+          (TRF: transl_function cu.(prog_comp_env) f = OK tf)
+          (TR: transl_statement cu.(prog_comp_env) (Clight.fn_return f) nbrk ncnt s = OK ts)
           (MTR: match_transl ts tk ts' tk')
           (MENV: match_env e te)
-          (MK: match_cont (Clight.fn_return f) nbrk ncnt k tk),
+          (MK: match_cont cu.(prog_comp_env) (Clight.fn_return f) nbrk ncnt k tk),
       match_states (Clight.State f s k e le m)
                    (State tf ts' tk' te le m)
   | match_callstate:
-      forall fd args k m tfd tk targs tres cconv
-          (TR: transl_fundef ge fd = OK tfd)
-          (MK: match_cont Tvoid 0%nat 0%nat k tk)
+      forall fd args k m tfd tk targs tres cconv cu ce
+          (LINK: linkorder cu prog)
+          (TR: match_fundef cu fd tfd)
+          (MK: match_cont ce Tvoid 0%nat 0%nat k tk)
           (ISCC: Clight.is_call_cont k)
           (TY: type_of_fundef fd = Tfunction targs tres cconv),
       match_states (Clight.Callstate fd args k m)
                    (Callstate tfd args tk m)
   | match_returnstate:
-      forall res k m tk
-          (MK: match_cont Tvoid 0%nat 0%nat k tk),
+      forall res k m tk ce
+          (MK: match_cont ce Tvoid 0%nat 0%nat k tk),
       match_states (Clight.Returnstate res k m)
                    (Returnstate res tk m).
 
 Remark match_states_skip:
-  forall f e le te nbrk ncnt k tf tk m,
-  transl_function ge f = OK tf ->
+  forall f e le te nbrk ncnt k tf tk m cu,
+  linkorder cu prog ->
+  transl_function cu.(prog_comp_env) f = OK tf ->
   match_env e te ->
-  match_cont (Clight.fn_return f) nbrk ncnt k tk ->
+  match_cont cu.(prog_comp_env) (Clight.fn_return f) nbrk ncnt k tk ->
   match_states (Clight.State f Clight.Sskip k e le m) (State tf Sskip tk te le m).
 Proof.
   intros. econstructor; eauto. simpl; reflexivity. constructor.
@@ -1125,89 +1237,90 @@ Qed.
 (** Commutation between label resolution and compilation *)
 
 Section FIND_LABEL.
+Variable ce: composite_env.
 Variable lbl: label.
 Variable tyret: type.
 
 Lemma transl_find_label:
   forall s nbrk ncnt k ts tk
-  (TR: transl_statement ge tyret nbrk ncnt s = OK ts)
-  (MC: match_cont tyret nbrk ncnt k tk),
+  (TR: transl_statement ce tyret nbrk ncnt s = OK ts)
+  (MC: match_cont ce tyret nbrk ncnt k tk),
   match Clight.find_label lbl s k with
   | None => find_label lbl ts tk = None
   | Some (s', k') =>
       exists ts', exists tk', exists nbrk', exists ncnt',
       find_label lbl ts tk = Some (ts', tk')
-      /\ transl_statement ge tyret nbrk' ncnt' s' = OK ts'
-      /\ match_cont tyret nbrk' ncnt' k' tk'
+      /\ transl_statement ce tyret nbrk' ncnt' s' = OK ts'
+      /\ match_cont ce tyret nbrk' ncnt' k' tk'
   end
 
 with transl_find_label_ls:
   forall ls nbrk ncnt k tls tk
-  (TR: transl_lbl_stmt ge tyret nbrk ncnt ls = OK tls)
-  (MC: match_cont tyret nbrk ncnt k tk),
+  (TR: transl_lbl_stmt ce tyret nbrk ncnt ls = OK tls)
+  (MC: match_cont ce tyret nbrk ncnt k tk),
   match Clight.find_label_ls lbl ls k with
   | None => find_label_ls lbl tls tk = None
   | Some (s', k') =>
       exists ts', exists tk', exists nbrk', exists ncnt',
       find_label_ls lbl tls tk = Some (ts', tk')
-      /\ transl_statement ge tyret nbrk' ncnt' s' = OK ts'
-      /\ match_cont tyret nbrk' ncnt' k' tk'
+      /\ transl_statement ce tyret nbrk' ncnt' s' = OK ts'
+      /\ match_cont ce tyret nbrk' ncnt' k' tk'
   end.
 
 Proof.
-  intro s; case s; intros; try (monadInv TR); simpl.
-(* skip *)
+* intro s; case s; intros; try (monadInv TR); simpl.
+- (* skip *)
   auto.
-(* assign *)
+- (* assign *)
   unfold make_store, make_memcpy in EQ3.
-  destruct (access_mode (typeof e)); inv EQ3; auto.
-(* set *)
+  destruct (access_mode (typeof e)); monadInv EQ3; auto.
+- (* set *)
   auto.
-(* call *)
+- (* call *)
   simpl in TR. destruct (classify_fun (typeof e)); monadInv TR. auto.
-(* builtin *)
+- (* builtin *)
   auto.
-(* seq *)
+- (* seq *)
   exploit (transl_find_label s0 nbrk ncnt (Clight.Kseq s1 k)); eauto. constructor; eauto.
   destruct (Clight.find_label lbl s0 (Clight.Kseq s1 k)) as [[s' k'] | ].
   intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
   rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
   intro. rewrite H. eapply transl_find_label; eauto.
-(* ifthenelse *)
+- (* ifthenelse *)
   exploit (transl_find_label s0); eauto.
   destruct (Clight.find_label lbl s0 k) as [[s' k'] | ].
   intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
   rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
   intro. rewrite H. eapply transl_find_label; eauto.
-(* loop *)
+- (* loop *)
   exploit (transl_find_label s0 1%nat 0%nat (Kloop1 s0 s1 k)); eauto. econstructor; eauto.
   destruct (Clight.find_label lbl s0 (Kloop1 s0 s1 k)) as [[s' k'] | ].
   intros [ts' [tk' [nbrk' [ncnt' [A [B C]]]]]].
   rewrite A. exists ts'; exists tk'; exists nbrk'; exists ncnt'; auto.
   intro. rewrite H.
   eapply transl_find_label; eauto. econstructor; eauto.
-(* break *)
+- (* break *)
   auto.
-(* continue *)
+- (* continue *)
   auto.
-(* return *)
+- (* return *)
   simpl in TR. destruct o; monadInv TR. auto. auto.
-(* switch *)
+- (* switch *)
   assert (exists b, ts = Sblock (Sswitch b x x0)).
   { destruct (classify_switch (typeof e)); inv EQ2; econstructor; eauto. }
   destruct H as [b EQ3]; rewrite EQ3; simpl.
   eapply transl_find_label_ls with (k := Clight.Kswitch k); eauto. econstructor; eauto.
-(* label *)
+- (* label *)
   destruct (ident_eq lbl l).
   exists x; exists tk; exists nbrk; exists ncnt; auto.
   eapply transl_find_label; eauto.
-(* goto *)
+- (* goto *)
   auto.
 
-  intro ls; case ls; intros; monadInv TR; simpl.
-(* nil *)
+* intro ls; case ls; intros; monadInv TR; simpl.
+- (* nil *)
   auto.
-(* cons *)
+- (* cons *)
   exploit (transl_find_label s nbrk ncnt (Clight.Kseq (seq_of_labeled_statement l) k)); eauto.
   econstructor; eauto. apply transl_lbl_stmt_2; eauto.
   destruct (Clight.find_label lbl s (Clight.Kseq (seq_of_labeled_statement l) k)) as [[s' k'] | ].
@@ -1222,9 +1335,9 @@ End FIND_LABEL.
 (** Properties of call continuations *)
 
 Lemma match_cont_call_cont:
-  forall tyret' nbrk' ncnt' tyret nbrk ncnt k tk,
-  match_cont tyret nbrk ncnt k tk ->
-  match_cont tyret' nbrk' ncnt' (Clight.call_cont k) (call_cont tk).
+  forall ce' tyret' nbrk' ncnt' ce tyret nbrk ncnt k tk,
+  match_cont ce tyret nbrk ncnt k tk ->
+  match_cont ce' tyret' nbrk' ncnt' (Clight.call_cont k) (call_cont tk).
 Proof.
   induction 1; simpl; auto.
   constructor.
@@ -1232,10 +1345,10 @@ Proof.
 Qed.
 
 Lemma match_cont_is_call_cont:
-  forall tyret nbrk ncnt k tk tyret' nbrk' ncnt',
-  match_cont tyret nbrk ncnt k tk ->
+  forall ce tyret nbrk ncnt k tk ce' tyret' nbrk' ncnt',
+  match_cont ce tyret nbrk ncnt k tk ->
   Clight.is_call_cont k ->
-  match_cont tyret' nbrk' ncnt' k tk /\ is_call_cont tk.
+  match_cont ce' tyret' nbrk' ncnt' k tk /\ is_call_cont tk.
 Proof.
   intros. inv H; simpl in H0; try contradiction; simpl.
   split; auto; constructor.
@@ -1251,11 +1364,12 @@ Lemma transl_step:
 Proof.
   induction 1; intros T1 MST; inv MST.
 
-(* assign *)
+- (* assign *)
   monadInv TR.
   assert (SAME: ts' = ts /\ tk' = tk).
-    inversion MTR. auto.
-    subst ts. unfold make_store, make_memcpy in EQ3. destruct (access_mode (typeof a1)); congruence.
+  { inversion MTR. auto.
+    subst ts. unfold make_store, make_memcpy in EQ3.
+    destruct (access_mode (typeof a1)); monadInv EQ3; auto. }
   destruct SAME; subst ts' tk'.
   econstructor; split.
   apply plus_one. eapply make_store_correct; eauto.
@@ -1263,62 +1377,61 @@ Proof.
   eapply transl_expr_correct; eauto.
   eapply match_states_skip; eauto.
 
-(* set *)
+- (* set *)
   monadInv TR. inv MTR. econstructor; split.
   apply plus_one. econstructor. eapply transl_expr_correct; eauto.
   eapply match_states_skip; eauto.
 
-(* call *)
+- (* call *)
   revert TR. simpl. case_eq (classify_fun (typeof a)); try congruence.
   intros targs tres cc CF TR. monadInv TR. inv MTR.
-  exploit functions_translated; eauto. intros [tfd [FIND TFD]].
+  exploit functions_translated; eauto. intros (cu' & tfd & FIND & TFD & LINK').
   rewrite H in CF. simpl in CF. inv CF.
   econstructor; split.
   apply plus_one. econstructor; eauto.
-  exploit transl_expr_correct; eauto.
-  exploit transl_arglist_correct; eauto.
+  eapply transl_expr_correct with (cunit := cu); eauto. 
+  eapply transl_arglist_correct with (cunit := cu); eauto.
   erewrite typlist_of_arglist_eq by eauto.
   eapply transl_fundef_sig1; eauto.
   rewrite H3. auto.
   econstructor; eauto.
-  econstructor; eauto.
+  eapply match_Kcall with (ce := prog_comp_env cu') (cu := cu); eauto.
   simpl. auto.
 
-(* builtin *)
+- (* builtin *)
   monadInv TR. inv MTR.
   econstructor; split.
   apply plus_one. econstructor.
   eapply transl_arglist_correct; eauto.
-  eapply external_call_symbols_preserved_gen with (ge1 := ge).
-  exact symbols_preserved. exact public_preserved. exact block_is_volatile_preserved. eauto.
+  eapply external_call_symbols_preserved with (ge1 := ge). apply senv_preserved. eauto.
   eapply match_states_skip; eauto.
 
-(* seq *)
+- (* seq *)
   monadInv TR. inv MTR.
   econstructor; split.
   apply plus_one. constructor.
   econstructor; eauto. constructor.
   econstructor; eauto.
 
-(* skip seq *)
+- (* skip seq *)
   monadInv TR. inv MTR. inv MK.
   econstructor; split.
   apply plus_one. apply step_skip_seq.
   econstructor; eauto. constructor.
 
-(* continue seq *)
+- (* continue seq *)
   monadInv TR. inv MTR. inv MK.
   econstructor; split.
   apply plus_one. constructor.
   econstructor; eauto. simpl. reflexivity. constructor.
 
-(* break seq *)
+- (* break seq *)
   monadInv TR. inv MTR. inv MK.
   econstructor; split.
   apply plus_one. constructor.
   econstructor; eauto. simpl. reflexivity. constructor.
 
-(* ifthenelse *)
+- (* ifthenelse *)
   monadInv TR. inv MTR.
   exploit make_boolean_correct; eauto.
   exploit transl_expr_correct; eauto.
@@ -1327,7 +1440,7 @@ Proof.
   apply plus_one. apply step_ifthenelse with (v := v) (b := b); auto.
   destruct b; econstructor; eauto; constructor.
 
-(* loop *)
+- (* loop *)
   monadInv TR.
   econstructor; split.
   eapply star_plus_trans. eapply match_transl_step; eauto.
@@ -1337,9 +1450,9 @@ Proof.
   reflexivity. reflexivity. traceEq.
   econstructor; eauto. constructor. econstructor; eauto.
 
-(* skip-or-continue loop *)
+- (* skip-or-continue loop *)
   assert ((ts' = Sskip \/ ts' = Sexit ncnt) /\ tk' = tk).
-    destruct H; subst x; monadInv TR; inv MTR; auto.
+  { destruct H; subst x; monadInv TR; inv MTR; auto. }
   destruct H0. inv MK.
   econstructor; split.
   eapply plus_left.
@@ -1347,7 +1460,7 @@ Proof.
   apply star_one. constructor. traceEq.
   econstructor; eauto. constructor. econstructor; eauto.
 
-(* break loop1 *)
+- (* break loop1 *)
   monadInv TR. inv MTR. inv MK.
   econstructor; split.
   eapply plus_left. constructor.
@@ -1357,16 +1470,15 @@ Proof.
   reflexivity. reflexivity. traceEq.
   eapply match_states_skip; eauto.
 
-(* skip loop2 *)
+- (* skip loop2 *)
   monadInv TR. inv MTR. inv MK.
   econstructor; split.
   apply plus_one. constructor.
   econstructor; eauto.
-Local Opaque ge.
-  simpl. rewrite H5; simpl. rewrite H7; simpl. eauto.
+  simpl. rewrite H6; simpl. rewrite H8; simpl. eauto.
   constructor.
 
-(* break loop2 *)
+- (* break loop2 *)
   monadInv TR. inv MTR. inv MK.
   econstructor; split.
   eapply plus_left. constructor.
@@ -1374,32 +1486,32 @@ Local Opaque ge.
   traceEq.
   eapply match_states_skip; eauto.
 
-(* return none *)
+- (* return none *)
   monadInv TR. inv MTR.
   econstructor; split.
   apply plus_one. constructor.
   eapply match_env_free_blocks; eauto.
-  econstructor; eauto.
+  eapply match_returnstate with (ce := prog_comp_env cu); eauto.
   eapply match_cont_call_cont. eauto.
 
-(* return some *)
+- (* return some *)
   monadInv TR. inv MTR.
   econstructor; split.
   apply plus_one. constructor.
   eapply make_cast_correct; eauto. eapply transl_expr_correct; eauto.
   eapply match_env_free_blocks; eauto.
-  econstructor; eauto.
+  eapply match_returnstate with (ce := prog_comp_env cu); eauto.
   eapply match_cont_call_cont. eauto.
 
-(* skip call *)
+- (* skip call *)
   monadInv TR. inv MTR.
   exploit match_cont_is_call_cont; eauto. intros [A B].
   econstructor; split.
   apply plus_one. apply step_skip_call. auto.
   eapply match_env_free_blocks; eauto.
-  constructor. eauto.
+  eapply match_returnstate with (ce := prog_comp_env cu); eauto.
 
-(* switch *)
+- (* switch *)
   monadInv TR.
   assert (E: exists b, ts = Sblock (Sswitch b x x0) /\ Switch.switch_argument b v n).
   { unfold sem_switch_arg in H0.
@@ -1415,7 +1527,7 @@ Local Opaque ge.
   constructor.
   econstructor. eauto.
 
-(* skip or break switch *)
+- (* skip or break switch *)
   assert ((ts' = Sskip \/ ts' = Sexit nbrk) /\ tk' = tk).
     destruct H; subst x; monadInv TR; inv MTR; auto.
   destruct H0. inv MK.
@@ -1423,57 +1535,54 @@ Local Opaque ge.
   apply plus_one. destruct H0; subst ts'. 2:constructor. constructor.
   eapply match_states_skip; eauto.
 
-
-(* continue switch *)
+- (* continue switch *)
   monadInv TR. inv MTR. inv MK.
   econstructor; split.
   apply plus_one. constructor.
   econstructor; eauto. simpl. reflexivity. constructor.
 
-(* label *)
+- (* label *)
   monadInv TR. inv MTR.
   econstructor; split.
   apply plus_one. constructor.
   econstructor; eauto. constructor.
 
-(* goto *)
+- (* goto *)
   monadInv TR. inv MTR.
   generalize TRF. unfold transl_function. intro TRF'. monadInv TRF'.
-  exploit (transl_find_label lbl). eexact EQ. eapply match_cont_call_cont. eauto.
+  exploit (transl_find_label (prog_comp_env cu) lbl). eexact EQ. eapply match_cont_call_cont. eauto.
   rewrite H.
   intros [ts' [tk'' [nbrk' [ncnt' [A [B C]]]]]].
   econstructor; split.
   apply plus_one. constructor. simpl. eexact A.
   econstructor; eauto. constructor.
 
-(* internal function *)
-  inv H. monadInv TR. monadInv EQ.
+- (* internal function *)
+  inv H. inv TR. monadInv H5. 
   exploit match_cont_is_call_cont; eauto. intros [A B].
   exploit match_env_alloc_variables; eauto.
   apply match_env_empty.
   intros [te1 [C D]].
   econstructor; split.
   apply plus_one. eapply step_internal_function.
-  simpl. rewrite list_map_compose. simpl. assumption.
-  simpl. auto.
-  simpl. auto.
-  simpl. eauto.
+  simpl. erewrite transl_vars_names by eauto. assumption.
+  simpl. assumption.
+  simpl. assumption.
+  simpl; eauto. 
   simpl. rewrite create_undef_temps_match. eapply bind_parameter_temps_match; eauto.
   simpl. econstructor; eauto.
-  unfold transl_function. rewrite EQ0; simpl. auto.
+  unfold transl_function. rewrite EQ; simpl. rewrite EQ1; simpl. auto.
   constructor.
 
-(* external function *)
-  simpl in TR.
-  destruct (signature_eq (ef_sig ef) (signature_of_type targs tres cconv)); inv TR.
+- (* external function *)
+  inv TR.
   exploit match_cont_is_call_cont; eauto. intros [A B].
   econstructor; split.
   apply plus_one. constructor. eauto.
-  eapply external_call_symbols_preserved_gen with (ge1 := ge).
-  exact symbols_preserved. exact public_preserved. exact block_is_volatile_preserved. eauto.
-  econstructor; eauto.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
+  eapply match_returnstate with (ce := ce); eauto.
 
-(* returnstate *)
+- (* returnstate *)
   inv MK.
   econstructor; split.
   apply plus_one. constructor.
@@ -1485,17 +1594,14 @@ Lemma transl_initial_states:
   exists R, initial_state tprog R /\ match_states S R.
 Proof.
   intros. inv H.
-  exploit function_ptr_translated; eauto. intros [tf [A B]].
-  assert (C: Genv.find_symbol tge (AST.prog_main tprog) = Some b).
-    rewrite symbols_preserved. replace (AST.prog_main tprog) with (prog_main prog).
-    auto. symmetry. unfold transl_program in TRANSL.
-    change (prog_main prog) with (AST.prog_main (program_of_program prog)).
-    eapply transform_partial_program2_main; eauto.
-  assert (funsig tf = signature_of_type Tnil type_int32s cc_default).
-    eapply transl_fundef_sig2; eauto.
+  exploit function_ptr_translated; eauto. intros (cu & tf & A & B & C).
+  assert (D: Genv.find_symbol tge (AST.prog_main tprog) = Some b).
+  { destruct TRANSL as (P & Q & R). rewrite Q. rewrite symbols_preserved. auto. }
+  assert (E: funsig tf = signature_of_type Tnil type_int32s cc_default).
+  { eapply transl_fundef_sig2; eauto. }
   econstructor; split.
-  econstructor; eauto. eapply Genv.init_mem_transf_partial2; eauto.
-  econstructor; eauto. constructor; auto. exact I.
+  econstructor; eauto. apply (Genv.init_mem_match TRANSL). eauto.
+  econstructor; eauto. instantiate (1 := prog_comp_env cu). constructor; auto. exact I.
 Qed.
 
 Lemma transl_final_states:
@@ -1509,10 +1615,40 @@ Theorem transl_program_correct:
   forward_simulation (Clight.semantics2 prog) (Csharpminor.semantics tprog).
 Proof.
   eapply forward_simulation_plus.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transl_initial_states.
   eexact transl_final_states.
   eexact transl_step.
 Qed.
 
 End CORRECTNESS.
+
+(** ** Commutation with linking *)
+
+Instance TransfCshmgenLink : TransfLink match_prog.
+Proof.
+  red; intros. destruct (link_linkorder _ _ _ H) as (LO1 & LO2).
+  generalize H. 
+Local Transparent Ctypes.Linker_program.
+  simpl; unfold link_program.
+  destruct (link (program_of_program p1) (program_of_program p2)) as [pp|] eqn:LP; try discriminate.
+  destruct (lift_option (link (prog_types p1) (prog_types p2))) as [[typs EQ]|P]; try discriminate.
+  destruct (link_build_composite_env (prog_types p1) (prog_types p2) typs
+           (prog_comp_env p1) (prog_comp_env p2) (prog_comp_env_eq p1)
+           (prog_comp_env_eq p2) EQ) as (env & P & Q).
+  intros E.
+  eapply Linking.link_match_program; eauto.
+- intros. 
+Local Transparent Linker_fundef Linking.Linker_fundef.
+  inv H3; inv H4; simpl in H2. 
++ discriminate.
++ destruct ef; inv H2. econstructor; split. simpl; eauto. left; constructor; auto.
++ destruct ef; inv H2. econstructor; split. simpl; eauto. right; constructor; auto.
++ destruct (external_function_eq ef ef0 && typelist_eq args args0 &&
+         type_eq res res0 && calling_convention_eq cc cc0) eqn:E'; inv H2.
+  InvBooleans. subst ef0. econstructor; split. 
+  simpl; rewrite dec_eq_true; eauto.
+  left; constructor. congruence.
+- intros. exists tt. auto.
+- replace (program_of_program p) with pp. auto. inv E; destruct pp; auto.
+Qed.
diff --git a/cfrontend/Cstrategy.v b/cfrontend/Cstrategy.v
index b3cbacca..2650e0a8 100644
--- a/cfrontend/Cstrategy.v
+++ b/cfrontend/Cstrategy.v
@@ -130,7 +130,7 @@ with eval_simple_rvalue: expr -> val -> Prop :=
       eval_simple_rvalue (Ebinop op r1 r2 ty) v
   | esr_cast: forall ty r1 v1 v,
       eval_simple_rvalue r1 v1 ->
-      sem_cast v1 (typeof r1) ty = Some v ->
+      sem_cast v1 (typeof r1) ty m = Some v ->
       eval_simple_rvalue (Ecast r1 ty) v
   | esr_sizeof: forall ty1 ty,
       eval_simple_rvalue (Esizeof ty1 ty) (Vint (Int.repr (sizeof ge ty1)))
@@ -141,7 +141,7 @@ Inductive eval_simple_list: exprlist -> typelist -> list val -> Prop :=
   | esrl_nil:
       eval_simple_list Enil Tnil nil
   | esrl_cons: forall r rl ty tyl v vl v',
-      eval_simple_rvalue r v' -> sem_cast v' (typeof r) ty = Some v ->
+      eval_simple_rvalue r v' -> sem_cast v' (typeof r) ty m = Some v ->
       eval_simple_list rl tyl vl ->
       eval_simple_list (Econs r rl) (Tcons ty tyl) (v :: vl).
 
@@ -283,7 +283,7 @@ Inductive estep: state -> trace -> state -> Prop :=
       leftcontext RV RV C ->
       eval_simple_lvalue e m l b ofs ->
       eval_simple_rvalue e m r v ->
-      sem_cast v (typeof r) (typeof l) = Some v' ->
+      sem_cast v (typeof r) (typeof l) m = Some v' ->
       assign_loc ge (typeof l) m b ofs v' t m' ->
       ty = typeof l ->
       estep (ExprState f (C (Eassign l r ty)) k e m)
@@ -295,7 +295,7 @@ Inductive estep: state -> trace -> state -> Prop :=
       deref_loc ge (typeof l) m b ofs t1 v1 ->
       eval_simple_rvalue e m r v2 ->
       sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m = Some v3 ->
-      sem_cast v3 tyres (typeof l) = Some v4 ->
+      sem_cast v3 tyres (typeof l) m = Some v4 ->
       assign_loc ge (typeof l) m b ofs v4 t2 m' ->
       ty = typeof l ->
       t = t1 ** t2 ->
@@ -310,7 +310,7 @@ Inductive estep: state -> trace -> state -> Prop :=
       match sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m with
       | None => True
       | Some v3 =>
-          match sem_cast v3 tyres (typeof l) with
+          match sem_cast v3 tyres (typeof l) m with
           | None => True
           | Some v4 => forall t2 m', ~(assign_loc ge (typeof l) m b ofs v4 t2 m')
           end
@@ -323,8 +323,8 @@ Inductive estep: state -> trace -> state -> Prop :=
       leftcontext RV RV C ->
       eval_simple_lvalue e m l b ofs ->
       deref_loc ge ty m b ofs t1 v1 ->
-      sem_incrdecr ge id v1 ty = Some v2 ->
-      sem_cast v2 (incrdecr_type ty) ty = Some v3 ->
+      sem_incrdecr ge id v1 ty m = Some v2 ->
+      sem_cast v2 (incrdecr_type ty) ty m = Some v3 ->
       assign_loc ge ty m b ofs v3 t2 m' ->
       ty = typeof l ->
       t = t1 ** t2 ->
@@ -335,10 +335,10 @@ Inductive estep: state -> trace -> state -> Prop :=
       leftcontext RV RV C ->
       eval_simple_lvalue e m l b ofs ->
       deref_loc ge ty m b ofs t v1 ->
-      match sem_incrdecr ge id v1 ty with
+      match sem_incrdecr ge id v1 ty m with
       | None => True
       | Some v2 =>
-          match sem_cast v2 (incrdecr_type ty) ty with
+          match sem_cast v2 (incrdecr_type ty) ty m with
           | None => True
           | Some v3 => forall t2 m', ~(assign_loc ge (typeof l) m b ofs v3 t2 m')
           end
@@ -357,7 +357,7 @@ Inductive estep: state -> trace -> state -> Prop :=
   | step_paren: forall f C r tycast ty k e m v1 v,
       leftcontext RV RV C ->
       eval_simple_rvalue e m r v1 ->
-      sem_cast v1 (typeof r) tycast = Some v ->
+      sem_cast v1 (typeof r) tycast m = Some v ->
       estep (ExprState f (C (Eparen r tycast ty)) k e m)
          E0 (ExprState f (C (Eval v ty)) k e m)
 
@@ -472,7 +472,7 @@ Proof.
 Qed.
 
 Lemma callred_kind:
-  forall a fd args ty, callred ge a fd args ty -> expr_kind a = RV.
+  forall a m fd args ty, callred ge a m fd args ty -> expr_kind a = RV.
 Proof.
   induction 1; auto.
 Qed.
@@ -540,7 +540,7 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
   | Ebinop op (Eval v1 ty1) (Eval v2 ty2) ty =>
       exists v, sem_binary_operation ge op v1 ty1 v2 ty2 m = Some v
   | Ecast (Eval v1 ty1) ty =>
-      exists v, sem_cast v1 ty1 ty = Some v
+      exists v, sem_cast v1 ty1 ty m = Some v
   | Eseqand (Eval v1 ty1) r2 ty =>
       exists b, bool_val v1 ty1 m = Some b
   | Eseqor (Eval v1 ty1) r2 ty =>
@@ -549,7 +549,7 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
       exists b, bool_val v1 ty1 m = Some b
   | Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty =>
       exists v, exists m', exists t,
-      ty = ty1 /\ sem_cast v2 ty2 ty1 = Some v /\ assign_loc ge ty1 m b ofs v t m'
+      ty = ty1 /\ sem_cast v2 ty2 ty1 m = Some v /\ assign_loc ge ty1 m b ofs v t m'
   | Eassignop op (Eloc b ofs ty1) (Eval v2 ty2) tyres ty =>
       exists t, exists v1,
       ty = ty1
@@ -561,18 +561,18 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
   | Ecomma (Eval v ty1) r2 ty =>
       typeof r2 = ty
   | Eparen (Eval v1 ty1) ty2 ty =>
-      exists v, sem_cast v1 ty1 ty2 = Some v
+      exists v, sem_cast v1 ty1 ty2 m = Some v
   | Ecall (Eval vf tyf) rargs ty =>
       exprlist_all_values rargs ->
       exists tyargs tyres cconv fd vl,
          classify_fun tyf = fun_case_f tyargs tyres cconv
       /\ Genv.find_funct ge vf = Some fd
-      /\ cast_arguments rargs tyargs vl
+      /\ cast_arguments m rargs tyargs vl
       /\ type_of_fundef fd = Tfunction tyargs tyres cconv
   | Ebuiltin ef tyargs rargs ty =>
       exprlist_all_values rargs ->
       exists vargs, exists t, exists vres, exists m',
-         cast_arguments rargs tyargs vargs
+         cast_arguments m rargs tyargs vargs
       /\ external_call ef ge vargs m t vres m'
   | _ => True
   end.
@@ -608,7 +608,7 @@ Qed.
 
 Lemma callred_invert:
   forall r fd args ty m,
-  callred ge r fd args ty ->
+  callred ge r m fd args ty ->
   invert_expr_prop r m.
 Proof.
   intros. inv H. simpl.
@@ -893,7 +893,7 @@ Inductive eval_simple_list': exprlist -> list val -> Prop :=
 Lemma eval_simple_list_implies:
   forall rl tyl vl,
   eval_simple_list e m rl tyl vl ->
-  exists vl', cast_arguments (rval_list vl' rl) tyl vl /\ eval_simple_list' rl vl'.
+  exists vl', cast_arguments m (rval_list vl' rl) tyl vl /\ eval_simple_list' rl vl'.
 Proof.
   induction 1.
   exists (@nil val); split. constructor. constructor.
@@ -905,7 +905,7 @@ Lemma can_eval_simple_list:
   forall rl vl,
   eval_simple_list' rl vl ->
   forall tyl vl',
-  cast_arguments (rval_list vl rl) tyl vl' ->
+  cast_arguments m (rval_list vl rl) tyl vl' ->
   eval_simple_list e m rl tyl vl'.
 Proof.
   induction 1; simpl; intros.
@@ -1234,9 +1234,9 @@ Proof.
   left; apply step_rred; auto. econstructor; eauto.
   set (op := match id with Incr => Oadd | Decr => Osub end).
   assert (SEM: sem_binary_operation ge op v1 (typeof l) (Vint Int.one) type_int32s m =
-              sem_incrdecr ge id v1 (typeof l)).
+              sem_incrdecr ge id v1 (typeof l) m).
     destruct id; auto.
-  destruct (sem_incrdecr ge id v1 (typeof l)) as [v2|].
+  destruct (sem_incrdecr ge id v1 (typeof l) m) as [v2|].
   eapply star_left.
   left; apply step_rred with (C := fun x => C (Ecomma (Eassign (Eloc b ofs (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto.
   econstructor; eauto.
@@ -1329,7 +1329,7 @@ Proof.
   intros [v [E2 S2]].
   exploit safe_inv. eexact S2. eauto. simpl. intros [t1 [v1 [A B]]].
   destruct (sem_binary_operation ge op v1 (typeof b1) v (typeof b2) m) as [v3|] eqn:?.
-  destruct (sem_cast v3 tyres (typeof b1)) as [v4|] eqn:?.
+  destruct (sem_cast v3 tyres (typeof b1) m) as [v4|] eqn:?.
   destruct (classic (exists t2, exists m', assign_loc ge (typeof b1) m b ofs v4 t2 m')).
   destruct H2 as [t2 [m' D]].
   econstructor; econstructor; eapply step_assignop; eauto.
@@ -1343,8 +1343,8 @@ Proof.
   exploit (simple_can_eval_lval f k e m b (fun x => C(Epostincr id x ty))); eauto.
   intros [b1 [ofs [E1 S1]]].
   exploit safe_inv. eexact S1. eauto. simpl. intros [t [v1 [A B]]].
-  destruct (sem_incrdecr ge id v1 ty) as [v2|] eqn:?.
-  destruct (sem_cast v2 (incrdecr_type ty) ty) as [v3|] eqn:?.
+  destruct (sem_incrdecr ge id v1 ty m) as [v2|] eqn:?.
+  destruct (sem_cast v2 (incrdecr_type ty) ty m) as [v3|] eqn:?.
   destruct (classic (exists t2, exists m', assign_loc ge ty m b1 ofs v3 t2 m')).
   destruct H0 as [t2 [m' D]].
   econstructor; econstructor; eapply step_postincr; eauto.
@@ -1498,7 +1498,7 @@ Proof.
   econstructor; econstructor; eauto.
   inv H10. exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t0.
   destruct (sem_binary_operation ge op v1' (typeof l) v2 (typeof r) m) as [v3'|] eqn:?.
-  destruct (sem_cast v3' tyres (typeof l)) as [v4'|] eqn:?.
+  destruct (sem_cast v3' tyres (typeof l) m) as [v4'|] eqn:?.
   destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v4' t2' m'')).
   destruct H1 as [t2' [m'' P]].
   econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity.
@@ -1511,7 +1511,7 @@ Proof.
   (* assignop stuck *)
   exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t1.
   destruct (sem_binary_operation ge op v1' (typeof l) v2 (typeof r) m) as [v3'|] eqn:?.
-  destruct (sem_cast v3' tyres (typeof l)) as [v4'|] eqn:?.
+  destruct (sem_cast v3' tyres (typeof l) m) as [v4'|] eqn:?.
   destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v4' t2' m'')).
   destruct H1 as [t2' [m'' P]].
   econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity.
@@ -1526,8 +1526,8 @@ Proof.
   subst t2. exploit assign_loc_receptive; eauto. intros EQ; rewrite EQ in H.
   econstructor; econstructor; eauto.
   inv H9. exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t0.
-  destruct (sem_incrdecr ge id v1' (typeof l)) as [v2'|] eqn:?.
-  destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l)) as [v3'|] eqn:?.
+  destruct (sem_incrdecr ge id v1' (typeof l) m) as [v2'|] eqn:?.
+  destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l) m) as [v3'|] eqn:?.
   destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v3' t2' m'')).
   destruct H1 as [t2' [m'' P]].
   econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity.
@@ -1539,8 +1539,8 @@ Proof.
   rewrite Heqo; auto.
   (* postincr stuck *)
   exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t1.
-  destruct (sem_incrdecr ge id v1' (typeof l)) as [v2'|] eqn:?.
-  destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l)) as [v3'|] eqn:?.
+  destruct (sem_incrdecr ge id v1' (typeof l) m) as [v2'|] eqn:?.
+  destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l) m) as [v3'|] eqn:?.
   destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v3' t2' m'')).
   destruct H1 as [t2' [m'' P]].
   econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity.
@@ -1641,11 +1641,11 @@ Definition outcome_switch (out: outcome) : outcome :=
   | o => o
   end.
 
-Definition outcome_result_value (out: outcome) (t: type) (v: val) : Prop :=
+Definition outcome_result_value (out: outcome) (t: type) (v: val) (m: mem) : Prop :=
   match out, t with
   | Out_normal, Tvoid => v = Vundef
   | Out_return None, Tvoid => v = Vundef
-  | Out_return (Some (v', ty')), ty => ty <> Tvoid /\ sem_cast v' ty' ty = Some v
+  | Out_return (Some (v', ty')), ty => ty <> Tvoid /\ sem_cast v' ty' ty m = Some v
   | _, _ => False
   end.
 
@@ -1697,7 +1697,7 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 ->
       bool_val v1 (typeof a1) m' = Some true ->
       eval_expr e m' RV a2 t2 m'' a2' -> eval_simple_rvalue ge e m'' a2' v2 ->
-      sem_cast v2 (typeof a2) type_bool = Some v ->
+      sem_cast v2 (typeof a2) type_bool m'' = Some v ->
       eval_expr e m RV (Eseqand a1 a2 ty) (t1**t2) m'' (Eval v ty)
   | eval_seqand_false: forall e m a1 a2 ty t1 m' a1' v1,
       eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 ->
@@ -1707,7 +1707,7 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 ->
       bool_val v1 (typeof a1) m' = Some false ->
       eval_expr e m' RV a2 t2 m'' a2' -> eval_simple_rvalue ge e m'' a2' v2 ->
-      sem_cast v2 (typeof a2) type_bool = Some v ->
+      sem_cast v2 (typeof a2) type_bool m'' = Some v ->
       eval_expr e m RV (Eseqor a1 a2 ty) (t1**t2) m'' (Eval v ty)
   | eval_seqor_true: forall e m a1 a2 ty t1 m' a1' v1,
       eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 ->
@@ -1717,7 +1717,7 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       eval_expr e m RV a1 t1 m' a1' -> eval_simple_rvalue ge e m' a1' v1 ->
       bool_val v1 (typeof a1) m' = Some b ->
       eval_expr e m' RV (if b then a2 else a3) t2 m'' a' -> eval_simple_rvalue ge e m'' a' v' ->
-      sem_cast v' (typeof (if b then a2 else a3)) ty = Some v ->
+      sem_cast v' (typeof (if b then a2 else a3)) ty m'' = Some v ->
       eval_expr e m RV (Econdition a1 a2 a3 ty) (t1**t2) m'' (Eval v ty)
   | eval_sizeof: forall e m ty' ty,
       eval_expr e m RV (Esizeof ty' ty) E0 m (Esizeof ty' ty)
@@ -1727,7 +1727,7 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       eval_expr e m LV l t1 m1 l' -> eval_expr e m1 RV r t2 m2 r' ->
       eval_simple_lvalue ge e m2 l' b ofs ->
       eval_simple_rvalue ge e m2 r' v ->
-      sem_cast v (typeof r) (typeof l) = Some v' ->
+      sem_cast v (typeof r) (typeof l) m2 = Some v' ->
       assign_loc ge (typeof l) m2 b ofs v' t3 m3 ->
       ty = typeof l ->
       eval_expr e m RV (Eassign l r ty) (t1**t2**t3) m3 (Eval v' ty)
@@ -1738,7 +1738,7 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       deref_loc ge (typeof l) m2 b ofs t3 v1 ->
       eval_simple_rvalue ge e m2 r' v2 ->
       sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m2 = Some v3 ->
-      sem_cast v3 tyres (typeof l) = Some v4 ->
+      sem_cast v3 tyres (typeof l) m2 = Some v4 ->
       assign_loc ge (typeof l) m2 b ofs v4 t4 m3 ->
       ty = typeof l ->
       eval_expr e m RV (Eassignop op l r tyres ty) (t1**t2**t3**t4) m3 (Eval v4 ty)
@@ -1746,8 +1746,8 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       eval_expr e m LV l t1 m1 l' ->
       eval_simple_lvalue ge e m1 l' b ofs ->
       deref_loc ge ty m1 b ofs t2 v1 ->
-      sem_incrdecr ge id v1 ty = Some v2 ->
-      sem_cast v2 (incrdecr_type ty) ty = Some v3 ->
+      sem_incrdecr ge id v1 ty m1 = Some v2 ->
+      sem_cast v2 (incrdecr_type ty) ty m1 = Some v3 ->
       assign_loc ge ty m1 b ofs v3 t3 m2 ->
       ty = typeof l ->
       eval_expr e m RV (Epostincr id l ty) (t1**t2**t3) m2 (Eval v1 ty)
@@ -1901,7 +1901,7 @@ with eval_funcall: mem -> fundef -> list val -> trace -> mem -> val -> Prop :=
       alloc_variables ge empty_env m (f.(fn_params) ++ f.(fn_vars)) e m1 ->
       bind_parameters ge 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 ->
+      outcome_result_value out f.(fn_return) vres m3 ->
       Mem.free_list m3 (blocks_of_env ge e) = Some m4 ->
       eval_funcall m (Internal f) vargs t m4 vres
   | eval_funcall_external: forall m ef targs tres cconv vargs t vres m',
diff --git a/cfrontend/Csyntax.v b/cfrontend/Csyntax.v
index 89d0b2bf..fd7a6b96 100644
--- a/cfrontend/Csyntax.v
+++ b/cfrontend/Csyntax.v
@@ -15,14 +15,9 @@
 
 (** Abstract syntax for the Compcert C language *)
 
-Require Import Coqlib.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import AST.
-Require Import Errors.
-Require Import Ctypes.
-Require Import Cop.
+Require Import Coqlib Maps Integers Floats Errors.
+Require Import AST Linking Values.
+Require Import Ctypes Cop.
 
 (** ** Expressions *)
 
@@ -191,9 +186,7 @@ Definition var_names (vars: list(ident * type)) : list ident :=
 (** Functions can either be defined ([Internal]) or declared as
   external functions ([External]). *)
 
-Inductive fundef : Type :=
-  | Internal: function -> fundef
-  | External: external_function -> typelist -> type -> calling_convention -> fundef.
+Definition fundef := Ctypes.fundef function.
 
 (** The type of a function definition. *)
 
@@ -206,50 +199,15 @@ Definition type_of_fundef (f: fundef) : type :=
   | External id args res cc => Tfunction args res cc
   end.
 
-(** ** Programs *)
+(** ** Programs and compilation units *)
 
-(** A "pre-program", as produced by the elaborator is composed of:
+(** As defined in module [Ctypes], a program, or compilation unit, is
+  composed of:
 - a list of definitions of functions and global variables;
 - the names of functions and global variables that are public (not static);
 - the name of the function that acts as entry point ("main" function).
 - a list of definitions for structure and union names
+- the corresponding composite environment
+- a proof that this environment is consistent with the definitions. *)
 
-A program is composed of the same information, plus the corresponding
-composite environment, and a proof that this environment is consistent
-with the composite definitions. *)
-
-Record pre_program : Type := {
-  pprog_defs: list (ident * globdef fundef type);
-  pprog_public: list ident;
-  pprog_main: ident;
-  pprog_types: list composite_definition
-}.
-
-Record program : Type := {
-  prog_defs: list (ident * globdef fundef type);
-  prog_public: list ident;
-  prog_main: ident;
-  prog_types: list composite_definition;
-  prog_comp_env: composite_env;
-  prog_comp_env_eq: build_composite_env prog_types = OK prog_comp_env
-}.
-
-Definition program_of_program (p: program) : AST.program fundef type :=
-  {| AST.prog_defs := p.(prog_defs);
-     AST.prog_public := p.(prog_public);
-     AST.prog_main := p.(prog_main) |}.
-
-Coercion program_of_program: program >-> AST.program.
-
-Program Definition program_of_pre_program (p: pre_program) : res program :=
-  match build_composite_env p.(pprog_types) with
-  | Error e => Error e
-  | OK ce =>
-      OK {| prog_defs := p.(pprog_defs);
-            prog_public := p.(pprog_public);
-            prog_main := p.(pprog_main);
-            prog_types := p.(pprog_types);
-            prog_comp_env := ce;
-            prog_comp_env_eq := _ |}
-  end.
-
+Definition program := Ctypes.program function.
diff --git a/cfrontend/Ctypes.v b/cfrontend/Ctypes.v
index 78345b42..9faa6d40 100644
--- a/cfrontend/Ctypes.v
+++ b/cfrontend/Ctypes.v
@@ -15,10 +15,8 @@
 
 (** Type expressions for the Compcert C and Clight languages *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Errors.
+Require Import Axioms Coqlib Maps Errors.
+Require Import AST Linking.
 Require Archi.
 
 (** * Syntax of types *)
@@ -157,6 +155,20 @@ Definition members : Type := list (ident * type).
 Inductive composite_definition : Type :=
   Composite (id: ident) (su: struct_or_union) (m: members) (a: attr).
 
+Definition name_composite_def (c: composite_definition) : ident :=
+  match c with Composite id su m a => id end.
+
+Definition composite_def_eq (x y: composite_definition): {x=y} + {x<>y}.
+Proof.
+  decide equality.
+- decide equality. decide equality. apply N.eq_dec. apply bool_dec.
+- apply list_eq_dec. decide equality. apply type_eq. apply ident_eq.
+- decide equality.
+- apply ident_eq.
+Defined.
+
+Global Opaque composite_def_eq. 
+
 (** For type-checking, compilation and semantics purposes, the composite
   definitions are collected in the following [composite_env] environment.
   The [composite] record contains additional information compared with
@@ -960,6 +972,29 @@ Record composite_consistent (env: composite_env) (co: composite) : Prop := {
 Definition composite_env_consistent (env: composite_env) : Prop :=
   forall id co, env!id = Some co -> composite_consistent env co.
 
+Lemma composite_consistent_stable:
+  forall (env env': composite_env)
+         (EXTENDS: forall id co, env!id = Some co -> env'!id = Some co)
+         co,
+  composite_consistent env co -> composite_consistent env' co.
+Proof.
+  intros. destruct H as [A B C D]. constructor. 
+  eapply complete_members_stable; eauto.
+  symmetry; rewrite B. f_equal. apply alignof_composite_stable; auto. 
+  symmetry; rewrite C. f_equal. apply sizeof_composite_stable; auto.
+  symmetry; rewrite D. apply rank_members_stable; auto.
+Qed.
+
+Lemma composite_of_def_consistent:
+  forall env id su m a co,
+  composite_of_def env id su m a = OK co ->
+  composite_consistent env co.
+Proof.
+  unfold composite_of_def; intros. 
+  destruct (env!id); try discriminate. destruct (complete_members env m) eqn:C; inv H.
+  constructor; auto.
+Qed. 
+
 Theorem build_composite_env_consistent:
   forall defs env, build_composite_env defs = OK env -> composite_env_consistent env.
 Proof.
@@ -973,28 +1008,15 @@ Proof.
 - destruct d1; monadInv H.
   eapply IHdefs; eauto.
   set (env1 := PTree.set id x env0) in *.
-  unfold composite_of_def in EQ.
-  destruct (env0!id) eqn:E; try discriminate.
-  destruct (complete_members env0 m) eqn:C; inversion EQ; clear EQ.
+  assert (env0!id = None). 
+  { unfold composite_of_def in EQ. destruct (env0!id). discriminate. auto. }
   assert (forall id1 co1, env0!id1 = Some co1 -> env1!id1 = Some co1).
   { intros. unfold env1. rewrite PTree.gso; auto. congruence. }
-  red; intros. unfold env1 in H2; rewrite PTree.gsspec in H2; destruct (peq id0 id).
+  red; intros. apply composite_consistent_stable with env0; auto.
+  unfold env1 in H2; rewrite PTree.gsspec in H2; destruct (peq id0 id).
 + subst id0. inversion H2; clear H2. subst co.
-(*
-  assert (A: alignof_composite env1 m = alignof_composite env0 m)
-  by (apply alignof_composite_stable; assumption).
-*)
-  rewrite <- H1; constructor; simpl.
-* eapply complete_members_stable; eauto.
-* f_equal. symmetry. apply alignof_composite_stable; auto.
-* f_equal. symmetry. apply sizeof_composite_stable; auto.
-* symmetry. apply rank_members_stable; auto.
-+ exploit H0; eauto. intros [P Q R S].
-  constructor; intros.
-* eapply complete_members_stable; eauto.
-* rewrite Q. f_equal. symmetry. apply alignof_composite_stable; auto.
-* rewrite R. f_equal. symmetry. apply sizeof_composite_stable; auto.
-* rewrite S. symmetry; apply rank_members_stable; auto.
+  eapply composite_of_def_consistent; eauto.
++ eapply H0; eauto. 
 Qed.
 
 (** Moreover, every composite definition is reflected in the composite environment. *)
@@ -1018,6 +1040,29 @@ Proof.
   subst x; auto.
 Qed.
 
+Theorem build_composite_env_domain:
+  forall env defs id co,
+  build_composite_env defs = OK env ->
+  env!id = Some co ->
+  In (Composite id (co_su co) (co_members co) (co_attr co)) defs.
+Proof.
+  intros env0 defs0 id co.
+  assert (REC: forall l env env',
+    add_composite_definitions env l = OK env' ->
+    env'!id = Some co ->
+    env!id = Some co \/ In (Composite id (co_su co) (co_members co) (co_attr co)) l).
+  { induction l; simpl; intros. 
+  - inv H; auto.
+  - destruct a; monadInv H. exploit IHl; eauto.
+    unfold composite_of_def in EQ. destruct (env!id0) eqn:E; try discriminate.
+    destruct (complete_members env m) eqn:C; simplify_eq EQ. clear EQ; intros EQ.
+    rewrite PTree.gsspec. intros [A|A]; auto.
+    destruct (peq id id0); auto.
+    inv A. rewrite <- H1; auto.
+  }
+  intros. exploit REC; eauto. rewrite PTree.gempty. intuition congruence.
+Qed.
+
 (** As a corollay, in a consistent environment, the rank of a composite type
   is strictly greater than the ranks of its member types. *)
 
@@ -1054,3 +1099,441 @@ Proof.
   exploit (rank_type_members ce); eauto.
   omega.
 Qed.
+
+(** * Programs and compilation units *)
+
+(** The definitions in this section are parameterized over a type [F] of 
+  internal function definitions, so that they apply both to CompCert C and to Clight. *)
+
+Set Implicit Arguments.
+
+Section PROGRAMS.
+
+Variable F: Type.
+
+(** Functions can either be defined ([Internal]) or declared as
+  external functions ([External]). *)
+
+Inductive fundef : Type :=
+  | Internal: F -> fundef
+  | External: external_function -> typelist -> type -> calling_convention -> fundef.
+
+(** A program, or compilation unit, is composed of:
+- a list of definitions of functions and global variables;
+- the names of functions and global variables that are public (not static);
+- the name of the function that acts as entry point ("main" function).
+- a list of definitions for structure and union names
+- the corresponding composite environment
+- a proof that this environment is consistent with the definitions. *)
+
+Record program : Type := {
+  prog_defs: list (ident * globdef fundef type);
+  prog_public: list ident;
+  prog_main: ident;
+  prog_types: list composite_definition;
+  prog_comp_env: composite_env;
+  prog_comp_env_eq: build_composite_env prog_types = OK prog_comp_env
+}.
+
+Definition program_of_program (p: program) : AST.program fundef type :=
+  {| AST.prog_defs := p.(prog_defs);
+     AST.prog_public := p.(prog_public);
+     AST.prog_main := p.(prog_main) |}.
+
+Coercion program_of_program: program >-> AST.program.
+
+Program Definition make_program (types: list composite_definition)
+                                (defs: list (ident * globdef fundef type))
+                                (public: list ident)
+                                (main: ident) : res program :=
+  match build_composite_env types with
+  | Error e => Error e
+  | OK ce =>
+      OK {| prog_defs := defs;
+            prog_public := public;
+            prog_main := main;
+            prog_types := types;
+            prog_comp_env := ce;
+            prog_comp_env_eq := _ |}
+  end.
+
+End PROGRAMS.
+
+Arguments External {F} _ _ _ _.
+
+Unset Implicit Arguments.
+
+(** * Separate compilation and linking *)
+
+(** ** Linking types *)
+
+Instance Linker_types : Linker type := {
+  link := fun t1 t2 => if type_eq t1 t2 then Some t1 else None;
+  linkorder := fun t1 t2 => t1 = t2
+}.
+Proof.
+  auto.
+  intros; congruence.
+  intros. destruct (type_eq x y); inv H. auto.
+Defined.
+
+Global Opaque Linker_types.
+
+(** ** Linking composite definitions *)
+
+Definition check_compat_composite (l: list composite_definition) (cd: composite_definition) : bool :=
+  List.forallb
+    (fun cd' =>
+      if ident_eq (name_composite_def cd') (name_composite_def cd) then composite_def_eq cd cd' else true)
+    l.
+
+Definition filter_redefs (l1 l2: list composite_definition) :=
+  let names1 := map name_composite_def l1 in
+  List.filter (fun cd => negb (In_dec ident_eq (name_composite_def cd) names1)) l2.
+
+Definition link_composite_defs (l1 l2: list composite_definition): option (list composite_definition) :=
+  if List.forallb (check_compat_composite l2) l1
+  then Some (l1 ++ filter_redefs l1 l2)
+  else None.
+
+Lemma link_composite_def_inv:
+  forall l1 l2 l,
+  link_composite_defs l1 l2 = Some l ->
+     (forall cd1 cd2, In cd1 l1 -> In cd2 l2 -> name_composite_def cd2 = name_composite_def cd1 -> cd2 = cd1)
+  /\ l = l1 ++ filter_redefs l1 l2
+  /\ (forall x, In x l <-> In x l1 \/ In x l2).
+Proof.
+  unfold link_composite_defs; intros.
+  destruct (forallb (check_compat_composite l2) l1) eqn:C; inv H.
+  assert (A: 
+    forall cd1 cd2, In cd1 l1 -> In cd2 l2 -> name_composite_def cd2 = name_composite_def cd1 -> cd2 = cd1).
+  { rewrite forallb_forall in C. intros.
+    apply C in H. unfold check_compat_composite in H. rewrite forallb_forall in H. 
+    apply H in H0. rewrite H1, dec_eq_true in H0. symmetry; eapply proj_sumbool_true; eauto. }
+  split. auto. split. auto. 
+  unfold filter_redefs; intros. 
+  rewrite in_app_iff. rewrite filter_In. intuition auto. 
+  destruct (in_dec ident_eq (name_composite_def x) (map name_composite_def l1)); simpl; auto.
+  exploit list_in_map_inv; eauto. intros (y & P & Q).
+  assert (x = y) by eauto. subst y. auto.
+Qed.
+
+Instance Linker_composite_defs : Linker (list composite_definition) := {
+  link := link_composite_defs;
+  linkorder := @List.incl composite_definition
+}.
+Proof.
+- intros; apply incl_refl.
+- intros; red; intros; eauto.
+- intros. apply link_composite_def_inv in H; destruct H as (A & B & C).
+  split; red; intros; apply C; auto.
+Defined.
+
+(** Connections with [build_composite_env]. *)
+
+Lemma add_composite_definitions_append:
+  forall l1 l2 env env'',
+  add_composite_definitions env (l1 ++ l2) = OK env'' <->
+  exists env', add_composite_definitions env l1 = OK env' /\ add_composite_definitions env' l2 = OK env''.
+Proof.
+  induction l1; simpl; intros.
+- split; intros. exists env; auto. destruct H as (env' & A & B). congruence.
+- destruct a; simpl. destruct (composite_of_def env id su m a); simpl.
+  apply IHl1. 
+  split; intros. discriminate. destruct H as (env' & A & B); discriminate.
+Qed.
+
+Lemma composite_eq:
+  forall su1 m1 a1 sz1 al1 r1 pos1 al2p1 szal1
+         su2 m2 a2 sz2 al2 r2 pos2 al2p2 szal2,
+  su1 = su2 -> m1 = m2 -> a1 = a2 -> sz1 = sz2 -> al1 = al2 -> r1 = r2 ->
+  Build_composite su1 m1 a1 sz1 al1 r1 pos1 al2p1 szal1 = Build_composite su2 m2 a2 sz2 al2 r2 pos2 al2p2 szal2.
+Proof.
+  intros. subst.
+  assert (pos1 = pos2) by apply proof_irr. 
+  assert (al2p1 = al2p2) by apply proof_irr.
+  assert (szal1 = szal2) by apply proof_irr.
+  subst. reflexivity.
+Qed.
+
+Lemma composite_of_def_eq:
+  forall env id co,
+  composite_consistent env co ->
+  env!id = None ->
+  composite_of_def env id (co_su co) (co_members co) (co_attr co) = OK co.
+Proof.
+  intros. destruct H as [A B C D]. unfold composite_of_def. rewrite H0, A.
+  destruct co; simpl in *. f_equal. apply composite_eq; auto. rewrite C, B; auto. 
+Qed.
+
+Lemma composite_consistent_unique:
+  forall env co1 co2,
+  composite_consistent env co1 ->
+  composite_consistent env co2 ->
+  co_su co1 = co_su co2 ->
+  co_members co1 = co_members co2 ->
+  co_attr co1 = co_attr co2 ->
+  co1 = co2.
+Proof.
+  intros. destruct H, H0. destruct co1, co2; simpl in *. apply composite_eq; congruence.
+Qed.
+
+Lemma composite_of_def_stable:
+  forall (env env': composite_env)
+         (EXTENDS: forall id co, env!id = Some co -> env'!id = Some co)
+         id su m a co,
+  env'!id = None ->
+  composite_of_def env id su m a = OK co ->
+  composite_of_def env' id su m a = OK co.
+Proof.
+  intros. 
+  unfold composite_of_def in H0. 
+  destruct (env!id) eqn:E; try discriminate.
+  destruct (complete_members env m) eqn:CM; try discriminate.
+  transitivity (composite_of_def env' id (co_su co) (co_members co) (co_attr co)).
+  inv H0; auto. 
+  apply composite_of_def_eq; auto. 
+  apply composite_consistent_stable with env; auto. 
+  inv H0; constructor; auto.
+Qed.
+
+Lemma link_add_composite_definitions:
+  forall l0 env0,
+  build_composite_env l0 = OK env0 ->
+  forall l env1 env1' env2,
+  add_composite_definitions env1 l = OK env1' ->
+  (forall id co, env1!id = Some co -> env2!id = Some co) ->
+  (forall id co, env0!id = Some co -> env2!id = Some co) ->
+  (forall id, env2!id = if In_dec ident_eq id (map name_composite_def l0) then env0!id else env1!id) ->
+  ((forall cd1 cd2, In cd1 l0 -> In cd2 l -> name_composite_def cd2 = name_composite_def cd1 -> cd2 = cd1)) ->
+  { env2' |
+      add_composite_definitions env2 (filter_redefs l0 l) = OK env2'
+  /\ (forall id co, env1'!id = Some co -> env2'!id = Some co)
+  /\ (forall id co, env0!id = Some co -> env2'!id = Some co) }.
+Proof.
+  induction l; simpl; intros until env2; intros ACD AGREE1 AGREE0 AGREE2 UNIQUE.
+- inv ACD. exists env2; auto.
+- destruct a. destruct (composite_of_def env1 id su m a) as [x|e] eqn:EQ; try discriminate.
+  simpl in ACD.
+  generalize EQ. unfold composite_of_def at 1. 
+  destruct (env1!id) eqn:E1; try congruence.
+  destruct (complete_members env1 m) eqn:CM1; try congruence. 
+  intros EQ1.
+  simpl. destruct (in_dec ident_eq id (map name_composite_def l0)); simpl.
++ eapply IHl; eauto.
+* intros. rewrite PTree.gsspec in H0. destruct (peq id0 id); auto.
+  inv H0.
+  exploit list_in_map_inv; eauto. intros ([id' su' m' a'] & P & Q).
+  assert (X: Composite id su m a = Composite id' su' m' a').
+  { eapply UNIQUE. auto. auto. rewrite <- P; auto. }
+  inv X.
+  exploit build_composite_env_charact; eauto. intros (co' & U & V & W & X). 
+  assert (co' = co).
+  { apply composite_consistent_unique with env2.
+    apply composite_consistent_stable with env0; auto. 
+    eapply build_composite_env_consistent; eauto.
+    apply composite_consistent_stable with env1; auto.
+    inversion EQ1; constructor; auto. 
+    inversion EQ1; auto.
+    inversion EQ1; auto.
+    inversion EQ1; auto. }
+  subst co'. apply AGREE0; auto. 
+* intros. rewrite AGREE2. destruct (in_dec ident_eq id0 (map name_composite_def l0)); auto. 
+  rewrite PTree.gsspec. destruct (peq id0 id); auto. subst id0. contradiction.
++ assert (E2: env2!id = None).
+  { rewrite AGREE2. rewrite pred_dec_false by auto. auto. }
+  assert (E3: composite_of_def env2 id su m a = OK x).
+  { eapply composite_of_def_stable. eexact AGREE1. eauto. eauto. }
+  rewrite E3. simpl. eapply IHl; eauto. 
+* intros until co; rewrite ! PTree.gsspec. destruct (peq id0 id); auto.
+* intros until co; rewrite ! PTree.gsspec. intros. destruct (peq id0 id); auto.
+  subst id0. apply AGREE0 in H0. congruence.
+* intros. rewrite ! PTree.gsspec. destruct (peq id0 id); auto. subst id0. 
+  rewrite pred_dec_false by auto. auto.
+Qed.
+
+Theorem link_build_composite_env:
+  forall l1 l2 l env1 env2,
+  build_composite_env l1 = OK env1 ->
+  build_composite_env l2 = OK env2 ->
+  link l1 l2 = Some l ->
+  { env |
+     build_composite_env l = OK env
+  /\ (forall id co, env1!id = Some co -> env!id = Some co)
+  /\ (forall id co, env2!id = Some co -> env!id = Some co) }.
+Proof.
+  intros. edestruct link_composite_def_inv as (A & B & C); eauto.
+  edestruct link_add_composite_definitions as (env & P & Q & R).
+  eexact H.
+  eexact H0.
+  instantiate (1 := env1). intros. rewrite PTree.gempty in H2; discriminate.
+  auto.
+  intros. destruct (in_dec ident_eq id (map name_composite_def l1)); auto.
+  rewrite PTree.gempty. destruct (env1!id) eqn:E1; auto. 
+  exploit build_composite_env_domain. eexact H. eauto.
+  intros. apply (in_map name_composite_def) in H2. elim n; auto. 
+  auto.
+  exists env; split; auto. subst l. apply add_composite_definitions_append. exists env1; auto. 
+Qed.
+
+(** ** Linking function definitions *)
+
+Definition link_fundef {F: Type} (fd1 fd2: fundef F) :=
+  match fd1, fd2 with
+  | Internal _, Internal _ => None
+  | External ef1 targs1 tres1 cc1, External ef2 targs2 tres2 cc2 =>
+      if external_function_eq ef1 ef2
+      && typelist_eq targs1 targs2
+      && type_eq tres1 tres2
+      && calling_convention_eq cc1 cc2
+      then Some (External ef1 targs1 tres1 cc1)
+      else None
+  | Internal f, External ef targs tres cc =>
+      match ef with EF_external id sg => Some (Internal f) | _ => None end
+  | External ef targs tres cc, Internal f =>
+      match ef with EF_external id sg => Some (Internal f) | _ => None end
+  end.
+
+Inductive linkorder_fundef {F: Type}: fundef F -> fundef F -> Prop :=
+  | linkorder_fundef_refl: forall fd,
+      linkorder_fundef fd fd
+  | linkorder_fundef_ext_int: forall f id sg targs tres cc,
+      linkorder_fundef (External (EF_external id sg) targs tres cc) (Internal f).
+
+Instance Linker_fundef (F: Type): Linker (fundef F) := {
+  link := link_fundef;
+  linkorder := linkorder_fundef
+}.
+Proof.
+- intros; constructor.
+- intros. inv H; inv H0; constructor.
+- intros x y z EQ. destruct x, y; simpl in EQ.
++ discriminate.
++ destruct e; inv EQ. split; constructor.
++ destruct e; inv EQ. split; constructor.
++ destruct (external_function_eq e e0 && typelist_eq t t1 && type_eq t0 t2 && calling_convention_eq c c0) eqn:A; inv EQ.
+  InvBooleans. subst. split; constructor.
+Defined.
+
+Remark link_fundef_either:
+  forall (F: Type) (f1 f2 f: fundef F), link f1 f2 = Some f -> f = f1 \/ f = f2.
+Proof.
+  simpl; intros. unfold link_fundef in H. destruct f1, f2; try discriminate.
+- destruct e; inv H. auto.
+- destruct e; inv H. auto.
+- destruct (external_function_eq e e0 && typelist_eq t t1 && type_eq t0 t2 && calling_convention_eq c c0); inv H; auto.
+Qed.
+
+Global Opaque Linker_fundef.
+
+(** ** Linking programs *)
+
+Definition lift_option {A: Type} (opt: option A) : { x | opt = Some x } + { opt = None }.
+Proof.
+  destruct opt. left; exists a; auto. right; auto. 
+Defined.
+
+Definition link_program {F:Type} (p1 p2: program F): option (program F) :=
+  match link (program_of_program p1) (program_of_program p2) with
+  | None => None
+  | Some p =>
+      match lift_option (link p1.(prog_types) p2.(prog_types)) with
+      | inright _ => None
+      | inleft (exist typs EQ) =>
+          match link_build_composite_env
+                   p1.(prog_types) p2.(prog_types) typs
+                   p1.(prog_comp_env) p2.(prog_comp_env)
+                   p1.(prog_comp_env_eq) p2.(prog_comp_env_eq) EQ with
+          | exist env (conj P Q) =>
+              Some {| prog_defs := p.(AST.prog_defs);
+                      prog_public := p.(AST.prog_public);
+                      prog_main := p.(AST.prog_main);
+                      prog_types := typs;
+                      prog_comp_env := env;
+                      prog_comp_env_eq := P |}
+          end
+      end
+  end.
+
+Definition linkorder_program {F: Type} (p1 p2: program F) : Prop :=
+     linkorder (program_of_program p1) (program_of_program p2)
+  /\ (forall id co, p1.(prog_comp_env)!id = Some co -> p2.(prog_comp_env)!id = Some co).
+
+Instance Linker_program (F: Type): Linker (program F) := {
+  link := link_program;
+  linkorder := linkorder_program
+}.
+Proof.
+- intros; split. apply linkorder_refl. auto. 
+- intros. destruct H, H0. split. eapply linkorder_trans; eauto.
+  intros; auto.
+- intros until z. unfold link_program. 
+  destruct (link (program_of_program x) (program_of_program y)) as [p|] eqn:LP; try discriminate.
+  destruct (lift_option (link (prog_types x) (prog_types y))) as [[typs EQ]|EQ]; try discriminate.
+  destruct (link_build_composite_env (prog_types x) (prog_types y) typs
+       (prog_comp_env x) (prog_comp_env y) (prog_comp_env_eq x)
+       (prog_comp_env_eq y) EQ) as (env & P & Q & R).
+  destruct (link_linkorder _ _ _ LP). 
+  intros X; inv X.
+  split; split; auto.
+Defined.
+
+Global Opaque Linker_program.
+
+(** ** Commutation between linking and program transformations *)
+
+Section LINK_MATCH_PROGRAM.
+
+Context {F G: Type}.
+Variable match_fundef: fundef F -> fundef G -> Prop.
+
+Hypothesis link_match_fundef:
+  forall f1 tf1 f2 tf2 f,
+  link f1 f2 = Some f ->
+  match_fundef f1 tf1 -> match_fundef f2 tf2 ->
+  exists tf, link tf1 tf2 = Some tf /\ match_fundef f tf.
+
+Let match_program (p: program F) (tp: program G) : Prop :=
+    Linking.match_program (fun ctx f tf => match_fundef f tf) eq p tp
+ /\ prog_types tp = prog_types p.
+
+Theorem link_match_program:
+  forall p1 p2 tp1 tp2 p,
+  link p1 p2 = Some p -> match_program p1 tp1 -> match_program p2 tp2 ->
+  exists tp, link tp1 tp2 = Some tp /\ match_program p tp.
+Proof.
+  intros. destruct H0, H1. 
+Local Transparent Linker_program.
+  simpl in H; unfold link_program in H.
+  destruct (link (program_of_program p1) (program_of_program p2)) as [pp|] eqn:LP; try discriminate.
+  assert (A: exists tpp,
+               link (program_of_program tp1) (program_of_program tp2) = Some tpp
+             /\ Linking.match_program (fun ctx f tf => match_fundef f tf) eq pp tpp).
+  { eapply Linking.link_match_program. 
+  - intros. exploit link_match_fundef; eauto. intros (tf & A & B). exists tf; auto.
+  - intros.
+    Local Transparent Linker_types.
+    simpl in *. destruct (type_eq v1 v2); inv H4. subst v tv2. exists tv1; rewrite dec_eq_true; auto.
+  - eauto.
+  - eauto.
+  - eauto.
+  - apply (link_linkorder _ _ _ LP).
+  - apply (link_linkorder _ _ _ LP). }
+  destruct A as (tpp & TLP & MP).
+  simpl; unfold link_program. rewrite TLP.
+  destruct (lift_option (link (prog_types p1) (prog_types p2))) as [[typs EQ]|EQ]; try discriminate.
+  destruct (link_build_composite_env (prog_types p1) (prog_types p2) typs
+           (prog_comp_env p1) (prog_comp_env p2) (prog_comp_env_eq p1)
+           (prog_comp_env_eq p2) EQ) as (env & P & Q). 
+  rewrite <- H2, <- H3 in EQ.
+  destruct (lift_option (link (prog_types tp1) (prog_types tp2))) as [[ttyps EQ']|EQ']; try congruence.
+  assert (ttyps = typs) by congruence. subst ttyps. 
+  destruct (link_build_composite_env (prog_types tp1) (prog_types tp2) typs
+         (prog_comp_env tp1) (prog_comp_env tp2) (prog_comp_env_eq tp1)
+         (prog_comp_env_eq tp2) EQ') as (tenv & R & S).
+  assert (tenv = env) by congruence. subst tenv.
+  econstructor; split; eauto. inv H. split; auto.
+  unfold program_of_program; simpl. destruct pp, tpp; exact MP.
+Qed.
+
+End LINK_MATCH_PROGRAM.
diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v
index aa320f20..440e4e84 100644
--- a/cfrontend/Ctyping.v
+++ b/cfrontend/Ctyping.v
@@ -15,21 +15,11 @@
 
 (** Typing rules and type-checking for the Compcert C language *)
 
-Require Import Coqlib.
 Require Import String.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Events.
-Require Import AST.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Csyntax.
-Require Import Csem.
-Require Import Errors.
+Require Import Coqlib Maps Integers Floats Errors.
+Require Import AST Linking.
+Require Import Values Memory Globalenvs Events.
+Require Import Ctypes Cop Csyntax Csem.
 
 Local Open Scope error_monad_scope.
 
@@ -911,8 +901,8 @@ Definition retype_fundef (ce: composite_env) (e: typenv) (fd: fundef) : res fund
 Definition typecheck_program (p: program) : res program :=
   let e := bind_globdef (PTree.empty _) p.(prog_defs) in
   let ce := p.(prog_comp_env) in
-  do defs <- transf_globdefs (retype_fundef ce e) (fun v => OK v) p.(prog_defs);
-  OK {| prog_defs := defs;
+  do tp <- transform_partial_program (retype_fundef ce e) p;
+  OK {| prog_defs := tp.(AST.prog_defs);
         prog_public := p.(prog_public);
         prog_main := p.(prog_main);
         prog_types := p.(prog_types);
@@ -1325,32 +1315,29 @@ Theorem typecheck_program_sound:
   forall p p', typecheck_program p = OK p' -> wt_program p'.
 Proof.
   unfold typecheck_program; intros. monadInv H.
-  rename x into defs.
+  rename x into tp.
   constructor; simpl.
   set (ce := prog_comp_env p) in *.
   set (e := bind_globdef (PTree.empty type) (prog_defs p)) in *.
-  set (e' := bind_globdef (PTree.empty type) defs) in *.
-  assert (MATCH:
-    list_forall2 (match_globdef (fun f tf => retype_fundef ce e f = OK tf) (fun v tv => tv = v)) (prog_defs p) defs).
-  {
-    revert EQ; generalize (prog_defs p) defs.
-    induction l as [ | [id gd] l ]; intros l'; simpl; intros.
-    inv EQ. constructor.
-    destruct gd as [f | v].
-    destruct (retype_fundef ce e f) as [tf|msg] eqn:R; monadInv EQ.
-    constructor; auto. constructor; auto.
-    monadInv EQ. constructor; auto. destruct v; constructor; auto. }
+  set (e' := bind_globdef (PTree.empty type) (AST.prog_defs tp)) in *.
+  assert (M: match_program (fun ctx f tf => retype_fundef ce e f = OK tf) eq p tp)
+  by (eapply match_transform_partial_program; eauto).
+  destruct M as (MATCH & _). simpl in MATCH.
   assert (ENVS: e' = e).
-  { unfold e, e'. revert MATCH; generalize (prog_defs p) defs (PTree.empty type).
+  { unfold e, e'. revert MATCH; generalize (prog_defs p) (AST.prog_defs tp) (PTree.empty type).
     induction l as [ | [id gd] l ]; intros l' t M; inv M.
-    auto. inv H1; simpl; auto. replace (type_of_fundef f2) with (type_of_fundef f1); auto.
-    unfold retype_fundef in H4. destruct f1; monadInv H4; auto. monadInv EQ0; auto.
+    auto.
+    destruct b1 as [id' gd']; destruct H1; simpl in *. inv H0; simpl.
+    replace (type_of_fundef f2) with (type_of_fundef f1); auto.
+    unfold retype_fundef in H2. destruct f1; monadInv H2; auto. monadInv EQ0; auto.
+    inv H1. simpl. auto.
   }
   rewrite ENVS.
-  intros id f. revert MATCH; generalize (prog_defs p) defs. induction 1; simpl; intros.
+  intros id f. revert MATCH; generalize (prog_defs p) (AST.prog_defs tp).
+  induction 1; simpl; intros.
   contradiction.
-  destruct H0; auto. subst b1; inv H. destruct f1; simpl in H2.
-  monadInv H2. eapply retype_function_sound; eauto. congruence.
+  destruct H0; auto. subst b1; inv H. simpl in H1. inv H1. 
+  destruct f1; monadInv H4. eapply retype_function_sound; eauto.
 Qed.
 
 (** * Subject reduction *)
@@ -1370,7 +1357,7 @@ Qed.
 Hint Resolve pres_cast_int_int: ty.
 
 Lemma pres_sem_cast:
-  forall v2 ty2 v1 ty1, wt_val v1 ty1 -> sem_cast v1 ty1 ty2 = Some v2 -> wt_val v2 ty2.
+  forall m v2 ty2 v1 ty1, wt_val v1 ty1 -> sem_cast v1 ty1 ty2 m = Some v2 -> wt_val v2 ty2.
 Proof.
   unfold sem_cast, classify_cast; induction 1; simpl; intros; DestructCases; auto with ty.
 - constructor. apply (pres_cast_int_int I8 s).
@@ -1385,7 +1372,10 @@ Proof.
 - constructor. apply (pres_cast_int_int I8 s).
 - constructor. apply (pres_cast_int_int I16 s).
 - destruct (Float32.cmp Ceq f Float32.zero); auto with ty.
+- constructor. reflexivity.
 - destruct (Int.eq n Int.zero); auto with ty.
+- constructor. reflexivity.
+- constructor. reflexivity.
 Qed.
 
 Lemma pres_sem_binarith:
@@ -1394,7 +1384,7 @@ Lemma pres_sem_binarith:
     (sem_long: signedness -> int64 -> int64 -> option val)
     (sem_float: float -> float -> option val)
     (sem_single: float32 -> float32 -> option val)
-    v1 ty1 v2 ty2 v ty msg,
+    v1 ty1 v2 ty2 m v ty msg,
     (forall sg n1 n2,
      match sem_int sg n1 n2 with None | Some (Vint _) | Some Vundef => True | _ => False end) ->
     (forall sg n1 n2,
@@ -1403,14 +1393,14 @@ Lemma pres_sem_binarith:
      match sem_float n1 n2 with None | Some (Vfloat _) | Some Vundef => True | _ => False end) ->
     (forall n1 n2,
      match sem_single n1 n2 with None | Some (Vsingle _) | Some Vundef => True | _ => False end) ->
-    sem_binarith sem_int sem_long sem_float sem_single v1 ty1 v2 ty2 = Some v ->
+    sem_binarith sem_int sem_long sem_float sem_single v1 ty1 v2 ty2 m = Some v ->
     binarith_type ty1 ty2 msg = OK ty ->
     wt_val v ty.
 Proof with (try discriminate).
   intros. unfold sem_binarith, binarith_type in *.
   set (ty' := Cop.binarith_type (classify_binarith ty1 ty2)) in *.
-  destruct (sem_cast v1 ty1 ty') as [v1'|] eqn:CAST1...
-  destruct (sem_cast v2 ty2 ty') as [v2'|] eqn:CAST2...
+  destruct (sem_cast v1 ty1 ty' m) as [v1'|] eqn:CAST1...
+  destruct (sem_cast v2 ty2 ty' m) as [v2'|] eqn:CAST2...
   DestructCases.
 - specialize (H s i i0). rewrite H3 in H.
   destruct v; auto with ty; contradiction.
@@ -1426,12 +1416,12 @@ Lemma pres_sem_binarith_int:
   forall
     (sem_int: signedness -> int -> int -> option val)
     (sem_long: signedness -> int64 -> int64 -> option val)
-    v1 ty1 v2 ty2 v ty msg,
+    v1 ty1 v2 ty2 m v ty msg,
     (forall sg n1 n2,
      match sem_int sg n1 n2 with None | Some (Vint _) | Some Vundef => True | _ => False end) ->
     (forall sg n1 n2,
      match sem_long sg n1 n2 with None | Some (Vlong _) | Some Vundef => True | _ => False end) ->
-    sem_binarith sem_int sem_long (fun n1 n2 => None) (fun n1 n2 => None) v1 ty1 v2 ty2 = Some v ->
+    sem_binarith sem_int sem_long (fun n1 n2 => None) (fun n1 n2 => None) v1 ty1 v2 ty2 m = Some v ->
     binarith_int_type ty1 ty2 msg = OK ty ->
     wt_val v ty.
 Proof.
@@ -2119,28 +2109,3 @@ Proof.
 Qed.
 
 End PRESERVATION.
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/cfrontend/Initializers.v b/cfrontend/Initializers.v
index b1a39c64..7228cd75 100644
--- a/cfrontend/Initializers.v
+++ b/cfrontend/Initializers.v
@@ -47,7 +47,7 @@ If [a] is a l-value, the returned value denotes:
 *)
 
 Definition do_cast (v: val) (t1 t2: type) : res val :=
-  match sem_cast v t1 t2 with
+  match sem_cast v t1 t2 Mem.empty with
   | Some v' => OK v'
   | None => Error(msg "undefined cast")
   end.
diff --git a/cfrontend/Initializersproof.v b/cfrontend/Initializersproof.v
index 9c662f5e..d5f39d7d 100644
--- a/cfrontend/Initializersproof.v
+++ b/cfrontend/Initializersproof.v
@@ -120,7 +120,7 @@ with eval_simple_rvalue: expr -> val -> Prop :=
       eval_simple_rvalue (Ebinop op r1 r2 ty) v
   | esr_cast: forall ty r1 v1 v,
       eval_simple_rvalue r1 v1 ->
-      sem_cast v1 (typeof r1) ty = Some v ->
+      sem_cast v1 (typeof r1) ty m = Some v ->
       eval_simple_rvalue (Ecast r1 ty) v
   | esr_sizeof: forall ty1 ty,
       eval_simple_rvalue (Esizeof ty1 ty) (Vint (Int.repr (sizeof ge ty1)))
@@ -129,7 +129,7 @@ with eval_simple_rvalue: expr -> val -> Prop :=
   | esr_seqand_true: forall r1 r2 ty v1 v2 v3,
       eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some true ->
       eval_simple_rvalue r2 v2 ->
-      sem_cast v2 (typeof r2) type_bool = Some v3 ->
+      sem_cast v2 (typeof r2) type_bool m = Some v3 ->
       eval_simple_rvalue (Eseqand r1 r2 ty) v3
   | esr_seqand_false: forall r1 r2 ty v1,
       eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some false ->
@@ -137,7 +137,7 @@ with eval_simple_rvalue: expr -> val -> Prop :=
   | esr_seqor_false: forall r1 r2 ty v1 v2 v3,
       eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some false ->
       eval_simple_rvalue r2 v2 ->
-      sem_cast v2 (typeof r2) type_bool = Some v3 ->
+      sem_cast v2 (typeof r2) type_bool m = Some v3 ->
       eval_simple_rvalue (Eseqor r1 r2 ty) v3
   | esr_seqor_true: forall r1 r2 ty v1,
       eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some true ->
@@ -145,13 +145,13 @@ with eval_simple_rvalue: expr -> val -> Prop :=
   | esr_condition: forall r1 r2 r3 ty v v1 b v',
       eval_simple_rvalue r1 v1 -> bool_val v1 (typeof r1) m = Some b ->
       eval_simple_rvalue (if b then r2 else r3) v' ->
-      sem_cast v' (typeof (if b then r2 else r3)) ty = Some v ->
+      sem_cast v' (typeof (if b then r2 else r3)) ty m = Some v ->
       eval_simple_rvalue (Econdition r1 r2 r3 ty) v
   | esr_comma: forall r1 r2 ty v1 v,
       eval_simple_rvalue r1 v1 -> eval_simple_rvalue r2 v ->
       eval_simple_rvalue (Ecomma r1 r2 ty) v
   | esr_paren: forall r tycast ty v v',
-      eval_simple_rvalue r v -> sem_cast v (typeof r) tycast = Some v' ->
+      eval_simple_rvalue r v -> sem_cast v (typeof r) tycast m = Some v' ->
       eval_simple_rvalue (Eparen r tycast ty) v'.
 
 End SIMPLE_EXPRS.
@@ -355,14 +355,16 @@ Proof.
 Qed.
 
 Lemma sem_cast_match:
-  forall v1 ty1 ty2 v2 v1' v2',
-  sem_cast v1 ty1 ty2 = Some v2 ->
+  forall v1 ty1 ty2 m v2 v1' v2',
+  sem_cast v1 ty1 ty2 m = Some v2 ->
   do_cast v1' ty1 ty2 = OK v2' ->
   Val.inject inj v1' v1 ->
   Val.inject inj v2' v2.
 Proof.
-  intros. unfold do_cast in H0. destruct (sem_cast v1' ty1 ty2) as [v2''|] eqn:E; inv H0.
-  exploit sem_cast_inject. eexact E. eauto.
+  intros. unfold do_cast in H0. destruct (sem_cast v1' ty1 ty2 Mem.empty) as [v2''|] eqn:E; inv H0.
+  exploit (sem_cast_inj inj Mem.empty m).
+  intros. rewrite mem_empty_not_weak_valid_pointer in H2. discriminate.
+  eexact E. eauto.
   intros [v' [A B]]. congruence.
 Qed.
 
@@ -605,7 +607,7 @@ Theorem transl_init_single_steps:
   forall ty a data f m v1 ty1 m' v chunk b ofs m'',
   transl_init_single ge ty a = OK data ->
   star step ge (ExprState f a Kstop empty_env m) E0 (ExprState f (Eval v1 ty1) Kstop empty_env m') ->
-  sem_cast v1 ty1 ty = Some v ->
+  sem_cast v1 ty1 ty m' = Some v ->
   access_mode ty = By_value chunk ->
   Mem.store chunk m' b ofs v = Some m'' ->
   Genv.store_init_data ge m b ofs data = Some m''.
@@ -647,7 +649,7 @@ Qed.
 Lemma transl_init_single_size:
   forall ty a data,
   transl_init_single ge ty a = OK data ->
-  Genv.init_data_size data = sizeof ge ty.
+  init_data_size data = sizeof ge ty.
 Proof.
   intros. monadInv H. destruct x0.
 - monadInv EQ2.
@@ -664,7 +666,7 @@ Proof.
   inv EQ2; auto.
 Qed.
 
-Notation idlsize := Genv.init_data_list_size.
+Notation idlsize := init_data_list_size.
 
 Remark padding_size:
   forall frm to, frm <= to -> idlsize (tr_padding frm to) = to - frm.
@@ -760,7 +762,7 @@ Inductive exec_init: mem -> block -> Z -> type -> initializer -> mem -> Prop :=
   | exec_init_single: forall m b ofs ty a v1 ty1 chunk m' v m'',
       star step ge (ExprState dummy_function a Kstop empty_env m)
                 E0 (ExprState dummy_function (Eval v1 ty1) Kstop empty_env m') ->
-      sem_cast v1 ty1 ty = Some v ->
+      sem_cast v1 ty1 ty m' = Some v ->
       access_mode ty = By_value chunk ->
       Mem.store chunk m' b ofs v = Some m'' ->
       exec_init m b ofs ty (Init_single a) m''
diff --git a/cfrontend/PrintClight.ml b/cfrontend/PrintClight.ml
index b8a2cb8d..e08411a5 100644
--- a/cfrontend/PrintClight.ml
+++ b/cfrontend/PrintClight.ml
@@ -80,9 +80,9 @@ let rec expr p (prec, e) =
   | Econst_int(n, _) ->
       fprintf p "%ld" (camlint_of_coqint n)
   | Econst_float(f, _) ->
-      fprintf p "%F" (camlfloat_of_coqfloat f)
+      fprintf p "%.15F" (camlfloat_of_coqfloat f)
   | Econst_single(f, _) ->
-      fprintf p "%Ff" (camlfloat_of_coqfloat32 f)
+      fprintf p "%.15Ff" (camlfloat_of_coqfloat32 f)
   | Econst_long(n, Tlong(Unsigned, _)) ->
       fprintf p "%LuLLU" (camlint64_of_coqint n)
   | Econst_long(n, _) ->
@@ -254,10 +254,10 @@ let print_function p id f =
 
 let print_fundef p id fd =
   match fd with
-  | Clight.External(EF_external(_,_), args, res, cconv) ->
+  | Ctypes.External((EF_external _ | EF_runtime _), args, res, cconv) ->
       fprintf p "extern %s;@ @ "
                 (name_cdecl (extern_atom id) (Tfunction(args, res, cconv)))
-  | Clight.External(_, _, _, _) ->
+  | Ctypes.External(_, _, _, _) ->
       ()
   | Internal f ->
       print_function p id f
diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml
index d518d6bb..4287f7f9 100644
--- a/cfrontend/PrintCsyntax.ml
+++ b/cfrontend/PrintCsyntax.ml
@@ -179,9 +179,9 @@ let print_typed_value p v ty =
   | Vint n, _ ->
       fprintf p "%ld" (camlint_of_coqint n)
   | Vfloat f, _ ->
-      fprintf p "%F" (camlfloat_of_coqfloat f)
+      fprintf p "%.15F" (camlfloat_of_coqfloat f)
   | Vsingle f, _ ->
-      fprintf p "%Ff" (camlfloat_of_coqfloat32 f)
+      fprintf p "%.15Ff" (camlfloat_of_coqfloat32 f)
   | Vlong n, Tlong(Unsigned, _) ->
       fprintf p "%LuLLU" (camlint64_of_coqint n)
   | Vlong n, _ ->
@@ -261,6 +261,8 @@ let rec expr p (prec, e) =
                 (camlstring_of_coqstring txt) exprlist (false, args)
   | Ebuiltin(EF_external(id, sg), _, args, _) ->
       fprintf p "%s@[<hov 1>(%a)@]" (camlstring_of_coqstring id) exprlist (true, args)
+  | Ebuiltin(EF_runtime(id, sg), _, args, _) ->
+      fprintf p "%s@[<hov 1>(%a)@]" (camlstring_of_coqstring id) exprlist (true, args)
   | Ebuiltin(EF_inline_asm(txt, sg, clob), _, args, _) ->
       extended_asm p txt None args clob
   | Ebuiltin(EF_debug(kind,txt,_),_,args,_) ->
@@ -424,12 +426,12 @@ let print_function p id f =
 
 let print_fundef p id fd =
   match fd with
-  | Csyntax.External(EF_external(_,_), args, res, cconv) ->
+  | Ctypes.External((EF_external _ | EF_runtime _), args, res, cconv) ->
       fprintf p "extern %s;@ @ "
                 (name_cdecl (extern_atom id) (Tfunction(args, res, cconv)))
-  | Csyntax.External(_, _, _, _) ->
+  | Ctypes.External(_, _, _, _) ->
       ()
-  | Csyntax.Internal f ->
+  | Ctypes.Internal f ->
       print_function p id f
 
 let string_of_init id =
@@ -454,8 +456,8 @@ let print_init p = function
   | Init_int16 n -> fprintf p "%ld" (camlint_of_coqint n)
   | Init_int32 n -> fprintf p "%ld" (camlint_of_coqint n)
   | Init_int64 n -> fprintf p "%LdLL" (camlint64_of_coqint n)
-  | Init_float32 n -> fprintf p "%F" (camlfloat_of_coqfloat n)
-  | Init_float64 n -> fprintf p "%F" (camlfloat_of_coqfloat n)
+  | Init_float32 n -> fprintf p "%.15F" (camlfloat_of_coqfloat n)
+  | Init_float64 n -> fprintf p "%.15F" (camlfloat_of_coqfloat n)
   | Init_space n -> fprintf p "/* skip %ld */@ " (camlint_of_coqint n)
   | Init_addrof(symb, ofs) ->
       let ofs = camlint_of_coqint ofs in
diff --git a/cfrontend/SimplExpr.v b/cfrontend/SimplExpr.v
index a5a6ad66..bfdd8ab9 100644
--- a/cfrontend/SimplExpr.v
+++ b/cfrontend/SimplExpr.v
@@ -114,7 +114,7 @@ Fixpoint eval_simpl_expr (a: expr) : option val :=
   | Ecast b ty =>
       match eval_simpl_expr b with
       | None => None
-      | Some v => sem_cast v (typeof b) ty
+      | Some v => sem_cast v (typeof b) ty Mem.empty
       end
   | _ => None
   end.
@@ -327,10 +327,10 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement
       let ty2 := Csyntax.typeof r2 in
       match dst with
       | For_val | For_set _ =>
-          do t <- gensym ty2;
+          do t <- gensym ty1;
           ret (finish dst
-                 (sl1 ++ sl2 ++ Sset t a2 :: make_assign a1 (Etempvar t ty2) :: nil)
-                 (Ecast (Etempvar t ty2) ty1))
+                 (sl1 ++ sl2 ++ Sset t (Ecast a2 ty1) :: make_assign a1 (Etempvar t ty1) :: nil)
+                 (Etempvar t ty1))
       | For_effects =>
           ret (sl1 ++ sl2 ++ make_assign a1 a2 :: nil,
                dummy_expr)
@@ -342,12 +342,12 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement
       do (sl3, a3) <- transl_valof ty1 a1;
       match dst with
       | For_val | For_set _ =>
-          do t <- gensym tyres;
+          do t <- gensym ty1;
           ret (finish dst
                  (sl1 ++ sl2 ++ sl3 ++
-                  Sset t (Ebinop op a3 a2 tyres) ::
-                  make_assign a1 (Etempvar t tyres) :: nil)
-                 (Ecast (Etempvar t tyres) ty1))
+                  Sset t (Ecast (Ebinop op a3 a2 tyres) ty1) ::
+                  make_assign a1 (Etempvar t ty1) :: nil)
+                 (Etempvar t ty1))
       | For_effects =>
           ret (sl1 ++ sl2 ++ sl3 ++ make_assign a1 (Ebinop op a3 a2 tyres) :: nil,
                dummy_expr)
@@ -512,9 +512,9 @@ Local Open Scope error_monad_scope.
 
 Definition transl_fundef (fd: Csyntax.fundef) : res fundef :=
   match fd with
-  | Csyntax.Internal f =>
+  | Internal f =>
       do tf <- transl_function f; OK (Internal tf)
-  | Csyntax.External ef targs tres cc =>
+  | External ef targs tres cc =>
       OK (External ef targs tres cc)
   end.
 
@@ -523,6 +523,6 @@ Definition transl_program (p: Csyntax.program) : res program :=
   OK {| prog_defs := AST.prog_defs p1;
         prog_public := AST.prog_public p1;
         prog_main := AST.prog_main p1;
-        prog_types := Csyntax.prog_types p;
-        prog_comp_env := Csyntax.prog_comp_env p;
-        prog_comp_env_eq := Csyntax.prog_comp_env_eq p |}.
+        prog_types := prog_types p;
+        prog_comp_env := prog_comp_env p;
+        prog_comp_env_eq := prog_comp_env_eq p |}.
diff --git a/cfrontend/SimplExprproof.v b/cfrontend/SimplExprproof.v
index 0c7c9ce7..64e52df8 100644
--- a/cfrontend/SimplExprproof.v
+++ b/cfrontend/SimplExprproof.v
@@ -12,30 +12,34 @@
 
 (** Correctness proof for expression simplification. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import AST.
-Require Import Errors.
-Require Import Integers.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Smallstep.
-Require Import Globalenvs.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Csyntax.
-Require Import Csem.
-Require Import Cstrategy.
-Require Import Clight.
-Require Import SimplExpr.
-Require Import SimplExprspec.
+Require Import Coqlib Maps Errors Integers.
+Require Import AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Ctypes Cop Csyntax Csem Cstrategy Clight.
+Require Import SimplExpr SimplExprspec.
+
+(** ** Relational specification of the translation. *)
+
+Definition match_prog (p: Csyntax.program) (tp: Clight.program) :=
+    match_program (fun ctx f tf => tr_fundef f tf) eq p tp
+ /\ prog_types tp = prog_types p.
+
+Lemma transf_program_match:
+  forall p tp, transl_program p = OK tp -> match_prog p tp.
+Proof.
+  unfold transl_program; intros. monadInv H. split; auto.
+  unfold program_of_program; simpl. destruct x; simpl.
+  eapply match_transform_partial_program_contextual. eexact EQ. 
+  intros. apply transl_fundef_spec; auto. 
+Qed.
+
+(** ** Semantic preservation *)
 
 Section PRESERVATION.
 
 Variable prog: Csyntax.program.
 Variable tprog: Clight.program.
-Hypothesis TRANSL: transl_program prog = OK tprog.
+Hypothesis TRANSL: match_prog prog tprog.
 
 Let ge := Csem.globalenv prog.
 Let tge := Clight.globalenv tprog.
@@ -45,22 +49,17 @@ Let tge := Clight.globalenv tprog.
 Lemma comp_env_preserved:
   Clight.genv_cenv tge = Csem.genv_cenv ge.
 Proof.
-  monadInv TRANSL. unfold tge; rewrite <- H0; auto.
+  simpl. destruct TRANSL. generalize (prog_comp_env_eq tprog) (prog_comp_env_eq prog). 
+  congruence.
 Qed.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  intros. eapply Genv.find_symbol_match. eapply transl_program_spec; eauto.
-  simpl. tauto.
-Qed.
+Proof (Genv.find_symbol_match (proj1 TRANSL)).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  intros. eapply Genv.public_symbol_match. eapply transl_program_spec; eauto.
-  simpl. tauto.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match (proj1 TRANSL)).
 
 Lemma function_ptr_translated:
   forall b f,
@@ -68,9 +67,8 @@ Lemma function_ptr_translated:
   exists tf,
   Genv.find_funct_ptr tge b = Some tf /\ tr_fundef f tf.
 Proof.
-  intros. eapply Genv.find_funct_ptr_match.
-  eapply transl_program_spec; eauto.
-  assumption.
+  intros.
+  edestruct (Genv.find_funct_ptr_match (proj1 TRANSL)) as (ctx & tf & A & B & C); eauto.
 Qed.
 
 Lemma functions_translated:
@@ -79,27 +77,8 @@ Lemma functions_translated:
   exists tf,
   Genv.find_funct tge v = Some tf /\ tr_fundef f tf.
 Proof.
-  intros. eapply Genv.find_funct_match.
-  eapply transl_program_spec; eauto.
-  assumption.
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intros. destruct (Genv.find_var_info ge b) as [v|] eqn:V.
-- exploit Genv.find_var_info_match. eapply transl_program_spec; eauto. eassumption.
-  intros [tv [A B]]. inv B. assumption.
-- destruct (Genv.find_var_info tge b) as [v'|] eqn:V'; auto.
-  exploit Genv.find_var_info_rev_match. eapply transl_program_spec; eauto. eassumption.
-  simpl. destruct (plt b (Genv.genv_next (Genv.globalenv prog))); try tauto.
-  intros [v [A B]]. inv B. change (Genv.globalenv prog) with (Csem.genv_genv ge) in A. congruence.
-Qed.
-
-Lemma block_is_volatile_preserved:
-  forall b, Genv.block_is_volatile tge b = Genv.block_is_volatile ge b.
-Proof.
-  intros. unfold Genv.block_is_volatile. rewrite varinfo_preserved. auto.
+  intros.
+  edestruct (Genv.find_funct_match (proj1 TRANSL)) as (ctx & tf & A & B & C); eauto.
 Qed.
 
 Lemma type_of_fundef_preserved:
@@ -167,8 +146,7 @@ Proof.
   (* By_value, not volatile *)
   rewrite H1. split; auto. eapply deref_loc_value; eauto.
   (* By_value, volatile *)
-  rewrite H0; rewrite H1. eapply volatile_load_preserved with (ge1 := ge); auto.
-  exact symbols_preserved. exact public_preserved. exact block_is_volatile_preserved.
+  rewrite H0; rewrite H1. eapply volatile_load_preserved with (ge1 := ge); auto. apply senv_preserved.
   (* By reference *)
   rewrite H0. destruct (type_is_volatile ty); split; auto; eapply deref_loc_reference; eauto.
   (* By copy *)
@@ -187,8 +165,7 @@ Proof.
   (* By_value, not volatile *)
   rewrite H1. split; auto. eapply assign_loc_value; eauto.
   (* By_value, volatile *)
-  rewrite H0; rewrite H1. eapply volatile_store_preserved with (ge1 := ge); auto.
-  exact symbols_preserved. exact public_preserved. exact block_is_volatile_preserved.
+  rewrite H0; rewrite H1. eapply volatile_store_preserved with (ge1 := ge); auto. apply senv_preserved.
   (* By copy *)
   rewrite H0. rewrite <- comp_env_preserved in *.
   destruct (type_is_volatile ty); split; auto; eapply assign_loc_copy; eauto.
@@ -752,12 +729,27 @@ Qed.
 
 (** Semantics of smart constructors *)
 
+Remark sem_cast_deterministic:
+  forall v ty ty' m1 v1 m2 v2,
+  sem_cast v ty ty' m1 = Some v1 ->
+  sem_cast v ty ty' m2 = Some v2 ->
+  v1 = v2.
+Proof.
+  unfold sem_cast; intros. destruct (classify_cast ty ty'); try congruence.
+  destruct v; try congruence.
+  destruct (Mem.weak_valid_pointer m1 b (Int.unsigned i)); inv H.
+  destruct (Mem.weak_valid_pointer m2 b (Int.unsigned i)); inv H0.
+  auto.
+Qed.
+
 Lemma eval_simpl_expr_sound:
   forall e le m a v, eval_expr tge e le m a v ->
   match eval_simpl_expr a with Some v' => v' = v | None => True end.
 Proof.
   induction 1; simpl; auto.
-  destruct (eval_simpl_expr a); auto. subst. rewrite H0. auto.
+  destruct (eval_simpl_expr a); auto. subst.
+  destruct (sem_cast v1 (typeof a) ty Mem.empty) as [v'|] eqn:C; auto.
+  eapply sem_cast_deterministic; eauto.
   inv H; simpl; auto.
 Qed.
 
@@ -811,7 +803,7 @@ Lemma step_make_assign:
   Csem.assign_loc ge ty m b ofs v t m' ->
   eval_lvalue tge e le m a1 b ofs ->
   eval_expr tge e le m a2 v2 ->
-  sem_cast v2 (typeof a2) ty = Some v ->
+  sem_cast v2 (typeof a2) ty m = Some v ->
   typeof a1 = ty ->
   step1 tge (State f (make_assign a1 a2) k e le m)
           t (State f Sskip k e le m').
@@ -1649,18 +1641,19 @@ Proof.
   (* for value *)
   exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
   exploit tr_simple_lvalue. eauto.
-    eapply tr_expr_invariant with (le' := PTree.set t0 v le). eauto.
+    eapply tr_expr_invariant with (le' := PTree.set t0 v' le). eauto.
     intros. apply PTree.gso. intuition congruence.
   intros [SL1 [TY1 EV1]].
   subst; simpl Kseqlist.
   econstructor; split.
   left. eapply plus_left. constructor.
-  eapply star_left. constructor. eauto.
+  eapply star_left. constructor. econstructor. eauto. rewrite <- TY2; eauto. 
   eapply star_left. constructor.
   apply star_one. eapply step_make_assign; eauto.
-  constructor. apply PTree.gss. reflexivity. reflexivity. traceEq.
+  constructor. apply PTree.gss. simpl. eapply cast_idempotent; eauto. 
+  reflexivity. reflexivity. traceEq.
   econstructor. auto. apply S.
-  apply tr_val_gen. auto. intros. econstructor; eauto. constructor.
+  apply tr_val_gen. auto. intros. constructor.
   rewrite H4; auto. apply PTree.gss.
   intros. apply PTree.gso. intuition congruence.
   auto. auto.
@@ -1692,7 +1685,7 @@ Proof.
   exploit tr_simple_rvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto.
   intros. apply INV. NOTIN. simpl. intros [SL2 [TY2 EV2]].
   exploit tr_simple_lvalue. eauto.
-    eapply tr_expr_invariant with (le := le) (le' := PTree.set t v3 le'). eauto.
+    eapply tr_expr_invariant with (le := le) (le' := PTree.set t v4 le'). eauto.
     intros. rewrite PTree.gso. apply INV. NOTIN. intuition congruence.
   intros [? [? EV1'']].
   subst; simpl Kseqlist.
@@ -1700,13 +1693,14 @@ Proof.
   left. rewrite app_ass. rewrite Kseqlist_app.
   eapply star_plus_trans. eexact EXEC.
   simpl. eapply plus_four. econstructor. econstructor.
-    econstructor. eexact EV3. eexact EV2.
+    econstructor. econstructor. eexact EV3. eexact EV2.
     rewrite TY3; rewrite <- TY1; rewrite <- TY2; rewrite comp_env_preserved; eauto.
+    eassumption.
   econstructor. eapply step_make_assign; eauto.
-    constructor. apply PTree.gss.
+    constructor. apply PTree.gss. simpl. eapply cast_idempotent; eauto.
     reflexivity. traceEq.
   econstructor. auto. apply S.
-  apply tr_val_gen. auto. intros. econstructor; eauto. constructor.
+  apply tr_val_gen. auto. intros. constructor.
   rewrite H10; auto. apply PTree.gss.
   intros. rewrite PTree.gso. apply INV.
   red; intros; elim H10; auto.
@@ -1890,8 +1884,7 @@ Proof.
   econstructor; split.
   left. eapply plus_left. constructor.  apply star_one.
   econstructor; eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   traceEq.
   econstructor; eauto.
   change sl2 with (nil ++ sl2). apply S. constructor. simpl; auto. auto.
@@ -1901,8 +1894,7 @@ Proof.
   econstructor; split.
   left. eapply plus_left. constructor. apply star_one.
   econstructor; eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   traceEq.
   econstructor; eauto.
   change sl2 with (nil ++ sl2). apply S.
@@ -2198,8 +2190,7 @@ Proof.
   inv H5.
   econstructor; split.
   left; apply plus_one. econstructor; eauto.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   constructor; auto.
 
 (* return *)
@@ -2229,15 +2220,14 @@ Lemma transl_initial_states:
   Csem.initial_state prog S ->
   exists S', Clight.initial_state tprog S' /\ match_states S S'.
 Proof.
-  intros. inv H. generalize TRANSL; intros TR; monadInv TR. rewrite H4.
-  exploit transl_program_spec; eauto. intros MP.
+  intros. inv H.
   exploit function_ptr_translated; eauto. intros [tf [FIND TR]].
   econstructor; split.
   econstructor.
-  exploit Genv.init_mem_match; eauto.
-  change (Genv.globalenv tprog) with (genv_genv tge).
-  rewrite symbols_preserved. rewrite <- H4; simpl.
-  rewrite (transform_partial_program_main _ _ EQ). eauto. 
+  eapply (Genv.init_mem_match (proj1 TRANSL)); eauto.
+  replace (prog_main tprog) with (prog_main prog).
+  rewrite symbols_preserved. eauto. 
+  destruct TRANSL. destruct H as (A & B & C). simpl in B. auto. 
   eexact FIND.
   rewrite <- H3. apply type_of_fundef_preserved. auto.
   constructor. auto. constructor.
@@ -2254,7 +2244,7 @@ Theorem transl_program_correct:
   forward_simulation (Cstrategy.semantics prog) (Clight.semantics1 tprog).
 Proof.
   eapply forward_simulation_star_wf with (order := ltof _ measure).
-  eexact public_preserved.
+  eapply senv_preserved.
   eexact transl_initial_states.
   eexact transl_final_states.
   apply well_founded_ltof.
@@ -2262,3 +2252,18 @@ Proof.
 Qed.
 
 End PRESERVATION.
+
+(** ** Commutation with linking *)
+
+Instance TransfSimplExprLink : TransfLink match_prog.
+Proof.
+  red; intros. eapply Ctypes.link_match_program; eauto. 
+- intros.
+Local Transparent Linker_fundef.
+  simpl in *; unfold link_fundef in *. inv H3; inv H4; try discriminate.
+  destruct ef; inv H2. exists (Internal tf); split; auto. constructor; auto.
+  destruct ef; inv H2. exists (Internal tf); split; auto. constructor; auto.
+  destruct (external_function_eq ef ef0 && typelist_eq targs targs0 &&
+            type_eq tres tres0 && calling_convention_eq cconv cconv0); inv H2.
+  exists (External ef targs tres cconv); split; auto. constructor.
+Qed.
diff --git a/cfrontend/SimplExprspec.v b/cfrontend/SimplExprspec.v
index 4077d7df..453a4c9a 100644
--- a/cfrontend/SimplExprspec.v
+++ b/cfrontend/SimplExprspec.v
@@ -12,18 +12,9 @@
 
 (** Relational specification of expression simplification. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import Memory.
-Require Import AST.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Csyntax.
-Require Import Clight.
-Require Import SimplExpr.
+Require Import Coqlib Maps Errors Integers Floats.
+Require Import AST Linking Memory.
+Require Import Ctypes Cop Csyntax Clight SimplExpr.
 
 Section SPEC.
 
@@ -222,10 +213,10 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement ->
       ty2 = Csyntax.typeof e2 ->
       tr_expr le dst (Csyntax.Eassign e1 e2 ty)
                    (sl1 ++ sl2 ++
-                    Sset t a2 ::
-                    make_assign a1 (Etempvar t ty2) ::
-                    final dst (Ecast (Etempvar t ty2) ty1))
-                   (Ecast (Etempvar t ty2) ty1) tmp
+                    Sset t (Ecast a2 ty1) ::
+                    make_assign a1 (Etempvar t ty1) ::
+                    final dst (Etempvar t ty1))
+                   (Etempvar t ty1) tmp
   | tr_assignop_effects: forall le op e1 e2 tyres ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 any tmp,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       tr_expr le For_val e2 sl2 a2 tmp2 ->
@@ -246,10 +237,10 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement ->
       ty1 = Csyntax.typeof e1 ->
       tr_expr le dst (Csyntax.Eassignop op e1 e2 tyres ty)
                    (sl1 ++ sl2 ++ sl3 ++
-                    Sset t (Ebinop op a3 a2 tyres) ::
-                    make_assign a1 (Etempvar t tyres) ::
-                    final dst (Ecast (Etempvar t tyres) ty1))
-                   (Ecast (Etempvar t tyres) ty1) tmp
+                    Sset t (Ecast (Ebinop op a3 a2 tyres) ty1) ::
+                    make_assign a1 (Etempvar t ty1) ::
+                    final dst (Etempvar t ty1))
+                   (Etempvar t ty1) tmp
   | tr_postincr_effects: forall le id e1 ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       tr_rvalof ty1 a1 sl2 a2 tmp2 ->
@@ -375,8 +366,7 @@ Qed.
   between Csyntax values and Cminor expressions: in the case of
   [tr_expr], the Cminor expression must not depend on memory,
   while in the case of [tr_top] it can depend on the current memory
-  state.  This special case is extended to values occurring under
-  one or several [Csyntax.Eparen]. *)
+  state. *)
 
 Section TR_TOP.
 
@@ -389,19 +379,9 @@ Inductive tr_top: destination -> Csyntax.expr -> list statement -> expr -> list
   | tr_top_val_val: forall v ty a tmp,
       typeof a = ty -> eval_expr ge e le m a v ->
       tr_top For_val (Csyntax.Eval v ty) nil a tmp
-(*
-  | tr_top_val_set: forall t tyl v ty a any tmp,
-      typeof a = ty -> eval_expr ge e le m a v ->
-      tr_top (For_set tyl t) (Csyntax.Eval v ty) (Sset t (fold_left Ecast tyl a) :: nil) any tmp
-*)
   | tr_top_base: forall dst r sl a tmp,
       tr_expr le dst r sl a tmp ->
       tr_top dst r sl a tmp.
-(*
-  | tr_top_paren_test: forall tyl t r ty sl a tmp,
-      tr_top (For_set (ty :: tyl) t) r sl a tmp ->
-      tr_top (For_set tyl t) (Csyntax.Eparen r ty) sl a tmp.
-*)
 
 End TR_TOP.
 
@@ -1088,8 +1068,7 @@ Opaque transl_expression transl_expr_stmt.
   monadInv TR; constructor; eauto.
 Qed.
 
-(** Relational presentation for the transformation of functions, fundefs, and va
-riables. *)
+(** Relational presentation for the transformation of functions, fundefs, and variables. *)
 
 Inductive tr_function: Csyntax.function -> Clight.function -> Prop :=
   | tr_function_intro: forall f tf,
@@ -1103,9 +1082,9 @@ Inductive tr_function: Csyntax.function -> Clight.function -> Prop :=
 Inductive tr_fundef: Csyntax.fundef -> Clight.fundef -> Prop :=
   | tr_internal: forall f tf,
       tr_function f tf ->
-      tr_fundef (Csyntax.Internal f) (Clight.Internal tf)
+      tr_fundef (Internal f) (Internal tf)
   | tr_external: forall ef targs tres cconv,
-      tr_fundef (Csyntax.External ef targs tres cconv) (External ef targs tres cconv).
+      tr_fundef (External ef targs tres cconv) (External ef targs tres cconv).
 
 Lemma transl_function_spec:
   forall f tf,
@@ -1128,30 +1107,5 @@ Proof.
 + constructor.
 Qed.
 
-Lemma transl_globdefs_spec:
-  forall l l',
-  transf_globdefs transl_fundef (fun v : type => OK v) l = OK l' ->
-  list_forall2 (match_globdef tr_fundef (fun v1 v2 => v1 = v2)) l l'.
-Proof.
-  induction l; simpl; intros.
-- inv H. constructor.
-- destruct a as [id gd]. destruct gd.
-  + destruct (transl_fundef f) as [tf | ?] eqn:E1; Errors.monadInv H.
-    constructor; eauto. constructor. eapply transl_fundef_spec; eauto.
-  + Errors.monadInv H. 
-    constructor; eauto. destruct v; constructor; auto.
-Qed.
-
-Theorem transl_program_spec:
-  forall p tp,
-  transl_program p = OK tp ->
-  match_program tr_fundef (fun v1 v2 => v1 = v2) nil (Csyntax.prog_main p) p tp.
-Proof.
-  unfold transl_program, transform_partial_program; intros. Errors.monadInv H. Errors.monadInv EQ; simpl.
-  split; auto. exists x0; split.
-  eapply transl_globdefs_spec; eauto.
-  rewrite <- app_nil_end; auto.
-Qed.
-
 End SPEC.
 
diff --git a/cfrontend/SimplLocals.v b/cfrontend/SimplLocals.v
index c4b1054d..580f02c2 100644
--- a/cfrontend/SimplLocals.v
+++ b/cfrontend/SimplLocals.v
@@ -15,13 +15,9 @@
 
 Require Import FSets.
 Require FSetAVL.
-Require Import Coqlib.
-Require Import Ordered.
-Require Import Errors.
-Require Import AST.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Clight.
+Require Import Coqlib Ordered Errors.
+Require Import AST Linking.
+Require Import Ctypes Cop Clight.
 Require Compopts.
 
 Open Scope error_monad_scope.
diff --git a/cfrontend/SimplLocalsproof.v b/cfrontend/SimplLocalsproof.v
index a47036bf..2cd82d8f 100644
--- a/cfrontend/SimplLocalsproof.v
+++ b/cfrontend/SimplLocalsproof.v
@@ -13,80 +13,58 @@
 (** Semantic preservation for the SimplLocals pass. *)
 
 Require Import FSets.
-Require FSetAVL.
-Require Import Coqlib.
-Require Import Errors.
-Require Import Ordered.
-Require Import AST.
-Require Import Maps.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Globalenvs.
-Require Import Events.
-Require Import Smallstep.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Clight.
-Require Import SimplLocals.
+Require Import Coqlib Errors Ordered Maps Integers Floats.
+Require Import AST Linking.
+Require Import Values Memory Globalenvs Events Smallstep.
+Require Import Ctypes Cop Clight SimplLocals.
 
 Module VSF := FSetFacts.Facts(VSet).
 Module VSP := FSetProperties.Properties(VSet).
 
+Definition match_prog (p tp: program) : Prop :=
+    match_program (fun ctx f tf => transf_fundef f = OK tf) eq p tp
+ /\ prog_types tp = prog_types p.
+
+Lemma match_transf_program:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  unfold transf_program; intros. monadInv H. 
+  split; auto. apply match_transform_partial_program. rewrite EQ. destruct x; auto.
+Qed.
+
 Section PRESERVATION.
 
 Variable prog: program.
 Variable tprog: program.
-Hypothesis TRANSF: transf_program prog = OK tprog.
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := globalenv prog.
 Let tge := globalenv tprog.
 
 Lemma comp_env_preserved:
   genv_cenv tge = genv_cenv ge.
 Proof.
-  monadInv TRANSF. unfold tge; rewrite <- H0; auto.
-Qed.
-
-Lemma transf_programs:
-  AST.transform_partial_program transf_fundef (program_of_program prog) = OK (program_of_program tprog).
-Proof.
-  monadInv TRANSF. rewrite EQ. destruct x; reflexivity.
+  unfold tge, ge. destruct prog, tprog; simpl. destruct TRANSF as [_ EQ]. simpl in EQ. congruence.
 Qed.
 
 Lemma symbols_preserved:
   forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
-Proof.
-  exact (Genv.find_symbol_transf_partial _ _ transf_programs).
-Qed.
+Proof (Genv.find_symbol_match (proj1 TRANSF)).
 
-Lemma public_preserved:
-  forall (s: ident), Genv.public_symbol tge s = Genv.public_symbol ge s.
-Proof.
-  exact (Genv.public_symbol_transf_partial _ _ transf_programs).
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  exact (Genv.find_var_info_transf_partial _ _ transf_programs).
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match (proj1 TRANSF)).
 
 Lemma functions_translated:
   forall (v: val) (f: fundef),
   Genv.find_funct ge v = Some f ->
   exists tf, Genv.find_funct tge v = Some tf /\ transf_fundef f = OK tf.
-Proof.
-  exact (Genv.find_funct_transf_partial _ _ transf_programs).
-Qed.
+Proof (Genv.find_funct_transf_partial (proj1 TRANSF)).
 
 Lemma function_ptr_translated:
   forall (b: block) (f: fundef),
   Genv.find_funct_ptr ge b = Some f ->
   exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf.
-Proof.
-  exact (Genv.find_funct_ptr_transf_partial _ _ transf_programs).
-Qed.
+Proof (Genv.find_funct_ptr_transf_partial (proj1 TRANSF)).
 
 Lemma type_of_fundef_preserved:
   forall fd tfd,
@@ -201,97 +179,7 @@ Proof.
   xomegaContradiction.
 Qed.
 
-(** Properties of values obtained by casting to a given type. *)
-
-Inductive val_casted: val -> type -> Prop :=
-  | val_casted_int: forall sz si attr n,
-      cast_int_int sz si n = n ->
-      val_casted (Vint n) (Tint sz si attr)
-  | val_casted_float: forall attr n,
-       val_casted (Vfloat n) (Tfloat F64 attr)
-  | val_casted_single: forall attr n,
-       val_casted (Vsingle n) (Tfloat F32 attr)
-  | val_casted_long: forall si attr n,
-      val_casted (Vlong n) (Tlong si attr)
-  | val_casted_ptr_ptr: forall b ofs ty attr,
-      val_casted (Vptr b ofs) (Tpointer ty attr)
-  | val_casted_int_ptr: forall n ty attr,
-      val_casted (Vint n) (Tpointer ty attr)
-  | val_casted_ptr_int: forall b ofs si attr,
-      val_casted (Vptr b ofs) (Tint I32 si attr)
-  | val_casted_struct: forall id attr b ofs,
-      val_casted (Vptr b ofs) (Tstruct id attr)
-  | val_casted_union: forall id attr b ofs,
-      val_casted (Vptr b ofs) (Tunion id attr)
-  | val_casted_void: forall v,
-      val_casted v Tvoid.
-
-Remark cast_int_int_idem:
-  forall sz sg i, cast_int_int sz sg (cast_int_int sz sg i) = cast_int_int sz sg i.
-Proof.
-  intros. destruct sz; simpl; auto.
-  destruct sg; [apply Int.sign_ext_idem|apply Int.zero_ext_idem]; compute; intuition congruence.
-  destruct sg; [apply Int.sign_ext_idem|apply Int.zero_ext_idem]; compute; intuition congruence.
-  destruct (Int.eq i Int.zero); auto.
-Qed.
-
-Lemma cast_val_is_casted:
-  forall v ty ty' v', sem_cast v ty ty' = Some v' -> val_casted v' ty'.
-Proof.
-  unfold sem_cast; intros. destruct ty'; simpl in *.
-(* void *)
-  constructor.
-(* int *)
-  destruct i; destruct ty; simpl in H; try (destruct f); try discriminate; destruct v; inv H.
-  constructor. apply (cast_int_int_idem I8 s).
-  constructor. apply (cast_int_int_idem I8 s).
-  destruct (cast_single_int s f); inv H1. constructor. apply (cast_int_int_idem I8 s).
-  destruct (cast_float_int s f); inv H1. constructor. apply (cast_int_int_idem I8 s).
-  constructor. apply (cast_int_int_idem I16 s).
-  constructor. apply (cast_int_int_idem I16 s).
-  destruct (cast_single_int s f); inv H1. constructor. apply (cast_int_int_idem I16 s).
-  destruct (cast_float_int s f); inv H1. constructor. apply (cast_int_int_idem I16 s).
-  constructor. auto.
-  constructor.
-  constructor. auto.
-  destruct (cast_single_int s f); inv H1. constructor. auto.
-  destruct (cast_float_int s f); inv H1. constructor; auto.
-  constructor; auto.
-  constructor.
-  constructor; auto.
-  constructor.
-  constructor; auto.
-  constructor.
-  constructor. simpl. destruct (Int.eq i0 Int.zero); auto.
-  constructor. simpl. destruct (Int64.eq i Int64.zero); auto.
-  constructor. simpl. destruct (Float32.cmp Ceq f Float32.zero); auto.
-  constructor. simpl. destruct (Float.cmp Ceq f Float.zero); auto.
-  constructor. simpl. destruct (Int.eq i Int.zero); auto.
-  constructor. simpl. destruct (Int.eq i Int.zero); auto.
-  constructor. simpl. destruct (Int.eq i Int.zero); auto.
-(* long *)
-  destruct ty; try (destruct f); try discriminate.
-  destruct v; inv H. constructor.
-  destruct v; inv H. constructor.
-  destruct v; try discriminate. destruct (cast_single_long s f); inv H. constructor.
-  destruct v; try discriminate. destruct (cast_float_long s f); inv H. constructor.
-  destruct v; inv H. constructor.
-  destruct v; inv H. constructor.
-  destruct v; inv H. constructor.
-(* float *)
-  destruct f; destruct ty; simpl in H; try (destruct f); try discriminate; destruct v; inv H; constructor.
-(* pointer *)
-  destruct ty; simpl in H; try discriminate; destruct v; inv H; try constructor.
-(* impossible cases *)
-  discriminate.
-  discriminate.
-(* structs *)
-  destruct ty; try discriminate; destruct v; try discriminate.
-  destruct (ident_eq i0 i); inv H; constructor.
-(* unions *)
-  destruct ty; try discriminate; destruct v; try discriminate.
-  destruct (ident_eq i0 i); inv H; constructor.
-Qed.
+(** Properties of values resulting from a cast *)
 
 Lemma val_casted_load_result:
   forall v ty chunk,
@@ -316,15 +204,6 @@ Proof.
   discriminate.
 Qed.
 
-Lemma cast_val_casted:
-  forall v ty, val_casted v ty -> sem_cast v ty ty = Some v.
-Proof.
-  intros. inversion H; clear H; subst v ty; unfold sem_cast; simpl; auto.
-  destruct sz; congruence.
-  unfold proj_sumbool; repeat rewrite dec_eq_true; auto.
-  unfold proj_sumbool; repeat rewrite dec_eq_true; auto.
-Qed.
-
 Lemma val_casted_inject:
   forall f v v' ty,
   Val.inject f v v' -> val_casted v ty -> val_casted v' ty.
@@ -363,7 +242,7 @@ Qed.
 Lemma make_cast_correct:
   forall e le m a v1 tto v2,
   eval_expr tge e le m a v1 ->
-  sem_cast v1 (typeof a) tto = Some v2 ->
+  sem_cast v1 (typeof a) tto m = Some v2 ->
   eval_expr tge e le m (make_cast a tto) v2.
 Proof.
   intros.
@@ -386,9 +265,9 @@ Qed.
 (** Debug annotations. *)
 
 Lemma cast_typeconv:
-  forall v ty,
+  forall v ty m,
   val_casted v ty ->
-  sem_cast v ty (typeconv ty) = Some v.
+  sem_cast v ty (typeconv ty) m = Some v.
 Proof.
   induction 1; simpl; auto.
 - destruct sz; auto.
@@ -423,7 +302,7 @@ Qed.
 Lemma step_Sset_debug:
   forall f id ty a k e le m v v',
   eval_expr tge e le m a v ->
-  sem_cast v (typeof a) ty = Some v' ->
+  sem_cast v (typeof a) ty m = Some v' ->
   plus step2 tge (State f (Sset_debug id ty a) k e le m)
               E0 (State f Sskip k e (PTree.set id v' le) m).
 Proof.
@@ -2172,8 +2051,7 @@ Proof.
   exploit external_call_mem_inject; eauto. apply match_globalenvs_preserves_globals; eauto with compat.
   intros [j' [tvres [tm' [P [Q [R [S [T [U V]]]]]]]]].
   econstructor; split.
-  apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto with compat.
   eapply match_envs_set_opttemp; eauto.
   eapply match_envs_extcall; eauto.
@@ -2334,8 +2212,7 @@ Proof.
   eapply match_cont_globalenv. eexact (MCONT VSet.empty).
   intros [j' [tvres [tm' [P [Q [R [S [T [U V]]]]]]]]].
   econstructor; split.
-  apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  apply plus_one. econstructor; eauto. eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   econstructor; eauto.
   intros. apply match_cont_incr_bounds with (Mem.nextblock m) (Mem.nextblock tm).
   eapply match_cont_extcall; eauto. xomega. xomega.
@@ -2358,10 +2235,10 @@ Proof.
   exploit function_ptr_translated; eauto. intros [tf [A B]].
   econstructor; split.
   econstructor.
-  eapply Genv.init_mem_transf_partial. eexact transf_programs. eauto.
-  change (prog_main tprog) with (AST.prog_main tprog).
-  rewrite (transform_partial_program_main _ _ transf_programs).
+  eapply (Genv.init_mem_transf_partial (proj1 TRANSF)). eauto.
+  replace (prog_main tprog) with (prog_main prog). 
   instantiate (1 := b). rewrite <- H1. apply symbols_preserved.
+  generalize (match_program_main (proj1 TRANSF)). simpl; auto.
   eauto.
   rewrite <- H3; apply type_of_fundef_preserved; auto.
   econstructor; eauto.
@@ -2391,10 +2268,27 @@ Theorem transf_program_correct:
   forward_simulation (semantics1 prog) (semantics2 tprog).
 Proof.
   eapply forward_simulation_plus.
-  eexact public_preserved.
+  apply senv_preserved.
   eexact initial_states_simulation.
   eexact final_states_simulation.
   eexact step_simulation.
 Qed.
 
 End PRESERVATION.
+
+(** ** Commutation with linking *)
+
+Instance TransfSimplLocalsLink : TransfLink match_prog.
+Proof.
+  red; intros. eapply Ctypes.link_match_program; eauto. 
+- intros.
+Local Transparent Linker_fundef.
+  simpl in *; unfold link_fundef in *.
+  destruct f1; monadInv H3; destruct f2; monadInv H4; try discriminate.
+  destruct e; inv H2. exists (Internal x); split; auto. simpl; rewrite EQ; auto.
+  destruct e; inv H2. exists (Internal x); split; auto. simpl; rewrite EQ; auto.
+  destruct (external_function_eq e e0 && typelist_eq t t1 &&
+            type_eq t0 t2 && calling_convention_eq c c0); inv H2.
+  econstructor; split; eauto. 
+Qed.
+
diff --git a/common/AST.v b/common/AST.v
index 16673c47..415e90e2 100644
--- a/common/AST.v
+++ b/common/AST.v
@@ -17,10 +17,7 @@
   the abstract syntax trees of many of the intermediate languages. *)
 
 Require Import String.
-Require Import Coqlib.
-Require Import Errors.
-Require Import Integers.
-Require Import Floats.
+Require Import Coqlib Maps Errors Integers Floats.
 
 Set Implicit Arguments.
 
@@ -106,6 +103,12 @@ Record calling_convention : Type := mkcallconv {
 Definition cc_default :=
   {| cc_vararg := false; cc_unproto := false; cc_structret := false |}.
 
+Definition calling_convention_eq (x y: calling_convention) : {x=y} + {x<>y}.
+Proof.
+  decide equality; apply bool_dec. 
+Defined.
+Global Opaque calling_convention_eq.
+
 Record signature : Type := mksignature {
   sig_args: list typ;
   sig_res: option typ;
@@ -120,8 +123,7 @@ Definition proj_sig_res (s: signature) : typ :=
 
 Definition signature_eq: forall (s1 s2: signature), {s1=s2} + {s1<>s2}.
 Proof.
-  generalize opt_typ_eq, list_typ_eq; intros; decide equality.
-  generalize bool_dec; intros. decide equality.
+  generalize opt_typ_eq, list_typ_eq, calling_convention_eq; decide equality.
 Defined.
 Global Opaque signature_eq.
 
@@ -189,6 +191,36 @@ Inductive init_data: Type :=
   | Init_space: Z -> init_data
   | Init_addrof: ident -> int -> init_data.  (**r address of symbol + offset *)
 
+Definition init_data_size (i: init_data) : Z :=
+  match i with
+  | Init_int8 _ => 1
+  | Init_int16 _ => 2
+  | Init_int32 _ => 4
+  | Init_int64 _ => 8
+  | Init_float32 _ => 4
+  | Init_float64 _ => 8
+  | Init_addrof _ _ => 4
+  | Init_space n => Zmax n 0
+  end.
+
+Fixpoint init_data_list_size (il: list init_data) {struct il} : Z :=
+  match il with
+  | nil => 0
+  | i :: il' => init_data_size i + init_data_list_size il'
+  end.
+
+Lemma init_data_size_pos:
+  forall i, init_data_size i >= 0.
+Proof.
+  destruct i; simpl; xomega.
+Qed.
+
+Lemma init_data_list_size_pos:
+  forall il, init_data_list_size il >= 0.
+Proof.
+  induction il; simpl. omega. generalize (init_data_size_pos a); omega.
+Qed.
+
 (** Information attached to global variables. *)
 
 Record globvar (V: Type) : Type := mkglobvar {
@@ -226,6 +258,49 @@ Record program (F V: Type) : Type := mkprogram {
 Definition prog_defs_names (F V: Type) (p: program F V) : list ident :=
   List.map fst p.(prog_defs).
 
+(** The "definition map" of a program maps names of globals to their definitions.
+  If several definitions have the same name, the one appearing last in [p.(prog_defs)] wins. *)
+
+Definition prog_defmap (F V: Type) (p: program F V) : PTree.t (globdef F V) :=
+  PTree_Properties.of_list p.(prog_defs).
+
+Section DEFMAP.
+
+Variables F V: Type.
+Variable p: program F V.
+
+Lemma in_prog_defmap:
+  forall id g, (prog_defmap p)!id = Some g -> In (id, g) (prog_defs p).
+Proof.
+  apply PTree_Properties.in_of_list.
+Qed.
+
+Lemma prog_defmap_dom:
+  forall id, In id (prog_defs_names p) -> exists g, (prog_defmap p)!id = Some g.
+Proof.
+  apply PTree_Properties.of_list_dom.
+Qed.
+
+Lemma prog_defmap_unique:
+  forall defs1 id g defs2,
+  prog_defs p = defs1 ++ (id, g) :: defs2 ->
+  ~In id (map fst defs2) ->
+  (prog_defmap p)!id = Some g.
+Proof.
+  unfold prog_defmap; intros. rewrite H. apply PTree_Properties.of_list_unique; auto. 
+Qed.
+
+Lemma prog_defmap_norepet:
+  forall id g,
+  list_norepet (prog_defs_names p) ->
+  In (id, g) (prog_defs p) ->
+  (prog_defmap p)!id = Some g.
+Proof.
+  apply PTree_Properties.of_list_norepet.
+Qed.
+
+End DEFMAP.
+
 (** * Generic transformations over programs *)
 
 (** We now define a general iterator over programs that applies a given
@@ -249,109 +324,44 @@ Definition transform_program (p: program A V) : program B V :=
     p.(prog_public)
     p.(prog_main).
 
-Lemma transform_program_function:
-  forall p i tf,
-  In (i, Gfun tf) (transform_program p).(prog_defs) ->
-  exists f, In (i, Gfun f) p.(prog_defs) /\ transf f = tf.
-Proof.
-  simpl. unfold transform_program. intros.
-  exploit list_in_map_inv; eauto.
-  intros [[i' gd] [EQ IN]]. simpl in EQ. destruct gd; inv EQ.
-  exists f; auto.
-Qed.
-
 End TRANSF_PROGRAM.
 
-(** General iterator over program that applies a given code transfomration
-    function to all function descriptions with their identifers and leaves
-    teh other parts of the program unchanged. *)
-
-Section TRANSF_PROGRAM_IDENT.
-
-Variable A B V: Type.
-Variable transf: ident -> A -> B.
-
-Definition transform_program_globdef_ident (idg: ident * globdef A V) : ident * globdef B V :=
-  match idg with
-  | (id, Gfun f) => (id, Gfun (transf id f))
-  | (id, Gvar v) => (id, Gvar v)
-  end.
-
-Definition transform_program_ident (p: program A V): program B V :=
-  mkprogram
-    (List.map transform_program_globdef_ident p.(prog_defs))
-    p.(prog_public)
-    p.(prog_main).
-
-Lemma tranforma_program_function_ident:
-  forall p i tf,
-  In (i, Gfun tf) (transform_program_ident p).(prog_defs) ->
-  exists f, In (i, Gfun f) p.(prog_defs) /\ transf i f = tf.
-Proof.
-  simpl. unfold transform_program_ident. intros.
-  exploit list_in_map_inv; eauto.
-  intros [[i' gd] [EQ IN]]. simpl in EQ. destruct gd; inv EQ.
-  exists f; auto.
-Qed.
-
-End TRANSF_PROGRAM_IDENT.
-
-(** The following is a more general presentation of [transform_program] where
-  global variable information can be transformed, in addition to function
-  definitions.  Moreover, the transformation functions can fail and
-  return an error message. Also the transformation functions are defined
-  for the case the identifier of the function is passed as additional
-  argument *)
+(** The following is a more general presentation of [transform_program]:
+- Global variable information can be transformed, in addition to function
+  definitions.
+- The transformation functions can fail and return an error message.
+- The transformation for function definitions receives a global context
+  (derived from the compilation unit being transformed) as additiona
+  argument.
+- The transformation functions receive the name of the global as
+  additional argument. *)
 
 Local Open Scope error_monad_scope.
 
 Section TRANSF_PROGRAM_GEN.
 
 Variables A B V W: Type.
-Variable transf_fun: A -> res B.
-Variable transf_fun_ident: ident -> A -> res B.
-Variable transf_var: V -> res W.
-Variable transf_var_ident: ident -> V -> res W.
+Variable transf_fun: ident -> A -> res B.
+Variable transf_var: ident -> V -> res W.
 
-Definition transf_globvar (g: globvar V) : res (globvar W) :=
-  do info' <- transf_var g.(gvar_info);
-  OK (mkglobvar info' g.(gvar_init) g.(gvar_readonly) g.(gvar_volatile)).
-
-Definition transf_globvar_ident (i: ident) (g: globvar V) : res (globvar W) :=
-  do info' <- transf_var_ident i g.(gvar_info);
+Definition transf_globvar (i: ident) (g: globvar V) : res (globvar W) :=
+  do info' <- transf_var i g.(gvar_info);
   OK (mkglobvar info' g.(gvar_init) g.(gvar_readonly) g.(gvar_volatile)).
 
 Fixpoint transf_globdefs (l: list (ident * globdef A V)) : res (list (ident * globdef B W)) :=
   match l with
   | nil => OK nil
   | (id, Gfun f) :: l' =>
-      match transf_fun f with
+    match transf_fun id f with
       | Error msg => Error (MSG "In function " :: CTX id :: MSG ": " :: msg)
       | OK tf =>
-          do tl' <- transf_globdefs l'; OK ((id, Gfun tf) :: tl')
-      end
-  | (id, Gvar v) :: l' =>
-      match transf_globvar v with
-      | Error msg => Error (MSG "In variable " :: CTX id :: MSG ": " :: msg)
-      | OK tv =>
-          do tl' <- transf_globdefs l'; OK ((id, Gvar tv) :: tl')
-      end
-  end.
-
-Fixpoint transf_globdefs_ident (l: list (ident * globdef A V)) : res (list (ident * globdef B W)) :=
-  match l with
-  | nil => OK nil
-  | (id, Gfun f) :: l' =>
-    match transf_fun_ident id f with
-      | Error msg => Error (MSG "In function " :: CTX id :: MSG ": " :: msg)
-      | OK tf =>
-        do tl' <- transf_globdefs_ident l'; OK ((id, Gfun tf) :: tl')
+        do tl' <- transf_globdefs l'; OK ((id, Gfun tf) :: tl')
     end
   | (id, Gvar v) :: l' =>
-    match transf_globvar_ident id v with
+    match transf_globvar id v with
       | Error msg => Error (MSG "In variable " :: CTX id :: MSG ": " :: msg)
       | OK tv =>
-        do tl' <- transf_globdefs_ident l'; OK ((id, Gvar tv) :: tl')
+        do tl' <- transf_globdefs l'; OK ((id, Gvar tv) :: tl')
     end
   end.
 
@@ -359,213 +369,6 @@ Definition transform_partial_program2 (p: program A V) : res (program B W) :=
   do gl' <- transf_globdefs p.(prog_defs);
   OK (mkprogram gl' p.(prog_public) p.(prog_main)).
 
-Definition transform_partial_ident_program2 (p: program A V) : res (program B W) :=
-  do gl' <- transf_globdefs_ident p.(prog_defs);
-  OK (mkprogram gl' p.(prog_public) p.(prog_main)).
-
-Lemma transform_partial_program2_function:
-  forall p tp i tf,
-  transform_partial_program2 p = OK tp ->
-  In (i, Gfun tf) tp.(prog_defs) ->
-  exists f, In (i, Gfun f) p.(prog_defs) /\ transf_fun f = OK tf.
-Proof.
-  intros. monadInv H. simpl in H0.
-  revert x EQ H0. induction (prog_defs p); simpl; intros.
-  inv EQ. contradiction.
-  destruct a as [id [f|v]].
-  destruct (transf_fun f) as [tf1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H. exists f; auto.
-  exploit IHl; eauto. intros [f' [P Q]]; exists f'; auto.
-  destruct (transf_globvar v) as [tv1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H.
-  exploit IHl; eauto. intros [f' [P Q]]; exists f'; auto.
-Qed.
-
-Lemma transform_partial_ident_program2_function:
-  forall p tp i tf,
-  transform_partial_ident_program2 p = OK tp ->
-  In (i, Gfun tf) tp.(prog_defs) ->
-  exists f, In (i, Gfun f) p.(prog_defs) /\ transf_fun_ident i f = OK tf.
-Proof.
-  intros. monadInv H. simpl in H0.
-  revert x EQ H0. induction (prog_defs p); simpl; intros.
-  inv EQ. contradiction.
-  destruct a as [id [f|v]].
-  destruct (transf_fun_ident id f) as [tf1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H. exists f; auto.
-  exploit IHl; eauto. intros [f' [P Q]]; exists f'; auto.
-  destruct (transf_globvar_ident id v) as [tv1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H.
-  exploit IHl; eauto. intros [f' [P Q]]; exists f'; auto.
-Qed.
-
-Lemma transform_partial_program2_variable:
-  forall p tp i tv,
-  transform_partial_program2 p = OK tp ->
-  In (i, Gvar tv) tp.(prog_defs) ->
-  exists v,
-     In (i, Gvar(mkglobvar v tv.(gvar_init) tv.(gvar_readonly) tv.(gvar_volatile))) p.(prog_defs)
-  /\ transf_var v = OK tv.(gvar_info).
-Proof.
-  intros. monadInv H. simpl in H0.
-  revert x EQ H0. induction (prog_defs p); simpl; intros.
-  inv EQ. contradiction.
-  destruct a as [id [f|v]].
-  destruct (transf_fun f) as [tf1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H.
-  exploit IHl; eauto. intros [v' [P Q]]; exists v'; auto.
-  destruct (transf_globvar v) as [tv1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H.
-  monadInv Heqr. simpl. exists (gvar_info v). split. left. destruct v; auto. auto.
-  exploit IHl; eauto. intros [v' [P Q]]; exists v'; auto.
-Qed.
-
-
-Lemma transform_partial_ident_program2_variable:
-  forall p tp i tv,
-  transform_partial_ident_program2 p = OK tp ->
-  In (i, Gvar tv) tp.(prog_defs) ->
-  exists v,
-     In (i, Gvar(mkglobvar v tv.(gvar_init) tv.(gvar_readonly) tv.(gvar_volatile))) p.(prog_defs)
-  /\ transf_var_ident i v = OK tv.(gvar_info).
-Proof.
-  intros. monadInv H. simpl in H0.
-  revert x EQ H0. induction (prog_defs p); simpl; intros.
-  inv EQ. contradiction.
-  destruct a as [id [f|v]].
-  destruct (transf_fun_ident id f) as [tf1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H.
-  exploit IHl; eauto. intros [v' [P Q]]; exists v'; auto.
-  destruct (transf_globvar_ident id v) as [tv1|msg] eqn:?; monadInv EQ.
-  simpl in H0; destruct H0. inv H.
-  monadInv Heqr. simpl. exists (gvar_info v). split. left. destruct v; auto. auto.
-  exploit IHl; eauto. intros [v' [P Q]]; exists v'; auto.
-Qed.
-
-Lemma transform_partial_program2_succeeds:
-  forall p tp i g,
-  transform_partial_program2 p = OK tp ->
-  In (i, g) p.(prog_defs) ->
-  match g with
-  | Gfun fd => exists tfd, transf_fun fd = OK tfd
-  | Gvar gv => exists tv, transf_var gv.(gvar_info) = OK tv
-  end.
-Proof.
-  intros. monadInv H.
-  revert x EQ H0. induction (prog_defs p); simpl; intros.
-  contradiction.
-  destruct a as [id1 g1]. destruct g1.
-  destruct (transf_fun f) eqn:TF; try discriminate. monadInv EQ.
-  destruct H0. inv H. econstructor; eauto. eapply IHl; eauto.
-  destruct (transf_globvar v) eqn:TV; try discriminate. monadInv EQ.
-  destruct H0. inv H. monadInv TV. econstructor; eauto. eapply IHl; eauto.
-Qed.
-
-Lemma transform_partial_ident_program2_succeeds:
-  forall p tp i g,
-  transform_partial_ident_program2 p = OK tp ->
-  In (i, g) p.(prog_defs) ->
-  match g with
-  | Gfun fd => exists tfd, transf_fun_ident i fd = OK tfd
-  | Gvar gv => exists tv, transf_var_ident i gv.(gvar_info) = OK tv
-  end.
-Proof.
-  intros. monadInv H.
-  revert x EQ H0. induction (prog_defs p); simpl; intros.
-  contradiction.
-  destruct a as [id1 g1]. destruct g1.
-  destruct (transf_fun_ident id1 f) eqn:TF; try discriminate. monadInv EQ.
-  destruct H0. inv H. econstructor; eauto. eapply IHl; eauto.
-  destruct (transf_globvar_ident id1 v) eqn:TV; try discriminate. monadInv EQ.
-  destruct H0. inv H. monadInv TV. econstructor; eauto. eapply IHl; eauto.
-Qed.
-
-Lemma transform_partial_program2_main:
-  forall p tp,
-  transform_partial_program2 p = OK tp ->
-  tp.(prog_main) = p.(prog_main).
-Proof.
-  intros. monadInv H. reflexivity.
-Qed.
-
-Lemma transform_partial_ident_program2_main:
-  forall p tp,
-  transform_partial_ident_program2 p = OK tp ->
-  tp.(prog_main) = p.(prog_main).
-Proof.
-  intros. monadInv H. reflexivity.
-Qed.
-
-Lemma transform_partial_program2_public:
-  forall p tp,
-  transform_partial_program2 p = OK tp ->
-  tp.(prog_public) = p.(prog_public).
-Proof.
-  intros. monadInv H. reflexivity.
-Qed.
-
-Lemma transform_partial_ident_program2_public:
-  forall p tp,
-  transform_partial_ident_program2 p = OK tp ->
-  tp.(prog_public) = p.(prog_public).
-Proof.
-  intros. monadInv H. reflexivity.
-Qed.
-
-(** Additionally, we can also "augment" the program with new global definitions
-  and a different "main" function. *)
-
-Section AUGMENT.
-
-Variable new_globs: list(ident * globdef B W).
-Variable new_main: ident.
-
-Definition transform_partial_augment_program (p: program A V) : res (program B W) :=
-  do gl' <- transf_globdefs p.(prog_defs);
-  OK(mkprogram (gl' ++ new_globs) p.(prog_public) new_main).
-
-Lemma transform_partial_augment_program_main:
-  forall p tp,
-  transform_partial_augment_program p = OK tp ->
-  tp.(prog_main) = new_main.
-Proof.
-  intros. monadInv H. reflexivity.
-Qed.
-
-Definition transform_partial_augment_ident_program (p: program A V) : res (program B W) :=
-  do gl' <- transf_globdefs_ident p.(prog_defs);
-  OK(mkprogram (gl' ++ new_globs) p.(prog_public) new_main).
-
-Lemma transform_partial_augment_ident_program_main:
-  forall p tp,
-  transform_partial_augment_ident_program p = OK tp ->
-  tp.(prog_main) = new_main.
-Proof.
-  intros. monadInv H. reflexivity.
-Qed.
-
-End AUGMENT.
-
-Remark transform_partial_program2_augment:
-  forall p,
-  transform_partial_program2 p =
-  transform_partial_augment_program nil p.(prog_main) p.
-Proof.
-  unfold transform_partial_program2, transform_partial_augment_program; intros.
-  destruct (transf_globdefs (prog_defs p)); auto.
-  simpl. f_equal. f_equal. rewrite <- app_nil_end. auto.
-Qed.
-
-Remark transform_partial_ident_program2_augment:
-  forall p,
-  transform_partial_ident_program2 p =
-  transform_partial_augment_ident_program nil p.(prog_main) p.
-Proof.
-  unfold transform_partial_ident_program2, transform_partial_augment_ident_program; intros.
-  destruct (transf_globdefs_ident (prog_defs p)); auto.
-  simpl. f_equal. f_equal. rewrite <- app_nil_end. auto.
-Qed.
-
 End TRANSF_PROGRAM_GEN.
 
 (** The following is a special case of [transform_partial_program2],
@@ -574,178 +377,26 @@ End TRANSF_PROGRAM_GEN.
 Section TRANSF_PARTIAL_PROGRAM.
 
 Variable A B V: Type.
-Variable transf_partial: A -> res B.
-Variable transf_partial_ident: ident -> A -> res B.
+Variable transf_fun: A -> res B.
 
 Definition transform_partial_program (p: program A V) : res (program B V) :=
-  transform_partial_program2 transf_partial (fun v => OK v) p.
-
-Definition transform_partial_ident_program (p: program A V) : res (program B V) :=
-  transform_partial_ident_program2 transf_partial_ident (fun _ v => OK v) p.
-
-Lemma transform_partial_program_main:
-  forall p tp,
-  transform_partial_program p = OK tp ->
-  tp.(prog_main) = p.(prog_main).
-Proof.
-  apply transform_partial_program2_main.
-Qed.
-
-Lemma transform_partial_ident_program_main:
-  forall p tp,
-  transform_partial_ident_program p = OK tp ->
-  tp.(prog_main) = p.(prog_main).
-Proof.
-  apply transform_partial_ident_program2_main.
-Qed.
-
-Lemma transform_partial_program_public:
-  forall p tp,
-  transform_partial_program p = OK tp ->
-  tp.(prog_public) = p.(prog_public).
-Proof.
-  apply transform_partial_program2_public.
-Qed.
-
-Lemma transform_partial_ident_program_public:
-  forall p tp,
-  transform_partial_ident_program p = OK tp ->
-  tp.(prog_public) = p.(prog_public).
-Proof.
-  apply transform_partial_ident_program2_public.
-Qed.
-
-Lemma transform_partial_program_function:
-  forall p tp i tf,
-  transform_partial_program p = OK tp ->
-  In (i, Gfun tf) tp.(prog_defs) ->
-  exists f, In (i, Gfun f) p.(prog_defs) /\ transf_partial f = OK tf.
-Proof.
-  apply transform_partial_program2_function.
-Qed.
-
-Lemma transform_partial_ident_program_function:
-  forall p tp i tf,
-  transform_partial_ident_program p = OK tp ->
-  In (i, Gfun tf) tp.(prog_defs) ->
-  exists f, In (i, Gfun f) p.(prog_defs) /\ transf_partial_ident i f = OK tf.
-Proof.
-  apply transform_partial_ident_program2_function.
-Qed.
-
-Lemma transform_partial_program_succeeds:
-  forall p tp i fd,
-  transform_partial_program p = OK tp ->
-  In (i, Gfun fd) p.(prog_defs) ->
-  exists tfd, transf_partial fd = OK tfd.
-Proof.
-  unfold transform_partial_program; intros.
-  exploit transform_partial_program2_succeeds; eauto.
-Qed.
-
-Lemma transform_partial_ident_program_succeeds:
-  forall p tp i fd,
-  transform_partial_ident_program p = OK tp ->
-  In (i, Gfun fd) p.(prog_defs) ->
-  exists tfd, transf_partial_ident i fd = OK tfd.
-Proof.
-  unfold transform_partial_ident_program; intros.
-  exploit transform_partial_ident_program2_succeeds; eauto.
-Qed.
+  transform_partial_program2 (fun i f => transf_fun f) (fun i v => OK v) p.
 
 End TRANSF_PARTIAL_PROGRAM.
 
 Lemma transform_program_partial_program:
-  forall (A B V: Type) (transf: A -> B) (p: program A V),
-  transform_partial_program (fun f => OK(transf f)) p = OK(transform_program transf p).
-Proof.
-  intros.
-  unfold transform_partial_program, transform_partial_program2, transform_program; intros.
-  replace (transf_globdefs (fun f => OK (transf f)) (fun v => OK v) p.(prog_defs))
-     with (OK (map (transform_program_globdef transf) p.(prog_defs))).
-  auto.
-  induction (prog_defs p); simpl.
-  auto.
-  destruct a as [id [f|v]]; rewrite <- IHl.
-    auto.
-    destruct v; auto.
-Qed.
-
-Lemma transform_program_partial_ident_program:
-  forall (A B V: Type) (transf: ident -> A -> B) (p: program A V),
-  transform_partial_ident_program (fun id f => OK(transf id f)) p = OK(transform_program_ident transf p).
-Proof.
-  intros.
-  unfold transform_partial_ident_program, transform_partial_ident_program2, transform_program; intros.
-  replace (transf_globdefs_ident (fun id f => OK (transf id f)) (fun _  v => OK v) p.(prog_defs))
-     with (OK (map (transform_program_globdef_ident transf) p.(prog_defs))).
-  auto.
-  induction (prog_defs p); simpl.
-  auto.
-  destruct a as [id [f|v]]; rewrite <- IHl.
-    auto.
-    destruct v; auto.
-Qed.
-
-(** The following is a relational presentation of
-  [transform_partial_augment_preogram].  Given relations between function
-  definitions and between variable information, it defines a relation
-  between programs stating that the two programs have appropriately related
-  shapes (global names are preserved and possibly augmented, etc)
-  and that identically-named function definitions
-  and variable information are related. *)
-
-Section MATCH_PROGRAM.
-
-Variable A B V W: Type.
-Variable match_fundef: A -> B -> Prop.
-Variable match_varinfo: V -> W -> Prop.
-
-Inductive match_globdef: ident * globdef A V -> ident * globdef B W -> Prop :=
-  | match_glob_fun: forall id f1 f2,
-      match_fundef f1 f2 ->
-      match_globdef (id, Gfun f1) (id, Gfun f2)
-  | match_glob_var: forall id init ro vo info1 info2,
-      match_varinfo info1 info2 ->
-      match_globdef (id, Gvar (mkglobvar info1 init ro vo)) (id, Gvar (mkglobvar info2 init ro vo)).
-
-Definition match_program (new_globs : list (ident * globdef B W))
-                         (new_main : ident)
-                         (p1: program A V)  (p2: program B W) : Prop :=
-  (exists tglob, list_forall2 match_globdef p1.(prog_defs) tglob /\
-                 p2.(prog_defs) = tglob ++ new_globs) /\
-  p2.(prog_main) = new_main /\
-  p2.(prog_public) = p1.(prog_public).
-
-End MATCH_PROGRAM.
-
-Lemma transform_partial_augment_program_match:
-  forall (A B V W: Type)
-         (transf_fun: A -> res B)
-         (transf_var: V -> res W)
-         (p: program A V)
-         (new_globs : list (ident * globdef B W))
-         (new_main : ident)
-         (tp: program B W),
-  transform_partial_augment_program transf_fun transf_var new_globs new_main p = OK tp ->
-  match_program
-    (fun fd tfd => transf_fun fd = OK tfd)
-    (fun info tinfo => transf_var info = OK tinfo)
-    new_globs new_main
-    p tp.
+  forall (A B V: Type) (transf_fun: A -> B) (p: program A V),
+  transform_partial_program (fun f => OK (transf_fun f)) p = OK (transform_program transf_fun p).
 Proof.
-  unfold transform_partial_augment_program; intros. monadInv H.
-  red; simpl. split; auto. exists x; split; auto.
-  revert x EQ. generalize (prog_defs p). induction l; simpl; intros.
-  monadInv EQ. constructor.
-  destruct a as [id [f|v]].
-  (* function *)
-  destruct (transf_fun f) as [tf|?] eqn:?; monadInv EQ.
-  constructor; auto. constructor; auto.
-  (* variable *)
-  unfold transf_globvar in EQ.
-  destruct (transf_var (gvar_info v)) as [tinfo|?] eqn:?; simpl in EQ; monadInv EQ.
-  constructor; auto. destruct v; simpl in *. constructor; auto.
+  intros. unfold transform_partial_program, transform_partial_program2.
+  assert (EQ: forall l,
+              transf_globdefs (fun i f => OK (transf_fun f)) (fun i (v: V) => OK v) l =
+              OK (List.map (transform_program_globdef transf_fun) l)).
+  { induction l as [ | [id g] l]; simpl.
+  - auto.
+  - destruct g; simpl; rewrite IHl; simpl. auto. destruct v; auto. 
+  }
+  rewrite EQ; simpl. auto.
 Qed.
 
 (** * External functions *)
@@ -763,6 +414,9 @@ Inductive external_function : Type :=
   | EF_builtin (name: string) (sg: signature)
      (** A compiler built-in function.  Behaves like an external, but
          can be inlined by the compiler. *)
+  | EF_runtime (name: string) (sg: signature)
+     (** A function from the run-time library.  Behaves like an
+         external, but must not be redefined. *)
   | EF_vload (chunk: memory_chunk)
      (** A volatile read operation.  If the adress given as first argument
          points within a volatile global variable, generate an
@@ -808,6 +462,7 @@ Definition ef_sig (ef: external_function): signature :=
   match ef with
   | EF_external name sg => sg
   | EF_builtin name sg => sg
+  | EF_runtime name sg => sg
   | EF_vload chunk => mksignature (Tint :: nil) (Some (type_of_chunk chunk)) cc_default
   | EF_vstore chunk => mksignature (Tint :: type_of_chunk chunk :: nil) None cc_default
   | EF_malloc => mksignature (Tint :: nil) (Some Tint) cc_default
@@ -825,6 +480,7 @@ Definition ef_inline (ef: external_function) : bool :=
   match ef with
   | EF_external name sg => false
   | EF_builtin name sg => true
+  | EF_runtime name sg => false
   | EF_vload chunk => true
   | EF_vstore chunk => true
   | EF_malloc => false
diff --git a/common/Behaviors.v b/common/Behaviors.v
index 1a6b8bd6..ef99b205 100644
--- a/common/Behaviors.v
+++ b/common/Behaviors.v
@@ -281,31 +281,29 @@ End PROGRAM_BEHAVIORS.
 
 Section FORWARD_SIMULATIONS.
 
-Variable L1: semantics.
-Variable L2: semantics.
-Variable S: forward_simulation L1 L2.
+Context L1 L2 index order match_states (S: fsim_properties L1 L2 index order match_states).
 
 Lemma forward_simulation_state_behaves:
   forall i s1 s2 beh1,
-  S i s1 s2 -> state_behaves L1 s1 beh1 ->
+  match_states i s1 s2 -> state_behaves L1 s1 beh1 ->
   exists beh2, state_behaves L2 s2 beh2 /\ behavior_improves beh1 beh2.
 Proof.
   intros. inv H0.
-(* termination *)
+- (* termination *)
   exploit simulation_star; eauto. intros [i' [s2' [A B]]].
   exists (Terminates t r); split.
   econstructor; eauto. eapply fsim_match_final_states; eauto.
   apply behavior_improves_refl.
-(* silent divergence *)
+- (* silent divergence *)
   exploit simulation_star; eauto. intros [i' [s2' [A B]]].
   exists (Diverges t); split.
   econstructor; eauto. eapply simulation_forever_silent; eauto.
   apply behavior_improves_refl.
-(* reactive divergence *)
+- (* reactive divergence *)
   exists (Reacts T); split.
   econstructor. eapply simulation_forever_reactive; eauto.
   apply behavior_improves_refl.
-(* going wrong *)
+- (* going wrong *)
   exploit simulation_star; eauto. intros [i' [s2' [A B]]].
   destruct (state_behaves_exists L2 s2') as [beh' SB].
   exists (behavior_app t beh'); split.
@@ -315,16 +313,19 @@ Proof.
   simpl. decEq. traceEq.
 Qed.
 
+End FORWARD_SIMULATIONS.
+
 Theorem forward_simulation_behavior_improves:
+  forall L1 L2, forward_simulation L1 L2 ->
   forall beh1, program_behaves L1 beh1 ->
   exists beh2, program_behaves L2 beh2 /\ behavior_improves beh1 beh2.
 Proof.
-  intros. inv H.
-(* initial state defined *)
+  intros L1 L2 FS. destruct FS as [init order match_states S]. intros. inv H.
+- (* initial state defined *)
   exploit (fsim_match_initial_states S); eauto. intros [i [s' [INIT MATCH]]].
   exploit forward_simulation_state_behaves; eauto. intros [beh2 [A B]].
   exists beh2; split; auto. econstructor; eauto.
-(* initial state undefined *)
+- (* initial state undefined *)
   destruct (classic (exists s', initial_state L2 s')).
   destruct H as [s' INIT].
   destruct (state_behaves_exists L2 s') as [beh' SB].
@@ -336,6 +337,7 @@ Proof.
 Qed.
 
 Corollary forward_simulation_same_safe_behavior:
+  forall L1 L2, forward_simulation L1 L2 ->
   forall beh,
   program_behaves L1 beh -> not_wrong beh ->
   program_behaves L2 beh.
@@ -343,18 +345,14 @@ Proof.
   intros. exploit forward_simulation_behavior_improves; eauto.
   intros [beh' [A B]]. destruct B.
   congruence.
-  destruct H1 as [t [C D]]. subst. contradiction.
+  destruct H2 as [t [C D]]. subst. contradiction.
 Qed.
 
-End FORWARD_SIMULATIONS.
-
 (** * Backward simulations and program behaviors *)
 
 Section BACKWARD_SIMULATIONS.
 
-Variable L1: semantics.
-Variable L2: semantics.
-Variable S: backward_simulation L1 L2.
+Context L1 L2 index order match_states (S: bsim_properties L1 L2 index order match_states).
 
 Definition safe_along_behavior (s: state L1) (b: program_behavior) : Prop :=
   forall t1 s' b2, Star L1 s t1 s' -> b = behavior_app t1 b2 ->
@@ -402,8 +400,8 @@ Qed.
 
 Lemma backward_simulation_star:
   forall s2 t s2', Star L2 s2 t s2' ->
-  forall i s1 b, S i s1 s2 -> safe_along_behavior s1 (behavior_app t b) ->
-  exists i', exists s1', Star L1 s1 t s1' /\ S i' s1' s2'.
+  forall i s1 b, match_states i s1 s2 -> safe_along_behavior s1 (behavior_app t b) ->
+  exists i', exists s1', Star L1 s1 t s1' /\ match_states i' s1' s2'.
 Proof.
   induction 1; intros.
   exists i; exists s1; split; auto. apply star_refl.
@@ -418,12 +416,12 @@ Qed.
 
 Lemma backward_simulation_forever_silent:
   forall i s1 s2,
-  Forever_silent L2 s2 -> S i s1 s2 -> safe L1 s1 ->
+  Forever_silent L2 s2 -> match_states i s1 s2 -> safe L1 s1 ->
   Forever_silent L1 s1.
 Proof.
   assert (forall i s1 s2,
-         Forever_silent L2 s2 -> S i s1 s2 -> safe L1 s1 ->
-         forever_silent_N (step L1) (bsim_order S) (globalenv L1) i s1).
+         Forever_silent L2 s2 -> match_states i s1 s2 -> safe L1 s1 ->
+         forever_silent_N (step L1) order (globalenv L1) i s1).
     cofix COINDHYP; intros.
     inv H.  destruct (bsim_simulation S _ _ _ H2 _ H0 H1) as [i' [s2' [A B]]].
     destruct A as [C | [C D]].
@@ -431,29 +429,29 @@ Proof.
       eapply star_safe; eauto. apply plus_star; auto.
     eapply forever_silent_N_star; eauto. eapply COINDHYP; eauto.
       eapply star_safe; eauto.
-  intros. eapply forever_silent_N_forever; eauto. apply bsim_order_wf.
+  intros. eapply forever_silent_N_forever; eauto. eapply bsim_order_wf; eauto.
 Qed.
 
 Lemma backward_simulation_forever_reactive:
   forall i s1 s2 T,
-  Forever_reactive L2 s2 T -> S i s1 s2 -> safe_along_behavior s1 (Reacts T) ->
+  Forever_reactive L2 s2 T -> match_states i s1 s2 -> safe_along_behavior s1 (Reacts T) ->
   Forever_reactive L1 s1 T.
 Proof.
   cofix COINDHYP; intros. inv H.
-  destruct (backward_simulation_star H2 _ (Reacts T0) H0) as [i' [s1' [A B]]]; eauto.
+  destruct (backward_simulation_star H2 (Reacts T0) H0) as [i' [s1' [A B]]]; eauto.
   econstructor; eauto. eapply COINDHYP; eauto. eapply star_safe_along; eauto.
 Qed.
 
 Lemma backward_simulation_state_behaves:
   forall i s1 s2 beh2,
-  S i s1 s2 -> state_behaves L2 s2 beh2 ->
+  match_states i s1 s2 -> state_behaves L2 s2 beh2 ->
   exists beh1, state_behaves L1 s1 beh1 /\ behavior_improves beh1 beh2.
 Proof.
   intros. destruct (classic (safe_along_behavior s1 beh2)).
-(* 1. Safe along *)
+- (* 1. Safe along *)
   exists beh2; split; [idtac|apply behavior_improves_refl].
   inv H0.
-(* termination *)
++ (* termination *)
   assert (Terminates t r = behavior_app t (Terminates E0 r)).
     simpl. rewrite E0_right; auto.
   rewrite H0 in H1.
@@ -463,7 +461,7 @@ Proof.
     eapply safe_along_safe. eapply star_safe_along; eauto.
   intros [s1'' [C D]].
   econstructor. eapply star_trans; eauto. traceEq. auto.
-(* silent divergence *)
++ (* silent divergence *)
   assert (Diverges t = behavior_app t (Diverges E0)).
     simpl. rewrite E0_right; auto.
   rewrite H0 in H1.
@@ -471,9 +469,9 @@ Proof.
   intros [i' [s1' [A B]]].
   econstructor. eauto. eapply backward_simulation_forever_silent; eauto.
   eapply safe_along_safe. eapply star_safe_along; eauto.
-(* reactive divergence *)
++ (* reactive divergence *)
   econstructor. eapply backward_simulation_forever_reactive; eauto.
-(* goes wrong *)
++ (* goes wrong *)
   assert (Goes_wrong t = behavior_app t (Goes_wrong E0)).
     simpl. rewrite E0_right; auto.
   rewrite H0 in H1.
@@ -484,7 +482,7 @@ Proof.
   elim (H4 _ FIN).
   elim (H3 _ _ STEP2).
 
-(* 2. Not safe along *)
+- (* 2. Not safe along *)
   exploit not_safe_along_behavior; eauto.
   intros [t [s1' [PREF [STEPS [NOSTEP NOFIN]]]]].
   exists (Goes_wrong t); split.
@@ -492,23 +490,26 @@ Proof.
   right. exists t; auto.
 Qed.
 
+End BACKWARD_SIMULATIONS.
+
 Theorem backward_simulation_behavior_improves:
+  forall L1 L2, backward_simulation L1 L2 ->
   forall beh2, program_behaves L2 beh2 ->
   exists beh1, program_behaves L1 beh1 /\ behavior_improves beh1 beh2.
 Proof.
-  intros. inv H.
-(* L2's initial state is defined. *)
+  intros L1 L2 S beh2 H. destruct S as [index order match_states S]. inv H.
+- (* L2's initial state is defined. *)
   destruct (classic (exists s1, initial_state L1 s1)) as [[s1 INIT] | NOINIT].
-(* L1's initial state is defined too. *)
++ (* L1's initial state is defined too. *)
   exploit (bsim_match_initial_states S); eauto. intros [i [s1' [INIT1' MATCH]]].
   exploit backward_simulation_state_behaves; eauto. intros [beh1 [A B]].
   exists beh1; split; auto. econstructor; eauto.
-(* L1 has no initial state *)
++ (* L1 has no initial state *)
   exists (Goes_wrong E0); split.
   apply program_goes_initially_wrong.
   intros; red; intros. elim NOINIT; exists s0; auto.
   apply behavior_improves_bot.
-(* L2 has no initial state *)
+- (* L2 has no initial state *)
   exists (Goes_wrong E0); split.
   apply program_goes_initially_wrong.
   intros; red; intros.
@@ -518,17 +519,16 @@ Proof.
 Qed.
 
 Corollary backward_simulation_same_safe_behavior:
+  forall L1 L2, backward_simulation L1 L2 ->
   (forall beh, program_behaves L1 beh -> not_wrong beh) ->
   (forall beh, program_behaves L2 beh -> program_behaves L1 beh).
 Proof.
   intros. exploit backward_simulation_behavior_improves; eauto.
   intros [beh' [A B]]. destruct B.
   congruence.
-  destruct H1 as [t [C D]]. subst. elim (H (Goes_wrong t)). auto.
+  destruct H2 as [t [C D]]. subst. elim (H0 (Goes_wrong t)). auto.
 Qed.
 
-End BACKWARD_SIMULATIONS.
-
 (** * Program behaviors for the "atomic" construction *)
 
 Section ATOMIC.
@@ -635,7 +635,7 @@ Theorem atomic_behaviors:
   forall beh, program_behaves L beh <-> program_behaves (atomic L) beh.
 Proof.
   intros; split; intros.
-  (* L -> atomic L *)
+- (* L -> atomic L *)
   exploit forward_simulation_behavior_improves. eapply atomic_forward_simulation. eauto.
   intros [beh2 [A B]]. red in B. destruct B as [EQ | [t [C D]]].
   congruence.
@@ -646,23 +646,23 @@ Proof.
   intros; red; intros. simpl in H. destruct H. eelim H4; eauto.
   apply program_goes_initially_wrong.
   intros; red; intros. simpl in H; destruct H. eelim H1; eauto.
-  (* atomic L -> L *)
+- (* atomic L -> L *)
   inv H.
-  (* initial state defined *)
++ (* initial state defined *)
   destruct s as [t s]. simpl in H0. destruct H0; subst t.
   apply program_runs with s; auto.
   inv H1.
-  (* termination *)
+* (* termination *)
   destruct s' as [t' s']. simpl in H2; destruct H2; subst t'.
   econstructor. eapply atomic_star_star; eauto. auto.
-  (* silent divergence *)
+* (* silent divergence *)
   destruct s' as [t' s'].
   assert (t' = E0). inv H2. inv H1; auto. subst t'.
   econstructor. eapply atomic_star_star; eauto.
   change s' with (snd (E0,s')). apply atomic_forever_silent_forever_silent. auto.
-  (* reactive divergence *)
+* (* reactive divergence *)
   econstructor. apply atomic_forever_reactive_forever_reactive. auto.
-  (* going wrong *)
+* (* going wrong *)
   destruct s' as [t' s'].
   assert (t' = E0).
     destruct t'; auto. eelim H2. simpl. apply atomic_step_continue.
@@ -672,7 +672,7 @@ Proof.
   elim (H2 E0 (E0,s'0)). constructor; auto.
   elim (H2 (e::nil) (t0,s'0)). constructor; auto.
   intros; red; intros. elim (H3 r). simpl; auto.
-  (* initial state undefined *)
++ (* initial state undefined *)
   apply program_goes_initially_wrong.
   intros; red; intros. elim (H0 (E0,s)); simpl; auto.
 Qed.
diff --git a/common/Events.v b/common/Events.v
index 7029a984..040029fb 100644
--- a/common/Events.v
+++ b/common/Events.v
@@ -619,9 +619,7 @@ Record extcall_properties (sem: extcall_sem) (sg: signature) : Prop :=
 (** The semantics is invariant under change of global environment that preserves symbols. *)
   ec_symbols_preserved:
     forall ge1 ge2 vargs m1 t vres m2,
-    (forall id, Senv.find_symbol ge2 id = Senv.find_symbol ge1 id) ->
-    (forall id, Senv.public_symbol ge2 id = Senv.public_symbol ge1 id) ->
-    (forall b, Senv.block_is_volatile ge2 b = Senv.block_is_volatile ge1 b) ->
+    Senv.equiv ge1 ge2 ->
     sem ge1 vargs m1 t vres m2 ->
     sem ge2 vargs m1 t vres m2;
 
@@ -704,17 +702,15 @@ Inductive volatile_load_sem (chunk: memory_chunk) (ge: Senv.t):
 
 Lemma volatile_load_preserved:
   forall ge1 ge2 chunk m b ofs t v,
-  (forall id, Senv.find_symbol ge2 id = Senv.find_symbol ge1 id) ->
-  (forall id, Senv.public_symbol ge2 id = Senv.public_symbol ge1 id) ->
-  (forall b, Senv.block_is_volatile ge2 b = Senv.block_is_volatile ge1 b) ->
+  Senv.equiv ge1 ge2 ->
   volatile_load ge1 chunk m b ofs t v ->
   volatile_load ge2 chunk m b ofs t v.
 Proof.
-  intros. inv H2; constructor; auto.
-  rewrite H1; auto.
-  rewrite H; auto.
+  intros. destruct H as (A & B & C). inv H0; constructor; auto.
+  rewrite C; auto.
+  rewrite A; auto.
   eapply eventval_match_preserved; eauto.
-  rewrite H1; auto.
+  rewrite C; auto.
 Qed.
 
 Lemma volatile_load_extends:
@@ -773,7 +769,7 @@ Proof.
 - unfold proj_sig_res; simpl. inv H. inv H0. apply Val.load_result_type.
   eapply Mem.load_type; eauto.
 (* symbols *)
-- inv H2. constructor. eapply volatile_load_preserved; eauto.
+- inv H0. constructor. eapply volatile_load_preserved; eauto.
 (* valid blocks *)
 - inv H; auto.
 (* max perms *)
@@ -817,17 +813,15 @@ Inductive volatile_store_sem (chunk: memory_chunk) (ge: Senv.t):
 
 Lemma volatile_store_preserved:
   forall ge1 ge2 chunk m1 b ofs v t m2,
-  (forall id, Senv.find_symbol ge2 id = Senv.find_symbol ge1 id) ->
-  (forall id, Senv.public_symbol ge2 id = Senv.public_symbol ge1 id) ->
-  (forall b, Senv.block_is_volatile ge2 b = Senv.block_is_volatile ge1 b) ->
+  Senv.equiv ge1 ge2 ->
   volatile_store ge1 chunk m1 b ofs v t m2 ->
   volatile_store ge2 chunk m1 b ofs v t m2.
 Proof.
-  intros. inv H2; constructor; auto.
-  rewrite H1; auto.
-  rewrite H; auto.
+  intros. destruct H as (A & B & C). inv H0; constructor; auto.
+  rewrite C; auto.
+  rewrite A; auto.
   eapply eventval_match_preserved; eauto.
-  rewrite H1; auto.
+  rewrite C; auto.
 Qed.
 
 Lemma volatile_store_readonly:
@@ -925,7 +919,7 @@ Proof.
 (* well typed *)
 - unfold proj_sig_res; simpl. inv H; constructor.
 (* symbols preserved *)
-- inv H2. constructor. eapply volatile_store_preserved; eauto.
+- inv H0. constructor. eapply volatile_store_preserved; eauto.
 (* valid block *)
 - inv H. inv H1. auto. eauto with mem.
 (* perms *)
@@ -972,19 +966,18 @@ Proof.
     Mem.store Mint32 m' b (-4) (Vint n) = Some m'' ->
     Mem.unchanged_on P m m'').
   {
-    intros; constructor; intros.
-  - split; intros; eauto with mem.
-  - assert (b0 <> b) by (eapply Mem.valid_not_valid_diff; eauto with mem).
-    erewrite Mem.store_mem_contents; eauto. rewrite Maps.PMap.gso by auto.
-    Local Transparent Mem.alloc. unfold Mem.alloc in H. injection H; intros A B.
-    rewrite <- B; simpl. rewrite A. rewrite Maps.PMap.gso by auto. auto.
+    intros.
+    apply Mem.unchanged_on_implies with (fun b1 ofs1 => b1 <> b).
+    apply Mem.unchanged_on_trans with m'. 
+    eapply Mem.alloc_unchanged_on; eauto.
+    eapply Mem.store_unchanged_on; eauto.
+    intros. eapply Mem.valid_not_valid_diff; eauto with mem.
   }
-
   constructor; intros.
 (* well typed *)
 - inv H. unfold proj_sig_res; simpl. auto.
 (* symbols preserved *)
-- inv H2; econstructor; eauto.
+- inv H0; econstructor; eauto.
 (* valid block *)
 - inv H. eauto with mem.
 (* perms *)
@@ -1045,7 +1038,7 @@ Proof.
 (* well typed *)
 - inv H. unfold proj_sig_res. simpl. auto.
 (* symbols preserved *)
-- inv H2; econstructor; eauto.
+- inv H0; econstructor; eauto.
 (* valid block *)
 - inv H. eauto with mem.
 (* perms *)
@@ -1124,7 +1117,7 @@ Proof.
 - (* return type *)
   intros. inv H. constructor.
 - (* change of globalenv *)
-  intros. inv H2. econstructor; eauto.
+  intros. inv H0. econstructor; eauto.
 - (* valid blocks *)
   intros. inv H. eauto with mem.
 - (* perms *)
@@ -1235,7 +1228,7 @@ Proof.
 (* well typed *)
 - inv H. simpl. auto.
 (* symbols *)
-- inv H2. econstructor; eauto.
+- destruct H as (A & B & C). inv H0. econstructor; eauto.
   eapply eventval_list_match_preserved; eauto.
 (* valid blocks *)
 - inv H; auto.
@@ -1280,7 +1273,7 @@ Proof.
 (* well typed *)
 - inv H. unfold proj_sig_res; simpl. eapply eventval_match_type; eauto.
 (* symbols *)
-- inv H2. econstructor; eauto.
+- destruct H as (A & B & C). inv H0. econstructor; eauto.
   eapply eventval_match_preserved; eauto.
 (* valid blocks *)
 - inv H; auto.
@@ -1324,7 +1317,7 @@ Proof.
 (* well typed *)
 - inv H. simpl. auto.
 (* symbols *)
-- inv H2. econstructor; eauto.
+- inv H0. econstructor; eauto.
 (* valid blocks *)
 - inv H; auto.
 (* perms *)
@@ -1351,8 +1344,9 @@ Qed.
 
 (** ** Semantics of external functions. *)
 
-(** For functions defined outside the program ([EF_external] and [EF_builtin]),
-  we do not define their semantics, but only assume that it satisfies
+(** For functions defined outside the program ([EF_external],
+  [EF_builtin] and [EF_runtime]), we do not define their
+  semantics, but only assume that it satisfies
   [extcall_properties]. *)
 
 Parameter external_functions_sem: String.string -> signature -> extcall_sem.
@@ -1384,6 +1378,7 @@ Definition external_call (ef: external_function): extcall_sem :=
   match ef with
   | EF_external name sg  => external_functions_sem name sg
   | EF_builtin name sg   => external_functions_sem name sg
+  | EF_runtime name sg   => external_functions_sem name sg
   | EF_vload chunk       => volatile_load_sem chunk
   | EF_vstore chunk      => volatile_store_sem chunk
   | EF_malloc            => extcall_malloc_sem
@@ -1402,6 +1397,7 @@ Proof.
   intros. unfold external_call, ef_sig; destruct ef.
   apply external_functions_properties.
   apply external_functions_properties.
+  apply external_functions_properties.
   apply volatile_load_ok.
   apply volatile_store_ok.
   apply extcall_malloc_ok.
@@ -1414,7 +1410,7 @@ Proof.
 Qed.
 
 Definition external_call_well_typed ef := ec_well_typed (external_call_spec ef).
-Definition external_call_symbols_preserved_gen ef := ec_symbols_preserved (external_call_spec ef).
+Definition external_call_symbols_preserved ef := ec_symbols_preserved (external_call_spec ef).
 Definition external_call_valid_block ef := ec_valid_block (external_call_spec ef).
 Definition external_call_max_perm ef := ec_max_perm (external_call_spec ef).
 Definition external_call_readonly ef := ec_readonly (external_call_spec ef).
@@ -1424,20 +1420,6 @@ Definition external_call_trace_length ef := ec_trace_length (external_call_spec
 Definition external_call_receptive ef := ec_receptive (external_call_spec ef).
 Definition external_call_determ ef := ec_determ (external_call_spec ef).
 
-(** Special cases of [external_call_symbols_preserved_gen]. *)
-
-Lemma external_call_symbols_preserved:
-  forall ef F1 F2 V (ge1: Genv.t F1 V) (ge2: Genv.t F2 V) vargs m1 t vres m2,
-  external_call ef ge1 vargs m1 t vres m2 ->
-  (forall id, Genv.find_symbol ge2 id = Genv.find_symbol ge1 id) ->
-  (forall id, Genv.public_symbol ge2 id = Genv.public_symbol ge1 id) ->
-  (forall b, Genv.find_var_info ge2 b = Genv.find_var_info ge1 b) ->
-  external_call ef ge2 vargs m1 t vres m2.
-Proof.
-  intros. apply external_call_symbols_preserved_gen with (ge1 := ge1); auto.
-  intros. simpl. unfold Genv.block_is_volatile. rewrite H2. auto.
-Qed.
-
 (** Corollary of [external_call_valid_block]. *)
 
 Lemma external_call_nextblock:
@@ -1596,9 +1578,7 @@ Qed.
 Lemma external_call_symbols_preserved':
   forall ef F1 F2 V (ge1: Genv.t F1 V) (ge2: Genv.t F2 V) vargs m1 t vres m2,
   external_call' ef ge1 vargs m1 t vres m2 ->
-  (forall id, Genv.find_symbol ge2 id = Genv.find_symbol ge1 id) ->
-  (forall id, Genv.public_symbol ge2 id = Genv.public_symbol ge1 id) ->
-  (forall b, Genv.find_var_info ge2 b = Genv.find_var_info ge1 b) ->
+  Senv.equiv ge1 ge2 ->
   external_call' ef ge2 vargs m1 t vres m2.
 Proof.
   intros. inv H. exists v; auto. eapply external_call_symbols_preserved; eauto.
diff --git a/common/Globalenvs.v b/common/Globalenvs.v
index 5f78ea6b..a8d0512c 100644
--- a/common/Globalenvs.v
+++ b/common/Globalenvs.v
@@ -3,7 +3,6 @@
 (*              The Compcert verified compiler                         *)
 (*                                                                     *)
 (*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
-(*  with contributions from Andrew Tolmach (Portland State University) *)
 (*                                                                     *)
 (*  Copyright Institut National de Recherche en Informatique et en     *)
 (*  Automatique.  All rights reserved.  This file is distributed       *)
@@ -36,14 +35,8 @@
 
 Require Recdef.
 Require Import Zwf.
-Require Import Coqlib.
-Require Import Errors.
-Require Import Maps.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
+Require Import Axioms Coqlib Errors Maps AST Linking.
+Require Import Integers Floats Values Memory.
 
 Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope.
 Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope.
@@ -113,6 +106,11 @@ Proof.
   intros. unfold symbol_address. destruct (find_symbol ge id); auto.
 Qed.
 
+Definition equiv (se1 se2: t) : Prop :=
+     (forall id, find_symbol se2 id = find_symbol se1 id)
+  /\ (forall id, public_symbol se2 id = public_symbol se1 id)
+  /\ (forall b, block_is_volatile se2 b = block_is_volatile se1 b).
+
 End Senv.
 
 Module Genv.
@@ -129,14 +127,10 @@ Variable V: Type.  (**r The type of information attached to variables *)
 Record t: Type := mkgenv {
   genv_public: list ident;              (**r which symbol names are public *)
   genv_symb: PTree.t block;             (**r mapping symbol -> block *)
-  genv_funs: PTree.t F;                 (**r mapping function pointer -> definition *)
-  genv_vars: PTree.t (globvar V);       (**r mapping variable pointer -> info *)
+  genv_defs: PTree.t (globdef F V);     (**r mapping block -> definition *)
   genv_next: block;                     (**r next symbol pointer *)
   genv_symb_range: forall id b, PTree.get id genv_symb = Some b -> Plt b genv_next;
-  genv_funs_range: forall b f, PTree.get b genv_funs = Some f -> Plt b genv_next;
-  genv_vars_range: forall b v, PTree.get b genv_vars = Some v -> Plt b genv_next;
-  genv_funs_vars: forall b1 b2 f v,
-    PTree.get b1 genv_funs = Some f -> PTree.get b2 genv_vars = Some v -> b1 <> b2;
+  genv_defs_range: forall b g, PTree.get b genv_defs = Some g -> Plt b genv_next;
   genv_vars_inj: forall id1 id2 b,
     PTree.get id1 genv_symb = Some b -> PTree.get id2 genv_symb = Some b -> id1 = id2
 }.
@@ -166,11 +160,16 @@ Definition public_symbol (ge: t) (id: ident) : bool :=
   | Some _ => In_dec ident_eq id ge.(genv_public)
   end.
 
+(** [find_def ge b] returns the global definition associated with the given address. *)
+
+Definition find_def (ge: t) (b: block) : option (globdef F V) :=
+  PTree.get b ge.(genv_defs).
+
 (** [find_funct_ptr ge b] returns the function description associated with
     the given address. *)
 
 Definition find_funct_ptr (ge: t) (b: block) : option F :=
-  PTree.get b ge.(genv_funs).
+  match find_def ge b with Some (Gfun f) => Some f | _ => None end.
 
 (** [find_funct] is similar to [find_funct_ptr], but the function address
     is given as a value, which must be a pointer with offset 0. *)
@@ -192,7 +191,7 @@ Definition invert_symbol (ge: t) (b: block) : option ident :=
    at address [b]. *)
 
 Definition find_var_info (ge: t) (b: block) : option (globvar V) :=
-  PTree.get b ge.(genv_vars).
+  match find_def ge b with Some (Gvar v) => Some v | _ => None end.
 
 (** [block_is_volatile ge b] returns [true] if [b] points to a global variable
   of volatile type, [false] otherwise. *)
@@ -209,16 +208,9 @@ Program Definition add_global (ge: t) (idg: ident * globdef F V) : t :=
   @mkgenv
     ge.(genv_public)
     (PTree.set idg#1 ge.(genv_next) ge.(genv_symb))
-    (match idg#2 with
-     | Gfun f => PTree.set ge.(genv_next) f ge.(genv_funs)
-     | Gvar v => ge.(genv_funs)
-     end)
-    (match idg#2 with
-     | Gfun f => ge.(genv_vars)
-     | Gvar v => PTree.set ge.(genv_next) v ge.(genv_vars)
-     end)
+    (PTree.set ge.(genv_next) idg#2 ge.(genv_defs))
     (Psucc ge.(genv_next))
-    _ _ _ _ _.
+    _ _ _.
 Next Obligation.
   destruct ge; simpl in *.
   rewrite PTree.gsspec in H. destruct (peq id i). inv H. apply Plt_succ.
@@ -226,34 +218,12 @@ Next Obligation.
 Qed.
 Next Obligation.
   destruct ge; simpl in *.
-  destruct g.
-  rewrite PTree.gsspec in H.
-  destruct (peq b genv_next0). inv H. apply Plt_succ.
-  apply Plt_trans_succ; eauto.
+  rewrite PTree.gsspec in H. destruct (peq b genv_next0).
+  inv H. apply Plt_succ.
   apply Plt_trans_succ; eauto.
 Qed.
 Next Obligation.
   destruct ge; simpl in *.
-  destruct g.
-  apply Plt_trans_succ; eauto.
-  rewrite PTree.gsspec in H.
-  destruct (peq b genv_next0). inv H. apply Plt_succ.
-  apply Plt_trans_succ; eauto.
-Qed.
-Next Obligation.
-  destruct ge; simpl in *.
-  destruct g.
-  rewrite PTree.gsspec in H.
-  destruct (peq b1 genv_next0). inv H.
-  apply sym_not_equal; apply Plt_ne; eauto.
-  eauto.
-  rewrite PTree.gsspec in H0.
-  destruct (peq b2 genv_next0). inv H0.
-  apply Plt_ne; eauto.
-  eauto.
-Qed.
-Next Obligation.
-  destruct ge; simpl in *.
   rewrite PTree.gsspec in H. rewrite PTree.gsspec in H0.
   destruct (peq id1 i); destruct (peq id2 i).
   congruence.
@@ -269,17 +239,11 @@ Lemma add_globals_app:
   forall gl2 gl1 ge,
   add_globals ge (gl1 ++ gl2) = add_globals (add_globals ge gl1) gl2.
 Proof.
-  induction gl1; simpl; intros. auto. rewrite IHgl1; auto.
+  intros. apply fold_left_app. 
 Qed.
 
 Program Definition empty_genv (pub: list ident): t :=
-  @mkgenv pub (PTree.empty _) (PTree.empty _) (PTree.empty _) 1%positive _ _ _ _ _.
-Next Obligation.
-  rewrite PTree.gempty in H. discriminate.
-Qed.
-Next Obligation.
-  rewrite PTree.gempty in H. discriminate.
-Qed.
+  @mkgenv pub (PTree.empty _) (PTree.empty _) 1%positive _ _ _.
 Next Obligation.
   rewrite PTree.gempty in H. discriminate.
 Qed.
@@ -400,84 +364,62 @@ Proof.
   intros; simpl. apply dec_eq_true.
 Qed.
 
-Theorem find_symbol_exists:
-  forall p id g,
-  In (id, g) (prog_defs p) ->
-  exists b, find_symbol (globalenv p) id = Some b.
+Theorem find_funct_ptr_iff:
+  forall ge b f, find_funct_ptr ge b = Some f <-> find_def ge b = Some (Gfun f).
 Proof.
-  intros. unfold globalenv. eapply add_globals_ensures; eauto.
-(* preserves *)
-  intros. unfold find_symbol; simpl. rewrite PTree.gsspec. destruct (peq id id0).
-  econstructor; eauto.
-  auto.
-(* ensures *)
-  intros. unfold find_symbol; simpl. rewrite PTree.gss. econstructor; eauto.
+  intros. unfold find_funct_ptr. destruct (find_def ge b) as [[f1|v1]|]; intuition congruence.
 Qed.
 
-Theorem find_funct_ptr_exists_2:
-  forall p gl1 id f gl2,
-  prog_defs p = gl1 ++ (id, Gfun f) :: gl2 -> ~In id (map fst gl2) ->
-  exists b,
-     find_symbol (globalenv p) id = Some b
-  /\ find_funct_ptr (globalenv p) b = Some f.
+Theorem find_var_info_iff:
+  forall ge b v, find_var_info ge b = Some v <-> find_def ge b = Some (Gvar v).
 Proof.
-  intros; unfold globalenv. rewrite H. eapply add_globals_unique_ensures; eauto.
-(* preserves *)
-  intros. unfold find_symbol, find_funct_ptr in *; simpl.
-  destruct H1 as [b [A B]]. exists b; split.
-  rewrite PTree.gso; auto.
-  destruct g1 as [f1 | v1]. rewrite PTree.gso. auto.
-  apply Plt_ne. eapply genv_funs_range; eauto.
-  auto.
-(* ensures *)
-  intros. unfold find_symbol, find_funct_ptr in *; simpl.
-  exists (genv_next ge); split. apply PTree.gss. apply PTree.gss.
+  intros. unfold find_var_info. destruct (find_def ge b) as [[f1|v1]|]; intuition congruence.
 Qed.
 
-Corollary find_funct_ptr_exists:
-  forall p id f,
-  list_norepet (prog_defs_names p) ->
-  In (id, Gfun f) (prog_defs p) ->
-  exists b,
-     find_symbol (globalenv p) id = Some b
-  /\ find_funct_ptr (globalenv p) b = Some f.
+Theorem find_def_symbol:
+  forall p id g,
+  (prog_defmap p)!id = Some g <-> exists b, find_symbol (globalenv p) id = Some b /\ find_def (globalenv p) b = Some g.
 Proof.
-  intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y).
-  eapply find_funct_ptr_exists_2; eauto.
+  intros.
+  set (P := fun m ge => m!id = Some g <-> exists b, find_symbol ge id = Some b /\ find_def ge b = Some g).
+  assert (REC: forall l m ge,
+            P m ge ->
+            P (fold_left (fun m idg => PTree.set idg#1 idg#2 m) l m)
+              (add_globals ge l)).
+  { induction l as [ | [id1 g1] l]; intros; simpl.
+  - auto.
+  - apply IHl. unfold P, add_global, find_symbol, find_def; simpl.
+    rewrite ! PTree.gsspec. destruct (peq id id1). 
+    + subst id1. split; intros.
+      inv H0. exists (genv_next ge); split; auto. apply PTree.gss.
+      destruct H0 as (b & A & B). inv A. rewrite PTree.gss in B. auto.
+    + red in H; rewrite H. split.
+      intros (b & A & B). exists b; split; auto. rewrite PTree.gso; auto. 
+      apply Plt_ne. eapply genv_symb_range; eauto. 
+      intros (b & A & B). rewrite PTree.gso in B. exists b; auto. 
+      apply Plt_ne. eapply genv_symb_range; eauto. 
+  }
+  apply REC. unfold P, find_symbol, find_def; simpl. 
+  rewrite ! PTree.gempty. split.
+  congruence.
+  intros (b & A & B); congruence.
 Qed.
 
-Theorem find_var_exists_2:
-  forall p gl1 id v gl2,
-  prog_defs p = gl1 ++ (id, Gvar v) :: gl2 -> ~In id (map fst gl2) ->
-  exists b,
-     find_symbol (globalenv p) id = Some b
-  /\ find_var_info (globalenv p) b = Some v.
+Theorem find_symbol_exists:
+  forall p id g,
+  In (id, g) (prog_defs p) ->
+  exists b, find_symbol (globalenv p) id = Some b.
 Proof.
-  intros; unfold globalenv. rewrite H. eapply add_globals_unique_ensures; eauto.
+  intros. unfold globalenv. eapply add_globals_ensures; eauto.
 (* preserves *)
-  intros. unfold find_symbol, find_var_info in *; simpl.
-  destruct H1 as [b [A B]]. exists b; split.
-  rewrite PTree.gso; auto.
-  destruct g1 as [f1 | v1]. auto. rewrite PTree.gso. auto.
-  apply Plt_ne. eapply genv_vars_range; eauto.
+  intros. unfold find_symbol; simpl. rewrite PTree.gsspec. destruct (peq id id0).
+  econstructor; eauto.
+  auto.
 (* ensures *)
-  intros. unfold find_symbol, find_var_info in *; simpl.
-  exists (genv_next ge); split. apply PTree.gss. apply PTree.gss.
-Qed.
-
-Corollary find_var_exists:
-  forall p id v,
-  list_norepet (prog_defs_names p) ->
-  In (id, Gvar v) (prog_defs p) ->
-  exists b,
-     find_symbol (globalenv p) id = Some b
-  /\ find_var_info (globalenv p) b = Some v.
-Proof.
-  intros. exploit in_norepet_unique; eauto. intros (gl1 & gl2 & X & Y).
-  eapply find_var_exists_2; eauto.
+  intros. unfold find_symbol; simpl. rewrite PTree.gss. econstructor; eauto.
 Qed.
 
-Lemma find_symbol_inversion : forall p x b,
+Theorem find_symbol_inversion : forall p x b,
   find_symbol (globalenv p) x = Some b ->
   In x (prog_defs_names p).
 Proof.
@@ -490,22 +432,30 @@ Proof.
   unfold find_symbol; simpl; intros. rewrite PTree.gempty in H. discriminate.
 Qed.
 
-Theorem find_funct_ptr_inversion:
-  forall p b f,
-  find_funct_ptr (globalenv p) b = Some f ->
-  exists id, In (id, Gfun f) (prog_defs p).
+Theorem find_def_inversion:
+  forall p b g,
+  find_def (globalenv p) b = Some g ->
+  exists id, In (id, g) (prog_defs p).
 Proof.
-  intros until f. unfold globalenv. apply add_globals_preserves.
+  intros until g. unfold globalenv. apply add_globals_preserves.
 (* preserves *)
-  unfold find_funct_ptr; simpl; intros. destruct g; auto.
+  unfold find_def; simpl; intros.
   rewrite PTree.gsspec in H1. destruct (peq b (genv_next ge)).
   inv H1. exists id; auto.
   auto.
 (* base *)
-  unfold find_funct_ptr; simpl; intros. rewrite PTree.gempty in H. discriminate.
+  unfold find_def; simpl; intros. rewrite PTree.gempty in H. discriminate.
 Qed.
 
-Theorem find_funct_inversion:
+Corollary find_funct_ptr_inversion:
+  forall p b f,
+  find_funct_ptr (globalenv p) b = Some f ->
+  exists id, In (id, Gfun f) (prog_defs p).
+Proof.
+  intros. apply find_def_inversion with b. apply find_funct_ptr_iff; auto.
+Qed.
+
+Corollary find_funct_inversion:
   forall p v f,
   find_funct (globalenv p) v = Some f ->
   exists id, In (id, Gfun f) (prog_defs p).
@@ -533,25 +483,6 @@ Proof.
   intros. exploit find_funct_inversion; eauto. intros [id IN]. eauto.
 Qed.
 
-Theorem find_funct_ptr_symbol_inversion:
-  forall p id b f,
-  find_symbol (globalenv p) id = Some b ->
-  find_funct_ptr (globalenv p) b = Some f ->
-  In (id, Gfun f) p.(prog_defs).
-Proof.
-  intros until f. unfold globalenv, find_symbol, find_funct_ptr. apply add_globals_preserves.
-(* preserves *)
-  intros. simpl in *. rewrite PTree.gsspec in H1. destruct (peq id id0).
-  inv H1. destruct g as [f1|v1]. rewrite PTree.gss in H2. inv H2. auto.
-  eelim Plt_strict. eapply genv_funs_range; eauto.
-  destruct g as [f1|v1]. rewrite PTree.gso in H2. auto.
-  apply Plt_ne. eapply genv_symb_range; eauto.
-  auto.
-(* initial *)
-  intros. simpl in *. rewrite PTree.gempty in H. discriminate.
-Qed.
-
-
 Theorem global_addresses_distinct:
   forall ge id1 id2 b1 b2,
   id1 <> id2 ->
@@ -626,7 +557,7 @@ Theorem block_is_volatile_below:
   forall ge b, block_is_volatile ge b = true ->  Plt b ge.(genv_next).
 Proof.
   unfold block_is_volatile; intros. destruct (find_var_info ge b) as [gv|] eqn:FV.
-  eapply genv_vars_range; eauto.
+  rewrite find_var_info_iff in FV. eapply genv_defs_range; eauto.
   discriminate.
 Qed.
 
@@ -652,24 +583,6 @@ Section INITMEM.
 
 Variable ge: t.
 
-Definition init_data_size (i: init_data) : Z :=
-  match i with
-  | Init_int8 _ => 1
-  | Init_int16 _ => 2
-  | Init_int32 _ => 4
-  | Init_int64 _ => 8
-  | Init_float32 _ => 4
-  | Init_float64 _ => 8
-  | Init_addrof _ _ => 4
-  | Init_space n => Zmax n 0
-  end.
-
-Lemma init_data_size_pos:
-  forall i, init_data_size i >= 0.
-Proof.
-  destruct i; simpl; try omega. generalize (Zle_max_r z 0). omega.
-Qed.
-
 Definition store_init_data (m: mem) (b: block) (p: Z) (id: init_data) : option mem :=
   match id with
   | Init_int8 n => Mem.store Mint8unsigned m b p (Vint n)
@@ -697,12 +610,6 @@ Fixpoint store_init_data_list (m: mem) (b: block) (p: Z) (idl: list init_data)
       end
   end.
 
-Fixpoint init_data_list_size (il: list init_data) {struct il} : Z :=
-  match il with
-  | nil => 0
-  | i :: il' => init_data_size i + init_data_list_size il'
-  end.
-
 Definition perm_globvar (gv: globvar V) : permission :=
   if gv.(gvar_volatile) then Nonempty
   else if gv.(gvar_readonly) then Readable
@@ -818,22 +725,32 @@ Proof.
   congruence.
 Qed.
 
-Remark store_init_data_list_perm:
-  forall k prm b' q idl b m p m',
-  store_init_data_list m b p idl = Some m' ->
+Remark store_init_data_perm:
+  forall k prm b' q i b m p m',
+  store_init_data m b p i = Some m' ->
   (Mem.perm m b' q k prm <-> Mem.perm m' b' q k prm).
 Proof.
-  induction idl; simpl; intros until m'.
-  intros. inv H. tauto.
-  caseEq (store_init_data m b p a); try congruence. intros.
-  rewrite <- (IHidl _ _ _ _ H0).
+  intros. 
   assert (forall chunk v,
-          Mem.store chunk m b p v = Some m0 ->
-          (Mem.perm m b' q k prm <-> Mem.perm m0 b' q k prm)).
+          Mem.store chunk m b p v = Some m' ->
+          (Mem.perm m b' q k prm <-> Mem.perm m' b' q k prm)).
     intros; split; eauto with mem.
-  destruct a; simpl in H; eauto.
+  destruct i; simpl in H; eauto. 
   inv H; tauto.
-  destruct (find_symbol ge i). eauto. discriminate.
+  destruct (find_symbol ge i); try discriminate. eauto.
+Qed.
+
+Remark store_init_data_list_perm:
+  forall k prm b' q idl b m p m',
+  store_init_data_list m b p idl = Some m' ->
+  (Mem.perm m b' q k prm <-> Mem.perm m' b' q k prm).
+Proof.
+  induction idl as [ | i1 idl]; simpl; intros.
+- inv H; tauto.
+- destruct (store_init_data m b p i1) as [m1|] eqn:S1; try discriminate.
+  transitivity (Mem.perm m1 b' q k prm). 
+  eapply store_init_data_perm; eauto.
+  eapply IHidl; eauto.
 Qed.
 
 Remark alloc_global_perm:
@@ -883,36 +800,146 @@ Qed.
 
 (** Data preservation properties *)
 
-Remark store_zeros_load_outside:
-  forall m b p n m',
+Remark store_zeros_unchanged:
+  forall (P: block -> Z -> Prop) m b p n m',
   store_zeros m b p n = Some m' ->
-  forall chunk b' p',
-  b' <> b \/ p' + size_chunk chunk <= p \/ p + n <= p' ->
-  Mem.load chunk m' b' p' = Mem.load chunk m b' p'.
+  (forall i, p <= i < p + n -> ~ P b i) ->
+  Mem.unchanged_on P m m'.
 Proof.
   intros until n. functional induction (store_zeros m b p n); intros.
-  inv H; auto.
-  transitivity (Mem.load chunk m' b' p').
-  apply IHo. auto. intuition omega.
-  eapply Mem.load_store_other; eauto. simpl. intuition omega.
-  discriminate.
+- inv H; apply Mem.unchanged_on_refl.
+- apply Mem.unchanged_on_trans with m'.
++ eapply Mem.store_unchanged_on; eauto. simpl. intros. apply H0. omega. 
++ apply IHo; auto. intros; apply H0; omega. 
+- discriminate.
+Qed.
+
+Remark store_init_data_unchanged:
+  forall (P: block -> Z -> Prop) b i m p m',
+  store_init_data m b p i = Some m' ->
+  (forall ofs, p <= ofs < p + init_data_size i -> ~ P b ofs) ->
+  Mem.unchanged_on P m m'.
+Proof.
+  intros. destruct i; simpl in *;
+  try (eapply Mem.store_unchanged_on; eauto; fail).
+  inv H; apply Mem.unchanged_on_refl.
+  destruct (find_symbol ge i); try congruence.
+  eapply Mem.store_unchanged_on; eauto. 
+Qed.
+
+Remark store_init_data_list_unchanged:
+  forall (P: block -> Z -> Prop) b il m p m',
+  store_init_data_list m b p il = Some m' ->
+  (forall ofs, p <= ofs -> ~ P b ofs) ->
+  Mem.unchanged_on P m m'.
+Proof.
+  induction il; simpl; intros.
+- inv H. apply Mem.unchanged_on_refl.
+- destruct (store_init_data m b p a) as [m1|] eqn:?; try congruence.
+  apply Mem.unchanged_on_trans with m1.
+  eapply store_init_data_unchanged; eauto. intros; apply H0; tauto. 
+  eapply IHil; eauto. intros; apply H0. generalize (init_data_size_pos a); omega.
 Qed.
 
-Remark store_zeros_loadbytes_outside:
+(** Properties related to [loadbytes] *)
+
+Definition readbytes_as_zero (m: mem) (b: block) (ofs len: Z) : Prop :=
+  forall p n,
+  ofs <= p -> p + Z.of_nat n <= ofs + len ->
+  Mem.loadbytes m b p (Z.of_nat n) = Some (list_repeat n (Byte Byte.zero)).
+
+Lemma store_zeros_loadbytes:
   forall m b p n m',
   store_zeros m b p n = Some m' ->
-  forall b' p' n',
-  b' <> b \/ p' + n' <= p \/ p + n <= p' ->
-  Mem.loadbytes m' b' p' n' = Mem.loadbytes m b' p' n'.
+  readbytes_as_zero m' b p n.
 Proof.
-  intros until n. functional induction (store_zeros m b p n); intros.
-  inv H; auto.
-  transitivity (Mem.loadbytes m' b' p' n').
-  apply IHo. auto. intuition omega.
-  eapply Mem.loadbytes_store_other; eauto. simpl. intuition omega.
-  discriminate.
+  intros until n; functional induction (store_zeros m b p n); red; intros.
+- destruct n0. simpl. apply Mem.loadbytes_empty. omega.
+  rewrite inj_S in H1. omegaContradiction.
+- destruct (zeq p0 p).
+  + subst p0. destruct n0. simpl. apply Mem.loadbytes_empty. omega.
+    rewrite inj_S in H1. rewrite inj_S.
+    replace (Z.succ (Z.of_nat n0)) with (1 + Z.of_nat n0) by omega.
+    change (list_repeat (S n0) (Byte Byte.zero))
+      with ((Byte Byte.zero :: nil) ++ list_repeat n0 (Byte Byte.zero)).
+    apply Mem.loadbytes_concat.
+    eapply Mem.loadbytes_unchanged_on with (P := fun b1 ofs1 => ofs1 = p).
+    eapply store_zeros_unchanged; eauto. intros; omega. 
+    intros; omega.
+    change (Byte Byte.zero :: nil) with (encode_val Mint8unsigned Vzero).
+    change 1 with (size_chunk Mint8unsigned).
+    eapply Mem.loadbytes_store_same; eauto.
+    eapply IHo; eauto. omega. omega. omega. omega.
+  + eapply IHo; eauto. omega. omega.
+- discriminate.
 Qed.
 
+Definition bytes_of_init_data (i: init_data): list memval :=
+  match i with
+  | Init_int8 n => inj_bytes (encode_int 1%nat (Int.unsigned n))
+  | Init_int16 n => inj_bytes (encode_int 2%nat (Int.unsigned n))
+  | Init_int32 n => inj_bytes (encode_int 4%nat (Int.unsigned n))
+  | Init_int64 n => inj_bytes (encode_int 8%nat (Int64.unsigned n))
+  | Init_float32 n => inj_bytes (encode_int 4%nat (Int.unsigned (Float32.to_bits n)))
+  | Init_float64 n => inj_bytes (encode_int 8%nat (Int64.unsigned (Float.to_bits n)))
+  | Init_space n => list_repeat (Z.to_nat n) (Byte Byte.zero)
+  | Init_addrof id ofs =>
+      match find_symbol ge id with
+      | Some b => inj_value Q32 (Vptr b ofs)
+      | None   => list_repeat 4%nat Undef
+      end
+  end.
+
+Lemma store_init_data_loadbytes:
+  forall m b p i m',
+  store_init_data m b p i = Some m' ->
+  readbytes_as_zero m b p (init_data_size i) ->
+  Mem.loadbytes m' b p (init_data_size i) = Some (bytes_of_init_data i).
+Proof.
+  intros; destruct i; simpl in H; try apply (Mem.loadbytes_store_same _ _ _ _ _ _ H).
+- inv H. simpl.
+  assert (EQ: Z.of_nat (Z.to_nat z) = Z.max z 0).
+  { destruct (zle 0 z). rewrite Z2Nat.id; xomega. destruct z; try discriminate. simpl. xomega. } 
+  rewrite <- EQ. apply H0. omega. simpl. omega. 
+- simpl; destruct (find_symbol ge i) as [b'|]; try discriminate.
+  apply (Mem.loadbytes_store_same _ _ _ _ _ _ H).
+Qed.
+
+Fixpoint bytes_of_init_data_list (il: list init_data): list memval :=
+  match il with
+  | nil => nil
+  | i :: il => bytes_of_init_data i ++ bytes_of_init_data_list il
+  end.
+
+Lemma store_init_data_list_loadbytes:
+  forall b il m p m',
+  store_init_data_list m b p il = Some m' ->
+  readbytes_as_zero m b p (init_data_list_size il) ->
+  Mem.loadbytes m' b p (init_data_list_size il) = Some (bytes_of_init_data_list il).
+Proof.
+  induction il as [ | i1 il]; simpl; intros.
+- apply Mem.loadbytes_empty. omega.
+- generalize (init_data_size_pos i1) (init_data_list_size_pos il); intros P1 PL.
+  destruct (store_init_data m b p i1) as [m1|] eqn:S; try discriminate.
+  apply Mem.loadbytes_concat.
+  eapply Mem.loadbytes_unchanged_on with (P := fun b1 ofs1 => ofs1 < p + init_data_size i1).
+  eapply store_init_data_list_unchanged; eauto.
+  intros; omega.
+  intros; omega.
+  eapply store_init_data_loadbytes; eauto. 
+  red; intros; apply H0. omega. omega.
+  apply IHil with m1; auto.
+  red; intros. 
+  eapply Mem.loadbytes_unchanged_on with (P := fun b1 ofs1 => p + init_data_size i1 <= ofs1).
+  eapply store_init_data_unchanged; eauto. 
+  intros; omega.
+  intros; omega. 
+  apply H0. omega. omega.
+  auto. auto.
+Qed.
+
+(** Properties related to [load] *)
+
 Definition read_as_zero (m: mem) (b: block) (ofs len: Z) : Prop :=
   forall chunk p,
   ofs <= p -> p + size_chunk chunk <= ofs + len ->
@@ -926,32 +953,16 @@ Definition read_as_zero (m: mem) (b: block) (ofs len: Z) : Prop :=
         | Many32 | Many64 => Vundef
         end).
 
-Remark store_zeros_loadbytes:
-  forall m b p n m',
-  store_zeros m b p n = Some m' ->
-  forall p' n',
-  p <= p' -> p' + Z.of_nat n' <= p + n ->
-  Mem.loadbytes m' b p' (Z.of_nat n') = Some (list_repeat n' (Byte Byte.zero)).
+Remark read_as_zero_unchanged:
+  forall (P: block -> Z -> Prop) m b ofs len m',
+  read_as_zero m b ofs len ->
+  Mem.unchanged_on P m m' ->
+  (forall i, ofs <= i < ofs + len -> P b i) ->
+  read_as_zero m' b ofs len.
 Proof.
-  intros until n; functional induction (store_zeros m b p n); intros.
-- destruct n'. simpl. apply Mem.loadbytes_empty. omega.
-  rewrite inj_S in H1. omegaContradiction.
-- destruct (zeq p' p).
-  + subst p'. destruct n'. simpl. apply Mem.loadbytes_empty. omega.
-    rewrite inj_S in H1. rewrite inj_S.
-    replace (Z.succ (Z.of_nat n')) with (1 + Z.of_nat n') by omega.
-    change (list_repeat (S n') (Byte Byte.zero))
-      with ((Byte Byte.zero :: nil) ++ list_repeat n' (Byte Byte.zero)).
-    apply Mem.loadbytes_concat.
-    erewrite store_zeros_loadbytes_outside; eauto.
-    change (Byte Byte.zero :: nil) with (encode_val Mint8unsigned Vzero).
-    change 1 with (size_chunk Mint8unsigned).
-    eapply Mem.loadbytes_store_same; eauto.
-    right; omega.
-    eapply IHo; eauto. omega. omega. omega. omega.
-  + eapply IHo; eauto. omega. omega.
-- discriminate.
-Qed.
+  intros; red; intros. eapply Mem.load_unchanged_on; eauto. 
+  intros; apply H1. omega. 
+Qed. 
 
 Lemma store_zeros_read_as_zero:
   forall m b p n m',
@@ -965,35 +976,6 @@ Proof.
   f_equal. destruct chunk; reflexivity.
 Qed.
 
-Remark store_init_data_outside:
-  forall b i m p m',
-  store_init_data m b p i = Some m' ->
-  forall chunk b' q,
-  b' <> b \/ q + size_chunk chunk <= p \/ p + init_data_size i <= q ->
-  Mem.load chunk m' b' q = Mem.load chunk m b' q.
-Proof.
-  intros. destruct i; simpl in *;
-  try (eapply Mem.load_store_other; eauto; fail).
-  inv H; auto.
-  destruct (find_symbol ge i); try congruence.
-  eapply Mem.load_store_other; eauto; intuition.
-Qed.
-
-Remark store_init_data_list_outside:
-  forall b il m p m',
-  store_init_data_list m b p il = Some m' ->
-  forall chunk b' q,
-  b' <> b \/ q + size_chunk chunk <= p ->
-  Mem.load chunk m' b' q = Mem.load chunk m b' q.
-Proof.
-  induction il; simpl.
-  intros; congruence.
-  intros. destruct (store_init_data m b p a) as [m1|] eqn:?; try congruence.
-  transitivity (Mem.load chunk m1 b' q).
-  eapply IHil; eauto. generalize (init_data_size_pos a). intuition omega.
-  eapply store_init_data_outside; eauto. tauto.
-Qed.
-
 Fixpoint load_store_init_data (m: mem) (b: block) (p: Z) (il: list init_data) {struct il} : Prop :=
   match il with
   | nil => True
@@ -1023,12 +1005,6 @@ Fixpoint load_store_init_data (m: mem) (b: block) (p: Z) (il: list init_data) {s
       /\ load_store_init_data m b (p + Zmax n 0) il'
   end.
 
-Remark init_data_list_size_pos:
-  forall il, init_data_list_size il >= 0.
-Proof.
-  induction il; simpl. omega. generalize (init_data_size_pos a); omega.
-Qed.
-
 Lemma store_init_data_list_charact:
   forall b il m p m',
   store_init_data_list m b p il = Some m' ->
@@ -1040,17 +1016,22 @@ Proof.
     store_init_data_list m1 b (p + size_chunk chunk) il = Some m' ->
     Mem.load chunk m' b p = Some(Val.load_result chunk v)).
   {
-    intros. transitivity (Mem.load chunk m1 b p).
-    eapply store_init_data_list_outside; eauto. right. omega.
+    intros.
+    eapply Mem.load_unchanged_on with (P := fun b' ofs' => ofs' < p + size_chunk chunk).
+    eapply store_init_data_list_unchanged; eauto. intros; omega.
+    intros; tauto.
     eapply Mem.load_store_same; eauto.
   }
   induction il; simpl.
   auto.
   intros. destruct (store_init_data m b p a) as [m1|] eqn:?; try congruence.
   exploit IHil; eauto.
-  red; intros. transitivity (Mem.load chunk m b p0).
-  eapply store_init_data_outside. eauto. auto.
-  apply H0. generalize (init_data_size_pos a); omega. omega. auto.
+  set (P := fun (b': block) ofs' => p + init_data_size a <= ofs').
+  apply read_as_zero_unchanged with (m := m) (P := P).
+  red; intros; apply H0; auto. generalize (init_data_size_pos a); omega. omega. 
+  eapply store_init_data_unchanged with (P := P); eauto.
+  intros; unfold P. omega.
+  intros; unfold P. omega.
   intro D.
   destruct a; simpl in Heqo; intuition.
   eapply (A Mint8unsigned (Vint i)); eauto.
@@ -1059,56 +1040,60 @@ Proof.
   eapply (A Mint64 (Vlong i)); eauto.
   eapply (A Mfloat32 (Vsingle f)); eauto.
   eapply (A Mfloat64 (Vfloat f)); eauto.
-  inv Heqo. red; intros. transitivity (Mem.load chunk m1 b p0).
-  eapply store_init_data_list_outside; eauto. right. simpl. xomega.
-  apply H0; auto. simpl. generalize (init_data_list_size_pos il); xomega.
+  set (P := fun (b': block) ofs' => ofs' < p + init_data_size (Init_space z)).
+  inv Heqo. apply read_as_zero_unchanged with (m := m1) (P := P).
+  red; intros. apply H0; auto. simpl. generalize (init_data_list_size_pos il); xomega.
+  eapply store_init_data_list_unchanged; eauto. 
+  intros; unfold P. omega.
+  intros; unfold P. simpl; xomega.
   destruct (find_symbol ge i); try congruence. exists b0; split; auto.
   eapply (A Mint32 (Vptr b0 i0)); eauto.
 Qed.
 
-Remark load_alloc_global:
-  forall chunk b p id g m m',
+Remark alloc_global_unchanged:
+  forall (P: block -> Z -> Prop) m id g m',
   alloc_global m (id, g) = Some m' ->
-  Mem.valid_block m b ->
-  Mem.load chunk m' b p = Mem.load chunk m b p.
+  Mem.unchanged_on P m m'.
 Proof.
   intros. destruct g as [f|v]; simpl in H.
-  (* function *)
-  destruct (Mem.alloc m 0 1) as [m1 b'] eqn:?.
-  assert (b <> b'). apply Mem.valid_not_valid_diff with m; eauto with mem.
-  transitivity (Mem.load chunk m1 b p).
-  eapply Mem.load_drop; eauto.
-  eapply Mem.load_alloc_unchanged; eauto.
-  (* variable *)
+- (* function *)
+  destruct (Mem.alloc m 0 1) as [m1 b] eqn:?.
+  set (Q := fun b' (ofs: Z) => b' <> b).
+  apply Mem.unchanged_on_implies with Q.
+  apply Mem.unchanged_on_trans with m1.
+  eapply Mem.alloc_unchanged_on; eauto.
+  eapply Mem.drop_perm_unchanged_on; eauto. 
+  intros; red. apply Mem.valid_not_valid_diff with m; eauto with mem.
+- (* variable *)
   set (init := gvar_init v) in *.
   set (sz := init_data_list_size init) in *.
-  destruct (Mem.alloc m 0 sz) as [m1 b'] eqn:?.
-  destruct (store_zeros m1 b' 0 sz) as [m2|] eqn:?; try discriminate.
-  destruct (store_init_data_list m2 b' 0 init) as [m3|] eqn:?; try discriminate.
-  assert (b <> b'). apply Mem.valid_not_valid_diff with m; eauto with mem.
-  transitivity (Mem.load chunk m3 b p).
-  eapply Mem.load_drop; eauto.
-  transitivity (Mem.load chunk m2 b p).
-  eapply store_init_data_list_outside; eauto.
-  transitivity (Mem.load chunk m1 b p).
-  eapply store_zeros_load_outside; eauto.
-  eapply Mem.load_alloc_unchanged; eauto.
-Qed.
-
-Remark load_alloc_globals:
-  forall chunk b p gl m m',
+  destruct (Mem.alloc m 0 sz) as [m1 b] eqn:?.
+  destruct (store_zeros m1 b 0 sz) as [m2|] eqn:?; try discriminate.
+  destruct (store_init_data_list m2 b 0 init) as [m3|] eqn:?; try discriminate.
+  set (Q := fun b' (ofs: Z) => b' <> b).
+  apply Mem.unchanged_on_implies with Q.
+  apply Mem.unchanged_on_trans with m1.
+  eapply Mem.alloc_unchanged_on; eauto.
+  apply Mem.unchanged_on_trans with m2.
+  eapply store_zeros_unchanged; eauto.
+  apply Mem.unchanged_on_trans with m3.
+  eapply store_init_data_list_unchanged; eauto. 
+  eapply Mem.drop_perm_unchanged_on; eauto. 
+  intros; red. apply Mem.valid_not_valid_diff with m; eauto with mem.
+Qed.
+
+Remark alloc_globals_unchanged:
+  forall (P: block -> Z -> Prop) gl m m',
   alloc_globals m gl = Some m' ->
-  Mem.valid_block m b ->
-  Mem.load chunk m' b p = Mem.load chunk m b p.
+  Mem.unchanged_on P m m'.
 Proof.
   induction gl; simpl; intros.
-  congruence.
-  destruct (alloc_global m a) as [m''|] eqn:?; try discriminate.
-  transitivity (Mem.load chunk m'' b p).
-  apply IHgl; auto. unfold Mem.valid_block in *.
-  erewrite alloc_global_nextblock; eauto.
-  apply Plt_trans with (Mem.nextblock m); auto. apply Plt_succ.
-  destruct a as [id g]. eapply load_alloc_global; eauto.
+- inv H. apply Mem.unchanged_on_refl.
+- destruct (alloc_global m a) as [m''|] eqn:?; try discriminate.
+  destruct a as [id g].
+  apply Mem.unchanged_on_trans with m''. 
+  eapply alloc_global_unchanged; eauto.
+  apply IHgl; auto.
 Qed.
 
 Remark load_store_init_data_invariant:
@@ -1119,125 +1104,101 @@ Remark load_store_init_data_invariant:
 Proof.
   induction il; intro p; simpl.
   auto.
-  repeat rewrite H. destruct a; intuition. red; intros; rewrite H; auto.
-Qed.
-
-Definition variables_initialized (g: t) (m: mem) :=
-  forall b gv,
-  find_var_info g b = Some gv ->
-  Mem.range_perm m b 0 (init_data_list_size gv.(gvar_init)) Cur (perm_globvar gv)
-  /\ (forall ofs k p, Mem.perm m b ofs k p ->
-        0 <= ofs < init_data_list_size gv.(gvar_init) /\ perm_order (perm_globvar gv) p)
-  /\ (gv.(gvar_volatile) = false -> load_store_init_data m b 0 gv.(gvar_init)).
-
-Definition functions_initialized (g: t) (m: mem) :=
-  forall b fd,
-  find_funct_ptr g b = Some fd ->
-  Mem.perm m b 0 Cur Nonempty
-  /\ (forall ofs k p, Mem.perm m b ofs k p -> ofs = 0 /\ perm_order Nonempty p).
+  rewrite ! H. destruct a; intuition. red; intros; rewrite H; auto.
+Qed.
+
+Definition globals_initialized (g: t) (m: mem) :=
+  forall b gd,
+  find_def g b = Some gd ->
+  match gd with
+  | Gfun f =>
+         Mem.perm m b 0 Cur Nonempty
+      /\ (forall ofs k p, Mem.perm m b ofs k p -> ofs = 0 /\ p = Nonempty)
+  | Gvar v =>
+         Mem.range_perm m b 0 (init_data_list_size v.(gvar_init)) Cur (perm_globvar v)
+      /\ (forall ofs k p, Mem.perm m b ofs k p ->
+            0 <= ofs < init_data_list_size v.(gvar_init) /\ perm_order (perm_globvar v) p)
+      /\ (v.(gvar_volatile) = false -> load_store_init_data m b 0 v.(gvar_init))
+      /\ (v.(gvar_volatile) = false -> Mem.loadbytes m b 0 (init_data_list_size v.(gvar_init)) = Some (bytes_of_init_data_list v.(gvar_init)))
+  end.
 
 Lemma alloc_global_initialized:
-  forall ge m id g m',
-  genv_next ge = Mem.nextblock m ->
-  alloc_global m (id, g) = Some m' ->
-  variables_initialized ge m ->
-  functions_initialized ge m ->
-  variables_initialized (add_global ge (id, g)) m'
-  /\ functions_initialized (add_global ge (id, g)) m'
-  /\ genv_next (add_global ge (id, g)) = Mem.nextblock m'.
+  forall g m id gd m',
+  genv_next g = Mem.nextblock m ->
+  alloc_global m (id, gd) = Some m' ->
+  globals_initialized g m ->
+     globals_initialized (add_global g (id, gd)) m'
+  /\ genv_next (add_global g (id, gd)) = Mem.nextblock m'.
 Proof.
   intros.
   exploit alloc_global_nextblock; eauto. intros NB. split.
-(* variables-initialized *)
-  destruct g as [f|v].
-(* function *)
-  red; intros. unfold find_var_info in H3. simpl in H3.
-  exploit H1; eauto. intros [A [B C]].
-  assert (D: Mem.valid_block m b).
-    red. exploit genv_vars_range; eauto. rewrite H; auto.
-  split. red; intros. erewrite <- alloc_global_perm; eauto.
-  split. intros. eapply B. erewrite alloc_global_perm; eauto.
-  intros. apply load_store_init_data_invariant with m; auto.
-  intros. eapply load_alloc_global; eauto.
-(* variable *)
-  red; intros. unfold find_var_info in H3. simpl in H3. rewrite PTree.gsspec in H3.
-  destruct (peq b (genv_next ge0)).
-  (* same *)
-  inv H3. simpl in H0.
-  set (init := gvar_init gv) in *.
+- (* globals-initialized *)
+  red; intros. unfold find_def in H2; simpl in H2.
+  rewrite PTree.gsspec in H2. destruct (peq b (genv_next g)).
++ inv H2. destruct gd0 as [f|v]; simpl in H0.
+* destruct (Mem.alloc m 0 1) as [m1 b] eqn:ALLOC.
+  exploit Mem.alloc_result; eauto. intros RES.
+  rewrite H, <- RES. split.
+  eapply Mem.perm_drop_1; eauto. omega.
+  intros. 
+  assert (0 <= ofs < 1). { eapply Mem.perm_alloc_3; eauto. eapply Mem.perm_drop_4; eauto. }
+  exploit Mem.perm_drop_2; eauto. intros ORD.
+  split. omega. inv ORD; auto.
+* set (init := gvar_init v) in *.
   set (sz := init_data_list_size init) in *.
-  destruct (Mem.alloc m 0 sz) as [m1 b'] eqn:?.
-  destruct (store_zeros m1 b' 0 sz) as [m2|] eqn:?; try discriminate.
-  destruct (store_init_data_list m2 b' 0 init) as [m3|] eqn:?; try discriminate.
+  destruct (Mem.alloc m 0 sz) as [m1 b] eqn:?.
+  destruct (store_zeros m1 b 0 sz) as [m2|] eqn:?; try discriminate.
+  destruct (store_init_data_list m2 b 0 init) as [m3|] eqn:?; try discriminate.
   exploit Mem.alloc_result; eauto. intro RES.
-  replace (genv_next ge0) with b' by congruence.
+  replace (genv_next g) with b by congruence.
   split. red; intros. eapply Mem.perm_drop_1; eauto.
   split. intros.
   assert (0 <= ofs < sz).
-    eapply Mem.perm_alloc_3; eauto.
-    erewrite store_zeros_perm; [idtac|eauto].
-    erewrite store_init_data_list_perm; [idtac|eauto].
-    eapply Mem.perm_drop_4; eauto.
-  split. auto. eapply Mem.perm_drop_2; eauto.
-  intros. apply load_store_init_data_invariant with m3.
-  intros. eapply Mem.load_drop; eauto.
-  right; right; right. unfold perm_globvar. rewrite H3.
-  destruct (gvar_readonly gv); auto with mem.
-  eapply store_init_data_list_charact; eauto.
+  { eapply Mem.perm_alloc_3; eauto. 
+    erewrite store_zeros_perm by eauto.
+    erewrite store_init_data_list_perm by eauto. 
+    eapply Mem.perm_drop_4; eauto. }
+  split; auto.
+  eapply Mem.perm_drop_2; eauto.
+  split. intros NOTVOL. apply load_store_init_data_invariant with m3.
+  intros. eapply Mem.load_drop; eauto. right; right; right. 
+  unfold perm_globvar. rewrite NOTVOL. destruct (gvar_readonly v); auto with mem.
+  eapply store_init_data_list_charact; eauto. 
   eapply store_zeros_read_as_zero; eauto.
-  (* older var *)
-  exploit H1; eauto. intros [A [B C]].
-  assert (D: Mem.valid_block m b).
-    red. exploit genv_vars_range; eauto. rewrite H; auto.
-  split. red; intros. erewrite <- alloc_global_perm; eauto.
-  split. intros. eapply B. erewrite alloc_global_perm; eauto.
-  intros. apply load_store_init_data_invariant with m; auto.
-  intros. eapply load_alloc_global; eauto.
-(* functions-initialized *)
-  split. destruct g as [f|v].
-(* function *)
-  red; intros. unfold find_funct_ptr in H3. simpl in H3. rewrite PTree.gsspec in H3.
-  destruct (peq b (genv_next ge0)).
-  (* same *)
-  inv H3. simpl in H0.
-  destruct (Mem.alloc m 0 1) as [m1 b'] eqn:?.
-  exploit Mem.alloc_result; eauto. intro RES.
-  replace (genv_next ge0) with b' by congruence.
-  split. eapply Mem.perm_drop_1; eauto. omega.
-  intros.
-  assert (0 <= ofs < 1).
-    eapply Mem.perm_alloc_3; eauto.
-    eapply Mem.perm_drop_4; eauto.
-  split. omega. eapply Mem.perm_drop_2; eauto.
-  (* older function *)
-  exploit H2; eauto. intros [A B].
-  assert (D: Mem.valid_block m b).
-    red. exploit genv_funs_range; eauto. rewrite H; auto.
-  split. erewrite <- alloc_global_perm; eauto.
-  intros. eapply B. erewrite alloc_global_perm; eauto.
-(* variables *)
-  red; intros. unfold find_funct_ptr in H3. simpl in H3.
-  exploit H2; eauto. intros [A B].
-  assert (D: Mem.valid_block m b).
-    red. exploit genv_funs_range; eauto. rewrite H; auto.
-  split. erewrite <- alloc_global_perm; eauto.
-  intros. eapply B. erewrite alloc_global_perm; eauto.
-(* nextblock *)
-  rewrite NB. simpl. rewrite H. auto.
+  intros NOTVOL. 
+  transitivity (Mem.loadbytes m3 b 0 sz). 
+  eapply Mem.loadbytes_drop; eauto. right; right; right.
+  unfold perm_globvar. rewrite NOTVOL. destruct (gvar_readonly v); auto with mem.
+  eapply store_init_data_list_loadbytes; eauto.
+  eapply store_zeros_loadbytes; eauto.
++ assert (U: Mem.unchanged_on (fun _ _ => True) m m') by (eapply alloc_global_unchanged; eauto).
+  assert (VALID: Mem.valid_block m b).
+  { red. rewrite <- H. eapply genv_defs_range; eauto. } 
+  exploit H1; eauto.
+  destruct gd0 as [f|v].
+* intros [A B]; split; intros.
+  eapply Mem.perm_unchanged_on; eauto. exact I.
+  eapply B. eapply Mem.perm_unchanged_on_2; eauto. exact I.
+* intros (A & B & C & D). split; [| split; [| split]]. 
+  red; intros. eapply Mem.perm_unchanged_on; eauto. exact I.
+  intros. eapply B. eapply Mem.perm_unchanged_on_2; eauto. exact I.
+  intros. apply load_store_init_data_invariant with m; auto. 
+  intros. eapply Mem.load_unchanged_on_1; eauto. intros; exact I.
+  intros. eapply Mem.loadbytes_unchanged_on; eauto. intros; exact I.
+- simpl. congruence.
 Qed.
 
 Lemma alloc_globals_initialized:
   forall gl ge m m',
-  genv_next ge = Mem.nextblock m ->
   alloc_globals m gl = Some m' ->
-  variables_initialized ge m ->
-  functions_initialized ge m ->
-  variables_initialized (add_globals ge gl) m' /\ functions_initialized (add_globals ge gl) m'.
+  genv_next ge = Mem.nextblock m ->
+  globals_initialized ge m ->
+  globals_initialized (add_globals ge gl) m'.
 Proof.
   induction gl; simpl; intros.
-  inv H0; auto.
-  destruct a as [id g]. destruct (alloc_global m (id, g)) as [m1|] eqn:?; try discriminate.
-  exploit alloc_global_initialized; eauto. intros [P [Q R]].
+- inv H; auto.
+- destruct a as [id g]. destruct (alloc_global m (id, g)) as [m1|] eqn:?; try discriminate.
+  exploit alloc_global_initialized; eauto. intros [P Q].
   eapply IHgl; eauto.
 Qed.
 
@@ -1265,13 +1226,21 @@ Proof.
   eapply genv_symb_range; eauto.
 Qed.
 
+Theorem find_def_not_fresh:
+  forall p b g m,
+  init_mem p = Some m ->
+  find_def (globalenv p) b = Some g -> Mem.valid_block m b.
+Proof.
+  intros. red. erewrite <- init_mem_genv_next; eauto.
+  eapply genv_defs_range; eauto.
+Qed.
+
 Theorem find_funct_ptr_not_fresh:
   forall p b f m,
   init_mem p = Some m ->
   find_funct_ptr (globalenv p) b = Some f -> Mem.valid_block m b.
 Proof.
-  intros. red. erewrite <- init_mem_genv_next; eauto.
-  eapply genv_funs_range; eauto.
+  intros. rewrite find_funct_ptr_iff in H0. eapply find_def_not_fresh; eauto.
 Qed.
 
 Theorem find_var_info_not_fresh:
@@ -1279,8 +1248,18 @@ Theorem find_var_info_not_fresh:
   init_mem p = Some m ->
   find_var_info (globalenv p) b = Some gv -> Mem.valid_block m b.
 Proof.
-  intros. red. erewrite <- init_mem_genv_next; eauto.
-  eapply genv_vars_range; eauto.
+  intros. rewrite find_var_info_iff in H0. eapply find_def_not_fresh; eauto.
+Qed.
+
+Lemma init_mem_characterization_gen:
+  forall p m,
+  init_mem p = Some m ->
+  globals_initialized (globalenv p) (globalenv p) m.
+Proof.
+  intros. apply alloc_globals_initialized with Mem.empty. 
+  auto.
+  rewrite Mem.nextblock_empty. auto.
+  red; intros. unfold find_def in H0; simpl in H0; rewrite PTree.gempty in H0; discriminate.
 Qed.
 
 Theorem init_mem_characterization:
@@ -1290,12 +1269,13 @@ Theorem init_mem_characterization:
   Mem.range_perm m b 0 (init_data_list_size gv.(gvar_init)) Cur (perm_globvar gv)
   /\ (forall ofs k p, Mem.perm m b ofs k p ->
         0 <= ofs < init_data_list_size gv.(gvar_init) /\ perm_order (perm_globvar gv) p)
-  /\ (gv.(gvar_volatile) = false -> load_store_init_data (globalenv p) m b 0 gv.(gvar_init)).
+  /\ (gv.(gvar_volatile) = false ->
+      load_store_init_data (globalenv p) m b 0 gv.(gvar_init))
+  /\ (gv.(gvar_volatile) = false ->
+      Mem.loadbytes m b 0 (init_data_list_size gv.(gvar_init)) = Some (bytes_of_init_data_list (globalenv p) gv.(gvar_init))).
 Proof.
-  intros. eapply alloc_globals_initialized; eauto.
-  rewrite Mem.nextblock_empty. auto.
-  red; intros. unfold find_var_info in H1. simpl in H1. rewrite PTree.gempty in H1. congruence.
-  red; intros. unfold find_funct_ptr in H1. simpl in H1. rewrite PTree.gempty in H1. congruence.
+  intros. rewrite find_var_info_iff in H.
+  exploit init_mem_characterization_gen; eauto.
 Qed.
 
 Theorem init_mem_characterization_2:
@@ -1303,12 +1283,10 @@ Theorem init_mem_characterization_2:
   find_funct_ptr (globalenv p) b = Some fd ->
   init_mem p = Some m ->
   Mem.perm m b 0 Cur Nonempty
-  /\ (forall ofs k p, Mem.perm m b ofs k p -> ofs = 0 /\ perm_order Nonempty p).
+  /\ (forall ofs k p, Mem.perm m b ofs k p -> ofs = 0 /\ p = Nonempty).
 Proof.
-  intros. unfold init_mem in H0. eapply alloc_globals_initialized; eauto.
-  rewrite Mem.nextblock_empty. auto.
-  red; intros. unfold find_var_info in H1. simpl in H1. rewrite PTree.gempty in H1. congruence.
-  red; intros. unfold find_funct_ptr in H1. simpl in H1. rewrite PTree.gempty in H1. congruence.
+  intros. rewrite find_funct_ptr_iff in H.
+  exploit init_mem_characterization_gen; eauto.
 Qed.
 
 (** ** Compatibility with memory injections *)
@@ -1426,302 +1404,296 @@ Proof.
   apply Ple_refl.
 Qed.
 
-Section INITMEM_AUGMENT_INJ.
+(** ** Sufficient and necessary conditions for the initial memory to exist. *)
+
+(** Alignment properties *)
+
+Definition init_data_alignment (i: init_data) : Z :=
+  match i with
+  | Init_int8 n => 1
+  | Init_int16 n => 2
+  | Init_int32 n => 4
+  | Init_int64 n => 8
+  | Init_float32 n => 4
+  | Init_float64 n => 4
+  | Init_addrof symb ofs => 4
+  | Init_space n => 1
+  end.
+
+Fixpoint init_data_list_aligned (p: Z) (il: list init_data) {struct il} : Prop :=
+  match il with
+  | nil => True
+  | i1 :: il => (init_data_alignment i1 | p) /\ init_data_list_aligned (p + init_data_size i1) il
+  end.
+
+Section INITMEM_INVERSION.
 
 Variable ge: t.
-Variable thr: block.
 
-Lemma store_zeros_augment:
-  forall m1 m2 b p n m2',
-  Mem.inject (Mem.flat_inj thr) m1 m2 ->
-  Ple thr b ->
-  store_zeros m2 b p n = Some m2' ->
-  Mem.inject (Mem.flat_inj thr) m1 m2'.
+Lemma store_init_data_aligned:
+  forall m b p i m',
+  store_init_data ge m b p i = Some m' ->
+  (init_data_alignment i | p).
 Proof.
-  intros until n. functional induction (store_zeros m2 b p n); intros.
-  inv H1; auto.
-  apply IHo; auto. exploit Mem.store_outside_inject; eauto. simpl.
-  intros. exfalso. unfold Mem.flat_inj in H2. destruct (plt b' thr).
-  inv H2. unfold Plt, Ple in *. zify; omega.
-  discriminate.
-  discriminate.
+  intros.
+  assert (DFL: forall chunk v,
+    Mem.store chunk m b p v = Some m' ->
+    align_chunk chunk = init_data_alignment i ->
+    (init_data_alignment i | p)).
+  { intros. apply Mem.store_valid_access_3 in H0. destruct H0. congruence. }
+  destruct i; simpl in H; eauto.
+  simpl. apply Z.divide_1_l.
+  destruct (find_symbol ge i); try discriminate. eauto.
 Qed.
 
-Lemma store_init_data_augment:
-  forall m1 m2 b p id m2',
-  Mem.inject (Mem.flat_inj thr) m1 m2 ->
-  Ple thr b ->
-  store_init_data ge m2 b p id = Some m2' ->
-  Mem.inject (Mem.flat_inj thr) m1 m2'.
-Proof.
-  intros until m2'. intros INJ BND ST.
-  assert (P: forall chunk ofs v m2',
-             Mem.store chunk m2 b ofs v = Some m2' ->
-             Mem.inject (Mem.flat_inj thr) m1 m2').
-    intros. eapply Mem.store_outside_inject; eauto.
-    intros. unfold Mem.flat_inj in H0.
-    destruct (plt b' thr); inv H0. unfold Plt, Ple in *. zify; omega.
-  destruct id; simpl in ST; try (eapply P; eauto; fail).
-  congruence.
-  revert ST.  caseEq (find_symbol ge i); try congruence. intros; eapply P; eauto.
+Lemma store_init_data_list_aligned:
+  forall b il m p m',
+  store_init_data_list ge m b p il = Some m' ->
+  init_data_list_aligned p il.
+Proof.
+  induction il as [ | i1 il]; simpl; intros.
+- auto.
+- destruct (store_init_data ge m b p i1) as [m1|] eqn:S1; try discriminate.
+  split; eauto. eapply store_init_data_aligned; eauto.
 Qed.
 
-Lemma store_init_data_list_augment:
-  forall b idl m1 m2 p m2',
-  Mem.inject (Mem.flat_inj thr) m1 m2 ->
-  Ple thr b ->
-  store_init_data_list ge m2 b p idl = Some m2' ->
-  Mem.inject (Mem.flat_inj thr) m1 m2'.
+Lemma store_init_data_list_free_idents:
+  forall b i o il m p m',
+  store_init_data_list ge m b p il = Some m' ->
+  In (Init_addrof i o) il ->
+  exists b', find_symbol ge i = Some b'.
 Proof.
-  induction idl; simpl.
-  intros; congruence.
-  intros until m2'; intros INJ FB.
-  caseEq (store_init_data ge m2 b p a); try congruence. intros.
-  eapply IHidl. eapply store_init_data_augment; eauto. auto. eauto.
+  induction il as [ | i1 il]; simpl; intros.
+- contradiction.
+- destruct (store_init_data ge m b p i1) as [m1|] eqn:S1; try discriminate.
+  destruct H0.
++ subst i1. simpl in S1. destruct (find_symbol ge i) as [b'|]. exists b'; auto. discriminate.
++ eapply IHil; eauto.
 Qed.
 
-Lemma alloc_global_augment:
-  forall idg m1 m2 m2',
-  alloc_global ge m2 idg = Some m2' ->
-  Mem.inject (Mem.flat_inj thr) m1 m2 ->
-  Ple thr (Mem.nextblock m2) ->
-  Mem.inject (Mem.flat_inj thr) m1 m2'.
-Proof.
-  intros. destruct idg as [id [f|v]]; simpl in H.
-  (* function *)
-  destruct (Mem.alloc m2 0 1) as [m3 b] eqn:?.
-  assert (Ple thr b). rewrite (Mem.alloc_result _ _ _ _ _ Heqp). auto.
-  eapply Mem.drop_outside_inject. 2: eauto.
-  eapply Mem.alloc_right_inject; eauto.
-  intros. unfold Mem.flat_inj in H3. destruct (plt b' thr); inv H3.
-  unfold Plt, Ple in *. zify; omega.
-  (* variable *)
-  set (init := gvar_init v) in *.
-  set (sz := init_data_list_size init) in *.
-  destruct (Mem.alloc m2 0 sz) as [m3 b] eqn:?.
-  destruct (store_zeros m3 b 0 sz) as [m4|] eqn:?; try discriminate.
-  destruct (store_init_data_list ge m4 b 0 init) as [m5|] eqn:?; try discriminate.
-  assert (Ple thr b). rewrite (Mem.alloc_result _ _ _ _ _ Heqp). auto.
-  eapply Mem.drop_outside_inject. 2: eauto.
-  eapply store_init_data_list_augment. 3: eauto. 2: eauto.
-  eapply store_zeros_augment. 3: eauto. 2: eauto.
-  eapply Mem.alloc_right_inject; eauto.
-  intros. unfold Mem.flat_inj in H3. destruct (plt b' thr); inv H3.
-  unfold Plt, Ple in *. zify; omega.
-Qed.
-
-Lemma alloc_globals_augment:
-  forall gl m1 m2 m2',
-  alloc_globals ge m2 gl = Some m2' ->
-  Mem.inject (Mem.flat_inj thr) m1 m2 ->
-  Ple thr (Mem.nextblock m2) ->
-  Mem.inject (Mem.flat_inj thr) m1 m2'.
-Proof.
-  induction gl; simpl.
-  intros. congruence.
-  intros until m2'. caseEq (alloc_global ge m2 a); try congruence. intros.
-  eapply IHgl with (m2 := m); eauto.
-    eapply alloc_global_augment; eauto.
-    rewrite (alloc_global_nextblock _ _ _ H).
-    apply Ple_trans with (Mem.nextblock m2); auto. apply Ple_succ.
+End INITMEM_INVERSION.
+
+Theorem init_mem_inversion:
+  forall p m id v,
+  init_mem p = Some m ->
+  In (id, Gvar v) p.(prog_defs) ->
+  init_data_list_aligned 0 v.(gvar_init)
+  /\ forall i o, In (Init_addrof i o) v.(gvar_init) -> exists b, find_symbol (globalenv p) i = Some b.
+Proof.
+  intros until v. unfold init_mem. set (ge := globalenv p). 
+  revert m. generalize Mem.empty. generalize (prog_defs p). 
+  induction l as [ | idg1 defs ]; simpl; intros m m'; intros.
+- contradiction.
+- destruct (alloc_global ge m idg1) as [m''|] eqn:A; try discriminate.
+  destruct H0.
++ subst idg1; simpl in A. 
+  set (il := gvar_init v) in *. set (sz := init_data_list_size il) in *. 
+  destruct (Mem.alloc m 0 sz) as [m1 b].
+  destruct (store_zeros m1 b 0 sz) as [m2|]; try discriminate.
+  destruct (store_init_data_list ge m2 b 0 il) as [m3|] eqn:B; try discriminate.
+  split. eapply store_init_data_list_aligned; eauto. intros; eapply store_init_data_list_free_idents; eauto.
++ eapply IHdefs; eauto.
+Qed.
+
+Section INITMEM_EXISTS.
+
+Variable ge: t.
+
+Lemma store_zeros_exists:
+  forall m b p n,
+  Mem.range_perm m b p (p + n) Cur Writable ->
+  exists m', store_zeros m b p n = Some m'.
+Proof.
+  intros until n. functional induction (store_zeros m b p n); intros PERM.
+- exists m; auto.
+- apply IHo. red; intros. eapply Mem.perm_store_1; eauto. apply PERM. omega.
+- destruct (Mem.valid_access_store m Mint8unsigned b p Vzero) as (m' & STORE).
+  split. red; intros. apply Mem.perm_cur. apply PERM. simpl in H. omega. 
+  simpl. apply Z.divide_1_l.
+  congruence.
 Qed.
 
-End INITMEM_AUGMENT_INJ.
+Lemma store_init_data_exists:
+  forall m b p i,
+  Mem.range_perm m b p (p + init_data_size i) Cur Writable ->
+  (init_data_alignment i | p) ->
+  (forall id ofs, i = Init_addrof id ofs -> exists b, find_symbol ge id = Some b) ->
+  exists m', store_init_data ge m b p i = Some m'.
+Proof.
+  intros. 
+  assert (DFL: forall chunk v,
+          init_data_size i = size_chunk chunk ->
+          init_data_alignment i = align_chunk chunk ->
+          exists m', Mem.store chunk m b p v = Some m').
+  { intros. destruct (Mem.valid_access_store m chunk b p v) as (m' & STORE).
+    split. rewrite <- H2; auto. rewrite <- H3; auto. 
+    exists m'; auto. }
+  destruct i; eauto.
+  simpl. exists m; auto.
+  simpl. exploit H1; eauto. intros (b1 & FS). rewrite FS. eauto. 
+Qed.
+
+Lemma store_init_data_list_exists:
+  forall b il m p,
+  Mem.range_perm m b p (p + init_data_list_size il) Cur Writable ->
+  init_data_list_aligned p il ->
+  (forall id ofs, In (Init_addrof id ofs) il -> exists b, find_symbol ge id = Some b) ->
+  exists m', store_init_data_list ge m b p il = Some m'.
+Proof.
+  induction il as [ | i1 il ]; simpl; intros.
+- exists m; auto.
+- destruct H0. 
+  destruct (@store_init_data_exists m b p i1) as (m1 & S1); eauto.
+  red; intros. apply H. generalize (init_data_list_size_pos il); omega.
+  rewrite S1. 
+  apply IHil; eauto. 
+  red; intros. erewrite <- store_init_data_perm by eauto. apply H. generalize (init_data_size_pos i1); omega.
+Qed.
+
+Lemma alloc_global_exists:
+  forall m idg,
+  match idg with
+  | (id, Gfun f) => True
+  | (id, Gvar v) =>
+        init_data_list_aligned 0 v.(gvar_init)
+     /\ forall i o, In (Init_addrof i o) v.(gvar_init) -> exists b, find_symbol ge i = Some b
+  end ->
+  exists m', alloc_global ge m idg = Some m'.
+Proof.
+  intros m [id [f|v]]; intros; simpl.
+- destruct (Mem.alloc m 0 1) as [m1 b] eqn:ALLOC.
+  destruct (Mem.range_perm_drop_2 m1 b 0 1 Nonempty) as [m2 DROP].
+  red; intros; eapply Mem.perm_alloc_2; eauto. 
+  exists m2; auto.
+- destruct H as [P Q].
+  set (sz := init_data_list_size (gvar_init v)).
+  destruct (Mem.alloc m 0 sz) as [m1 b] eqn:ALLOC.
+  assert (P1: Mem.range_perm m1 b 0 sz Cur Freeable) by (red; intros; eapply Mem.perm_alloc_2; eauto).
+  destruct (@store_zeros_exists m1 b 0 sz) as [m2 ZEROS].
+  red; intros. apply Mem.perm_implies with Freeable; auto with mem.
+  rewrite ZEROS.
+  assert (P2: Mem.range_perm m2 b 0 sz Cur Freeable).
+  { red; intros. erewrite <- store_zeros_perm by eauto. eauto. }
+  destruct (@store_init_data_list_exists b (gvar_init v) m2 0) as [m3 STORE]; auto.
+  red; intros. apply Mem.perm_implies with Freeable; auto with mem.
+  rewrite STORE.
+  assert (P3: Mem.range_perm m3 b 0 sz Cur Freeable).
+  { red; intros. erewrite <- store_init_data_list_perm by eauto. eauto. }
+  destruct (Mem.range_perm_drop_2 m3 b 0 sz (perm_globvar v)) as [m4 DROP]; auto.
+  exists m4; auto.
+Qed.
+
+End INITMEM_EXISTS.
+
+Theorem init_mem_exists:
+  forall p,
+  (forall id v, In (id, Gvar v) (prog_defs p) ->
+        init_data_list_aligned 0 v.(gvar_init)
+     /\ forall i o, In (Init_addrof i o) v.(gvar_init) -> exists b, find_symbol (globalenv p) i = Some b) ->
+  exists m, init_mem p = Some m.
+Proof.
+  intros. set (ge := globalenv p) in *. 
+  unfold init_mem. revert H. generalize (prog_defs p) Mem.empty.
+  induction l as [ | idg l]; simpl; intros.
+- exists m; auto.
+- destruct (@alloc_global_exists ge m idg) as [m1 A1].
+  destruct idg as [id [f|v]]; eauto.
+  fold ge. rewrite A1. eapply IHl; eauto. 
+Qed. 
 
 End GENV.
 
 (** * Commutation with program transformations *)
 
-(** ** Commutation with matching between programs. *)
-
-Section MATCH_PROGRAMS.
-
-Variables A B V W: Type.
-Variable match_fun: A -> B -> Prop.
-Variable match_varinfo: V -> W -> Prop.
+Section MATCH_GENVS.
 
-Inductive match_globvar: globvar V -> globvar W -> Prop :=
-  | match_globvar_intro: forall info1 info2 init ro vo,
-      match_varinfo info1 info2 ->
-      match_globvar (mkglobvar info1 init ro vo) (mkglobvar info2 init ro vo).
+Context {A B V W: Type} (R: globdef A V -> globdef B W -> Prop).
 
-Record match_genvs (new_globs : list (ident * globdef B W))
-                   (ge1: t A V) (ge2: t B W): Prop := {
+Record match_genvs (ge1: t A V) (ge2: t B W): Prop := {
   mge_next:
-    genv_next ge2 = advance_next new_globs (genv_next ge1);
+    genv_next ge2 = genv_next ge1;
   mge_symb:
-    forall id, ~ In id (map fst new_globs) ->
-                   PTree.get id (genv_symb ge2) = PTree.get id (genv_symb ge1);
-  mge_funs:
-    forall b f, PTree.get b (genv_funs ge1) = Some f ->
-    exists tf, PTree.get b (genv_funs ge2) = Some tf /\ match_fun f tf;
-  mge_rev_funs:
-    forall b tf, PTree.get b (genv_funs ge2) = Some tf ->
-    if plt b (genv_next ge1) then
-      exists f, PTree.get b (genv_funs ge1) = Some f /\ match_fun f tf
-    else
-      In (Gfun tf) (map snd new_globs);
-  mge_vars:
-    forall b v, PTree.get b (genv_vars ge1) = Some v ->
-    exists tv, PTree.get b (genv_vars ge2) = Some tv /\ match_globvar v tv;
-  mge_rev_vars:
-    forall b tv, PTree.get b (genv_vars ge2) = Some tv ->
-    if plt b (genv_next ge1) then
-      exists v, PTree.get b (genv_vars ge1) = Some v /\ match_globvar v tv
-    else
-      In (Gvar tv) (map snd new_globs)
+    forall id, PTree.get id (genv_symb ge2) = PTree.get id (genv_symb ge1);
+  mge_defs:
+    forall b, option_rel R (PTree.get b (genv_defs ge1)) (PTree.get b (genv_defs ge2))
 }.
 
 Lemma add_global_match:
-  forall ge1 ge2 idg1 idg2,
-  match_genvs nil ge1 ge2 ->
-  match_globdef match_fun match_varinfo idg1 idg2 ->
-  match_genvs nil (add_global ge1 idg1) (add_global ge2 idg2).
-Proof.
-  intros. destruct H. simpl in mge_next0.
-  inv H0.
-(* two functions *)
-  constructor; simpl.
-  congruence.
-  intros. rewrite mge_next0.
-    repeat rewrite PTree.gsspec. destruct (peq id0 id); auto.
-  rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec.
-    destruct (peq b (genv_next ge1)).
-     exists f2; split; congruence.
-     eauto.
-  rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec.
-   destruct (peq b (genv_next ge1)).
-    subst b. rewrite pred_dec_true. exists f1; split; congruence. apply Plt_succ.
-    pose proof (mge_rev_funs0 b tf H0).
-    destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto. apply Plt_trans_succ; auto.
-    contradiction.
-  eauto.
-  intros.
-    pose proof (mge_rev_vars0 b tv H0).
-    destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto.
-    apply Plt_trans with (genv_next ge1); auto. apply Plt_succ.
-    contradiction.
-(* two variables *)
-  constructor; simpl.
-  congruence.
-  intros. rewrite mge_next0.
-    repeat rewrite PTree.gsspec. destruct (peq id0 id); auto.
-  eauto.
-  intros.
-    pose proof (mge_rev_funs0 b tf H0).
-    destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto. apply Plt_trans_succ; auto.
-    contradiction.
-  rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec.
-    destruct (peq b (genv_next ge1)).
-    econstructor; split. eauto. inv H0. constructor; auto.
-    eauto.
-  rewrite mge_next0. intros. rewrite PTree.gsspec in H0. rewrite PTree.gsspec.
-   destruct (peq b (genv_next ge1)).
-    subst b. rewrite pred_dec_true.
-    econstructor; split. eauto. inv H0. constructor; auto. apply Plt_succ.
-    pose proof (mge_rev_vars0 b tv H0).
-    destruct (plt b (genv_next ge1)). rewrite pred_dec_true. auto. apply Plt_trans_succ; auto.
-    contradiction.
+  forall ge1 ge2 id g1 g2,
+  match_genvs ge1 ge2 ->
+  R g1 g2 ->
+  match_genvs (add_global ge1 (id, g1)) (add_global ge2 (id, g2)).
+Proof.
+  intros. destruct H. constructor; simpl; intros.
+- congruence.
+- rewrite mge_next0, ! PTree.gsspec. destruct (peq id0 id); auto. 
+- rewrite mge_next0, ! PTree.gsspec. destruct (peq b (genv_next ge1)). 
+  constructor; auto.
+  auto.
 Qed.
 
 Lemma add_globals_match:
-  forall gl1 gl2, list_forall2 (match_globdef match_fun match_varinfo) gl1 gl2 ->
-  forall ge1 ge2, match_genvs nil ge1 ge2 ->
-  match_genvs nil (add_globals ge1 gl1) (add_globals ge2 gl2).
+  forall gl1 gl2,
+  list_forall2 (fun idg1 idg2 => fst idg1 = fst idg2 /\ R (snd idg1) (snd idg2)) gl1 gl2 ->
+  forall ge1 ge2, match_genvs ge1 ge2 ->
+  match_genvs (add_globals ge1 gl1) (add_globals ge2 gl2).
 Proof.
   induction 1; intros; simpl.
   auto.
+  destruct a1 as [id1 g1]; destruct b1 as [id2 g2]; simpl in *; destruct H; subst id2.
   apply IHlist_forall2. apply add_global_match; auto.
 Qed.
 
-Lemma add_global_augment_match:
-  forall new_globs ge1 ge2 idg,
-  match_genvs new_globs ge1 ge2 ->
-  match_genvs (new_globs ++ (idg :: nil)) ge1 (add_global ge2 idg).
-Proof.
-  intros. destruct H.
-  assert (LE: Ple (genv_next ge1) (genv_next ge2)).
-  { rewrite mge_next0; apply advance_next_le. }
-  constructor; simpl.
-  rewrite mge_next0. unfold advance_next. rewrite fold_left_app. simpl. auto.
-  intros. rewrite map_app in H. rewrite in_app in H. simpl in H.
-    destruct (peq id idg#1). subst. intuition. rewrite PTree.gso.
-    apply mge_symb0. intuition. auto.
-  intros. destruct idg as [id1 [f1|v1]]; simpl; eauto.
-    rewrite PTree.gso. eauto.
-    exploit genv_funs_range; eauto. intros.
-    unfold Plt, Ple in *; zify; omega.
-  intros. rewrite map_app. destruct idg as [id1 [f1|v1]]; simpl in H.
-    rewrite PTree.gsspec in H. destruct (peq b (genv_next ge2)).
-    rewrite pred_dec_false. rewrite in_app. simpl; right; left. congruence.
-    subst b. unfold Plt, Ple in *; zify; omega.
-    exploit mge_rev_funs0; eauto. destruct (plt b (genv_next ge1)); auto.
-    rewrite in_app. tauto.
-    exploit mge_rev_funs0; eauto. destruct (plt b (genv_next ge1)); auto.
-    rewrite in_app. tauto.
-  intros. destruct idg as [id1 [f1|v1]]; simpl; eauto.
-    rewrite PTree.gso. eauto. exploit genv_vars_range; eauto.
-    unfold Plt, Ple in *; zify; omega.
-  intros. rewrite map_app. destruct idg as [id1 [f1|v1]]; simpl in H.
-    exploit mge_rev_vars0; eauto. destruct (plt b (genv_next ge1)); auto.
-    rewrite in_app. tauto.
-    rewrite PTree.gsspec in H. destruct (peq b (genv_next ge2)).
-    rewrite pred_dec_false. rewrite in_app. simpl; right; left. congruence.
-    subst b. unfold Plt, Ple in *; zify; omega.
-    exploit mge_rev_vars0; eauto. destruct (plt b (genv_next ge1)); auto.
-    rewrite in_app. tauto.
-Qed.
-
-Lemma add_globals_augment_match:
-  forall gl new_globs ge1 ge2,
-  match_genvs new_globs ge1 ge2 ->
-  match_genvs (new_globs ++ gl) ge1 (add_globals ge2 gl).
-Proof.
-  induction gl; simpl.
-    intros. rewrite app_nil_r. auto.
-    intros. change (a :: gl) with ((a :: nil) ++ gl). rewrite <- app_ass.
-      apply IHgl. apply add_global_augment_match. auto.
-Qed.
-
-Variable new_globs : list (ident * globdef B W).
-Variable new_main : ident.
-
-Variable p: program A V.
-Variable p': program B W.
-Hypothesis progmatch:
-  match_program match_fun match_varinfo new_globs new_main p p'.
+End MATCH_GENVS.
+
+Section MATCH_PROGRAMS.
+
+Context {C F1 V1 F2 V2: Type} {LC: Linker C} {LF: Linker F1} {LV: Linker V1}.
+Variable match_fundef: C -> F1 -> F2 -> Prop.
+Variable match_varinfo: V1 -> V2 -> Prop.
+Variable ctx: C.
+Variable p: program F1 V1.
+Variable tp: program F2 V2.
+Hypothesis progmatch: match_program_gen match_fundef match_varinfo ctx p tp.
 
 Lemma globalenvs_match:
-  match_genvs new_globs (globalenv p) (globalenv p').
+  match_genvs (match_globdef match_fundef match_varinfo ctx) (globalenv p) (globalenv tp).
+Proof.
+  intros. apply add_globals_match. apply progmatch. 
+  constructor; simpl; intros; auto. rewrite ! PTree.gempty. constructor.
+Qed.
+
+Theorem find_def_match_2:
+  forall b, option_rel (match_globdef match_fundef match_varinfo ctx)
+                       (find_def (globalenv p) b) (find_def (globalenv tp) b).
+Proof (mge_defs globalenvs_match).
+
+Theorem find_def_match:
+  forall b g,
+  find_def (globalenv p) b = Some g ->
+  exists tg,
+  find_def (globalenv tp) b = Some tg /\ match_globdef match_fundef match_varinfo ctx g tg.
 Proof.
-  unfold globalenv. destruct progmatch as [[tglob [P Q]] R].
-  rewrite Q. rewrite add_globals_app.
-  change new_globs with (nil ++ new_globs) at 1.
-  apply add_globals_augment_match.
-  apply add_globals_match; auto.
-  constructor; simpl; auto; intros; rewrite PTree.gempty in H; congruence.
+  intros. generalize (find_def_match_2 b). rewrite H; intros R; inv R.
+  exists y; auto. 
 Qed.
 
 Theorem find_funct_ptr_match:
-  forall (b : block) (f : A),
+  forall b f,
   find_funct_ptr (globalenv p) b = Some f ->
-  exists tf : B,
-  find_funct_ptr (globalenv p') b = Some tf /\ match_fun f tf.
-Proof (mge_funs globalenvs_match).
-
-Theorem find_funct_ptr_rev_match:
-  forall (b : block) (tf : B),
-  find_funct_ptr (globalenv p') b = Some tf ->
-  if plt b (genv_next (globalenv p)) then
-      exists f, find_funct_ptr (globalenv p) b = Some f /\ match_fun f tf
-  else
-      In (Gfun tf) (map snd new_globs).
-Proof (mge_rev_funs globalenvs_match).
+  exists cunit tf,
+  find_funct_ptr (globalenv tp) b = Some tf /\ match_fundef cunit f tf /\ linkorder cunit ctx.
+Proof.
+  intros. rewrite find_funct_ptr_iff in *. apply find_def_match in H. 
+  destruct H as (tg & P & Q). inv Q. 
+  exists ctx', f2; intuition auto. apply find_funct_ptr_iff; auto.
+Qed.
 
 Theorem find_funct_match:
-  forall (v : val) (f : A),
+  forall v f,
   find_funct (globalenv p) v = Some f ->
-  exists tf : B, find_funct (globalenv p') v = Some tf /\ match_fun f tf.
+  exists cunit tf,
+  find_funct (globalenv tp) v = Some tf /\ match_fundef cunit f tf /\ linkorder cunit ctx.
 Proof.
   intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v.
   rewrite find_funct_find_funct_ptr in H.
@@ -1729,569 +1701,180 @@ Proof.
   apply find_funct_ptr_match. auto.
 Qed.
 
-Theorem find_funct_rev_match:
-  forall (v : val) (tf : B),
-  find_funct (globalenv p') v = Some tf ->
-  (exists f, find_funct (globalenv p) v = Some f /\ match_fun f tf)
-  \/ (In (Gfun tf) (map snd new_globs)).
-Proof.
-  intros. exploit find_funct_inv; eauto. intros [b EQ]. subst v.
-  rewrite find_funct_find_funct_ptr in H.
-  rewrite find_funct_find_funct_ptr.
-  apply find_funct_ptr_rev_match in H.
-   destruct (plt b (genv_next (globalenv p))); auto.
-Qed.
-
 Theorem find_var_info_match:
-  forall (b : block) (v : globvar V),
+  forall b v,
   find_var_info (globalenv p) b = Some v ->
   exists tv,
-  find_var_info (globalenv p') b = Some tv /\ match_globvar v tv.
-Proof (mge_vars globalenvs_match).
-
-Theorem find_var_info_rev_match:
-  forall (b : block) (tv : globvar W),
-  find_var_info (globalenv p') b = Some tv ->
-  if plt b (genv_next (globalenv p)) then
-    exists v, find_var_info (globalenv p) b = Some v /\ match_globvar v tv
-  else
-    In (Gvar tv) (map snd new_globs).
-Proof (mge_rev_vars globalenvs_match).
+  find_var_info (globalenv tp) b = Some tv /\ match_globvar match_varinfo v tv.
+Proof.
+  intros. rewrite find_var_info_iff in *. apply find_def_match in H. 
+  destruct H as (tg & P & Q). inv Q. 
+  exists v2; split; auto. apply find_var_info_iff; auto.
+Qed.
 
 Theorem find_symbol_match:
   forall (s : ident),
-  ~In s (map fst new_globs) ->
-  find_symbol (globalenv p') s = find_symbol (globalenv p) s.
+  find_symbol (globalenv tp) s = find_symbol (globalenv p) s.
 Proof.
-  intros. destruct globalenvs_match. unfold find_symbol.  auto.
+  intros. destruct globalenvs_match. apply mge_symb0.
 Qed.
 
-Theorem public_symbol_match:
-  forall (s : ident),
-  ~In s (map fst new_globs) ->
-  public_symbol (globalenv p') s = public_symbol (globalenv p) s.
+Theorem senv_match:
+  Senv.equiv (to_senv (globalenv p)) (to_senv (globalenv tp)).
 Proof.
-  intros. unfold public_symbol. rewrite find_symbol_match by auto.
-  destruct (find_symbol (globalenv p) s); auto.
-  rewrite ! globalenv_public.
+  red; simpl. repeat split.
+- apply find_symbol_match.
+- intros. unfold public_symbol. rewrite find_symbol_match. 
+  rewrite ! globalenv_public. 
   destruct progmatch as (P & Q & R). rewrite R. auto.
+- intros. unfold block_is_volatile. 
+  destruct globalenvs_match as [P Q R]. specialize (R b).
+  unfold find_var_info, find_def.
+  inv R; auto.
+  inv H1; auto.
+  inv H2; auto.
 Qed.
 
-Hypothesis new_ids_fresh:
-  forall s, In s (prog_defs_names p) -> In s (map fst new_globs) -> False.
-Hypothesis new_ids_unique:
-  list_norepet (map fst new_globs).
-
 Lemma store_init_data_list_match:
   forall idl m b ofs m',
   store_init_data_list (globalenv p) m b ofs idl = Some m' ->
-  store_init_data_list (globalenv p') m b ofs idl = Some m'.
+  store_init_data_list (globalenv tp) m b ofs idl = Some m'.
 Proof.
   induction idl; simpl; intros.
-  auto.
-  assert (forall m', store_init_data (globalenv p) m b ofs a = Some m' ->
-          store_init_data (globalenv p') m b ofs a = Some m').
-   destruct a; simpl; auto. rewrite find_symbol_match. auto.
-   simpl in H. destruct (find_symbol (globalenv p) i) as [b'|] eqn:?; try discriminate.
-   red; intros. exploit find_symbol_inversion; eauto.
-  case_eq (store_init_data (globalenv p) m b ofs a); intros.
-    rewrite H1 in H.
-    pose proof (H0 _ H1). rewrite H2. auto.
-    rewrite H1 in H. inversion H.
+- auto.
+- destruct (store_init_data (globalenv p) m b ofs a) as [m1|] eqn:S; try discriminate.
+  assert (X: store_init_data (globalenv tp) m b ofs a = Some m1).
+  { destruct a; auto. simpl; rewrite find_symbol_match; auto. }
+  rewrite X. auto.
 Qed.
 
 Lemma alloc_globals_match:
-  forall gl1 gl2, list_forall2 (match_globdef match_fun match_varinfo) gl1 gl2 ->
+  forall gl1 gl2, list_forall2 (match_ident_globdef match_fundef match_varinfo ctx) gl1 gl2 ->
   forall m m',
   alloc_globals (globalenv p) m gl1 = Some m' ->
-  alloc_globals (globalenv p') m gl2 = Some m'.
+  alloc_globals (globalenv tp) m gl2 = Some m'.
 Proof.
   induction 1; simpl; intros.
-  auto.
-  destruct (alloc_global (globalenv p) m a1) as [m1|] eqn:?; try discriminate.
-  assert (alloc_global (globalenv p') m b1 = Some m1).
-    inv H; simpl in *.
-    auto.
+- auto.
+- destruct (alloc_global (globalenv p) m a1) as [m1|] eqn:?; try discriminate.
+  assert (X: alloc_global (globalenv tp) m b1 = Some m1).
+  { destruct a1 as [id1 g1]; destruct b1 as [id2 g2]; destruct H; simpl in *.
+    subst id2. inv H2.
+  - auto.
+  - inv H; simpl in *. 
     set (sz := init_data_list_size init) in *.
     destruct (Mem.alloc m 0 sz) as [m2 b] eqn:?.
     destruct (store_zeros m2 b 0 sz) as [m3|] eqn:?; try discriminate.
     destruct (store_init_data_list (globalenv p) m3 b 0 init) as [m4|] eqn:?; try discriminate.
     erewrite store_init_data_list_match; eauto.
-  rewrite H2. eauto.
+  }
+  rewrite X; eauto.
 Qed.
 
 Theorem init_mem_match:
-  forall m, init_mem p = Some m ->
-  init_mem p' = alloc_globals (globalenv p') m new_globs.
+  forall m, init_mem p = Some m -> init_mem tp = Some m.
 Proof.
   unfold init_mem; intros.
-  destruct progmatch as [[tglob [P Q]] R].
-  rewrite Q. erewrite <- alloc_globals_app; eauto.
-  eapply alloc_globals_match; eauto.
-Qed.
-
-Theorem find_new_funct_ptr_match:
-  forall id f, In (id, Gfun f) new_globs ->
-  exists b,
-     find_symbol (globalenv p') id = Some b
-  /\ find_funct_ptr (globalenv p') b = Some f.
-Proof.
-  intros.
-  destruct progmatch as [[tglob [P Q]] R].
-  exploit in_norepet_unique; eauto. intros (gl1 & gl2 & S & T).
-  rewrite S in Q. rewrite <- app_ass in Q.
-  eapply find_funct_ptr_exists_2; eauto.
-Qed.
-
-Theorem find_new_var_match:
-  forall id v, In (id, Gvar v) new_globs ->
-  exists b,
-     find_symbol (globalenv p') id = Some b
-  /\ find_var_info (globalenv p') b = Some v.
-Proof.
-  intros.
-  destruct progmatch as [[tglob [P Q]] R].
-  exploit in_norepet_unique; eauto. intros (gl1 & gl2 & S & T).
-  rewrite S in Q. rewrite <- app_ass in Q.
-  eapply find_var_exists_2; eauto.
+  eapply alloc_globals_match; eauto. apply progmatch.
 Qed.
 
 End MATCH_PROGRAMS.
 
-Section TRANSF_PROGRAM_AUGMENT.
-
-Variable A B V W: Type.
-Variable transf_fun: A -> res B.
-Variable transf_var: V -> res W.
+(** Special case for partial transformations that do not depend on the compilation unit *)
 
-Variable new_globs : list (ident * globdef B W).
-Variable new_main : ident.
+Section TRANSFORM_PARTIAL.
 
-Variable p: program A V.
-Variable p': program B W.
-
-Hypothesis transf_OK:
-  transform_partial_augment_program transf_fun transf_var new_globs new_main p = OK p'.
-
-Let prog_match:
-  match_program
-    (fun fd tfd => transf_fun fd = OK tfd)
-    (fun info tinfo => transf_var info = OK tinfo)
-    new_globs new_main
-    p p'.
-Proof.
-  apply transform_partial_augment_program_match; auto.
-Qed.
-
-Theorem find_funct_ptr_transf_augment:
-  forall (b: block) (f: A),
-  find_funct_ptr (globalenv p) b = Some f ->
-  exists f',
-  find_funct_ptr (globalenv p') b = Some f' /\ transf_fun f = OK f'.
-Proof.
-  intros.
-  exploit find_funct_ptr_match. eexact prog_match. eauto.
-  intros [tf [X Y]]. exists tf; auto.
-Qed.
-
-Theorem find_funct_ptr_rev_transf_augment:
-  forall (b: block) (tf: B),
-  find_funct_ptr (globalenv p') b = Some tf ->
-  if plt b (genv_next (globalenv p)) then
-   (exists f, find_funct_ptr (globalenv p) b = Some f /\ transf_fun f = OK tf)
-  else
-   In (Gfun tf) (map snd new_globs).
-Proof.
-  intros.
-  exploit find_funct_ptr_rev_match; eauto.
-Qed.
-
-Theorem find_funct_transf_augment:
-  forall (v: val) (f: A),
-  find_funct (globalenv p) v = Some f ->
-  exists f',
-  find_funct (globalenv p') v = Some f' /\ transf_fun f = OK f'.
-Proof.
-  intros.
-  exploit find_funct_match. eexact prog_match. eauto. auto.
-Qed.
-
-Theorem find_funct_rev_transf_augment:
-  forall (v: val) (tf: B),
-  find_funct (globalenv p') v = Some tf ->
-  (exists f, find_funct (globalenv p) v = Some f /\ transf_fun f = OK tf) \/
-  In (Gfun tf) (map snd new_globs).
-Proof.
-  intros.
-  exploit find_funct_rev_match. eexact prog_match. eauto. auto.
-Qed.
-
-Theorem find_var_info_transf_augment:
-  forall (b: block) (v: globvar V),
-  find_var_info (globalenv p) b = Some v ->
-  exists v',
-  find_var_info (globalenv p') b = Some v' /\ transf_globvar transf_var v = OK v'.
-Proof.
-  intros.
-  exploit find_var_info_match. eexact prog_match. eauto. intros [tv [X Y]].
-  exists tv; split; auto. inv Y. unfold transf_globvar; simpl.
-  rewrite H0; simpl. auto.
-Qed.
-
-Theorem find_var_info_rev_transf_augment:
-  forall (b: block) (v': globvar W),
-  find_var_info (globalenv p') b = Some v' ->
-  if plt b (genv_next (globalenv p)) then
-    (exists v, find_var_info (globalenv p) b = Some v /\ transf_globvar transf_var v = OK v')
-  else
-    (In (Gvar v') (map snd new_globs)).
-Proof.
-  intros.
-  exploit find_var_info_rev_match. eexact prog_match. eauto.
-  destruct (plt b (genv_next (globalenv p))); auto.
-  intros [v [X Y]]. exists v; split; auto. inv Y. unfold transf_globvar; simpl.
-  rewrite H0; simpl. auto.
-Qed.
-
-Theorem find_symbol_transf_augment:
-  forall (s: ident),
-  ~ In s (map fst new_globs) ->
-  find_symbol (globalenv p') s = find_symbol (globalenv p) s.
-Proof.
-  intros. eapply find_symbol_match. eexact prog_match. auto.
-Qed.
-
-Theorem public_symbol_transf_augment:
-  forall (s: ident),
-  ~ In s (map fst new_globs) ->
-  public_symbol (globalenv p') s = public_symbol (globalenv p) s.
-Proof.
-  intros. eapply public_symbol_match. eexact prog_match. auto.
-Qed.
-
-Hypothesis new_ids_fresh:
-  forall s, In s (prog_defs_names p) -> In s (map fst new_globs) -> False.
-Hypothesis new_ids_unique:
-  list_norepet (map fst new_globs).
-
-Theorem init_mem_transf_augment:
-   forall m, init_mem p = Some m ->
-   init_mem p' = alloc_globals (globalenv p') m new_globs.
-Proof.
-  intros. eapply init_mem_match. eexact prog_match. auto. auto.
-Qed.
-
-Theorem init_mem_inject_transf_augment:
-  forall m, init_mem p = Some m ->
-  forall m', init_mem p' = Some m' ->
-  Mem.inject (Mem.flat_inj (Mem.nextblock m)) m m'.
-Proof.
-  intros.
-  pose proof (initmem_inject p H).
-  erewrite init_mem_transf_augment in H0; eauto.
-  eapply alloc_globals_augment; eauto. apply Ple_refl.
-Qed.
-
-Theorem find_new_funct_ptr_exists:
-  forall id f, In (id, Gfun f) new_globs ->
-  exists b, find_symbol (globalenv p') id = Some b
-         /\ find_funct_ptr (globalenv p') b = Some f.
-Proof.
-  intros. eapply find_new_funct_ptr_match; eauto.
-Qed.
-
-Theorem find_new_var_exists:
-  forall id gv, In (id, Gvar gv) new_globs ->
-  exists b, find_symbol (globalenv p') id = Some b
-         /\ find_var_info (globalenv p') b = Some gv.
-Proof.
-  intros. eapply find_new_var_match; eauto.
-Qed.
-
-End TRANSF_PROGRAM_AUGMENT.
-
-Section TRANSF_PROGRAM_PARTIAL2.
-
-Variable A B V W: Type.
-Variable transf_fun: A -> res B.
-Variable transf_var: V -> res W.
-Variable p: program A V.
-Variable p': program B W.
-Hypothesis transf_OK:
-  transform_partial_program2 transf_fun transf_var p = OK p'.
-
-Remark transf_augment_OK:
-  transform_partial_augment_program transf_fun transf_var nil p.(prog_main) p = OK p'.
-Proof.
-  rewrite <- transf_OK. symmetry. apply transform_partial_program2_augment.
-Qed.
-
-Theorem find_funct_ptr_transf_partial2:
-  forall (b: block) (f: A),
-  find_funct_ptr (globalenv p) b = Some f ->
-  exists f',
-  find_funct_ptr (globalenv p') b = Some f' /\ transf_fun f = OK f'.
-Proof.
-  exact (@find_funct_ptr_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-Qed.
-
-Theorem find_funct_ptr_rev_transf_partial2:
-  forall (b: block) (tf: B),
-  find_funct_ptr (globalenv p') b = Some tf ->
-  exists f, find_funct_ptr (globalenv p) b = Some f /\ transf_fun f = OK tf.
-Proof.
-  pose proof (@find_funct_ptr_rev_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-  intros.  pose proof (H b tf H0).
-  destruct (plt b (genv_next (globalenv p))).  auto. contradiction.
-Qed.
-
-Theorem find_funct_transf_partial2:
-  forall (v: val) (f: A),
-  find_funct (globalenv p) v = Some f ->
-  exists f',
-  find_funct (globalenv p') v = Some f' /\ transf_fun f = OK f'.
-Proof.
-  exact (@find_funct_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-Qed.
-
-Theorem find_funct_rev_transf_partial2:
-  forall (v: val) (tf: B),
-  find_funct (globalenv p') v = Some tf ->
-  exists f, find_funct (globalenv p) v = Some f /\ transf_fun f = OK tf.
-Proof.
-  pose proof (@find_funct_rev_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-  intros. pose proof (H v tf H0).
-  destruct H1. auto. contradiction.
-Qed.
-
-Theorem find_var_info_transf_partial2:
-  forall (b: block) (v: globvar V),
-  find_var_info (globalenv p) b = Some v ->
-  exists v',
-  find_var_info (globalenv p') b = Some v' /\ transf_globvar transf_var v = OK v'.
-Proof.
-  exact (@find_var_info_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-Qed.
-
-Theorem find_var_info_rev_transf_partial2:
-  forall (b: block) (v': globvar W),
-  find_var_info (globalenv p') b = Some v' ->
-  exists v,
-  find_var_info (globalenv p) b = Some v /\ transf_globvar transf_var v = OK v'.
-Proof.
-  pose proof (@find_var_info_rev_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-  intros.  pose proof (H b v' H0).
-  destruct (plt b (genv_next (globalenv p))).  auto. contradiction.
-Qed.
-
-Theorem find_symbol_transf_partial2:
-  forall (s: ident),
-  find_symbol (globalenv p') s = find_symbol (globalenv p) s.
-Proof.
-  pose proof (@find_symbol_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-  auto.
-Qed.
-
-Theorem public_symbol_transf_partial2:
-  forall (s: ident),
-  public_symbol (globalenv p') s = public_symbol (globalenv p) s.
-Proof.
-  pose proof (@public_symbol_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-  auto.
-Qed.
-
-Theorem block_is_volatile_transf_partial2:
-  forall (b: block),
-  block_is_volatile (globalenv p') b = block_is_volatile (globalenv p) b.
-Proof.
-  unfold block_is_volatile; intros.
-  destruct (find_var_info (globalenv p) b) as [v|] eqn:FV.
-  exploit find_var_info_transf_partial2; eauto. intros (v' & P & Q).
-  rewrite P. monadInv Q. auto.
-  destruct (find_var_info (globalenv p') b) as [v'|] eqn:FV'.
-  exploit find_var_info_rev_transf_partial2; eauto. intros (v & P & Q). congruence.
-  auto.
-Qed.
-
-Theorem init_mem_transf_partial2:
-  forall m, init_mem p = Some m -> init_mem p' = Some m.
-Proof.
-  pose proof (@init_mem_transf_augment _ _ _ _ _ _ _ _ _ _ transf_augment_OK).
-  intros. simpl in H. apply H; auto.
-Qed.
-
-End TRANSF_PROGRAM_PARTIAL2.
-
-Section TRANSF_PROGRAM_PARTIAL.
-
-Variable A B V: Type.
-Variable transf: A -> res B.
-Variable p: program A V.
-Variable p': program B V.
-Hypothesis transf_OK: transform_partial_program transf p = OK p'.
+Context {A B V: Type} {LA: Linker A} {LV: Linker V}.
+Context {transf: A -> res B} {p: program A V} {tp: program B V}.
+Hypothesis progmatch: match_program (fun cu f tf => transf f = OK tf) eq p tp.
 
 Theorem find_funct_ptr_transf_partial:
-  forall (b: block) (f: A),
+  forall b f,
   find_funct_ptr (globalenv p) b = Some f ->
-  exists f',
-  find_funct_ptr (globalenv p') b = Some f' /\ transf f = OK f'.
-Proof.
-  exact (@find_funct_ptr_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
-Qed.
-
-Theorem find_funct_ptr_rev_transf_partial:
-  forall (b: block) (tf: B),
-  find_funct_ptr (globalenv p') b = Some tf ->
-  exists f, find_funct_ptr (globalenv p) b = Some f /\ transf f = OK tf.
+  exists tf,
+  find_funct_ptr (globalenv tp) b = Some tf /\ transf f = OK tf.
 Proof.
-  exact (@find_funct_ptr_rev_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
+  intros. exploit (find_funct_ptr_match progmatch); eauto. 
+  intros (cu & tf & P & Q & R); exists tf; auto.
 Qed.
 
 Theorem find_funct_transf_partial:
-  forall (v: val) (f: A),
+  forall v f,
   find_funct (globalenv p) v = Some f ->
-  exists f',
-  find_funct (globalenv p') v = Some f' /\ transf f = OK f'.
-Proof.
-  exact (@find_funct_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
-Qed.
-
-Theorem find_funct_rev_transf_partial:
-  forall (v: val) (tf: B),
-  find_funct (globalenv p') v = Some tf ->
-  exists f, find_funct (globalenv p) v = Some f /\ transf f = OK tf.
+  exists tf,
+  find_funct (globalenv tp) v = Some tf /\ transf f = OK tf.
 Proof.
-  exact (@find_funct_rev_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
+  intros. exploit (find_funct_match progmatch); eauto. 
+  intros (cu & tf & P & Q & R); exists tf; auto.
 Qed.
 
 Theorem find_symbol_transf_partial:
-  forall (s: ident),
-  find_symbol (globalenv p') s = find_symbol (globalenv p) s.
-Proof.
-  exact (@find_symbol_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
-Qed.
-
-Theorem public_symbol_transf_partial:
-  forall (s: ident),
-  public_symbol (globalenv p') s = public_symbol (globalenv p) s.
-Proof.
-  exact (@public_symbol_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
-Qed.
-
-Theorem find_var_info_transf_partial:
-  forall (b: block),
-  find_var_info (globalenv p') b = find_var_info (globalenv p) b.
+  forall (s : ident),
+  find_symbol (globalenv tp) s = find_symbol (globalenv p) s.
 Proof.
-  intros. case_eq (find_var_info (globalenv p) b); intros.
-  exploit find_var_info_transf_partial2. eexact transf_OK. eauto.
-  intros [v' [P Q]]. monadInv Q. rewrite P. inv EQ. destruct g; auto.
-  case_eq (find_var_info (globalenv p') b); intros.
-  exploit find_var_info_rev_transf_partial2. eexact transf_OK. eauto.
-  intros [v' [P Q]]. monadInv Q. inv EQ. congruence.
-  auto.
+  intros. eapply (find_symbol_match progmatch). 
 Qed.
 
-Theorem block_is_volatile_transf_partial:
-  forall (b: block),
-  block_is_volatile (globalenv p') b = block_is_volatile (globalenv p) b.
+Theorem senv_transf_partial:
+  Senv.equiv (to_senv (globalenv p)) (to_senv (globalenv tp)).
 Proof.
-  exact (@block_is_volatile_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
+  intros. eapply (senv_match progmatch).
 Qed.
 
 Theorem init_mem_transf_partial:
-  forall m, init_mem p = Some m -> init_mem p' = Some m.
+  forall m, init_mem p = Some m -> init_mem tp = Some m.
 Proof.
-  exact (@init_mem_transf_partial2 _ _ _ _ _ _ _ _ transf_OK).
+  eapply (init_mem_match progmatch).
 Qed.
 
-End TRANSF_PROGRAM_PARTIAL.
+End TRANSFORM_PARTIAL.
 
-Section TRANSF_PROGRAM.
+(** Special case for total transformations that do not depend on the compilation unit *)
 
-Variable A B V: Type.
-Variable transf: A -> B.
-Variable p: program A V.
-Let tp := transform_program transf p.
+Section TRANSFORM_TOTAL.
 
-Remark transf_OK:
-  transform_partial_program (fun x => OK (transf x)) p = OK tp.
-Proof.
-  unfold tp. apply transform_program_partial_program.
-Qed.
+Context {A B V: Type} {LA: Linker A} {LV: Linker V}.
+Context {transf: A -> B} {p: program A V} {tp: program B V}.
+Hypothesis progmatch: match_program (fun cu f tf => tf = transf f) eq p tp.
 
 Theorem find_funct_ptr_transf:
-  forall (b: block) (f: A),
+  forall b f,
   find_funct_ptr (globalenv p) b = Some f ->
   find_funct_ptr (globalenv tp) b = Some (transf f).
 Proof.
-  intros.
-  destruct (@find_funct_ptr_transf_partial _ _ _ _ _ _ transf_OK _ _ H)
-  as [f' [X Y]]. congruence.
-Qed.
-
-Theorem find_funct_ptr_rev_transf:
-  forall (b: block) (tf: B),
-  find_funct_ptr (globalenv tp) b = Some tf ->
-  exists f, find_funct_ptr (globalenv p) b = Some f /\ transf f = tf.
-Proof.
-  intros. exploit find_funct_ptr_rev_transf_partial. eexact transf_OK. eauto.
-  intros [f [X Y]]. exists f; split. auto. congruence.
+  intros. exploit (find_funct_ptr_match progmatch); eauto. 
+  intros (cu & tf & P & Q & R). congruence.
 Qed.
 
 Theorem find_funct_transf:
-  forall (v: val) (f: A),
+  forall v f,
   find_funct (globalenv p) v = Some f ->
   find_funct (globalenv tp) v = Some (transf f).
 Proof.
-  intros.
-  destruct (@find_funct_transf_partial _ _ _ _ _ _ transf_OK _ _ H)
-  as [f' [X Y]]. congruence.
-Qed.
-
-Theorem find_funct_rev_transf:
-  forall (v: val) (tf: B),
-  find_funct (globalenv tp) v = Some tf ->
-  exists f, find_funct (globalenv p) v = Some f /\ transf f = tf.
-Proof.
-  intros. exploit find_funct_rev_transf_partial. eexact transf_OK. eauto.
-  intros [f [X Y]]. exists f; split. auto. congruence.
+  intros. exploit (find_funct_match progmatch); eauto. 
+  intros (cu & tf & P & Q & R). congruence.
 Qed.
 
 Theorem find_symbol_transf:
-  forall (s: ident),
+  forall (s : ident),
   find_symbol (globalenv tp) s = find_symbol (globalenv p) s.
 Proof.
-  exact (@find_symbol_transf_partial _ _ _ _ _ _ transf_OK).
-Qed.
-
-Theorem public_symbol_transf:
-  forall (s: ident),
-  public_symbol (globalenv tp) s = public_symbol (globalenv p) s.
-Proof.
-  exact (@public_symbol_transf_partial _ _ _ _ _ _ transf_OK).
-Qed.
-
-Theorem find_var_info_transf:
-  forall (b: block),
-  find_var_info (globalenv tp) b = find_var_info (globalenv p) b.
-Proof.
-  exact (@find_var_info_transf_partial _ _ _ _ _ _ transf_OK).
+  intros. eapply (find_symbol_match progmatch).
 Qed.
 
-Theorem block_is_volatile_transf:
-  forall (b: block),
-  block_is_volatile (globalenv tp) b = block_is_volatile (globalenv p) b.
+Theorem senv_transf:
+  Senv.equiv (to_senv (globalenv p)) (to_senv (globalenv tp)).
 Proof.
-  exact (@block_is_volatile_transf_partial _ _ _ _ _ _ transf_OK).
+  intros. eapply (senv_match progmatch).
 Qed.
 
 Theorem init_mem_transf:
   forall m, init_mem p = Some m -> init_mem tp = Some m.
 Proof.
-  exact (@init_mem_transf_partial _ _ _ _ _ _ transf_OK).
+  eapply (init_mem_match progmatch).
 Qed.
 
-End TRANSF_PROGRAM.
+End TRANSFORM_TOTAL.
 
 End Genv.
 
diff --git a/common/Linking.v b/common/Linking.v
new file mode 100644
index 00000000..52e774db
--- /dev/null
+++ b/common/Linking.v
@@ -0,0 +1,905 @@
+(* *********************************************************************)
+(*                                                                     *)
+(*              The Compcert verified compiler                         *)
+(*                                                                     *)
+(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
+(*                                                                     *)
+(*  Copyright Institut National de Recherche en Informatique et en     *)
+(*  Automatique.  All rights reserved.  This file is distributed       *)
+(*  under the terms of the GNU General Public License as published by  *)
+(*  the Free Software Foundation, either version 2 of the License, or  *)
+(*  (at your option) any later version.  This file is also distributed *)
+(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
+(*                                                                     *)
+(* *********************************************************************)
+
+(** Separate compilation and syntactic linking *)
+
+Require Import Coqlib Maps Errors AST.
+
+(** This file follows "approach A" from the paper
+       "Lightweight Verification of Separate Compilation"
+    by Kang, Kim, Hur, Dreyer and Vafeiadis, POPL 2016. *)
+
+
+(** * Syntactic linking *)
+
+(** A syntactic element [A] supports syntactic linking if it is equipped with the following:
+- a partial binary operator [link] that produces the result of linking two elements,
+  or fails if they cannot be linked (e.g. two definitions that are incompatible);
+- a preorder [linkorder] with the meaning that [linkorder a1 a2] holds
+  if [a2] can be obtained by linking [a1] with some other syntactic element.
+*)
+
+Class Linker (A: Type) := {
+  link: A -> A -> option A;
+  linkorder: A -> A -> Prop;
+  linkorder_refl: forall x, linkorder x x;
+  linkorder_trans: forall x y z, linkorder x y -> linkorder y z -> linkorder x z;
+  link_linkorder: forall x y z, link x y = Some z -> linkorder x z /\ linkorder y z
+}.
+
+(** Linking function definitions.  External functions of the [EF_external]
+  kind can link with internal function definitions; the result of
+  linking is the internal definition.  Two external functions can link
+  if they are identical. *)
+
+Definition link_fundef {F: Type} (fd1 fd2: fundef F) :=
+  match fd1, fd2 with
+  | Internal _, Internal _ => None
+  | External ef1, External ef2 =>
+      if external_function_eq ef1 ef2 then Some (External ef1) else None
+  | Internal f, External ef =>
+      match ef with EF_external id sg => Some (Internal f) | _ => None end
+  | External ef, Internal f =>
+      match ef with EF_external id sg => Some (Internal f) | _ => None end
+  end.
+
+Inductive linkorder_fundef {F: Type}: fundef F -> fundef F -> Prop :=
+  | linkorder_fundef_refl: forall fd, linkorder_fundef fd fd
+  | linkorder_fundef_ext_int: forall f id sg, linkorder_fundef (External (EF_external id sg)) (Internal f).
+
+Instance Linker_fundef (F: Type): Linker (fundef F) := {
+  link := link_fundef;
+  linkorder := linkorder_fundef
+}.
+Proof.
+- intros; constructor.
+- intros. inv H; inv H0; constructor.
+- intros x y z EQ. destruct x, y; simpl in EQ.
++ discriminate.
++ destruct e; inv EQ. split; constructor.
++ destruct e; inv EQ. split; constructor.
++ destruct (external_function_eq e e0); inv EQ. split; constructor.
+Defined.
+
+Global Opaque Linker_fundef.
+
+(** Linking variable initializers.  We adopt the following conventions:
+- an "extern" variable has an empty initialization list;
+- a "common" variable has an initialization list of the form [Init_space sz];
+- all other initialization lists correspond to fully defined variables, neither "common" nor "extern".
+*)
+
+Inductive init_class : list init_data -> Type :=
+  | Init_extern: init_class nil
+  | Init_common: forall sz, init_class (Init_space sz :: nil)
+  | Init_definitive: forall il, init_class il.
+
+Definition classify_init (i: list init_data) : init_class i :=
+  match i with
+  | nil => Init_extern
+  | Init_space sz :: nil => Init_common sz
+  | i => Init_definitive i
+  end.
+
+Definition link_varinit (i1 i2: list init_data) :=
+  match classify_init i1, classify_init i2 with
+  | Init_extern, _ => Some i2
+  | _, Init_extern => Some i1
+  | Init_common sz1, _ => if zeq sz1 (init_data_list_size i2) then Some i2 else None
+  | _, Init_common sz2 => if zeq sz2 (init_data_list_size i1) then Some i1 else None
+  | _, _ => None
+  end.
+
+Inductive linkorder_varinit: list init_data -> list init_data -> Prop :=
+  | linkorder_varinit_refl: forall il, linkorder_varinit il il
+  | linkorder_varinit_extern: forall il, linkorder_varinit nil il
+  | linkorder_varinit_common: forall sz il,
+      il <> nil -> init_data_list_size il = sz ->
+      linkorder_varinit (Init_space sz :: nil) il.
+
+Instance Linker_varinit : Linker (list init_data) := {
+  link := link_varinit;
+  linkorder := linkorder_varinit    
+}.
+Proof.
+- intros. constructor.
+- intros. inv H; inv H0; constructor; auto.
+  congruence.
+  simpl. generalize (init_data_list_size_pos z). xomega. 
+- unfold link_varinit; intros until z.
+  destruct (classify_init x) eqn:Cx, (classify_init y) eqn:Cy; intros E; inv E; try (split; constructor; fail).
++ destruct (zeq sz (Z.max sz0 0 + 0)); inv H0.
+  split; constructor. congruence. auto.
++ destruct (zeq sz (init_data_list_size il)); inv H0.
+  split; constructor. red; intros; subst z; discriminate. auto.
++ destruct (zeq sz (init_data_list_size il)); inv H0.
+  split; constructor. red; intros; subst z; discriminate. auto.
+Defined.
+
+Global Opaque Linker_varinit.
+
+(** Linking variable definitions. *)
+
+Definition link_vardef {V: Type} {LV: Linker V} (v1 v2: globvar V) :=
+  match link v1.(gvar_info) v2.(gvar_info) with
+  | None => None
+  | Some info =>
+      match link v1.(gvar_init) v2.(gvar_init) with
+      | None => None
+      | Some init =>
+          if eqb v1.(gvar_readonly) v2.(gvar_readonly)
+          && eqb v1.(gvar_volatile) v2.(gvar_volatile)
+          then Some {| gvar_info := info; gvar_init := init;
+                       gvar_readonly := v1.(gvar_readonly);
+                       gvar_volatile := v1.(gvar_volatile) |}
+          else None
+      end
+  end.
+
+Inductive linkorder_vardef {V: Type} {LV: Linker V}: globvar V -> globvar V -> Prop :=
+  | linkorder_vardef_intro: forall info1 info2 i1 i2 ro vo,
+      linkorder info1 info2 ->
+      linkorder i1 i2 ->
+      linkorder_vardef (mkglobvar info1 i1 ro vo) (mkglobvar info2 i2 ro vo).
+
+Instance Linker_vardef (V: Type) {LV: Linker V}: Linker (globvar V) := {
+  link := link_vardef;
+  linkorder := linkorder_vardef
+}.
+Proof.
+- intros. destruct x; constructor; apply linkorder_refl. 
+- intros. inv H; inv H0. constructor; eapply linkorder_trans; eauto.
+- unfold link_vardef; intros until z.
+  destruct x as [f1 i1 r1 v1], y as [f2 i2 r2 v2]; simpl.
+  destruct (link f1 f2) as [f|] eqn:LF; try discriminate.
+  destruct (link i1 i2) as [i|] eqn:LI; try discriminate.
+  destruct (eqb r1 r2) eqn:ER; try discriminate.
+  destruct (eqb v1 v2) eqn:EV; intros EQ; inv EQ.
+  apply eqb_prop in ER; apply eqb_prop in EV; subst r2 v2.
+  apply link_linkorder in LF. apply link_linkorder in LI.
+  split; constructor; tauto.
+Defined.
+
+Global Opaque Linker_vardef.
+
+(** A trivial linker for the trivial var info [unit]. *)
+
+Instance Linker_unit: Linker unit := {
+  link := fun x y => Some tt;
+  linkorder := fun x y => True
+}.
+Proof.
+- auto.
+- auto.
+- auto.
+Defined.
+
+Global Opaque Linker_unit.
+
+(** Linking global definitions *)
+
+Definition link_def {F V: Type} {LF: Linker F} {LV: Linker V} (gd1 gd2: globdef F V) :=
+  match gd1, gd2 with
+  | Gfun f1, Gfun f2 =>
+      match link f1 f2 with Some f => Some (Gfun f) | None => None end
+  | Gvar v1, Gvar v2 =>
+      match link v1 v2 with Some v => Some (Gvar v) | None => None end
+  | _, _ => None
+  end.
+
+Inductive linkorder_def {F V: Type} {LF: Linker F} {LV: Linker V}: globdef F V -> globdef F V -> Prop :=
+  | linkorder_def_fun: forall fd1 fd2,
+      linkorder fd1 fd2 ->
+      linkorder_def (Gfun fd1) (Gfun fd2)
+  | linkorder_def_var: forall v1 v2,
+      linkorder v1 v2 ->
+      linkorder_def (Gvar v1) (Gvar v2).
+
+Instance Linker_def (F V: Type) {LF: Linker F} {LV: Linker V}: Linker (globdef F V) := {
+  link := link_def;
+  linkorder := linkorder_def
+}.
+Proof.
+- intros. destruct x; constructor; apply linkorder_refl.
+- intros. inv H; inv H0; constructor; eapply linkorder_trans; eauto.
+- unfold link_def; intros.  
+  destruct x as [f1|v1], y as [f2|v2]; try discriminate.
++ destruct (link f1 f2) as [f|] eqn:L; inv H. apply link_linkorder in L.
+  split; constructor; tauto.
++ destruct (link v1 v2) as [v|] eqn:L; inv H. apply link_linkorder in L.
+  split; constructor; tauto.
+Defined.
+
+Global Opaque Linker_def.
+
+(** Linking two compilation units.  Compilation units are represented like
+  whole programs using the type [program F V].  If a name has
+  a global definition in one unit but not in the other, this definition
+  is left unchanged in the result of the link.  If a name has
+  global definitions in both units, and is public (not static) in both,
+  the two definitions are linked as per [Linker_def] above.  
+
+  If one or both definitions are static (not public), we should ideally
+  rename it so that it can be kept unchanged in the result of the link.
+  This would require a general notion of renaming of global identifiers
+  in programs that we do not have yet.  Hence, as a first step, linking
+  is undefined if static definitions with the same name appear in both
+  compilation units. *)
+
+Section LINKER_PROG.
+
+Context {F V: Type} {LF: Linker F} {LV: Linker V} (p1 p2: program F V).
+
+Let dm1 := prog_defmap p1.
+Let dm2 := prog_defmap p2.
+
+Definition link_prog_check (x: ident) (gd1: globdef F V) :=
+  match dm2!x with
+  | None => true
+  | Some gd2 =>
+      In_dec peq x p1.(prog_public)
+      && In_dec peq x p2.(prog_public)
+      && match link gd1 gd2 with Some _ => true | None => false end
+  end.
+
+Definition link_prog_merge (o1 o2: option (globdef F V)) :=
+  match o1, o2 with
+  | None, _ => o2
+  | _, None => o1
+  | Some gd1, Some gd2 => link gd1 gd2
+  end.
+
+Definition link_prog :=
+  if ident_eq p1.(prog_main) p2.(prog_main)
+  && PTree_Properties.for_all dm1 link_prog_check then
+    Some {| prog_main := p1.(prog_main);
+            prog_public := p1.(prog_public) ++ p2.(prog_public);
+            prog_defs := PTree.elements (PTree.combine link_prog_merge dm1 dm2) |}
+  else
+    None.
+
+Lemma link_prog_inv:
+  forall p,
+  link_prog = Some p ->
+      p1.(prog_main) = p2.(prog_main)
+   /\ (forall id gd1 gd2,
+         dm1!id = Some gd1 -> dm2!id = Some gd2 ->
+         In id p1.(prog_public) /\ In id p2.(prog_public) /\ exists gd, link gd1 gd2 = Some gd)
+  /\ p = {| prog_main := p1.(prog_main);
+            prog_public := p1.(prog_public) ++ p2.(prog_public);
+            prog_defs := PTree.elements (PTree.combine link_prog_merge dm1 dm2) |}.
+Proof.
+  unfold link_prog; intros p E.
+  destruct (ident_eq (prog_main p1) (prog_main p2)); try discriminate.
+  destruct (PTree_Properties.for_all dm1 link_prog_check) eqn:C; inv E.
+  rewrite PTree_Properties.for_all_correct in C. 
+  split; auto. split; auto. 
+  intros. exploit C; eauto. unfold link_prog_check. rewrite H0. intros.
+  destruct (in_dec peq id (prog_public p1)); try discriminate.
+  destruct (in_dec peq id (prog_public p2)); try discriminate.
+  destruct (link gd1 gd2) eqn:L; try discriminate.
+  intuition auto. exists g; auto.
+Qed.
+
+Lemma link_prog_succeeds:
+  p1.(prog_main) = p2.(prog_main) ->
+  (forall id gd1 gd2,
+      dm1!id = Some gd1 -> dm2!id = Some gd2 ->
+      In id p1.(prog_public) /\ In id p2.(prog_public) /\ link gd1 gd2 <> None) ->
+  link_prog =
+    Some {| prog_main := p1.(prog_main);
+            prog_public := p1.(prog_public) ++ p2.(prog_public);
+            prog_defs := PTree.elements (PTree.combine link_prog_merge dm1 dm2) |}.
+Proof.
+  intros. unfold link_prog. unfold proj_sumbool. rewrite H, dec_eq_true. simpl. 
+  replace (PTree_Properties.for_all dm1 link_prog_check) with true; auto.
+  symmetry. apply PTree_Properties.for_all_correct; intros. rename a into gd1.
+  unfold link_prog_check. destruct dm2!x as [gd2|] eqn:G2; auto.
+  exploit H0; eauto. intros (P & Q & R). unfold proj_sumbool; rewrite ! pred_dec_true by auto.
+  destruct (link gd1 gd2); auto; discriminate.
+Qed.
+
+Lemma prog_defmap_elements:
+  forall (m: PTree.t (globdef F V)) pub mn x,
+  (prog_defmap {| prog_defs := PTree.elements m; prog_public := pub; prog_main := mn |})!x = m!x.
+Proof.
+  intros. unfold prog_defmap; simpl. apply PTree_Properties.of_list_elements.
+Qed.
+
+End LINKER_PROG.
+
+Instance Linker_prog (F V: Type) {LF: Linker F} {LV: Linker V} : Linker (program F V) := {
+  link := link_prog;
+  linkorder := fun p1 p2 =>
+     p1.(prog_main) = p2.(prog_main)
+  /\ incl p1.(prog_public) p2.(prog_public)
+  /\ forall id gd1,
+     (prog_defmap p1)!id = Some gd1 ->
+     exists gd2,
+        (prog_defmap p2)!id = Some gd2
+     /\ linkorder gd1 gd2
+     /\ (~In id p2.(prog_public) -> gd2 = gd1)
+}.
+Proof.
+- intros; split; auto. split. apply incl_refl. intros.
+  exists gd1; split; auto. split; auto. apply linkorder_refl. 
+
+- intros x y z (A1 & B1 & C1) (A2 & B2 & C2). 
+  split. congruence. split. red; eauto. 
+  intros. exploit C1; eauto. intros (gd2 & P & Q & R). 
+  exploit C2; eauto. intros (gd3 & U & X & Y). 
+  exists gd3. split; auto. split. eapply linkorder_trans; eauto. 
+  intros. transitivity gd2. apply Y. auto. apply R. red; intros; elim H0; auto. 
+
+- intros. apply link_prog_inv in H. destruct H as (L1 & L2 & L3).
+  subst z; simpl. intuition auto.
++ red; intros; apply in_app_iff; auto.
++ rewrite prog_defmap_elements, PTree.gcombine, H by auto. 
+  destruct (prog_defmap y)!id as [gd2|] eqn:GD2; simpl.
+* exploit L2; eauto. intros (P & Q & gd & R).
+  exists gd; split. auto. split. apply link_linkorder in R; tauto. 
+  rewrite in_app_iff; tauto.
+* exists gd1; split; auto. split. apply linkorder_refl. auto.
++ red; intros; apply in_app_iff; auto.
++ rewrite prog_defmap_elements, PTree.gcombine, H by auto. 
+  destruct (prog_defmap x)!id as [gd2|] eqn:GD2; simpl.
+* exploit L2; eauto. intros (P & Q & gd & R).
+  exists gd; split. auto. split. apply link_linkorder in R; tauto. 
+  rewrite in_app_iff; tauto.
+* exists gd1; split; auto. split. apply linkorder_refl. auto.
+Defined.
+
+Lemma prog_defmap_linkorder:
+  forall {F V: Type} {LF: Linker F} {LV: Linker V} (p1 p2: program F V) id gd1,
+  linkorder p1 p2 ->
+  (prog_defmap p1)!id = Some gd1 ->
+  exists gd2, (prog_defmap p2)!id = Some gd2 /\ linkorder gd1 gd2.
+Proof.
+  intros. destruct H as (A & B & C).
+  exploit C; eauto. intros (gd2 & P & Q & R). exists gd2; auto.
+Qed.
+
+Global Opaque Linker_prog.
+
+(** * Matching between two programs *)
+
+(** The following is a relational presentation of program transformations,
+  e.g. [transf_partial_program] from module [AST].  *)
+
+(** To capture the possibility of separate compilation, we parameterize
+  the [match_fundef] relation between function definitions with
+  a context, e.g. the compilation unit from which the function definition comes.
+  This unit is characterized as any program that is in the [linkorder]
+  relation with the final, whole program. *)
+
+Section MATCH_PROGRAM_GENERIC.
+
+Context {C F1 V1 F2 V2: Type} {LC: Linker C} {LF: Linker F1} {LV: Linker V1}.
+Variable match_fundef: C -> F1 -> F2 -> Prop.
+Variable match_varinfo: V1 -> V2 -> Prop.
+
+Inductive match_globvar: globvar V1 -> globvar V2 -> Prop :=
+  | match_globvar_intro: forall i1 i2 init ro vo,
+      match_varinfo i1 i2 ->
+      match_globvar (mkglobvar i1 init ro vo) (mkglobvar i2 init ro vo).
+
+Inductive match_globdef (ctx: C): globdef F1 V1 -> globdef F2 V2 -> Prop :=
+  | match_globdef_fun: forall ctx' f1 f2,
+      linkorder ctx' ctx ->
+      match_fundef ctx' f1 f2 ->
+      match_globdef ctx (Gfun f1) (Gfun f2)
+  | match_globdef_var: forall v1 v2,
+      match_globvar v1 v2 ->
+      match_globdef ctx (Gvar v1) (Gvar v2).
+
+Definition match_ident_globdef
+     (ctx: C) (ig1: ident * globdef F1 V1) (ig2: ident * globdef F2 V2) : Prop :=
+  fst ig1 = fst ig2 /\ match_globdef ctx (snd ig1) (snd ig2).
+
+Definition match_program_gen (ctx: C) (p1: program F1 V1) (p2: program F2 V2) : Prop :=
+  list_forall2 (match_ident_globdef ctx) p1.(prog_defs) p2.(prog_defs)
+  /\ p2.(prog_main) = p1.(prog_main)
+  /\ p2.(prog_public) = p1.(prog_public).
+
+Theorem match_program_defmap:
+  forall ctx p1 p2, match_program_gen ctx p1 p2 ->
+  forall id, option_rel (match_globdef ctx) (prog_defmap p1)!id (prog_defmap p2)!id.
+Proof.
+  intros. apply PTree_Properties.of_list_related. apply H. 
+Qed.
+
+Lemma match_program_gen_main:
+  forall ctx p1 p2, match_program_gen ctx p1 p2 -> p2.(prog_main) = p1.(prog_main).
+Proof.
+  intros. apply H. 
+Qed.
+
+Lemma match_program_public:
+  forall ctx p1 p2, match_program_gen ctx p1 p2 -> p2.(prog_public) = p1.(prog_public).
+Proof.
+  intros. apply H. 
+Qed.
+
+End MATCH_PROGRAM_GENERIC.
+
+(** In many cases, the context for [match_program_gen] is the source program or 
+  source compilation unit itself.  We provide a specialized definition for this case. *)
+
+Definition match_program {F1 V1 F2 V2: Type} {LF: Linker F1} {LV: Linker V1}
+                         (match_fundef: program F1 V1 -> F1 -> F2 -> Prop)
+                         (match_varinfo: V1 -> V2 -> Prop)
+                         (p1: program F1 V1) (p2: program F2 V2) : Prop :=
+  match_program_gen match_fundef match_varinfo p1 p1 p2.
+
+Lemma match_program_main:
+  forall {F1 V1 F2 V2: Type} {LF: Linker F1} {LV: Linker V1}
+         {match_fundef: program F1 V1 -> F1 -> F2 -> Prop}
+         {match_varinfo: V1 -> V2 -> Prop}
+         {p1: program F1 V1} {p2: program F2 V2},
+  match_program match_fundef match_varinfo p1 p2 -> p2.(prog_main) = p1.(prog_main).
+Proof.
+  intros. apply H.
+Qed.
+
+(*
+Lemma match_program_implies:
+  forall (A B V W: Type) (LA: Linker A) (LV: Linker V)
+         (match_fundef1 match_fundef2: program A V -> A -> B -> Prop)
+         (match_varinfo1 match_varinfo2: V -> W -> Prop)
+         p p',
+  match_program match_fundef1 match_varinfo1 p p' ->
+  (forall cu a b, match_fundef1 cu a b -> linkorder cu p -> match_fundef2 cu a b) ->
+  (forall v w, match_varinfo1 v w -> match_varinfo2 v w) ->
+  match_program match_fundef2 match_varinfo2 p p'.
+Proof.
+  intros. destruct H as [P Q]. split; auto. 
+  eapply list_forall2_imply; eauto.
+  intros. inv H3. split; auto. inv H5.
+  econstructor; eauto.
+  constructor. inv H7; constructor; auto.
+Qed.
+*)
+
+(** Relation between the program transformation functions from [AST]
+  and the [match_program] predicate. *)
+
+Theorem match_transform_partial_program2:
+  forall {C F1 V1 F2 V2: Type} {LC: Linker C} {LF: Linker F1} {LV: Linker V1}
+         (match_fundef: C -> F1 -> F2 -> Prop)
+         (match_varinfo: V1 -> V2 -> Prop)
+         (transf_fun: ident -> F1 -> res F2)
+         (transf_var: ident -> V1 -> res V2)
+         (ctx: C) (p: program F1 V1) (tp: program F2 V2),
+  transform_partial_program2 transf_fun transf_var p = OK tp ->
+  (forall i f tf, transf_fun i f = OK tf -> match_fundef ctx f tf) ->
+  (forall i v tv, transf_var i v = OK tv -> match_varinfo v tv) ->
+  match_program_gen match_fundef match_varinfo ctx p tp.
+Proof.
+  unfold transform_partial_program2; intros. monadInv H.
+  red; simpl; split; auto. 
+  revert x EQ. generalize (prog_defs p). 
+  induction l as [ | [i g] l]; simpl; intros.
+- monadInv EQ. constructor.
+- destruct g as [f|v].
++ destruct (transf_fun i f) as [tf|?] eqn:TF; monadInv EQ. 
+  constructor; auto. split; simpl; auto. econstructor. apply linkorder_refl. eauto.
++ destruct (transf_globvar transf_var i v) as [tv|?] eqn:TV; monadInv EQ.
+  constructor; auto. split; simpl; auto. constructor.
+  monadInv TV. destruct v; simpl; constructor. eauto.
+Qed.
+
+Theorem match_transform_partial_program_contextual:
+  forall {A B V: Type} {LA: Linker A} {LV: Linker V}
+         (match_fundef: program A V -> A -> B -> Prop)
+         (transf_fun: A -> res B)
+         (p: program A V) (tp: program B V),
+  transform_partial_program transf_fun p = OK tp ->
+  (forall f tf, transf_fun f = OK tf -> match_fundef p f tf) ->
+  match_program match_fundef eq p tp.
+Proof.
+  intros. 
+  eapply match_transform_partial_program2. eexact H.
+  auto.
+  simpl; intros. congruence.
+Qed.
+
+Theorem match_transform_program_contextual:
+  forall {A B V: Type} {LA: Linker A} {LV: Linker V}
+         (match_fundef: program A V -> A -> B -> Prop)
+         (transf_fun: A -> B)
+         (p: program A V),
+  (forall f, match_fundef p f (transf_fun f)) ->
+  match_program match_fundef eq p (transform_program transf_fun p).
+Proof.
+  intros. 
+  eapply match_transform_partial_program_contextual. 
+  apply transform_program_partial_program with (transf_fun := transf_fun).
+  simpl; intros. inv H0. auto.
+Qed.
+
+(** The following two theorems are simpler versions for the case where the
+  function transformation does not depend on the compilation unit. *)
+
+Theorem match_transform_partial_program:
+  forall {A B V: Type} {LA: Linker A} {LV: Linker V}
+         (transf_fun: A -> res B)
+         (p: program A V) (tp: program B V),
+  transform_partial_program transf_fun p = OK tp ->
+  match_program (fun cu f tf => transf_fun f = OK tf) eq p tp.
+Proof.
+  intros.
+  eapply match_transform_partial_program2. eexact H.
+  auto.
+  simpl; intros. congruence.
+Qed.
+
+Theorem match_transform_program:
+  forall {A B V: Type} {LA: Linker A} {LV: Linker V}
+         (transf: A -> B)
+         (p: program A V),
+  match_program (fun cu f tf => tf = transf f) eq p (transform_program transf p).
+Proof.
+  intros. apply match_transform_program_contextual. auto.
+Qed.
+
+(** * Commutation between linking and program transformations *)
+
+Section LINK_MATCH_PROGRAM.
+
+Context {C F1 V1 F2 V2: Type} {LC: Linker C} {LF1: Linker F1} {LF2: Linker F2} {LV1: Linker V1} {LV2: Linker V2}.
+Variable match_fundef: C -> F1 -> F2 -> Prop.
+Variable match_varinfo: V1 -> V2 -> Prop.
+
+Local Transparent Linker_vardef Linker_def Linker_prog.
+
+Hypothesis link_match_fundef:
+  forall ctx1 ctx2 f1 tf1 f2 tf2 f,
+  link f1 f2 = Some f ->
+  match_fundef ctx1 f1 tf1 -> match_fundef ctx2 f2 tf2 ->
+  exists tf, link tf1 tf2 = Some tf /\ (match_fundef ctx1 f tf \/ match_fundef ctx2 f tf).
+
+Hypothesis link_match_varinfo:
+  forall v1 tv1 v2 tv2 v,
+  link v1 v2 = Some v ->
+  match_varinfo v1 tv1 -> match_varinfo v2 tv2 ->
+  exists tv, link tv1 tv2 = Some tv /\ match_varinfo v tv.
+
+Lemma link_match_globvar:
+  forall v1 tv1 v2 tv2 v,
+  link v1 v2 = Some v ->
+  match_globvar match_varinfo v1 tv1 -> match_globvar match_varinfo v2 tv2 ->
+  exists tv, link tv1 tv2 = Some tv /\ match_globvar match_varinfo v tv.
+Proof.
+  simpl; intros. unfold link_vardef in *. inv H0; inv H1; simpl in *. 
+  destruct (link i1 i0) as [info'|] eqn:LINFO; try discriminate.
+  destruct (link init init0) as [init'|] eqn:LINIT; try discriminate.
+  destruct (eqb ro ro0 && eqb vo vo0); inv H.
+  exploit link_match_varinfo; eauto. intros (tinfo & P & Q). rewrite P. 
+  econstructor; split. eauto. constructor. auto.
+Qed.
+
+Lemma link_match_globdef:
+  forall ctx1 ctx2 ctx g1 tg1 g2 tg2 g,
+  linkorder ctx1 ctx -> linkorder ctx2 ctx ->
+  link g1 g2 = Some g ->
+  match_globdef match_fundef match_varinfo ctx1 g1 tg1 ->
+  match_globdef match_fundef match_varinfo ctx2 g2 tg2 ->
+  exists tg, link tg1 tg2 = Some tg /\ match_globdef match_fundef match_varinfo ctx g tg.
+Proof.
+  simpl link. unfold link_def. intros. inv H2; inv H3; try discriminate.
+- destruct (link f1 f0) as [f|] eqn:LF; inv H1.
+  exploit link_match_fundef; eauto. intros (tf & P & Q).
+  assert (X: exists ctx', linkorder ctx' ctx /\ match_fundef ctx' f tf).
+  { destruct Q as [Q|Q]; econstructor; (split; [|eassumption]).
+    apply linkorder_trans with ctx1; auto. 
+    apply linkorder_trans with ctx2; auto. }
+  destruct X as (cu & X & Y).
+  exists (Gfun tf); split. rewrite P; auto. econstructor; eauto.
+- destruct (link v1 v0) as [v|] eqn:LVAR; inv H1.
+  exploit link_match_globvar; eauto. intros (tv & P & Q).
+  exists (Gvar tv); split. rewrite P; auto. constructor; auto.
+Qed.
+
+Lemma match_globdef_linkorder:
+  forall ctx ctx' g tg,
+  match_globdef match_fundef match_varinfo ctx g tg ->
+  linkorder ctx ctx' ->
+  match_globdef match_fundef match_varinfo ctx' g tg.
+Proof.
+  intros. inv H. 
+- econstructor. eapply linkorder_trans; eauto. auto.
+- constructor; auto.
+Qed.
+
+Theorem link_match_program:
+  forall ctx1 ctx2 ctx p1 p2 tp1 tp2 p,
+  link p1 p2 = Some p ->
+  match_program_gen match_fundef match_varinfo ctx1 p1 tp1 ->
+  match_program_gen match_fundef match_varinfo ctx2 p2 tp2 ->
+  linkorder ctx1 ctx -> linkorder ctx2 ctx ->
+  exists tp, link tp1 tp2 = Some tp /\ match_program_gen match_fundef match_varinfo ctx p tp.
+Proof.
+  intros. destruct (link_prog_inv _ _ _ H) as (P & Q & R).
+  generalize H0; intros (A1 & B1 & C1).
+  generalize H1; intros (A2 & B2 & C2).
+  econstructor; split.
+- apply link_prog_succeeds. 
++ congruence. 
++ intros. 
+  generalize (match_program_defmap _ _ _ _ _ H0 id) (match_program_defmap _ _ _ _ _ H1 id).
+  rewrite H4, H5. intros R1 R2; inv R1; inv R2.
+  exploit Q; eauto. intros (X & Y & gd & Z).
+  exploit link_match_globdef. eexact H2. eexact H3. eauto. eauto. eauto. 
+  intros (tg & TL & _). intuition congruence.
+- split; [|split].
++ rewrite R. apply PTree.elements_canonical_order'. intros id. 
+  rewrite ! PTree.gcombine by auto.
+  generalize (match_program_defmap _ _ _ _ _ H0 id) (match_program_defmap _ _ _ _ _ H1 id).
+  clear R. intros R1 R2; inv R1; inv R2; unfold link_prog_merge.
+* constructor.
+* constructor. apply match_globdef_linkorder with ctx2; auto. 
+* constructor. apply match_globdef_linkorder with ctx1; auto.
+* exploit Q; eauto. intros (X & Y & gd & Z).
+  exploit link_match_globdef. eexact H2. eexact H3. eauto. eauto. eauto. 
+  intros (tg & TL & MG). rewrite Z, TL. constructor; auto. 
++ rewrite R; simpl; auto.
++ rewrite R; simpl. congruence.
+Qed.
+
+End LINK_MATCH_PROGRAM.
+
+(** We now wrap this commutation diagram into a class, and provide some common instances. *)
+
+Class TransfLink {A B: Type} {LA: Linker A} {LB: Linker B} (transf: A -> B -> Prop) :=
+  transf_link:
+    forall (p1 p2: A) (tp1 tp2: B) (p: A),
+    link p1 p2 = Some p ->
+    transf p1 tp1 -> transf p2 tp2 ->
+    exists tp, link tp1 tp2 = Some tp /\ transf p tp.
+
+Remark link_transf_partial_fundef:
+  forall (A B: Type) (tr1 tr2: A -> res B) (f1 f2: fundef A) (tf1 tf2: fundef B) (f: fundef A),
+  link f1 f2 = Some f ->
+  transf_partial_fundef tr1 f1 = OK tf1 ->
+  transf_partial_fundef tr2 f2 = OK tf2 ->
+  exists tf, 
+      link tf1 tf2 = Some tf
+  /\ (transf_partial_fundef tr1 f = OK tf \/ transf_partial_fundef tr2 f = OK tf).
+Proof.
+Local Transparent Linker_fundef.
+  simpl; intros. destruct f1 as [f1|ef1], f2 as [f2|ef2]; simpl in *; monadInv H0; monadInv H1.
+- discriminate.
+- destruct ef2; inv H. exists (Internal x); split; auto. left; simpl; rewrite EQ; auto.
+- destruct ef1; inv H. exists (Internal x); split; auto. right; simpl; rewrite EQ; auto.
+- destruct (external_function_eq ef1 ef2); inv H. exists (External ef2); split; auto. simpl. rewrite dec_eq_true; auto. 
+Qed.
+
+Instance TransfPartialContextualLink
+           {A B C V: Type} {LV: Linker V}
+           (tr_fun: C -> A -> res B)
+           (ctx_for: program (fundef A) V -> C):
+  TransfLink (fun (p1: program (fundef A) V) (p2: program (fundef B) V) =>
+              match_program
+                (fun cu f tf => AST.transf_partial_fundef (tr_fun (ctx_for cu)) f = OK tf)
+                eq p1 p2).
+Proof.
+  red. intros. destruct (link_linkorder _ _ _ H) as [LO1 LO2].
+  eapply link_match_program; eauto.
+- intros. eapply link_transf_partial_fundef; eauto. 
+- intros; subst. exists v; auto. 
+Qed.
+
+Instance TransfPartialLink
+           {A B V: Type} {LV: Linker V}
+           (tr_fun: A -> res B):
+  TransfLink (fun (p1: program (fundef A) V) (p2: program (fundef B) V) =>
+              match_program
+                (fun cu f tf => AST.transf_partial_fundef tr_fun f = OK tf)
+                eq p1 p2).
+Proof.
+  red. intros. destruct (link_linkorder _ _ _ H) as [LO1 LO2].
+  eapply link_match_program; eauto.
+- intros. eapply link_transf_partial_fundef; eauto. 
+- intros; subst. exists v; auto. 
+Qed.
+
+Instance TransfTotallContextualLink
+           {A B C V: Type} {LV: Linker V}
+           (tr_fun: C -> A -> B)
+           (ctx_for: program (fundef A) V -> C):
+  TransfLink (fun (p1: program (fundef A) V) (p2: program (fundef B) V) =>
+              match_program
+                (fun cu f tf => tf = AST.transf_fundef (tr_fun (ctx_for cu)) f)
+                eq p1 p2).
+Proof.
+  red. intros. destruct (link_linkorder _ _ _ H) as [LO1 LO2].
+  eapply link_match_program; eauto.
+- intros. subst. destruct f1, f2; simpl in *. 
++ discriminate.
++ destruct e; inv H2. econstructor; eauto. 
++ destruct e; inv H2. econstructor; eauto. 
++ destruct (external_function_eq e e0); inv H2. econstructor; eauto. 
+- intros; subst. exists v; auto. 
+Qed.
+
+Instance TransfTotalLink
+           {A B V: Type} {LV: Linker V}
+           (tr_fun: A -> B):
+  TransfLink (fun (p1: program (fundef A) V) (p2: program (fundef B) V) =>
+              match_program
+                (fun cu f tf => tf = AST.transf_fundef tr_fun f)
+                eq p1 p2).
+Proof.
+  red. intros. destruct (link_linkorder _ _ _ H) as [LO1 LO2].
+  eapply link_match_program; eauto.
+- intros. subst. destruct f1, f2; simpl in *. 
++ discriminate.
++ destruct e; inv H2. econstructor; eauto. 
++ destruct e; inv H2. econstructor; eauto. 
++ destruct (external_function_eq e e0); inv H2. econstructor; eauto. 
+- intros; subst. exists v; auto. 
+Qed.
+
+(** * Linking a set of compilation units *)
+
+(** Here, we take a more general view of linking as taking a nonempty list of compilation units
+  and producing a whole program. *)
+
+Section LINK_LIST.
+
+Context {A: Type} {LA: Linker A}.
+
+Fixpoint link_list (l: nlist A) : option A :=
+  match l with
+  | nbase a => Some a
+  | ncons a l =>
+      match link_list l with None => None | Some b => link a b end
+  end.
+
+Lemma link_list_linkorder:
+  forall a l b, link_list l = Some b -> nIn a l -> linkorder a b.
+Proof.
+  induction l; simpl; intros.
+- inv H. subst. apply linkorder_refl.
+- destruct (link_list l) as [b'|]; try discriminate.
+  apply link_linkorder in H. destruct H0.
++ subst a0. tauto.
++ apply linkorder_trans with b'. auto. tauto.
+Qed.
+
+End LINK_LIST.
+
+(** List linking commutes with program transformations, provided the
+  transformation commutes with simple (binary) linking. *)
+
+Section LINK_LIST_MATCH.
+
+Context {A B: Type} {LA: Linker A} {LB: Linker B} (prog_match: A -> B -> Prop) {TL: TransfLink prog_match}.
+
+Theorem link_list_match:
+  forall al bl, nlist_forall2 prog_match al bl ->
+  forall a, link_list al = Some a ->
+  exists b, link_list bl = Some b /\ prog_match a b.
+Proof.
+  induction 1; simpl; intros a' L.
+- inv L. exists b; auto. 
+- destruct (link_list l) as [a1|] eqn:LL; try discriminate.
+  exploit IHnlist_forall2; eauto. intros (b' & P & Q).
+  red in TL. exploit TL; eauto. intros (b'' & U & V).
+  rewrite P; exists b''; auto.
+Qed.
+
+End LINK_LIST_MATCH.
+
+(** * Linking and composition of compilation passes *)
+
+Set Implicit Arguments.
+
+(** A generic language is a type of programs and a linker. *)
+
+Structure Language := mklang { lang_prog :> Type; lang_link: Linker lang_prog }.
+
+Canonical Structure Language_gen (A: Type) (L: Linker A) : Language := @mklang A L.
+
+(** A compilation pass from language [S] (source) to language [T] (target)
+  is a matching relation between [S] programs and [T] programs,
+  plus two linkers, one for [S] and one for [T],
+  and a property of commutation with linking. *)
+
+Record Pass (S T: Language) := mkpass {
+  pass_match :> lang_prog S -> lang_prog T -> Prop;
+  pass_match_link: @TransfLink (lang_prog S) (lang_prog T) (lang_link S) (lang_link T) pass_match
+}.
+
+Arguments mkpass {S} {T} (pass_match) {pass_match_link}.
+
+Program Definition pass_identity (l: Language): Pass l l :=
+  {| pass_match := fun p1 p2 => p1 = p2;
+     pass_match_link := _ |}.
+Next Obligation.
+  red; intros. subst. exists p; auto. 
+Defined.
+
+Program Definition pass_compose {l1 l2 l3: Language} (pass: Pass l1 l2) (pass': Pass l2 l3) : Pass l1 l3 :=
+  {| pass_match := fun p1 p3 => exists p2, pass_match pass p1 p2 /\ pass_match pass' p2 p3;
+     pass_match_link := _ |}.
+Next Obligation.
+  red; intros.
+  destruct H0 as (p1' & A1 & B1).
+  destruct H1 as (p2' & A2 & B2).
+  edestruct (pass_match_link pass) as (p' & A & B); eauto.
+  edestruct (pass_match_link pass') as (tp & C & D); eauto.
+Defined.
+
+(** A list of compilation passes that can be composed. *)
+
+Inductive Passes: Language -> Language -> Type :=
+  | pass_nil: forall l, Passes l l
+  | pass_cons: forall l1 l2 l3, Pass l1 l2 -> Passes l2 l3 -> Passes l1 l3.
+
+Infix ":::" := pass_cons (at level 60, right associativity) : linking_scope.
+
+(** The pass corresponding to the composition of a list of passes. *)
+
+Fixpoint compose_passes (l l': Language) (passes: Passes l l') : Pass l l' :=
+  match passes in Passes l l' return Pass l l' with
+  | pass_nil l => pass_identity l
+  | pass_cons l1 l2 l3 pass1 passes => pass_compose pass1 (compose_passes passes)
+  end.
+
+(** Some more lemmas about [nlist_forall2]. *)
+
+Lemma nlist_forall2_identity:
+  forall (A: Type) (la lb: nlist A),
+  nlist_forall2 (fun a b => a = b) la lb -> la = lb.
+Proof.
+  induction 1; congruence.
+Qed.
+
+Lemma nlist_forall2_compose_inv:
+  forall (A B C: Type) (R1: A -> B -> Prop) (R2: B -> C -> Prop)
+         (la: nlist A) (lc: nlist C),
+  nlist_forall2 (fun a c => exists b, R1 a b /\ R2 b c) la lc ->
+  exists lb: nlist B, nlist_forall2 R1 la lb /\ nlist_forall2 R2 lb lc.
+Proof.
+  induction 1.
+- rename b into c. destruct H as (b & P & Q). 
+  exists (nbase b); split; constructor; auto.
+- rename b into c. destruct H as (b & P & Q). destruct IHnlist_forall2 as (lb & U & V).
+  exists (ncons b lb); split; constructor; auto.
+Qed.
+
+(** List linking with a composition of compilation passes. *)
+
+Theorem link_list_compose_passes:
+  forall (src tgt: Language) (passes: Passes src tgt)
+         (src_units: nlist src) (tgt_units: nlist tgt),
+  nlist_forall2 (pass_match (compose_passes passes)) src_units tgt_units ->
+  forall src_prog,
+  @link_list _ (lang_link src) src_units = Some src_prog ->
+  exists tgt_prog,
+  @link_list _ (lang_link tgt) tgt_units = Some tgt_prog
+  /\ pass_match (compose_passes passes) src_prog tgt_prog.
+Proof.
+  induction passes; simpl; intros src_units tgt_units F2 src_prog LINK.
+- apply nlist_forall2_identity in F2. subst tgt_units. exists src_prog; auto.
+- apply nlist_forall2_compose_inv in F2. destruct F2 as (interm_units & P & Q).
+  edestruct (@link_list_match _ _ (lang_link l1) (lang_link l2) (pass_match p))
+  as (interm_prog & U & V).
+  apply pass_match_link. eauto. eauto.  
+  exploit IHpasses; eauto. intros (tgt_prog & X & Y).
+  exists tgt_prog; split; auto. exists interm_prog; auto. 
+Qed.
+
diff --git a/common/Memory.v b/common/Memory.v
index 93d0e432..0ea9e3b0 100644
--- a/common/Memory.v
+++ b/common/Memory.v
@@ -4143,6 +4143,8 @@ Section UNCHANGED_ON.
 Variable P: block -> Z -> Prop.
 
 Record unchanged_on (m_before m_after: mem) : Prop := mk_unchanged_on {
+  unchanged_on_nextblock:
+    Ple (nextblock m_before) (nextblock m_after);
   unchanged_on_perm:
     forall b ofs k p,
     P b ofs -> valid_block m_before b ->
@@ -4157,15 +4159,22 @@ Record unchanged_on (m_before m_after: mem) : Prop := mk_unchanged_on {
 Lemma unchanged_on_refl:
   forall m, unchanged_on m m.
 Proof.
-  intros; constructor; tauto.
+  intros; constructor. apply Ple_refl. tauto. tauto.
+Qed.
+
+Lemma valid_block_unchanged_on:
+  forall m m' b,
+  unchanged_on m m' -> valid_block m b -> valid_block m' b.
+Proof.
+  unfold valid_block; intros. apply unchanged_on_nextblock in H. xomega.
 Qed.
 
 Lemma perm_unchanged_on:
   forall m m' b ofs k p,
-  unchanged_on m m' -> P b ofs -> valid_block m b ->
+  unchanged_on m m' -> P b ofs ->
   perm m b ofs k p -> perm m' b ofs k p.
 Proof.
-  intros. destruct H. apply unchanged_on_perm0; auto.
+  intros. destruct H. apply unchanged_on_perm0; auto. eapply perm_valid_block; eauto. 
 Qed.
 
 Lemma perm_unchanged_on_2:
@@ -4176,6 +4185,17 @@ Proof.
   intros. destruct H. apply unchanged_on_perm0; auto.
 Qed.
 
+Lemma unchanged_on_trans:
+  forall m1 m2 m3, unchanged_on m1 m2 -> unchanged_on m2 m3 -> unchanged_on m1 m3.
+Proof.
+  intros; constructor.
+- apply Ple_trans with (nextblock m2); apply unchanged_on_nextblock; auto.
+- intros. transitivity (perm m2 b ofs k p); apply unchanged_on_perm; auto.
+  eapply valid_block_unchanged_on; eauto.
+- intros. transitivity (ZMap.get ofs (mem_contents m2)#b); apply unchanged_on_contents; auto.
+  eapply perm_unchanged_on; eauto. 
+Qed.
+
 Lemma loadbytes_unchanged_on_1:
   forall m m' b ofs n,
   unchanged_on m m' ->
@@ -4243,6 +4263,7 @@ Lemma store_unchanged_on:
   unchanged_on m m'.
 Proof.
   intros; constructor; intros.
+- rewrite (nextblock_store _ _ _ _ _ _ H). apply Ple_refl.
 - split; intros; eauto with mem.
 - erewrite store_mem_contents; eauto. rewrite PMap.gsspec.
   destruct (peq b0 b); auto. subst b0. apply setN_outside.
@@ -4259,6 +4280,7 @@ Lemma storebytes_unchanged_on:
   unchanged_on m m'.
 Proof.
   intros; constructor; intros.
+- rewrite (nextblock_storebytes _ _ _ _ _ H). apply Ple_refl.
 - split; intros. eapply perm_storebytes_1; eauto. eapply perm_storebytes_2; eauto.
 - erewrite storebytes_mem_contents; eauto. rewrite PMap.gsspec.
   destruct (peq b0 b); auto. subst b0. apply setN_outside.
@@ -4273,6 +4295,7 @@ Lemma alloc_unchanged_on:
   unchanged_on m m'.
 Proof.
   intros; constructor; intros.
+- rewrite (nextblock_alloc _ _ _ _ _ H). apply Ple_succ.
 - split; intros.
   eapply perm_alloc_1; eauto.
   eapply perm_alloc_4; eauto.
@@ -4288,6 +4311,7 @@ Lemma free_unchanged_on:
   unchanged_on m m'.
 Proof.
   intros; constructor; intros.
+- rewrite (nextblock_free _ _ _ _ _ H). apply Ple_refl.
 - split; intros.
   eapply perm_free_1; eauto.
   destruct (eq_block b0 b); auto. destruct (zlt ofs lo); auto. destruct (zle hi ofs); auto.
@@ -4297,8 +4321,39 @@ Proof.
   simpl. auto.
 Qed.
 
+Lemma drop_perm_unchanged_on:
+  forall m b lo hi p m',
+  drop_perm m b lo hi p = Some m' ->
+  (forall i, lo <= i < hi -> ~ P b i) ->
+  unchanged_on m m'.
+Proof.
+  intros; constructor; intros.
+- rewrite (nextblock_drop _ _ _ _ _ _ H). apply Ple_refl.
+- split; intros. eapply perm_drop_3; eauto.
+  destruct (eq_block b0 b); auto.
+  subst b0. 
+  assert (~ (lo <= ofs < hi)). { red; intros; eelim H0; eauto. }
+  right; omega.
+  eapply perm_drop_4; eauto. 
+- unfold drop_perm in H. 
+  destruct (range_perm_dec m b lo hi Cur Freeable); inv H; simpl. auto.
+Qed. 
+
 End UNCHANGED_ON.
 
+Lemma unchanged_on_implies:
+  forall (P Q: block -> Z -> Prop) m m',
+  unchanged_on P m m' ->
+  (forall b ofs, Q b ofs -> valid_block m b -> P b ofs) ->
+  unchanged_on Q m m'.
+Proof.
+  intros. destruct H. constructor; intros.
+- auto.
+- apply unchanged_on_perm0; auto. 
+- apply unchanged_on_contents0; auto. 
+  apply H0; auto. eapply perm_valid_block; eauto. 
+Qed.
+
 End Mem.
 
 Notation mem := Mem.mem.
diff --git a/common/PrintAST.ml b/common/PrintAST.ml
index 39481bfb..48172dfd 100644
--- a/common/PrintAST.ml
+++ b/common/PrintAST.ml
@@ -39,6 +39,7 @@ let name_of_chunk = function
 let name_of_external = function
   | EF_external(name, sg) -> sprintf "extern %S" (camlstring_of_coqstring name)
   | EF_builtin(name, sg) -> sprintf "builtin %S" (camlstring_of_coqstring name)
+  | EF_runtime(name, sg) -> sprintf "runtime %S" (camlstring_of_coqstring name)
   | EF_vload chunk -> sprintf "volatile load %s" (name_of_chunk chunk)
   | EF_vstore chunk -> sprintf "volatile store %s" (name_of_chunk chunk)
   | EF_malloc -> "malloc"
@@ -55,8 +56,8 @@ let rec print_builtin_arg px oc = function
   | BA x -> px oc x
   | BA_int n -> fprintf oc "int %ld" (camlint_of_coqint n)
   | BA_long n -> fprintf oc "long %Ld" (camlint64_of_coqint n)
-  | BA_float n -> fprintf oc "float %F" (camlfloat_of_coqfloat n)
-  | BA_single n -> fprintf oc "single %F" (camlfloat_of_coqfloat32 n)
+  | BA_float n -> fprintf oc "float %.15F" (camlfloat_of_coqfloat n)
+  | BA_single n -> fprintf oc "single %.15F" (camlfloat_of_coqfloat32 n)
   | BA_loadstack(chunk, ofs) ->
       fprintf oc "%s[sp + %ld]" (name_of_chunk chunk) (camlint_of_coqint ofs)
   | BA_addrstack(ofs) ->
diff --git a/common/Smallstep.v b/common/Smallstep.v
index 71cef35f..9c91243a 100644
--- a/common/Smallstep.v
+++ b/common/Smallstep.v
@@ -513,43 +513,49 @@ Open Scope smallstep_scope.
 
 (** The general form of a forward simulation. *)
 
-Record forward_simulation (L1 L2: semantics) : Type :=
-  Forward_simulation {
-    fsim_index: Type;
-    fsim_order: fsim_index -> fsim_index -> Prop;
-    fsim_order_wf: well_founded fsim_order;
-    fsim_match_states :> fsim_index -> state L1 -> state L2 -> Prop;
+Record fsim_properties (L1 L2: semantics) (index: Type)
+                       (order: index -> index -> Prop)
+                       (match_states: index -> state L1 -> state L2 -> Prop) : Prop := {
+    fsim_order_wf: well_founded order;
     fsim_match_initial_states:
       forall s1, initial_state L1 s1 ->
-      exists i, exists s2, initial_state L2 s2 /\ fsim_match_states i s1 s2;
+      exists i, exists s2, initial_state L2 s2 /\ match_states i s1 s2;
     fsim_match_final_states:
       forall i s1 s2 r,
-      fsim_match_states i s1 s2 -> final_state L1 s1 r -> final_state L2 s2 r;
+      match_states i s1 s2 -> final_state L1 s1 r -> final_state L2 s2 r;
     fsim_simulation:
       forall s1 t s1', Step L1 s1 t s1' ->
-      forall i s2, fsim_match_states i s1 s2 ->
+      forall i s2, match_states i s1 s2 ->
       exists i', exists s2',
-         (Plus L2 s2 t s2' \/ (Star L2 s2 t s2' /\ fsim_order i' i))
-      /\ fsim_match_states i' s1' s2';
+         (Plus L2 s2 t s2' \/ (Star L2 s2 t s2' /\ order i' i))
+      /\ match_states i' s1' s2';
     fsim_public_preserved:
       forall id, Senv.public_symbol (symbolenv L2) id = Senv.public_symbol (symbolenv L1) id
   }.
 
-Implicit Arguments forward_simulation [].
+Arguments fsim_properties: clear implicits.
+
+Inductive forward_simulation (L1 L2: semantics) : Prop :=
+  Forward_simulation (index: Type)
+                     (order: index -> index -> Prop)
+                     (match_states: index -> state L1 -> state L2 -> Prop)
+                     (props: fsim_properties L1 L2 index order match_states).
+
+Arguments Forward_simulation {L1 L2 index} order match_states props.
 
 (** An alternate form of the simulation diagram *)
 
 Lemma fsim_simulation':
-  forall L1 L2 (S: forward_simulation L1 L2),
+  forall L1 L2 index order match_states, fsim_properties L1 L2 index order match_states ->
   forall i s1 t s1', Step L1 s1 t s1' ->
-  forall s2, S i s1 s2 ->
-  (exists i', exists s2', Plus L2 s2 t s2' /\ S i' s1' s2')
-  \/ (exists i', fsim_order S i' i /\ t = E0 /\ S i' s1' s2).
+  forall s2, match_states i s1 s2 ->
+  (exists i', exists s2', Plus L2 s2 t s2' /\ match_states i' s1' s2')
+  \/ (exists i', order i' i /\ t = E0 /\ match_states i' s1' s2).
 Proof.
   intros. exploit fsim_simulation; eauto.
   intros [i' [s2' [A B]]]. intuition.
   left; exists i'; exists s2'; auto.
-  inv H2.
+  inv H3.
   right; exists i'; auto.
   left; exists i'; exists s2'; split; auto. econstructor; eauto.
 Qed.
@@ -602,15 +608,15 @@ Hypothesis simulation:
 
 Lemma forward_simulation_star_wf: forward_simulation L1 L2.
 Proof.
-  apply Forward_simulation with
-    (fsim_order := order)
-    (fsim_match_states := fun idx s1 s2 => idx = s1 /\ match_states s1 s2);
-  auto.
-  intros. exploit match_initial_states; eauto. intros [s2 [A B]].
+  apply Forward_simulation with order (fun idx s1 s2 => idx = s1 /\ match_states s1 s2);
+  constructor.
+- auto.
+- intros. exploit match_initial_states; eauto. intros [s2 [A B]].
     exists s1; exists s2; auto.
-  intros. destruct H. eapply match_final_states; eauto.
-  intros. destruct H0. subst i. exploit simulation; eauto. intros [s2' [A B]].
-  exists s1'; exists s2'; intuition.
+- intros. destruct H. eapply match_final_states; eauto.
+- intros. destruct H0. subst i. exploit simulation; eauto. intros [s2' [A B]].
+  exists s1'; exists s2'; intuition auto.
+- auto.
 Qed.
 
 End SIMULATION_STAR_WF.
@@ -709,28 +715,26 @@ End FORWARD_SIMU_DIAGRAMS.
 
 Section SIMULATION_SEQUENCES.
 
-Variable L1: semantics.
-Variable L2: semantics.
-Variable S: forward_simulation L1 L2.
+Context L1 L2 index order match_states (S: fsim_properties L1 L2 index order match_states).
 
 Lemma simulation_star:
   forall s1 t s1', Star L1 s1 t s1' ->
-  forall i s2, S i s1 s2 ->
-  exists i', exists s2', Star L2 s2 t s2' /\ S i' s1' s2'.
+  forall i s2, match_states i s1 s2 ->
+  exists i', exists s2', Star L2 s2 t s2' /\ match_states i' s1' s2'.
 Proof.
   induction 1; intros.
   exists i; exists s2; split; auto. apply star_refl.
   exploit fsim_simulation; eauto. intros [i' [s2' [A B]]].
   exploit IHstar; eauto. intros [i'' [s2'' [C D]]].
   exists i''; exists s2''; split; auto. eapply star_trans; eauto.
-  intuition. apply plus_star; auto.
+  intuition auto. apply plus_star; auto.
 Qed.
 
 Lemma simulation_plus:
   forall s1 t s1', Plus L1 s1 t s1' ->
-  forall i s2, S i s1 s2 ->
-  (exists i', exists s2', Plus L2 s2 t s2' /\ S i' s1' s2')
-  \/ (exists i', clos_trans _ (fsim_order S) i' i /\ t = E0 /\ S i' s1' s2).
+  forall i s2, match_states i s1 s2 ->
+  (exists i', exists s2', Plus L2 s2 t s2' /\ match_states i' s1' s2')
+  \/ (exists i', clos_trans _ order i' i /\ t = E0 /\ match_states i' s1' s2).
 Proof.
   induction 1 using plus_ind2; intros.
 (* base case *)
@@ -744,34 +748,34 @@ Proof.
   left; exists i''; exists s2''; split; auto. eapply plus_star_trans; eauto.
   exploit IHplus; eauto. intros [[i'' [s2'' [P Q]]] | [i'' [P [Q R]]]].
   subst. simpl. left; exists i''; exists s2''; auto.
-  subst. simpl. right; exists i''; intuition.
+  subst. simpl. right; exists i''; intuition auto.
   eapply t_trans; eauto. eapply t_step; eauto.
 Qed.
 
 Lemma simulation_forever_silent:
   forall i s1 s2,
-  Forever_silent L1 s1 -> S i s1 s2 ->
+  Forever_silent L1 s1 -> match_states i s1 s2 ->
   Forever_silent L2 s2.
 Proof.
   assert (forall i s1 s2,
-          Forever_silent L1 s1 -> S i s1 s2 ->
-          forever_silent_N (step L2) (fsim_order S) (globalenv L2) i s2).
+          Forever_silent L1 s1 -> match_states i s1 s2 ->
+          forever_silent_N (step L2) order (globalenv L2) i s2).
     cofix COINDHYP; intros.
     inv H. destruct (fsim_simulation S _ _ _ H1 _ _ H0) as [i' [s2' [A B]]].
     destruct A as [C | [C D]].
     eapply forever_silent_N_plus; eauto.
     eapply forever_silent_N_star; eauto.
-  intros. eapply forever_silent_N_forever; eauto. apply fsim_order_wf.
+  intros. eapply forever_silent_N_forever; eauto. eapply fsim_order_wf; eauto.
 Qed.
 
 Lemma simulation_forever_reactive:
   forall i s1 s2 T,
-  Forever_reactive L1 s1 T -> S i s1 s2 ->
+  Forever_reactive L1 s1 T -> match_states i s1 s2 ->
   Forever_reactive L2 s2 T.
 Proof.
   cofix COINDHYP; intros.
   inv H.
-  destruct (simulation_star H1 i _ H0) as [i' [st2' [A B]]].
+  edestruct simulation_star as [i' [st2' [A B]]]; eauto.
   econstructor; eauto.
 Qed.
 
@@ -779,56 +783,48 @@ End SIMULATION_SEQUENCES.
 
 (** ** Composing two forward simulations *)
 
-Section COMPOSE_SIMULATIONS.
-
-Variable L1: semantics.
-Variable L2: semantics.
-Variable L3: semantics.
-Variable S12: forward_simulation L1 L2.
-Variable S23: forward_simulation L2 L3.
-
-Let ff_index : Type := (fsim_index S23 * fsim_index S12)%type.
-
-Let ff_order : ff_index -> ff_index -> Prop :=
-  lex_ord (clos_trans _ (fsim_order S23)) (fsim_order S12).
-
-Let ff_match_states (i: ff_index) (s1: state L1) (s3: state L3) : Prop :=
-  exists s2, S12 (snd i) s1 s2 /\ S23 (fst i) s2 s3.
-
-Lemma compose_forward_simulation: forward_simulation L1 L3.
-Proof.
-  apply Forward_simulation with (fsim_order := ff_order) (fsim_match_states := ff_match_states).
-(* well founded *)
-  unfold ff_order. apply wf_lex_ord. apply wf_clos_trans. apply fsim_order_wf. apply fsim_order_wf.
-(* initial states *)
-  intros. exploit (fsim_match_initial_states S12); eauto. intros [i [s2 [A B]]].
-  exploit (fsim_match_initial_states S23); eauto. intros [i' [s3 [C D]]].
+Lemma compose_forward_simulations:
+  forall L1 L2 L3, forward_simulation L1 L2 -> forward_simulation L2 L3 -> forward_simulation L1 L3.
+Proof.
+  intros L1 L2 L3 S12 S23. 
+  destruct S12 as [index order match_states props].
+  destruct S23 as [index' order' match_states' props'].
+
+  set (ff_index := (index' * index)%type).
+  set (ff_order := lex_ord (clos_trans _ order') order).
+  set (ff_match_states := fun (i: ff_index) (s1: state L1) (s3: state L3) =>
+                             exists s2, match_states (snd i) s1 s2 /\ match_states' (fst i) s2 s3).
+  apply Forward_simulation with ff_order ff_match_states; constructor.
+- (* well founded *)
+  unfold ff_order. apply wf_lex_ord. apply wf_clos_trans.
+  eapply fsim_order_wf; eauto. eapply fsim_order_wf; eauto.
+- (* initial states *)
+  intros. exploit (fsim_match_initial_states props); eauto. intros [i [s2 [A B]]].
+  exploit (fsim_match_initial_states props'); eauto. intros [i' [s3 [C D]]].
   exists (i', i); exists s3; split; auto. exists s2; auto.
-(* final states *)
+- (* final states *)
   intros. destruct H as [s3 [A B]].
-  eapply (fsim_match_final_states S23); eauto.
-  eapply (fsim_match_final_states S12); eauto.
-(* simulation *)
+  eapply (fsim_match_final_states props'); eauto.
+  eapply (fsim_match_final_states props); eauto.
+- (* simulation *)
   intros. destruct H0 as [s3 [A B]]. destruct i as [i2 i1]; simpl in *.
-  exploit (fsim_simulation' S12); eauto. intros [[i1' [s3' [C D]]] | [i1' [C [D E]]]].
-  (* L2 makes one or several steps. *)
+  exploit (fsim_simulation' props); eauto. intros [[i1' [s3' [C D]]] | [i1' [C [D E]]]].
++ (* L2 makes one or several steps. *)
   exploit simulation_plus; eauto. intros [[i2' [s2' [P Q]]] | [i2' [P [Q R]]]].
-  (* L3 makes one or several steps *)
+* (* L3 makes one or several steps *)
   exists (i2', i1'); exists s2'; split. auto. exists s3'; auto.
-  (* L3 makes no step *)
+* (* L3 makes no step *)
   exists (i2', i1'); exists s2; split.
   right; split. subst t; apply star_refl. red. left. auto.
   exists s3'; auto.
-  (* L2 makes no step *)
++ (* L2 makes no step *)
   exists (i2, i1'); exists s2; split.
   right; split. subst t; apply star_refl. red. right. auto.
   exists s3; auto.
-(* symbols *)
-  intros. transitivity (Senv.public_symbol (symbolenv L2) id); apply fsim_public_preserved; auto.
+- (* symbols *)
+  intros. transitivity (Senv.public_symbol (symbolenv L2) id); eapply fsim_public_preserved; eauto.
 Qed.
 
-End COMPOSE_SIMULATIONS.
-
 (** * Receptiveness and determinacy *)
 
 Definition single_events (L: semantics) : Prop :=
@@ -916,49 +912,57 @@ Qed.
 
 (** The general form of a backward simulation. *)
 
-Record backward_simulation (L1 L2: semantics) : Type :=
-  Backward_simulation {
-    bsim_index: Type;
-    bsim_order: bsim_index -> bsim_index -> Prop;
-    bsim_order_wf: well_founded bsim_order;
-    bsim_match_states :> bsim_index -> state L1 -> state L2 -> Prop;
+Record bsim_properties (L1 L2: semantics) (index: Type)
+                       (order: index -> index -> Prop)
+                       (match_states: index -> state L1 -> state L2 -> Prop) : Prop := {
+    bsim_order_wf: well_founded order;
     bsim_initial_states_exist:
       forall s1, initial_state L1 s1 -> exists s2, initial_state L2 s2;
     bsim_match_initial_states:
       forall s1 s2, initial_state L1 s1 -> initial_state L2 s2 ->
-      exists i, exists s1', initial_state L1 s1' /\ bsim_match_states i s1' s2;
+      exists i, exists s1', initial_state L1 s1' /\ match_states i s1' s2;
     bsim_match_final_states:
       forall i s1 s2 r,
-      bsim_match_states i s1 s2 -> safe L1 s1 -> final_state L2 s2 r ->
+      match_states i s1 s2 -> safe L1 s1 -> final_state L2 s2 r ->
       exists s1', Star L1 s1 E0 s1' /\ final_state L1 s1' r;
     bsim_progress:
       forall i s1 s2,
-      bsim_match_states i s1 s2 -> safe L1 s1 ->
+      match_states i s1 s2 -> safe L1 s1 ->
       (exists r, final_state L2 s2 r) \/
       (exists t, exists s2', Step L2 s2 t s2');
     bsim_simulation:
       forall s2 t s2', Step L2 s2 t s2' ->
-      forall i s1, bsim_match_states i s1 s2 -> safe L1 s1 ->
+      forall i s1, match_states i s1 s2 -> safe L1 s1 ->
       exists i', exists s1',
-         (Plus L1 s1 t s1' \/ (Star L1 s1 t s1' /\ bsim_order i' i))
-      /\ bsim_match_states i' s1' s2';
+         (Plus L1 s1 t s1' \/ (Star L1 s1 t s1' /\ order i' i))
+      /\ match_states i' s1' s2';
     bsim_public_preserved:
       forall id, Senv.public_symbol (symbolenv L2) id = Senv.public_symbol (symbolenv L1) id
   }.
 
+Arguments bsim_properties: clear implicits.
+
+Inductive backward_simulation (L1 L2: semantics) : Prop :=
+  Backward_simulation (index: Type)
+                      (order: index -> index -> Prop)
+                      (match_states: index -> state L1 -> state L2 -> Prop)
+                      (props: bsim_properties L1 L2 index order match_states).
+
+Arguments Backward_simulation {L1 L2 index} order match_states props.
+
 (** An alternate form of the simulation diagram *)
 
 Lemma bsim_simulation':
-  forall L1 L2 (S: backward_simulation L1 L2),
+  forall L1 L2 index order match_states, bsim_properties L1 L2 index order match_states ->
   forall i s2 t s2', Step L2 s2 t s2' ->
-  forall s1, S i s1 s2 -> safe L1 s1 ->
-  (exists i', exists s1', Plus L1 s1 t s1' /\ S i' s1' s2')
-  \/ (exists i', bsim_order S i' i /\ t = E0 /\ S i' s1 s2').
+  forall s1, match_states i s1 s2 -> safe L1 s1 ->
+  (exists i', exists s1', Plus L1 s1 t s1' /\ match_states i' s1' s2')
+  \/ (exists i', order i' i /\ t = E0 /\ match_states i' s1 s2').
 Proof.
   intros. exploit bsim_simulation; eauto.
   intros [i' [s1' [A B]]]. intuition.
   left; exists i'; exists s1'; auto.
-  inv H3.
+  inv H4.
   right; exists i'; auto.
   left; exists i'; exists s1'; split; auto. econstructor; eauto.
 Qed.
@@ -1004,13 +1008,13 @@ Hypothesis simulation:
 Lemma backward_simulation_plus: backward_simulation L1 L2.
 Proof.
   apply Backward_simulation with
-    (bsim_order := fun (x y: unit) => False)
-    (bsim_match_states := fun (i: unit) s1 s2 => match_states s1 s2);
-  auto.
-  red; intros; constructor; intros. contradiction.
-  intros. exists tt; eauto.
-  intros. exists s1; split. apply star_refl. eauto.
-  intros. exploit simulation; eauto. intros [s1' [A B]].
+    (fun (x y: unit) => False)
+    (fun (i: unit) s1 s2 => match_states s1 s2);
+  constructor; auto.
+- red; intros; constructor; intros. contradiction.
+- intros. exists tt; eauto.
+- intros. exists s1; split. apply star_refl. eauto.
+- intros. exploit simulation; eauto. intros [s1' [A B]].
   exists tt; exists s1'; auto.
 Qed.
 
@@ -1022,19 +1026,17 @@ End BACKWARD_SIMU_DIAGRAMS.
 
 Section BACKWARD_SIMULATION_SEQUENCES.
 
-Variable L1: semantics.
-Variable L2: semantics.
-Variable S: backward_simulation L1 L2.
+Context L1 L2 index order match_states (S: bsim_properties L1 L2 index order match_states).
 
 Lemma bsim_E0_star:
   forall s2 s2', Star L2 s2 E0 s2' ->
-  forall i s1, S i s1 s2 -> safe L1 s1 ->
-  exists i', exists s1', Star L1 s1 E0 s1' /\ S i' s1' s2'.
+  forall i s1, match_states i s1 s2 -> safe L1 s1 ->
+  exists i', exists s1', Star L1 s1 E0 s1' /\ match_states i' s1' s2'.
 Proof.
   intros s20 s20' STAR0. pattern s20, s20'. eapply star_E0_ind; eauto.
-(* base case *)
+- (* base case *)
   intros. exists i; exists s1; split; auto. apply star_refl.
-(* inductive case *)
+- (* inductive case *)
   intros. exploit bsim_simulation; eauto. intros [i' [s1' [A B]]].
   assert (Star L1 s0 E0 s1'). intuition. apply plus_star; auto.
   exploit H0. eauto. eapply star_safe; eauto. intros [i'' [s1'' [C D]]].
@@ -1043,7 +1045,7 @@ Qed.
 
 Lemma bsim_safe:
   forall i s1 s2,
-  S i s1 s2 -> safe L1 s1 -> safe L2 s2.
+  match_states i s1 s2 -> safe L1 s1 -> safe L2 s2.
 Proof.
   intros; red; intros.
   exploit bsim_E0_star; eauto. intros [i' [s1' [A B]]].
@@ -1052,22 +1054,22 @@ Qed.
 
 Lemma bsim_E0_plus:
   forall s2 t s2', Plus L2 s2 t s2' -> t = E0 ->
-  forall i s1, S i s1 s2 -> safe L1 s1 ->
-     (exists i', exists s1', Plus L1 s1 E0 s1' /\ S i' s1' s2')
-  \/ (exists i', clos_trans _ (bsim_order S) i' i /\ S i' s1 s2').
+  forall i s1, match_states i s1 s2 -> safe L1 s1 ->
+     (exists i', exists s1', Plus L1 s1 E0 s1' /\ match_states i' s1' s2')
+  \/ (exists i', clos_trans _ order i' i /\ match_states i' s1 s2').
 Proof.
   induction 1 using plus_ind2; intros; subst t.
-(* base case *)
+- (* base case *)
   exploit bsim_simulation'; eauto. intros [[i' [s1' [A B]]] | [i' [A [B C]]]].
-  left; exists i'; exists s1'; auto.
-  right; exists i'; intuition.
-(* inductive case *)
++ left; exists i'; exists s1'; auto.
++ right; exists i'; intuition.
+- (* inductive case *)
   exploit Eapp_E0_inv; eauto. intros [EQ1 EQ2]; subst.
   exploit bsim_simulation'; eauto. intros [[i' [s1' [A B]]] | [i' [A [B C]]]].
-  exploit bsim_E0_star. apply plus_star; eauto. eauto. eapply star_safe; eauto. apply plus_star; auto.
++ exploit bsim_E0_star. apply plus_star; eauto. eauto. eapply star_safe; eauto. apply plus_star; auto.
   intros [i'' [s1'' [P Q]]].
   left; exists i''; exists s1''; intuition. eapply plus_star_trans; eauto.
-  exploit IHplus; eauto. intros [P | [i'' [P Q]]].
++ exploit IHplus; eauto. intros [P | [i'' [P Q]]].
   left; auto.
   right; exists i''; intuition. eapply t_trans; eauto. apply t_step; auto.
 Qed.
@@ -1098,21 +1100,20 @@ Variable L1: semantics.
 Variable L2: semantics.
 Variable L3: semantics.
 Hypothesis L3_single_events: single_events L3.
-Variable S12: backward_simulation L1 L2.
-Variable S23: backward_simulation L2 L3.
+Context index order match_states (S12: bsim_properties L1 L2 index order match_states).
+Context index' order' match_states' (S23: bsim_properties L2 L3 index' order' match_states').
 
-Let bb_index : Type := (bsim_index S12 * bsim_index S23)%type.
+Let bb_index : Type := (index * index')%type.
 
-Let bb_order : bb_index -> bb_index -> Prop :=
-  lex_ord (clos_trans _ (bsim_order S12)) (bsim_order S23).
+Definition bb_order : bb_index -> bb_index -> Prop := lex_ord (clos_trans _ order) order'.
 
 Inductive bb_match_states: bb_index -> state L1 -> state L3 -> Prop :=
   | bb_match_later: forall i1 i2 s1 s3 s2x s2y,
-      S12 i1 s1 s2x -> Star L2 s2x E0 s2y -> S23 i2 s2y s3 ->
+      match_states i1 s1 s2x -> Star L2 s2x E0 s2y -> match_states' i2 s2y s3 ->
       bb_match_states (i1, i2) s1 s3.
 
 Lemma bb_match_at: forall i1 i2 s1 s3 s2,
-  S12 i1 s1 s2 -> S23 i2 s2 s3 ->
+  match_states i1 s1 s2 -> match_states' i2 s2 s3 ->
   bb_match_states (i1, i2) s1 s3.
 Proof.
   intros. econstructor; eauto. apply star_refl.
@@ -1120,7 +1121,7 @@ Qed.
 
 Lemma bb_simulation_base:
   forall s3 t s3', Step L3 s3 t s3' ->
-  forall i1 s1 i2 s2, S12 i1 s1 s2 -> S23 i2 s2 s3 -> safe L1 s1 ->
+  forall i1 s1 i2 s2, match_states i1 s1 s2 -> match_states' i2 s2 s3 -> safe L1 s1 ->
   exists i', exists s1',
     (Plus L1 s1 t s1' \/ (Star L1 s1 t s1' /\ bb_order i' (i1, i2)))
     /\ bb_match_states i' s1' s3'.
@@ -1128,29 +1129,29 @@ Proof.
   intros.
   exploit (bsim_simulation' S23); eauto. eapply bsim_safe; eauto.
   intros [ [i2' [s2' [PLUS2 MATCH2]]] | [i2' [ORD2 [EQ MATCH2]]]].
-  (* 1 L2 makes one or several transitions *)
+- (* 1 L2 makes one or several transitions *)
   assert (EITHER: t = E0 \/ (length t = 1)%nat).
-    exploit L3_single_events; eauto.
-    destruct t; auto. destruct t; auto. simpl. intros. omegaContradiction.
+  { exploit L3_single_events; eauto.
+    destruct t; auto. destruct t; auto. simpl. intros. omegaContradiction. }
   destruct EITHER.
-  (* 1.1 these are silent transitions *)
-  subst t. exploit bsim_E0_plus; eauto.
++ (* 1.1 these are silent transitions *)
+  subst t. exploit (bsim_E0_plus S12); eauto.
   intros [ [i1' [s1' [PLUS1 MATCH1]]] | [i1' [ORD1 MATCH1]]].
-  (* 1.1.1 L1 makes one or several transitions *)
+* (* 1.1.1 L1 makes one or several transitions *)
   exists (i1', i2'); exists s1'; split. auto. eapply bb_match_at; eauto.
-  (* 1.1.2 L1 makes no transitions *)
+* (* 1.1.2 L1 makes no transitions *)
   exists (i1', i2'); exists s1; split.
   right; split. apply star_refl. left; auto.
   eapply bb_match_at; eauto.
-  (* 1.2 non-silent transitions *)
++ (* 1.2 non-silent transitions *)
   exploit star_non_E0_split. apply plus_star; eauto. auto.
   intros [s2x [s2y [P [Q R]]]].
-  exploit bsim_E0_star. eexact P. eauto. auto. intros [i1' [s1x [X Y]]].
-  exploit bsim_simulation'. eexact Q. eauto. eapply star_safe; eauto.
+  exploit (bsim_E0_star S12). eexact P. eauto. auto. intros [i1' [s1x [X Y]]].
+  exploit (bsim_simulation' S12). eexact Q. eauto. eapply star_safe; eauto.
   intros [[i1'' [s1y [U V]]] | [i1'' [U [V W]]]]; try (subst t; discriminate).
   exists (i1'', i2'); exists s1y; split.
   left. eapply star_plus_trans; eauto. eapply bb_match_later; eauto.
-  (* 2. L2 makes no transitions *)
+- (* 2. L2 makes no transitions *)
   subst. exists (i1, i2'); exists s1; split.
   right; split. apply star_refl. right; auto.
   eapply bb_match_at; eauto.
@@ -1165,12 +1166,12 @@ Lemma bb_simulation:
 Proof.
   intros. inv H0.
   exploit star_inv; eauto. intros [[EQ1 EQ2] | PLUS].
-  (* 1. match at *)
+- (* 1. match at *)
   subst. eapply bb_simulation_base; eauto.
-  (* 2. match later *)
-  exploit bsim_E0_plus; eauto.
+- (* 2. match later *)
+  exploit (bsim_E0_plus S12); eauto.
   intros [[i1' [s1' [A B]]] | [i1' [A B]]].
-  (* 2.1 one or several silent transitions *)
++ (* 2.1 one or several silent transitions *)
   exploit bb_simulation_base. eauto. auto. eexact B. eauto.
     eapply star_safe; eauto. eapply plus_star; eauto.
   intros [i'' [s1'' [C D]]].
@@ -1178,7 +1179,7 @@ Proof.
   left. eapply plus_star_trans; eauto.
   destruct C as [P | [P Q]]. apply plus_star; eauto. eauto.
   traceEq.
-  (* 2.2 no silent transition *)
++ (* 2.2 no silent transition *)
   exploit bb_simulation_base. eauto. auto. eexact B. eauto. auto.
   intros [i'' [s1'' [C D]]].
   exists i''; exists s1''; split; auto.
@@ -1186,48 +1187,53 @@ Proof.
   inv H6. left. eapply t_trans; eauto. left; auto.
 Qed.
 
-Lemma compose_backward_simulation: backward_simulation L1 L3.
-Proof.
-  apply Backward_simulation with (bsim_order := bb_order) (bsim_match_states := bb_match_states).
-(* well founded *)
-  unfold bb_order. apply wf_lex_ord. apply wf_clos_trans. apply bsim_order_wf. apply bsim_order_wf.
-(* initial states exist *)
-  intros. exploit (bsim_initial_states_exist S12); eauto. intros [s2 A].
-  eapply (bsim_initial_states_exist S23); eauto.
-(* match initial states *)
+End COMPOSE_BACKWARD_SIMULATIONS.
+
+Lemma compose_backward_simulation:
+  forall L1 L2 L3,
+  single_events L3 -> backward_simulation L1 L2 -> backward_simulation L2 L3 ->
+  backward_simulation L1 L3.
+Proof.
+  intros L1 L2 L3 L3single S12 S23.
+  destruct S12 as [index order match_states props].
+  destruct S23 as [index' order' match_states' props'].
+  apply Backward_simulation with (bb_order order order') (bb_match_states L1 L2 L3 match_states match_states');
+  constructor.
+- (* well founded *)
+  unfold bb_order. apply wf_lex_ord. apply wf_clos_trans. eapply bsim_order_wf; eauto. eapply bsim_order_wf; eauto.
+- (* initial states exist *)
+  intros. exploit (bsim_initial_states_exist props); eauto. intros [s2 A].
+  eapply (bsim_initial_states_exist props'); eauto.
+- (* match initial states *)
   intros s1 s3 INIT1 INIT3.
-  exploit (bsim_initial_states_exist S12); eauto. intros [s2 INIT2].
-  exploit (bsim_match_initial_states S23); eauto. intros [i2 [s2' [INIT2' M2]]].
-  exploit (bsim_match_initial_states S12); eauto. intros [i1 [s1' [INIT1' M1]]].
-  exists (i1, i2); exists s1'; intuition. eapply bb_match_at; eauto.
-(* match final states *)
+  exploit (bsim_initial_states_exist props); eauto. intros [s2 INIT2].
+  exploit (bsim_match_initial_states props'); eauto. intros [i2 [s2' [INIT2' M2]]].
+  exploit (bsim_match_initial_states props); eauto. intros [i1 [s1' [INIT1' M1]]].
+  exists (i1, i2); exists s1'; intuition auto. eapply bb_match_at; eauto.
+- (* match final states *)
   intros i s1 s3 r MS SAFE FIN. inv MS.
-  exploit (bsim_match_final_states S23); eauto.
+  exploit (bsim_match_final_states props'); eauto.
     eapply star_safe; eauto. eapply bsim_safe; eauto.
   intros [s2' [A B]].
-  exploit bsim_E0_star. eapply star_trans. eexact H0. eexact A. auto. eauto. auto.
+  exploit (bsim_E0_star props). eapply star_trans. eexact H0. eexact A. auto. eauto. auto.
   intros [i1' [s1' [C D]]].
-  exploit (bsim_match_final_states S12); eauto. eapply star_safe; eauto.
+  exploit (bsim_match_final_states props); eauto. eapply star_safe; eauto.
   intros [s1'' [P Q]].
   exists s1''; split; auto. eapply star_trans; eauto.
-(* progress *)
+- (* progress *)
   intros i s1 s3 MS SAFE. inv MS.
-  eapply (bsim_progress S23). eauto. eapply star_safe; eauto. eapply bsim_safe; eauto.
-(* simulation *)
-  exact bb_simulation.
-(* symbols *)
-  intros. transitivity (Senv.public_symbol (symbolenv L2) id); apply bsim_public_preserved; auto.
+  eapply (bsim_progress props'). eauto. eapply star_safe; eauto. eapply bsim_safe; eauto.
+- (* simulation *)
+  apply bb_simulation; auto.
+- (* symbols *)
+  intros. transitivity (Senv.public_symbol (symbolenv L2) id); eapply bsim_public_preserved; eauto.
 Qed.
 
-End COMPOSE_BACKWARD_SIMULATIONS.
-
 (** ** Converting a forward simulation to a backward simulation *)
 
 Section FORWARD_TO_BACKWARD.
 
-Variable L1: semantics.
-Variable L2: semantics.
-Variable FS: forward_simulation L1 L2.
+Context L1 L2 index order match_states (FS: fsim_properties L1 L2 index order match_states).
 Hypothesis L1_receptive: receptive L1.
 Hypothesis L2_determinate: determinate L2.
 
@@ -1243,38 +1249,38 @@ Inductive f2b_transitions: state L1 -> state L2 -> Prop :=
       Star L1 s1 E0 s1' ->
       Step L1 s1' t s1'' ->
       Plus L2 s2 t s2' ->
-      FS i' s1' s2 ->
-      FS i'' s1'' s2' ->
+      match_states i' s1' s2 ->
+      match_states i'' s1'' s2' ->
       f2b_transitions s1 s2.
 
 Lemma f2b_progress:
-  forall i s1 s2, FS i s1 s2 -> safe L1 s1 -> f2b_transitions s1 s2.
+  forall i s1 s2, match_states i s1 s2 -> safe L1 s1 -> f2b_transitions s1 s2.
 Proof.
-  intros i0; pattern i0. apply well_founded_ind with (R := fsim_order FS).
-  apply fsim_order_wf.
+  intros i0; pattern i0. apply well_founded_ind with (R := order).
+  eapply fsim_order_wf; eauto.
   intros i REC s1 s2 MATCH SAFE.
   destruct (SAFE s1) as [[r FINAL] | [t [s1' STEP1]]]. apply star_refl.
-  (* final state reached *)
+- (* final state reached *)
   eapply f2b_trans_final; eauto.
   apply star_refl.
   eapply fsim_match_final_states; eauto.
-  (* L1 can make one step *)
+- (* L1 can make one step *)
   exploit (fsim_simulation FS); eauto. intros [i' [s2' [A MATCH']]].
-  assert (B: Plus L2 s2 t s2' \/ (s2' = s2 /\ t = E0 /\ fsim_order FS i' i)).
-    intuition.
-    destruct (star_inv H0); intuition.
+  assert (B: Plus L2 s2 t s2' \/ (s2' = s2 /\ t = E0 /\ order i' i)).
+    intuition auto.
+    destruct (star_inv H0); intuition auto.
   clear A. destruct B as [PLUS2 | [EQ1 [EQ2 ORDER]]].
-  eapply f2b_trans_step; eauto. apply star_refl.
-  subst. exploit REC; eauto. eapply star_safe; eauto. apply star_one; auto.
++ eapply f2b_trans_step; eauto. apply star_refl.
++ subst. exploit REC; eauto. eapply star_safe; eauto. apply star_one; auto.
   intros TRANS; inv TRANS.
-  eapply f2b_trans_final; eauto. eapply star_left; eauto.
-  eapply f2b_trans_step; eauto. eapply star_left; eauto.
+* eapply f2b_trans_final; eauto. eapply star_left; eauto.
+* eapply f2b_trans_step; eauto. eapply star_left; eauto.
 Qed.
 
 Lemma fsim_simulation_not_E0:
   forall s1 t s1', Step L1 s1 t s1' -> t <> E0 ->
-  forall i s2, FS i s1 s2 ->
-  exists i', exists s2', Plus L2 s2 t s2' /\ FS i' s1' s2'.
+  forall i s2, match_states i s1 s2 ->
+  exists i', exists s2', Plus L2 s2 t s2' /\ match_states i' s1' s2'.
 Proof.
   intros. exploit (fsim_simulation FS); eauto. intros [i' [s2' [A B]]].
   exists i'; exists s2'; split; auto.
@@ -1363,23 +1369,23 @@ Qed.
 
 Inductive f2b_match_states: f2b_index -> state L1 -> state L2 -> Prop :=
   | f2b_match_at: forall i s1 s2,
-      FS i s1 s2 ->
+      match_states i s1 s2 ->
       f2b_match_states (F2BI_after O) s1 s2
   | f2b_match_before: forall s1 t s1' s2b s2 n s2a i,
       Step L1 s1 t s1' ->  t <> E0 ->
       Star L2 s2b E0 s2 ->
       starN (step L2) (globalenv L2) n s2 t s2a ->
-      FS i s1 s2b ->
+      match_states i s1 s2b ->
       f2b_match_states (F2BI_before n) s1 s2
   | f2b_match_after: forall n s2 s2a s1 i,
       starN (step L2) (globalenv L2) (S n) s2 E0 s2a ->
-      FS i s1 s2a ->
+      match_states i s1 s2a ->
       f2b_match_states (F2BI_after (S n)) s1 s2.
 
 Remark f2b_match_after':
   forall n s2 s2a s1 i,
   starN (step L2) (globalenv L2) n s2 E0 s2a ->
-  FS i s1 s2a ->
+  match_states i s1 s2a ->
   f2b_match_states (F2BI_after n) s1 s2.
 Proof.
   intros. inv H.
@@ -1398,15 +1404,15 @@ Lemma f2b_simulation_step:
 Proof.
   intros s2 t s2' STEP2 i s1 MATCH SAFE.
   inv MATCH.
-(* 1. At matching states *)
+- (* 1. At matching states *)
   exploit f2b_progress; eauto. intros TRANS; inv TRANS.
-  (* 1.1  L1 can reach final state and L2 is at final state: impossible! *)
++ (* 1.1  L1 can reach final state and L2 is at final state: impossible! *)
   exploit (sd_final_nostep L2_determinate); eauto. contradiction.
-  (* 1.2  L1 can make 0 or several steps; L2 can make 1 or several matching steps. *)
++ (* 1.2  L1 can make 0 or several steps; L2 can make 1 or several matching steps. *)
   inv H2.
   exploit f2b_determinacy_inv. eexact H5. eexact STEP2.
   intros [[EQ1 [EQ2 EQ3]] | [NOT1 [NOT2 MT]]].
-  (* 1.2.1  L2 makes a silent transition *)
+* (* 1.2.1  L2 makes a silent transition *)
   destruct (silent_or_not_silent t2).
   (* 1.2.1.1  L1 makes a silent transition too: perform transition now and go to "after" state *)
   subst. simpl in *. destruct (star_starN H6) as [n STEPS2].
@@ -1418,7 +1424,7 @@ Proof.
   exists (F2BI_before n); exists s1'; split.
   right; split. auto. constructor.
   econstructor. eauto. auto. apply star_one; eauto. eauto. eauto.
-  (* 1.2.2 L2 makes a non-silent transition, and so does L1 *)
+* (* 1.2.2 L2 makes a non-silent transition, and so does L1 *)
   exploit not_silent_length. eapply (sr_traces L1_receptive); eauto. intros [EQ | EQ].
   congruence.
   subst t2. rewrite E0_right in H1.
@@ -1437,15 +1443,15 @@ Proof.
   left. eapply plus_right; eauto.
   eapply f2b_match_after'; eauto.
 
-(* 2. Before *)
+- (* 2. Before *)
   inv H2. congruence.
   exploit f2b_determinacy_inv. eexact H4. eexact STEP2.
   intros [[EQ1 [EQ2 EQ3]] | [NOT1 [NOT2 MT]]].
-  (* 2.1 L2 makes a silent transition: remain in "before" state *)
++ (* 2.1 L2 makes a silent transition: remain in "before" state *)
   subst. simpl in *. exists (F2BI_before n0); exists s1; split.
   right; split. apply star_refl. constructor. omega.
   econstructor; eauto. eapply star_right; eauto.
-  (* 2.2 L2 make a non-silent transition *)
++ (* 2.2 L2 make a non-silent transition *)
   exploit not_silent_length. eapply (sr_traces L1_receptive); eauto. intros [EQ | EQ].
   congruence.
   subst. rewrite E0_right in *.
@@ -1466,7 +1472,7 @@ Proof.
   left. apply plus_one; auto.
   eapply f2b_match_after'; eauto.
 
-(* 3. After *)
+- (* 3. After *)
   inv H. exploit Eapp_E0_inv; eauto. intros [EQ1 EQ2]; subst.
   exploit f2b_determinacy_inv. eexact H2. eexact STEP2.
   intros [[EQ1 [EQ2 EQ3]] | [NOT1 [NOT2 MT]]].
@@ -1476,20 +1482,28 @@ Proof.
   congruence.
 Qed.
 
+End FORWARD_TO_BACKWARD.
+
 (** The backward simulation *)
 
-Lemma forward_to_backward_simulation: backward_simulation L1 L2.
+Lemma forward_to_backward_simulation:
+  forall L1 L2,
+  forward_simulation L1 L2 -> receptive L1 -> determinate L2 ->
+  backward_simulation L1 L2.
 Proof.
-  apply Backward_simulation with (bsim_order := f2b_order) (bsim_match_states := f2b_match_states).
+  intros L1 L2 FS L1_receptive L2_determinate.
+  destruct FS as [index order match_states FS].
+  apply Backward_simulation with f2b_order (f2b_match_states L1 L2 match_states); constructor.
+- (* well founded *)
   apply wf_f2b_order.
-(* initial states exist *)
+- (* initial states exist *)
   intros. exploit (fsim_match_initial_states FS); eauto. intros [i [s2 [A B]]].
   exists s2; auto.
-(* initial states *)
+- (* initial states *)
   intros. exploit (fsim_match_initial_states FS); eauto. intros [i [s2' [A B]]].
   assert (s2 = s2') by (eapply sd_initial_determ; eauto). subst s2'.
   exists (F2BI_after O); exists s1; split; auto. econstructor; eauto.
-(* final states *)
+- (* final states *)
   intros. inv H.
   exploit f2b_progress; eauto. intros TRANS; inv TRANS.
   assert (r0 = r) by (eapply (sd_final_determ L2_determinate); eauto). subst r0.
@@ -1497,21 +1511,19 @@ Proof.
   inv H4. exploit (sd_final_nostep L2_determinate); eauto. contradiction.
   inv H5. congruence. exploit (sd_final_nostep L2_determinate); eauto. contradiction.
   inv H2. exploit (sd_final_nostep L2_determinate); eauto. contradiction.
-(* progress *)
+- (* progress *)
   intros. inv H.
   exploit f2b_progress; eauto. intros TRANS; inv TRANS.
   left; exists r; auto.
   inv H3. right; econstructor; econstructor; eauto.
   inv H4. congruence. right; econstructor; econstructor; eauto.
   inv H1. right; econstructor; econstructor; eauto.
-(* simulation *)
-  exact f2b_simulation_step.
-(* symbols preserved *)
+- (* simulation *)
+  eapply f2b_simulation_step; eauto.
+- (* symbols preserved *)
   exact (fsim_public_preserved FS).
 Qed.
 
-End FORWARD_TO_BACKWARD.
-
 (** * Transforming a semantics into a single-event, equivalent semantics *)
 
 Definition well_behaved_traces (L: semantics) : Prop :=
@@ -1554,15 +1566,15 @@ Section FACTOR_FORWARD_SIMULATION.
 
 Variable L1: semantics.
 Variable L2: semantics.
-Variable sim: forward_simulation L1 L2.
+Context index order match_states (sim: fsim_properties L1 L2 index order match_states).
 Hypothesis L2single: single_events L2.
 
-Inductive ffs_match: fsim_index sim -> (trace * state L1) -> state L2 -> Prop :=
+Inductive ffs_match: index -> (trace * state L1) -> state L2 -> Prop :=
   | ffs_match_at: forall i s1 s2,
-      sim i s1 s2 ->
+      match_states i s1 s2 ->
       ffs_match i (E0, s1) s2
   | ffs_match_buffer: forall i ev t s1 s2 s2',
-      Star L2 s2 (ev :: t) s2' -> sim i s1 s2' ->
+      Star L2 s2 (ev :: t) s2' -> match_states i s1 s2' ->
       ffs_match i (ev :: t, s1) s2.
 
 Lemma star_non_E0_split':
@@ -1585,27 +1597,27 @@ Lemma ffs_simulation:
   forall s1 t s1', Step (atomic L1) s1 t s1' ->
   forall i s2, ffs_match i s1 s2 ->
   exists i', exists s2',
-     (Plus L2 s2 t s2' \/ (Star L2 s2 t s2') /\ fsim_order sim i' i)
+     (Plus L2 s2 t s2' \/ (Star L2 s2 t s2') /\ order i' i)
   /\ ffs_match i' s1' s2'.
 Proof.
   induction 1; intros.
-(* silent step *)
+- (* silent step *)
   inv H0.
   exploit (fsim_simulation sim); eauto.
   intros [i' [s2' [A B]]].
   exists i'; exists s2'; split. auto. constructor; auto.
-(* start step *)
+- (* start step *)
   inv H0.
   exploit (fsim_simulation sim); eauto.
   intros [i' [s2' [A B]]].
   destruct t as [ | ev' t].
-  (* single event *)
++ (* single event *)
   exists i'; exists s2'; split. auto. constructor; auto.
-  (* multiple events *)
++ (* multiple events *)
   assert (C: Star L2 s2 (ev :: ev' :: t) s2'). intuition. apply plus_star; auto.
   exploit star_non_E0_split'. eauto. simpl. intros [s2x [P Q]].
   exists i'; exists s2x; split. auto. econstructor; eauto.
-(* continue step *)
+- (* continue step *)
   inv H0.
   exploit star_non_E0_split'. eauto. simpl. intros [s2x [P Q]].
   destruct t.
@@ -1613,27 +1625,31 @@ Proof.
   exists i; exists s2x; split. auto. econstructor; eauto.
 Qed.
 
+End FACTOR_FORWARD_SIMULATION.
+
 Theorem factor_forward_simulation:
+  forall L1 L2,
+  forward_simulation L1 L2 -> single_events L2 ->
   forward_simulation (atomic L1) L2.
 Proof.
-  apply Forward_simulation with (fsim_match_states := ffs_match) (fsim_order := fsim_order sim).
-(* wf *)
-  apply fsim_order_wf.
-(* initial states *)
+  intros L1 L2 FS L2single. 
+  destruct FS as [index order match_states sim].
+  apply Forward_simulation with order (ffs_match L1 L2 match_states); constructor.
+- (* wf *)
+  eapply fsim_order_wf; eauto.
+- (* initial states *)
   intros. destruct s1 as [t1 s1]. simpl in H. destruct H. subst.
   exploit (fsim_match_initial_states sim); eauto. intros [i [s2 [A B]]].
   exists i; exists s2; split; auto. constructor; auto.
-(* final states *)
+- (* final states *)
   intros. destruct s1 as [t1 s1]. simpl in H0; destruct H0; subst. inv H.
   eapply (fsim_match_final_states sim); eauto.
-(* simulation *)
-  exact ffs_simulation.
-(* symbols preserved *)
+- (* simulation *)
+  eapply ffs_simulation; eauto.
+- (* symbols preserved *)
   simpl. exact (fsim_public_preserved sim).
 Qed.
 
-End FACTOR_FORWARD_SIMULATION.
-
 (** Likewise, a backward simulation from a single-event semantics [L1] to a semantics [L2]
   can be "factored" as a backward simulation from [L1] to [atomic L2]. *)
 
@@ -1641,13 +1657,13 @@ Section FACTOR_BACKWARD_SIMULATION.
 
 Variable L1: semantics.
 Variable L2: semantics.
-Variable sim: backward_simulation L1 L2.
+Context index order match_states (sim: bsim_properties L1 L2 index order match_states).
 Hypothesis L1single: single_events L1.
 Hypothesis L2wb: well_behaved_traces L2.
 
-Inductive fbs_match: bsim_index sim -> state L1 -> (trace * state L2) -> Prop :=
+Inductive fbs_match: index -> state L1 -> (trace * state L2) -> Prop :=
   | fbs_match_intro: forall i s1 t s2 s1',
-      Star L1 s1 t s1' -> sim i s1' s2 ->
+      Star L1 s1 t s1' -> match_states i s1' s2 ->
       t = E0 \/ output_trace t ->
       fbs_match i s1 (t, s2).
 
@@ -1655,18 +1671,18 @@ Lemma fbs_simulation:
   forall s2 t s2', Step (atomic L2) s2 t s2' ->
   forall i s1, fbs_match i s1 s2 -> safe L1 s1 ->
   exists i', exists s1',
-     (Plus L1 s1 t s1' \/ (Star L1 s1 t s1' /\ bsim_order sim i' i))
+     (Plus L1 s1 t s1' \/ (Star L1 s1 t s1' /\ order i' i))
      /\ fbs_match i' s1' s2'.
 Proof.
   induction 1; intros.
-(* silent step *)
+- (* silent step *)
   inv H0.
   exploit (bsim_simulation sim); eauto. eapply star_safe; eauto.
   intros [i' [s1'' [A B]]].
   exists i'; exists s1''; split.
   destruct A as [P | [P Q]]. left. eapply star_plus_trans; eauto. right; split; auto. eapply star_trans; eauto.
   econstructor. apply star_refl. auto. auto.
-(* start step *)
+- (* start step *)
   inv H0.
   exploit (bsim_simulation sim); eauto. eapply star_safe; eauto.
   intros [i' [s1'' [A B]]].
@@ -1677,7 +1693,7 @@ Proof.
   left; auto.
   econstructor; eauto.
   exploit L2wb; eauto.
-(* continue step *)
+- (* continue step *)
   inv H0. unfold E0 in H8; destruct H8; try congruence.
   exploit star_non_E0_split'; eauto. simpl. intros [s1x [P Q]].
   exists i; exists s1x; split. left; auto. econstructor; eauto. simpl in H0; tauto.
@@ -1690,47 +1706,51 @@ Lemma fbs_progress:
   (exists t, exists s2', Step (atomic L2) s2 t s2').
 Proof.
   intros. inv H. destruct t.
-(* 1. no buffered events *)
+- (* 1. no buffered events *)
   exploit (bsim_progress sim); eauto. eapply star_safe; eauto.
   intros [[r A] | [t [s2' A]]].
-(* final state *)
++ (* final state *)
   left; exists r; simpl; auto.
-(* L2 can step *)
++ (* L2 can step *)
   destruct t.
   right; exists E0; exists (nil, s2'). constructor. auto.
   right; exists (e :: nil); exists (t, s2'). constructor. auto.
-(* 2. some buffered events *)
+- (* 2. some buffered events *)
   unfold E0 in H3; destruct H3. congruence.
   right; exists (e :: nil); exists (t, s3). constructor. auto.
 Qed.
 
+End FACTOR_BACKWARD_SIMULATION.
+
 Theorem factor_backward_simulation:
+  forall L1 L2,
+  backward_simulation L1 L2 -> single_events L1 -> well_behaved_traces L2 ->
   backward_simulation L1 (atomic L2).
 Proof.
-  apply Backward_simulation with (bsim_match_states := fbs_match) (bsim_order := bsim_order sim).
-(* wf *)
-  apply bsim_order_wf.
-(* initial states exist *)
+  intros L1 L2 BS L1single L2wb. 
+  destruct BS as [index order match_states sim].
+  apply Backward_simulation with order (fbs_match L1 L2 match_states); constructor.
+- (* wf *)
+  eapply bsim_order_wf; eauto.
+- (* initial states exist *)
   intros. exploit (bsim_initial_states_exist sim); eauto. intros [s2 A].
   exists (E0, s2). simpl; auto.
-(* initial states match *)
+- (* initial states match *)
   intros. destruct s2 as [t s2]; simpl in H0; destruct H0; subst.
   exploit (bsim_match_initial_states sim); eauto. intros [i [s1' [A B]]].
   exists i; exists s1'; split. auto. econstructor. apply star_refl. auto. auto.
-(* final states match *)
+- (* final states match *)
   intros. destruct s2 as [t s2]; simpl in H1; destruct H1; subst.
   inv H. exploit (bsim_match_final_states sim); eauto. eapply star_safe; eauto.
   intros [s1'' [A B]]. exists s1''; split; auto. eapply star_trans; eauto.
-(* progress *)
-  exact fbs_progress.
-(* simulation *)
-  exact fbs_simulation.
-(* symbols *)
+- (* progress *)
+  eapply fbs_progress; eauto.
+- (* simulation *)
+  eapply fbs_simulation; eauto.
+- (* symbols *)
   simpl. exact (bsim_public_preserved sim).
 Qed.
 
-End FACTOR_BACKWARD_SIMULATION.
-
 (** Receptiveness of [atomic L]. *)
 
 Record strongly_receptive (L: semantics) : Prop :=
diff --git a/configure b/configure
index d03fd15e..9e315065 100755
--- a/configure
+++ b/configure
@@ -115,6 +115,7 @@ case "$target" in
         cprepro="${toolprefix}dcc"
         cprepro_options="-E -D__GNUC__"
         casm="${toolprefix}das"
+        casm_options="-Xalign-value"
         asm_supports_cfi=false
         clinker="${toolprefix}dcc"
         libmath="-lm"
diff --git a/debug/DebugInformation.ml b/debug/DebugInformation.ml
index 828759a7..471318af 100644
--- a/debug/DebugInformation.ml
+++ b/debug/DebugInformation.ml
@@ -27,8 +27,6 @@ let next_id () =
   let nid = !id in
   incr id; nid
 
-let reset_id () =
-  id := 0
 
 (* Auximilary functions *)
 let list_replace c f l =
@@ -601,14 +599,6 @@ let section_to_string = function
   | Section_user (n,_,_) -> n
   | _ -> ".text"
 
-let add_compilation_section_start sec addr =
-  let sec = section_to_string sec in
-  Hashtbl.add compilation_section_start sec addr
-
-let add_compilation_section_end sec addr =
-  let sec = section_to_string sec in
-  Hashtbl.add compilation_section_end sec addr
-
 let add_diab_info sec addr1 add2 addr3 =
   let sec' = section_to_string sec in
   Hashtbl.add compilation_section_start sec' addr3;
diff --git a/driver/Compiler.v b/driver/Compiler.v
index ea5849ec..dd752aca 100644
--- a/driver/Compiler.v
+++ b/driver/Compiler.v
@@ -14,15 +14,10 @@
 
 (** Libraries. *)
 Require Import String.
-Require Import Coqlib.
-Require Import Errors.
-Require Import AST.
-Require Import Smallstep.
+Require Import Coqlib Errors.
+Require Import AST Linking Smallstep.
 (** Languages (syntax and semantics). *)
-Require Csyntax.
-Require Csem.
-Require Cstrategy.
-Require Cexec.
+Require Ctypes Csyntax Csem Cstrategy Cexec.
 Require Clight.
 Require Csharpminor.
 Require Cminor.
@@ -192,171 +187,228 @@ Proof.
   intros. destruct x; simpl. rewrite print_identity. auto. auto.
 Qed.
 
-Remark forward_simulation_identity:
-  forall sem, forward_simulation sem sem.
+(** * Relational specification of compilation *)
+
+Definition match_if {A: Type} (flag: unit -> bool) (R: A -> A -> Prop): A -> A -> Prop :=
+  if flag tt then R else eq.
+
+Lemma total_if_match:
+  forall (A: Type) (flag: unit -> bool) (f: A -> A) (rel: A -> A -> Prop) (prog: A),
+  (forall p, rel p (f p)) ->
+  match_if flag rel prog (total_if flag f prog).
 Proof.
-  intros. apply forward_simulation_step with (fun s1 s2 => s2 = s1); intros.
-- auto.
-- exists s1; auto.
-- subst s2; auto.
-- subst s2. exists s1'; auto.
+  intros. unfold match_if, total_if. destruct (flag tt); auto.
 Qed.
 
-Lemma total_if_simulation:
-  forall (A: Type) (sem: A -> semantics) (flag: unit -> bool) (f: A -> A) (prog: A),
-  (forall p, forward_simulation (sem p) (sem (f p))) ->
-  forward_simulation (sem prog) (sem (total_if flag f prog)).
+Lemma partial_if_match:
+  forall (A: Type) (flag: unit -> bool) (f: A -> res A) (rel: A -> A -> Prop) (prog tprog: A),
+  (forall p tp, f p = OK tp -> rel p tp) ->
+  partial_if flag f prog = OK tprog ->
+  match_if flag rel prog tprog.
 Proof.
-  intros. unfold total_if. destruct (flag tt). auto. apply forward_simulation_identity.
+  intros. unfold match_if, partial_if in *. destruct (flag tt). auto. congruence.
 Qed.
 
-Lemma partial_if_simulation:
-  forall (A: Type) (sem: A -> semantics) (flag: unit -> bool) (f: A -> res A) (prog tprog: A),
-  partial_if flag f prog = OK tprog ->
-  (forall p tp, f p = OK tp -> forward_simulation (sem p) (sem tp)) ->
-  forward_simulation (sem prog) (sem tprog).
+Instance TransfIfLink {A: Type} {LA: Linker A}
+                      (flag: unit -> bool) (transf: A -> A -> Prop) (TL: TransfLink transf)
+                      : TransfLink (match_if flag transf).
+Proof.
+  unfold match_if. destruct (flag tt).
+- auto.
+- red; intros. subst tp1 tp2. exists p; auto.
+Qed.
+
+(** This is the list of compilation passes of CompCert in relational style.
+  Each pass is characterized by a [match_prog] relation between its
+  input code and its output code.  The [mkpass] and [:::] combinators,
+  defined in module [Linking], ensure that the passes are composable
+  (the output language of a pass is the input language of the next pass)
+  and that they commute with linking (property [TransfLink], inferred
+  by the type class mechanism of Coq). *)
+
+Local Open Scope linking_scope.
+
+Definition CompCert's_passes :=
+      mkpass SimplExprproof.match_prog
+  ::: mkpass SimplLocalsproof.match_prog
+  ::: mkpass Cshmgenproof.match_prog
+  ::: mkpass Cminorgenproof.match_prog
+  ::: mkpass Selectionproof.match_prog
+  ::: mkpass RTLgenproof.match_prog
+  ::: mkpass (match_if Compopts.optim_tailcalls Tailcallproof.match_prog)
+  ::: mkpass Inliningproof.match_prog
+  ::: mkpass Renumberproof.match_prog
+  ::: mkpass (match_if Compopts.optim_constprop Constpropproof.match_prog)
+  ::: mkpass (match_if Compopts.optim_constprop Renumberproof.match_prog)
+  ::: mkpass (match_if Compopts.optim_CSE CSEproof.match_prog)
+  ::: mkpass (match_if Compopts.optim_redundancy Deadcodeproof.match_prog)
+  ::: mkpass Unusedglobproof.match_prog
+  ::: mkpass Allocproof.match_prog
+  ::: mkpass Tunnelingproof.match_prog
+  ::: mkpass Linearizeproof.match_prog
+  ::: mkpass CleanupLabelsproof.match_prog
+  ::: mkpass (match_if Compopts.debug Debugvarproof.match_prog)
+  ::: mkpass Stackingproof.match_prog
+  ::: mkpass Asmgenproof.match_prog
+  ::: pass_nil _.
+
+(** Composing the [match_prog] relations above, we obtain the relation
+  between CompCert C sources and Asm code that characterize CompCert's
+  compilation. *)
+
+Definition match_prog: Csyntax.program -> Asm.program -> Prop :=
+  pass_match (compose_passes CompCert's_passes).
+
+(** The [transf_c_program] function, when successful, produces
+  assembly code that is in the [match_prog] relation with the source C program. *)
+
+Theorem transf_c_program_match:
+  forall p tp,
+  transf_c_program p = OK tp ->
+  match_prog p tp.
 Proof.
-  intros. unfold partial_if in *. destruct (flag tt). eauto. inv H. apply forward_simulation_identity.
+  intros p tp T.
+  unfold transf_c_program, time in T. simpl in T.
+  destruct (SimplExpr.transl_program p) as [p1|e] eqn:P1; simpl in T; try discriminate.
+  unfold transf_clight_program, time in T. rewrite ! compose_print_identity in T. simpl in T.
+  destruct (SimplLocals.transf_program p1) as [p2|e] eqn:P2; simpl in T; try discriminate.
+  destruct (Cshmgen.transl_program p2) as [p3|e] eqn:P3; simpl in T; try discriminate.
+  destruct (Cminorgen.transl_program p3) as [p4|e] eqn:P4; simpl in T; try discriminate.
+  unfold transf_cminor_program, time in T. rewrite ! compose_print_identity in T. simpl in T.
+  destruct (Selection.sel_program p4) as [p5|e] eqn:P5; simpl in T; try discriminate.
+  destruct (RTLgen.transl_program p5) as [p6|e] eqn:P6; simpl in T; try discriminate.
+  unfold transf_rtl_program, time in T. rewrite ! compose_print_identity in T. simpl in T.
+  set (p7 := total_if optim_tailcalls Tailcall.transf_program p6) in *.
+  destruct (Inlining.transf_program p7) as [p8|e] eqn:P8; simpl in T; try discriminate.
+  set (p9 := Renumber.transf_program p8) in *.
+  set (p10 := total_if optim_constprop Constprop.transf_program p9) in *.
+  set (p11 := total_if optim_constprop Renumber.transf_program p10) in *.
+  destruct (partial_if optim_CSE CSE.transf_program p11) as [p12|e] eqn:P12; simpl in T; try discriminate.
+  destruct (partial_if optim_redundancy Deadcode.transf_program p12) as [p13|e] eqn:P13; simpl in T; try discriminate.
+  destruct (Unusedglob.transform_program p13) as [p14|e] eqn:P14; simpl in T; try discriminate.
+  destruct (Allocation.transf_program p14) as [p15|e] eqn:P15; simpl in T; try discriminate.
+  set (p16 := Tunneling.tunnel_program p15) in *.
+  destruct (Linearize.transf_program p16) as [p17|e] eqn:P17; simpl in T; try discriminate.
+  set (p18 := CleanupLabels.transf_program p17) in *.
+  destruct (partial_if debug Debugvar.transf_program p18) as [p19|e] eqn:P19; simpl in T; try discriminate.
+  destruct (Stacking.transf_program p19) as [p20|e] eqn:P20; simpl in T; try discriminate.
+  unfold match_prog; simpl. 
+  exists p1; split. apply SimplExprproof.transf_program_match; auto.
+  exists p2; split. apply SimplLocalsproof.match_transf_program; auto.
+  exists p3; split. apply Cshmgenproof.transf_program_match; auto.
+  exists p4; split. apply Cminorgenproof.transf_program_match; auto.
+  exists p5; split. apply Selectionproof.transf_program_match; auto.
+  exists p6; split. apply RTLgenproof.transf_program_match; auto.
+  exists p7; split. apply total_if_match. apply Tailcallproof.transf_program_match.
+  exists p8; split. apply Inliningproof.transf_program_match; auto.
+  exists p9; split. apply Renumberproof.transf_program_match; auto.
+  exists p10; split. apply total_if_match. apply Constpropproof.transf_program_match.
+  exists p11; split. apply total_if_match. apply Renumberproof.transf_program_match.
+  exists p12; split. eapply partial_if_match; eauto. apply CSEproof.transf_program_match.
+  exists p13; split. eapply partial_if_match; eauto. apply Deadcodeproof.transf_program_match.
+  exists p14; split. apply Unusedglobproof.transf_program_match; auto.
+  exists p15; split. apply Allocproof.transf_program_match; auto.
+  exists p16; split. apply Tunnelingproof.transf_program_match.
+  exists p17; split. apply Linearizeproof.transf_program_match; auto.
+  exists p18; split. apply CleanupLabelsproof.transf_program_match; auto.
+  exists p19; split. eapply partial_if_match; eauto. apply Debugvarproof.transf_program_match.
+  exists p20; split. apply Stackingproof.transf_program_match; auto.
+  exists tp; split. apply Asmgenproof.transf_program_match; auto. 
+  reflexivity.
 Qed.
 
 (** * Semantic preservation *)
 
-(** We prove that the [transf_program] translations preserve semantics
-  by constructing the following simulations:
-- Forward simulations from [Cstrategy] / [Cminor] / [RTL] to [Asm]
+(** We now prove that the whole CompCert compiler (as characterized by the
+  [match_prog] relation) preserves semantics by constructing 
+  the following simulations:
+- Forward simulations from [Cstrategy] to [Asm]
   (composition of the forward simulations for each pass).
 - Backward simulations for the same languages
   (derived from the forward simulation, using receptiveness of the source
   language and determinacy of [Asm]).
 - Backward simulation from [Csem] to [Asm]
   (composition of two backward simulations).
+*)
 
-These results establish the correctness of the whole compiler! *)
-
-Theorem transf_rtl_program_correct:
-  forall p tp,
-  transf_rtl_program p = OK tp ->
-  forward_simulation (RTL.semantics p) (Asm.semantics tp)
-  * backward_simulation (RTL.semantics p) (Asm.semantics tp).
-Proof.
-  intros.
-  assert (F: forward_simulation (RTL.semantics p) (Asm.semantics tp)).
-  unfold transf_rtl_program, time in H.
-  repeat rewrite compose_print_identity in H.
-  simpl in H.
-  set (p1 := total_if optim_tailcalls Tailcall.transf_program p) in *.
-  destruct (Inlining.transf_program p1) as [p11|] eqn:?; simpl in H; try discriminate.
-  set (p12 := Renumber.transf_program p11) in *.
-  set (p2 := total_if optim_constprop Constprop.transf_program p12) in *.
-  set (p21 := total_if optim_constprop Renumber.transf_program p2) in *.
-  destruct (partial_if optim_CSE CSE.transf_program p21) as [p3|] eqn:?; simpl in H; try discriminate.
-  destruct (partial_if optim_redundancy Deadcode.transf_program p3) as [p31|] eqn:?; simpl in H; try discriminate.
-  destruct (Unusedglob.transform_program p31) as [p32|] eqn:?; simpl in H; try discriminate.
-  destruct (Allocation.transf_program p32) as [p4|] eqn:?; simpl in H; try discriminate.
-  set (p5 := Tunneling.tunnel_program p4) in *.
-  destruct (Linearize.transf_program p5) as [p6|] eqn:?; simpl in H; try discriminate.
-  set (p7 := CleanupLabels.transf_program p6) in *.
-  destruct (partial_if debug Debugvar.transf_program p7) as [p71|] eqn:?; simpl in H; try discriminate.
-  destruct (Stacking.transf_program p71) as [p8|] eqn:?; simpl in H; try discriminate.
-  apply compose_forward_simulation with (RTL.semantics p1).
-    apply total_if_simulation. apply Tailcallproof.transf_program_correct.
-  apply compose_forward_simulation with (RTL.semantics p11).
-    apply Inliningproof.transf_program_correct; auto.
-  apply compose_forward_simulation with (RTL.semantics p12).
-    apply Renumberproof.transf_program_correct.
-  apply compose_forward_simulation with (RTL.semantics p2).
-    apply total_if_simulation. apply Constpropproof.transf_program_correct.
-  apply compose_forward_simulation with (RTL.semantics p21).
-    apply total_if_simulation. apply Renumberproof.transf_program_correct.
-  apply compose_forward_simulation with (RTL.semantics p3).
-    eapply partial_if_simulation; eauto.  apply CSEproof.transf_program_correct.
-  apply compose_forward_simulation with (RTL.semantics p31).
-    eapply partial_if_simulation; eauto. apply Deadcodeproof.transf_program_correct.
-  apply compose_forward_simulation with (RTL.semantics p32).
-    apply Unusedglobproof.transf_program_correct; auto.
-  apply compose_forward_simulation with (LTL.semantics p4).
-    apply Allocproof.transf_program_correct; auto.
-  apply compose_forward_simulation with (LTL.semantics p5).
-    apply Tunnelingproof.transf_program_correct.
-  apply compose_forward_simulation with (Linear.semantics p6).
-    apply Linearizeproof.transf_program_correct; auto.
-  apply compose_forward_simulation with (Linear.semantics p7).
-    apply CleanupLabelsproof.transf_program_correct.
-  apply compose_forward_simulation with (Linear.semantics p71).
-    eapply partial_if_simulation; eauto. apply Debugvarproof.transf_program_correct.
-  apply compose_forward_simulation with (Mach.semantics Asmgenproof0.return_address_offset p8).
-    apply Stackingproof.transf_program_correct.
-    exact Asmgenproof.return_address_exists.
-    auto.
-  apply Asmgenproof.transf_program_correct; eauto.
-  split. auto.
-  apply forward_to_backward_simulation. auto.
-  apply RTL.semantics_receptive.
-  apply Asm.semantics_determinate.
-Qed.
-
-Theorem transf_cminor_program_correct:
-  forall p tp,
-  transf_cminor_program p = OK tp ->
-  forward_simulation (Cminor.semantics p) (Asm.semantics tp)
-  * backward_simulation (Cminor.semantics p) (Asm.semantics tp).
+Remark forward_simulation_identity:
+  forall sem, forward_simulation sem sem.
 Proof.
-  intros.
-  assert (F: forward_simulation (Cminor.semantics p) (Asm.semantics tp)).
-  unfold transf_cminor_program, time in H.
-  repeat rewrite compose_print_identity in H.
-  simpl in H.
-  destruct (Selection.sel_program p) as [p1|] eqn:?; simpl in H; try discriminate.
-  destruct (RTLgen.transl_program p1) as [p2|] eqn:?; simpl in H; try discriminate.
-  eapply compose_forward_simulation. apply Selectionproof.transf_program_correct. eauto.
-  eapply compose_forward_simulation. apply RTLgenproof.transf_program_correct. eassumption.
-  exact (fst (transf_rtl_program_correct _ _ H)).
-
-  split. auto.
-  apply forward_to_backward_simulation. auto.
-  apply Cminor.semantics_receptive.
-  apply Asm.semantics_determinate.
+  intros. apply forward_simulation_step with (fun s1 s2 => s2 = s1); intros.
+- auto.
+- exists s1; auto.
+- subst s2; auto.
+- subst s2. exists s1'; auto.
 Qed.
 
-Theorem transf_clight_program_correct:
-  forall p tp,
-  transf_clight_program p = OK tp ->
-  forward_simulation (Clight.semantics1 p) (Asm.semantics tp)
-  * backward_simulation (Clight.semantics1 p) (Asm.semantics tp).
+Lemma match_if_simulation:
+  forall (A: Type) (sem: A -> semantics) (flag: unit -> bool) (transf: A -> A -> Prop) (prog tprog: A),
+  match_if flag transf prog tprog ->
+  (forall p tp, transf p tp -> forward_simulation (sem p) (sem tp)) ->
+  forward_simulation (sem prog) (sem tprog).
 Proof.
-  intros.
-  assert (F: forward_simulation (Clight.semantics1 p) (Asm.semantics tp)).
-  revert H; unfold transf_clight_program, time; simpl.
-  rewrite print_identity.
-  caseEq (SimplLocals.transf_program p); simpl; try congruence; intros p0 EQ0.
-  caseEq (Cshmgen.transl_program p0); simpl; try congruence; intros p1 EQ1.
-  caseEq (Cminorgen.transl_program p1); simpl; try congruence; intros p2 EQ2.
-  intros EQ3.
-  eapply compose_forward_simulation. apply SimplLocalsproof.transf_program_correct. eauto.
-  eapply compose_forward_simulation. apply Cshmgenproof.transl_program_correct. eauto.
-  eapply compose_forward_simulation. apply Cminorgenproof.transl_program_correct. eauto.
-  exact (fst (transf_cminor_program_correct _ _ EQ3)).
-
-  split. auto.
-  apply forward_to_backward_simulation. auto.
-  apply Clight.semantics_receptive.
-  apply Asm.semantics_determinate.
+  intros. unfold match_if in *. destruct (flag tt). eauto. subst. apply forward_simulation_identity.
 Qed.
 
-Theorem transf_cstrategy_program_correct:
+Theorem cstrategy_semantic_preservation:
   forall p tp,
-  transf_c_program p = OK tp ->
+  match_prog p tp ->
   forward_simulation (Cstrategy.semantics p) (Asm.semantics tp)
-  * backward_simulation (atomic (Cstrategy.semantics p)) (Asm.semantics tp).
+  /\ backward_simulation (atomic (Cstrategy.semantics p)) (Asm.semantics tp).
 Proof.
-  intros.
-  assert (F: forward_simulation (Cstrategy.semantics p) (Asm.semantics tp)).
-  revert H; unfold transf_c_program, time; simpl.
-  caseEq (SimplExpr.transl_program p); simpl; try congruence; intros p0 EQ0.
-  intros EQ1.
-  eapply compose_forward_simulation. apply SimplExprproof.transl_program_correct. eauto.
-  exact (fst (transf_clight_program_correct _ _ EQ1)).
-
+  intros p tp M. unfold match_prog, pass_match in M; simpl in M.
+Ltac DestructM :=
+  match goal with
+    [ H: exists p, _ /\ _ |- _ ] => 
+      let p := fresh "p" in let M := fresh "M" in let MM := fresh "MM" in
+      destruct H as (p & M & MM); clear H
+  end.
+  repeat DestructM. subst tp.
+  assert (F: forward_simulation (Cstrategy.semantics p) (Asm.semantics p21)).
+  {
+  eapply compose_forward_simulations.
+    eapply SimplExprproof.transl_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply SimplLocalsproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Cshmgenproof.transl_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Cminorgenproof.transl_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Selectionproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply RTLgenproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply match_if_simulation. eassumption. exact Tailcallproof.transf_program_correct.
+  eapply compose_forward_simulations.
+    eapply Inliningproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations. eapply Renumberproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply match_if_simulation. eassumption. exact Constpropproof.transf_program_correct.
+  eapply compose_forward_simulations.
+    eapply match_if_simulation. eassumption. exact Renumberproof.transf_program_correct.
+  eapply compose_forward_simulations.
+    eapply match_if_simulation. eassumption. exact CSEproof.transf_program_correct.
+  eapply compose_forward_simulations.
+    eapply match_if_simulation. eassumption. exact Deadcodeproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Unusedglobproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Allocproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Tunnelingproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply Linearizeproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply CleanupLabelsproof.transf_program_correct; eassumption.
+  eapply compose_forward_simulations.
+    eapply match_if_simulation. eassumption. exact Debugvarproof.transf_program_correct.
+  eapply compose_forward_simulations.
+    eapply Stackingproof.transf_program_correct with (return_address_offset := Asmgenproof0.return_address_offset).
+    exact Asmgenproof.return_address_exists.
+    eassumption.
+  eapply Asmgenproof.transf_program_correct; eassumption.
+  }
   split. auto.
   apply forward_to_backward_simulation.
   apply factor_forward_simulation. auto. eapply sd_traces. eapply Asm.semantics_determinate.
@@ -364,9 +416,9 @@ Proof.
   apply Asm.semantics_determinate.
 Qed.
 
-Theorem transf_c_program_correct:
+Theorem c_semantic_preservation:
   forall p tp,
-  transf_c_program p = OK tp ->
+  match_prog p tp ->
   backward_simulation (Csem.semantics p) (Asm.semantics tp).
 Proof.
   intros.
@@ -376,5 +428,54 @@ Proof.
   apply Cstrategy.strategy_simulation.
   apply Csem.semantics_single_events.
   eapply ssr_well_behaved; eapply Cstrategy.semantics_strongly_receptive.
-  exact (snd (transf_cstrategy_program_correct _ _ H)).
+  exact (proj2 (cstrategy_semantic_preservation _ _ H)).
+Qed.
+
+(** * Correctness of the CompCert compiler *)
+
+(** Combining the results above, we obtain semantic preservation for two
+  usage scenarios of CompCert: compilation of a single monolithic program,
+  and separate compilation of multiple source files followed by linking.
+
+  In the monolithic case, we have a whole C program [p] that is
+  compiled in one run of CompCert to a whole Asm program [tp].
+  Then, [tp] preserves the semantics of [p], in the sense that there
+  exists a backward simulation of the dynamic semantics of [p]
+  by the dynamic semantics of [tp]. *)
+
+Theorem transf_c_program_correct:
+  forall p tp,
+  transf_c_program p = OK tp ->
+  backward_simulation (Csem.semantics p) (Asm.semantics tp).
+Proof.
+  intros. apply c_semantic_preservation. apply transf_c_program_match; auto.
+Qed.
+
+(** Here is the separate compilation case.  Consider a nonempty list [c_units]
+  of C source files (compilation units), [C1 ,,, Cn].  Assume that every
+  C compilation unit [Ci] is successfully compiled by CompCert, obtaining
+  an Asm compilation unit [Ai].  Let [asm_unit] be the nonempty list
+  [A1 ... An].  Further assume that the C units [C1 ... Cn] can be linked
+  together to produce a whole C program [c_program].  Then, the generated
+  Asm units can be linked together, producing a whole Asm program
+  [asm_program].  Moreover, [asm_program] preserves the semantics of
+  [c_program], in the sense that there exists a backward simulation of
+  the dynamic semantics of [asm_program] by the dynamic semantics of [c_program].
+*)
+
+Theorem separate_transf_c_program_correct:
+  forall c_units asm_units c_program,
+  nlist_forall2 (fun cu tcu => transf_c_program cu = OK tcu) c_units asm_units ->
+  link_list c_units = Some c_program ->
+  exists asm_program, 
+      link_list asm_units = Some asm_program
+   /\ backward_simulation (Csem.semantics c_program) (Asm.semantics asm_program).
+Proof.
+  intros. 
+  assert (nlist_forall2 match_prog c_units asm_units).
+  { eapply nlist_forall2_imply. eauto. simpl; intros. apply transf_c_program_match; auto. }
+  assert (exists asm_program, link_list asm_units = Some asm_program /\ match_prog c_program asm_program).
+  { eapply link_list_compose_passes; eauto. }
+  destruct H2 as (asm_program & P & Q).
+  exists asm_program; split; auto. apply c_semantic_preservation; auto.
 Qed.
diff --git a/driver/Complements.v b/driver/Complements.v
index 8651f2ff..f7598758 100644
--- a/driver/Complements.v
+++ b/driver/Complements.v
@@ -80,17 +80,19 @@ Theorem transf_cstrategy_program_preservation:
 Proof.
   assert (WBT: forall p, well_behaved_traces (Cstrategy.semantics p)).
     intros. eapply ssr_well_behaved. apply Cstrategy.semantics_strongly_receptive.
-  intros. intuition.
+  intros. 
+  assert (MATCH: match_prog p tp) by (apply transf_c_program_match; auto).
+  intuition auto.
   eapply forward_simulation_behavior_improves; eauto.
-    apply (fst (transf_cstrategy_program_correct _ _ H)).
+    apply (proj1 (cstrategy_semantic_preservation _ _ MATCH)).
   exploit backward_simulation_behavior_improves.
-    apply (snd (transf_cstrategy_program_correct _ _ H)).
+    apply (proj2 (cstrategy_semantic_preservation _ _ MATCH)).
     eauto.
   intros [beh1 [A B]]. exists beh1; split; auto. rewrite atomic_behaviors; auto.
   eapply forward_simulation_same_safe_behavior; eauto.
-    apply (fst (transf_cstrategy_program_correct _ _ H)).
+    apply (proj1 (cstrategy_semantic_preservation _ _ MATCH)).
   exploit backward_simulation_same_safe_behavior.
-    apply (snd (transf_cstrategy_program_correct _ _ H)).
+    apply (proj2 (cstrategy_semantic_preservation _ _ MATCH)).
     intros. rewrite <- atomic_behaviors in H2; eauto. eauto.
     intros. rewrite atomic_behaviors; auto.
 Qed.
diff --git a/driver/Interp.ml b/driver/Interp.ml
index e3a7d3b8..5c2158ae 100644
--- a/driver/Interp.ml
+++ b/driver/Interp.ml
@@ -42,8 +42,8 @@ let print_id_ofs p (id, ofs) =
 
 let print_eventval p = function
   | EVint n -> fprintf p "%ld" (camlint_of_coqint n)
-  | EVfloat f -> fprintf p "%F" (camlfloat_of_coqfloat f)
-  | EVsingle f -> fprintf p "%F" (camlfloat_of_coqfloat32 f)
+  | EVfloat f -> fprintf p "%.15F" (camlfloat_of_coqfloat f)
+  | EVsingle f -> fprintf p "%.15F" (camlfloat_of_coqfloat32 f)
   | EVlong n -> fprintf p "%LdLL" (camlint64_of_coqint n)
   | EVptr_global(id, ofs) -> fprintf p "&%a" print_id_ofs (id, ofs)
 
@@ -83,16 +83,16 @@ let name_of_fundef prog fd =
       if fd == fd' then extern_atom id else find_name rem
   | (id, Gvar v) :: rem ->
       find_name rem
-  in find_name prog.Csyntax.prog_defs
+  in find_name prog.Ctypes.prog_defs
 
 let name_of_function prog fn =
   let rec find_name = function
   | [] -> "<unknown function>"
-  | (id, Gfun(Csyntax.Internal fn')) :: rem ->
+  | (id, Gfun(Ctypes.Internal fn')) :: rem ->
       if fn == fn' then extern_atom id else find_name rem
   | (id, _) :: rem ->
       find_name rem
-  in find_name prog.Csyntax.prog_defs
+  in find_name prog.Ctypes.prog_defs
 
 let invert_local_variable e b =
   Maps.PTree.fold
@@ -581,7 +581,7 @@ let world_program prog =
         (id, Gvar gv')
     | Gfun fd ->
         (id, gd) in
- {prog with Csyntax.prog_defs = List.map change_def prog.Csyntax.prog_defs}
+ {prog with Ctypes.prog_defs = List.map change_def prog.Ctypes.prog_defs}
 
 (* Massaging the program to get a suitable "main" function *)
 
@@ -596,7 +596,7 @@ let change_main_function p old_main old_main_ty =
       fn_params = []; fn_vars = []; fn_body = body } in
   let new_main_id = intern_string "___main" in
   { prog_main = new_main_id;
-    Csyntax.prog_defs = (new_main_id, Gfun(Internal new_main_fn)) :: p.Csyntax.prog_defs;
+    Ctypes.prog_defs = (new_main_id, Gfun(Internal new_main_fn)) :: p.Ctypes.prog_defs;
     prog_public = p.prog_public;
     prog_types = p.prog_types;
     prog_comp_env = p.prog_comp_env }
@@ -607,7 +607,7 @@ let rec find_main_function name = function
   | (id, Gvar v) :: gdl -> find_main_function name gdl
 
 let fixup_main p =
-  match find_main_function p.Csyntax.prog_main p.prog_defs with
+  match find_main_function p.Ctypes.prog_main p.prog_defs with
   | None ->
       fprintf err_formatter "ERROR: no main() function@.";
       None
diff --git a/exportclight/ExportClight.ml b/exportclight/ExportClight.ml
index a14b08d8..0e4f1fa3 100644
--- a/exportclight/ExportClight.ml
+++ b/exportclight/ExportClight.ml
@@ -235,6 +235,8 @@ let external_function p = function
       fprintf p "@[<hov 2>(EF_external %a@ %a)@]" coqstring name signatur sg
   | EF_builtin(name, sg) ->
       fprintf p "@[<hov 2>(EF_builtin %a@ %a)@]" coqstring name signatur sg
+  | EF_runtime(name, sg) ->
+      fprintf p "@[<hov 2>(EF_runtime %a@ %a)@]" coqstring name signatur sg
   | EF_vload chunk ->
       fprintf p "(EF_vload %s)" (name_of_chunk chunk)
   | EF_vstore chunk ->
diff --git a/extraction/extraction.v b/extraction/extraction.v
index 0f0a8637..22a69c49 100644
--- a/extraction/extraction.v
+++ b/extraction/extraction.v
@@ -158,11 +158,10 @@ Separate Extraction
    Csyntax.Eindex Csyntax.Epreincr
    Ctyping.typecheck_program
    Ctyping.epostincr Ctyping.epostdecr Ctyping.epreincr Ctyping.epredecr
-   Clight.make_program
+   Ctypes.make_program
    Conventions1.dummy_int_reg Conventions1.dummy_float_reg
    RTL.instr_defs RTL.instr_uses
    Machregs.mregs_for_operation Machregs.mregs_for_builtin
    Machregs.two_address_op Machregs.is_stack_reg
    AST.signature_main
-   AST.transform_partial_ident_program
    Parser.translation_unit_file.
diff --git a/ia32/Asmexpand.ml b/ia32/Asmexpand.ml
index 4f2bb937..5e5bbb3e 100644
--- a/ia32/Asmexpand.ml
+++ b/ia32/Asmexpand.ml
@@ -459,4 +459,4 @@ let expand_fundef id = function
       Errors.OK (External ef)
 
 let expand_program (p: Asm.program) : Asm.program Errors.res =
-  AST.transform_partial_ident_program expand_fundef p
+  AST.transform_partial_program2 expand_fundef (fun id v -> Errors.OK v) p
diff --git a/ia32/Asmgen.v b/ia32/Asmgen.v
index 91122898..fd0d5bc5 100644
--- a/ia32/Asmgen.v
+++ b/ia32/Asmgen.v
@@ -12,16 +12,9 @@
 
 (** Translation from Mach to IA32 Asm. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Memdata.
-Require Import Op.
-Require Import Locations.
-Require Import Mach.
-Require Import Asm.
+Require Import Coqlib Errors.
+Require Import Integers Floats AST Memdata.
+Require Import Op Locations Mach Asm.
 
 Open Local Scope string_scope.
 Open Local Scope error_monad_scope.
diff --git a/ia32/Asmgenproof.v b/ia32/Asmgenproof.v
index 105347e7..28237237 100644
--- a/ia32/Asmgenproof.v
+++ b/ia32/Asmgenproof.v
@@ -12,56 +12,43 @@
 
 (** Correctness proof for x86 generation: main proof. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Locations.
-Require Import Mach.
-Require Import Conventions.
-Require Import Asm.
-Require Import Asmgen.
-Require Import Asmgenproof0.
-Require Import Asmgenproof1.
+Require Import Coqlib Errors.
+Require Import Integers Floats AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Locations Mach Conventions Asm.
+Require Import Asmgen Asmgenproof0 Asmgenproof1.
+
+Definition match_prog (p: Mach.program) (tp: Asm.program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
 
 Section PRESERVATION.
 
 Variable prog: Mach.program.
 Variable tprog: Asm.program.
-Hypothesis TRANSF: transf_program prog = Errors.OK tprog.
-
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
-  forall id, Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall id, Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.public_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall b f,
   Genv.find_funct_ptr ge b = Some f ->
-  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = Errors.OK tf.
-Proof
-  (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
+  exists tf,
+  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf.
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
 
 Lemma functions_transl:
   forall fb f tf,
@@ -73,14 +60,6 @@ Proof.
   monadInv B. rewrite H0 in EQ; inv EQ; auto.
 Qed.
 
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_var_info_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
-
 (** * Properties of control flow *)
 
 Lemma transf_function_no_overflow:
@@ -682,8 +661,7 @@ Opaque loadind.
   eapply find_instr_tail; eauto.
   erewrite <- sp_val by eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   eauto.
   econstructor; eauto.
   instantiate (2 := tf); instantiate (1 := x).
@@ -866,8 +844,7 @@ Transparent destroyed_at_function_entry.
   intros [res' [m2' [P [Q [R S]]]]].
   left; econstructor; split.
   apply plus_one. eapply exec_step_external; eauto.
-  eapply external_call_symbols_preserved'; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   econstructor; eauto.
   unfold loc_external_result.
   apply agree_set_other; auto. apply agree_set_mregs; auto.
@@ -885,7 +862,7 @@ Proof.
   intros. inversion H. unfold ge0 in *.
   econstructor; split.
   econstructor.
-  eapply Genv.init_mem_transf_partial; eauto.
+  eapply (Genv.init_mem_transf_partial TRANSF); eauto.
   replace (Genv.symbol_address (Genv.globalenv tprog) (prog_main tprog) Int.zero)
      with (Vptr fb Int.zero).
   econstructor; eauto.
@@ -893,7 +870,7 @@ Proof.
   apply Mem.extends_refl.
   split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto.
   unfold Genv.symbol_address.
-  rewrite (transform_partial_program_main _ _ TRANSF).
+  rewrite (match_program_main TRANSF).
   rewrite symbols_preserved.
   unfold ge; rewrite H1. auto.
 Qed.
@@ -911,7 +888,7 @@ Theorem transf_program_correct:
   forward_simulation (Mach.semantics return_address_offset prog) (Asm.semantics tprog).
 Proof.
   eapply forward_simulation_star with (measure := measure).
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   exact step_simulation.
diff --git a/ia32/PrintOp.ml b/ia32/PrintOp.ml
index 1f7f4a65..2a80e3d4 100644
--- a/ia32/PrintOp.ml
+++ b/ia32/PrintOp.ml
@@ -67,8 +67,8 @@ let print_addressing reg pp = function
 let print_operation reg pp = function
   | Omove, [r1] -> reg pp r1
   | Ointconst n, [] -> fprintf pp "%ld" (camlint_of_coqint n)
-  | Ofloatconst n, [] -> fprintf pp "%F" (camlfloat_of_coqfloat n)
-  | Osingleconst n, [] -> fprintf pp "%Ff" (camlfloat_of_coqfloat32 n)
+  | Ofloatconst n, [] -> fprintf pp "%.15F" (camlfloat_of_coqfloat n)
+  | Osingleconst n, [] -> fprintf pp "%.15Ff" (camlfloat_of_coqfloat32 n)
   | Oindirectsymbol id, [] -> fprintf pp "&%s" (extern_atom id)
   | Ocast8signed, [r1] -> fprintf pp "int8signed(%a)" reg r1
   | Ocast8unsigned, [r1] -> fprintf pp "int8unsigned(%a)" reg r1
@@ -119,6 +119,9 @@ let print_operation reg pp = function
   | Omakelong, [r1;r2] -> fprintf pp "makelong(%a,%a)" reg r1 reg r2
   | Olowlong, [r1] -> fprintf pp "lowlong(%a)" reg r1
   | Ohighlong, [r1] -> fprintf pp "highlong(%a)" reg r1
+  | Onot, [r1] -> fprintf pp "not(%a)" reg r1
+  | Omulhs, [r1;r2] -> fprintf pp "mulhs(%a,%a)" reg r1 reg r2
+  | Omulhu, [r1;r2] -> fprintf pp "mulhu(%a,%a)" reg r1 reg r2
   | Ocmp c, args -> print_condition reg pp (c, args)
   | _ -> fprintf pp "<bad operator>"
 
diff --git a/lib/Coqlib.v b/lib/Coqlib.v
index 4ec19fa9..fc4a59f6 100644
--- a/lib/Coqlib.v
+++ b/lib/Coqlib.v
@@ -643,6 +643,12 @@ Definition option_eq (A: Type) (eqA: forall (x y: A), {x=y} + {x<>y}):
 Proof. decide equality. Defined.
 Global Opaque option_eq.
 
+(** Lifting a relation to an option type. *)
+
+Inductive option_rel (A B: Type) (R: A -> B -> Prop) : option A -> option B -> Prop :=
+  | option_rel_none: option_rel R None None
+  | option_rel_some: forall x y, R x y -> option_rel R (Some x) (Some y).
+
 (** Mapping a function over an option type. *)
 
 Definition option_map (A B: Type) (f: A -> B) (x: option A) : option B :=
@@ -1184,6 +1190,24 @@ Proof.
   induction 1; simpl; congruence.
 Qed.
 
+Lemma list_forall2_in_left:
+  forall x1 l1 l2,
+  list_forall2 l1 l2 -> In x1 l1 -> exists x2, In x2 l2 /\ P x1 x2.
+Proof.
+  induction 1; simpl; intros. contradiction. destruct H1.
+  subst; exists b1; auto.
+  exploit IHlist_forall2; eauto. intros (x2 & U & V); exists x2; auto.
+Qed.
+  
+Lemma list_forall2_in_right:
+  forall x2 l1 l2,
+  list_forall2 l1 l2 -> In x2 l2 -> exists x1, In x1 l1 /\ P x1 x2.
+Proof.
+  induction 1; simpl; intros. contradiction. destruct H1.
+  subst; exists a1; auto.
+  exploit IHlist_forall2; eauto. intros (x1 & U & V); exists x1; auto.
+Qed.
+  
 End FORALL2.
 
 Lemma list_forall2_imply:
@@ -1376,3 +1400,35 @@ Qed.
 
 End LEX_ORDER.
 
+(** * Nonempty lists *)
+
+Inductive nlist (A: Type) : Type :=
+  | nbase: A -> nlist A
+  | ncons: A -> nlist A -> nlist A.
+
+Definition nfirst {A: Type} (l: nlist A) :=
+  match l with nbase a => a | ncons a l' => a end.
+
+Fixpoint nlast {A: Type} (l: nlist A) :=
+  match l with nbase a => a | ncons a l' => nlast l' end.
+
+Fixpoint nIn {A: Type} (x: A) (l: nlist A) : Prop :=
+  match l with
+  | nbase a => a = x
+  | ncons a l => a = x \/ nIn x l
+  end.
+
+Inductive nlist_forall2 {A B: Type} (R: A -> B -> Prop) : nlist A -> nlist B -> Prop :=
+  | nbase_forall2: forall a b, R a b -> nlist_forall2 R (nbase a) (nbase b)
+  | ncons_forall2: forall a l b m, R a b -> nlist_forall2 R l m -> nlist_forall2 R (ncons a l) (ncons b m).
+
+Lemma nlist_forall2_imply:
+  forall (A B: Type) (P1: A -> B -> Prop) (l1: nlist A) (l2: nlist B),
+  nlist_forall2 P1 l1 l2 ->
+  forall (P2: A -> B -> Prop),
+  (forall v1 v2, nIn v1 l1 -> nIn v2 l2 -> P1 v1 v2 -> P2 v1 v2) ->
+  nlist_forall2 P2 l1 l2.
+Proof.
+  induction 1; simpl; intros; constructor; auto.
+Qed.
+
diff --git a/lib/Maps.v b/lib/Maps.v
index 39fec9fd..b7825331 100644
--- a/lib/Maps.v
+++ b/lib/Maps.v
@@ -789,46 +789,42 @@ Module PTree <: TREE.
     intros. apply (H (xO i0)).
   Qed.
 
-  Theorem elements_canonical_order:
+  Theorem elements_canonical_order':
     forall (A B: Type) (R: A -> B -> Prop) (m: t A) (n: t B),
-    (forall i x, get i m = Some x -> exists y, get i n = Some y /\ R x y) ->
-    (forall i y, get i n = Some y -> exists x, get i m = Some x /\ R x y) ->
+    (forall i, option_rel R (get i m) (get i n)) ->
     list_forall2
       (fun i_x i_y => fst i_x = fst i_y /\ R (snd i_x) (snd i_y))
       (elements m) (elements n).
   Proof.
-    intros until R.
-    assert (forall m n j,
+    intros until n. unfold elements. generalize 1%positive. revert m n.
+    induction m; intros.
+  - simpl. rewrite xelements_empty. constructor.
+    intros. specialize (H i). rewrite gempty in H. inv H; auto.
+  - destruct n as [ | n1 o' n2 ].
+  + rewrite (xelements_empty (Node m1 o m2)). simpl; constructor.
+    intros. specialize (H i). rewrite gempty in H. inv H; auto.
+  + rewrite ! xelements_node. repeat apply list_forall2_app.
+    apply IHm1. intros. apply (H (xO i)).
+    generalize (H xH); simpl; intros OR; inv OR.
+    constructor.
+    constructor. auto. constructor.
+    apply IHm2. intros. apply (H (xI i)).
+  Qed.
+
+  Theorem elements_canonical_order:
+    forall (A B: Type) (R: A -> B -> Prop) (m: t A) (n: t B),
     (forall i x, get i m = Some x -> exists y, get i n = Some y /\ R x y) ->
     (forall i y, get i n = Some y -> exists x, get i m = Some x /\ R x y) ->
     list_forall2
       (fun i_x i_y => fst i_x = fst i_y /\ R (snd i_x) (snd i_y))
-      (xelements m j nil) (xelements n j nil)).
-  {
-    induction m; intros.
-  - rewrite xelements_leaf. rewrite xelements_empty. constructor.
-    intros. destruct (get i n) eqn:E; auto. exploit H0; eauto.
-    intros [x [P Q]]. rewrite gleaf in P; congruence.
-  - destruct n as [ | n1 o' n2 ].
-    + rewrite xelements_leaf, xelements_empty. constructor.
-      intros. destruct (get i (Node m1 o m2)) eqn:E; auto. exploit H; eauto.
-      intros [x [P Q]]. rewrite gleaf in P; congruence.
-    + rewrite ! xelements_node. apply list_forall2_app.
-      apply IHm1.
-      intros. apply (H (xO i) x); auto.
-      intros. apply (H0 (xO i) y); auto.
-      apply list_forall2_app.
-      destruct o, o'.
-      destruct (H xH a) as [x [P Q]]. auto. simpl in P. inv P.
-      constructor. auto. constructor.
-      destruct (H xH a) as [x [P Q]]. auto. simpl in P. inv P.
-      destruct (H0 xH b) as [x [P Q]]. auto. simpl in P. inv P.
-      constructor.
-      apply IHm2.
-      intros. apply (H (xI i) x); auto.
-      intros. apply (H0 (xI i) y); auto.
-    }
-    intros. apply H with (j := xH); auto.
+      (elements m) (elements n).
+  Proof.
+    intros. apply elements_canonical_order'. 
+    intros. destruct (get i m) as [x|] eqn:GM. 
+    exploit H; eauto. intros (y & P & Q). rewrite P; constructor; auto.
+    destruct (get i n) as [y|] eqn:GN.
+    exploit H0; eauto. intros (x & P & Q). congruence.
+    constructor.
   Qed.
 
   Theorem elements_extensional:
@@ -837,9 +833,8 @@ Module PTree <: TREE.
     elements m = elements n.
   Proof.
     intros.
-    exploit (elements_canonical_order (fun (x y: A) => x = y) m n).
-    intros. rewrite H in H0. exists x; auto.
-    intros. rewrite <- H in H0. exists y; auto.
+    exploit (@elements_canonical_order' _ _ (fun (x y: A) => x = y) m n).
+    intros. rewrite H. destruct (get i n); constructor; auto.
     induction 1. auto. destruct a1 as [a2 a3]; destruct b1 as [b2 b3]; simpl in *.
     destruct H0. congruence.
   Qed.
@@ -1542,6 +1537,110 @@ Instance Equal_EqDec : EqDec (T.t A) Equal := Equal_dec.
 
 End EXTENSIONAL_EQUALITY.
 
+(** Creating a tree from a list of (key, value) pairs. *)
+
+Section OF_LIST.
+
+Variable A: Type.
+
+Let f := fun (m: T.t A) (k_v: T.elt * A) => T.set (fst k_v) (snd k_v) m.
+
+Definition of_list (l: list (T.elt * A)) : T.t A :=
+  List.fold_left f l (T.empty _).
+
+Lemma in_of_list:
+  forall l k v, T.get k (of_list l) = Some v -> In (k, v) l.
+Proof.
+  assert (REC: forall k v l m,
+           T.get k (fold_left f l m) = Some v -> In (k, v) l \/ T.get k m = Some v).
+  { induction l as [ | [k1 v1] l]; simpl; intros.
+  - tauto.
+  - apply IHl in H. unfold f in H. simpl in H. rewrite T.gsspec in H.
+    destruct H; auto. 
+    destruct (T.elt_eq k k1). inv H. auto. auto. 
+  }
+  intros. apply REC in H. rewrite T.gempty in H. intuition congruence.
+Qed.
+
+Lemma of_list_dom:
+  forall l k, In k (map fst l) -> exists v, T.get k (of_list l) = Some v.
+Proof.
+  assert (REC: forall k l m,
+            In k (map fst l) \/ (exists v, T.get k m = Some v) ->
+            exists v, T.get k (fold_left f l m) = Some v).
+  { induction l as [ | [k1 v1] l]; simpl; intros.
+  - tauto.
+  - apply IHl. unfold f; rewrite T.gsspec. simpl. destruct (T.elt_eq k k1). 
+    right; econstructor; eauto.
+    intuition congruence.
+  }
+  intros. apply REC. auto.
+Qed.
+
+Remark of_list_unchanged:
+  forall k l m, ~In k (map fst l) -> T.get k (List.fold_left f l m) = T.get k m.
+Proof.
+  induction l as [ | [k1 v1] l]; simpl; intros.
+- auto.
+- rewrite IHl by tauto. unfold f; apply T.gso; intuition auto.
+Qed.
+
+Lemma of_list_unique:
+  forall k v l1 l2,
+  ~In k (map fst l2) -> T.get k (of_list (l1 ++ (k, v) :: l2)) = Some v.
+Proof.
+  intros. unfold of_list. rewrite fold_left_app. simpl. 
+  rewrite of_list_unchanged by auto. unfold f; apply T.gss.
+Qed.
+
+Lemma of_list_norepet:
+  forall l k v, list_norepet (map fst l) -> In (k, v) l -> T.get k (of_list l) = Some v.
+Proof.
+  assert (REC: forall k v l m,
+            list_norepet (map fst l) ->
+            In (k, v) l ->
+            T.get k (fold_left f l m) = Some v).
+  { induction l as [ | [k1 v1] l]; simpl; intros.
+    contradiction.
+    inv H. destruct H0.
+    inv H. rewrite of_list_unchanged by auto. apply T.gss. 
+    apply IHl; auto. 
+  }
+  intros; apply REC; auto.
+Qed.
+
+Lemma of_list_elements:
+  forall m k, T.get k (of_list (T.elements m)) = T.get k m.
+Proof.
+  intros. destruct (T.get k m) as [v|] eqn:M.
+- apply of_list_norepet. apply T.elements_keys_norepet. apply T.elements_correct; auto.
+- destruct (T.get k (of_list (T.elements m))) as [v|] eqn:M'; auto.
+  apply in_of_list in M'. apply T.elements_complete in M'. congruence.
+Qed.
+
+End OF_LIST.
+
+Lemma of_list_related:
+  forall (A B: Type) (R: A -> B -> Prop) k l1 l2,
+  list_forall2 (fun ka kb => fst ka = fst kb /\ R (snd ka) (snd kb)) l1 l2 ->
+  option_rel R (T.get k (of_list l1)) (T.get k (of_list l2)).
+Proof.
+  intros until k. unfold of_list.
+  set (R' := fun ka kb => fst ka = fst kb /\ R (snd ka) (snd kb)).
+  set (fa := fun (m : T.t A) (k_v : T.elt * A) => T.set (fst k_v) (snd k_v) m).
+  set (fb := fun (m : T.t B) (k_v : T.elt * B) => T.set (fst k_v) (snd k_v) m).
+  assert (REC: forall l1 l2, list_forall2 R' l1 l2 ->
+               forall m1 m2, option_rel R (T.get k m1) (T.get k m2) ->
+               option_rel R (T.get k (fold_left fa l1 m1)) (T.get k (fold_left fb l2 m2))).
+  { induction 1; intros; simpl.
+  - auto.
+  - apply IHlist_forall2. unfold fa, fb. rewrite ! T.gsspec.
+    destruct H as [E F]. rewrite E. destruct (T.elt_eq k (fst b1)).
+    constructor; auto.
+    auto. }
+  intros. apply REC; auto. rewrite ! T.gempty. constructor.
+Qed.
+
 End Tree_Properties.
 
 Module PTree_Properties := Tree_Properties(PTree).
diff --git a/powerpc/Asmexpand.ml b/powerpc/Asmexpand.ml
index 870b20b3..bfec9254 100644
--- a/powerpc/Asmexpand.ml
+++ b/powerpc/Asmexpand.ml
@@ -790,4 +790,4 @@ let expand_fundef id = function
       Errors.OK (External ef)
 
 let expand_program (p: Asm.program) : Asm.program Errors.res =
-  AST.transform_partial_ident_program expand_fundef p
+  AST.transform_partial_program2 expand_fundef (fun id v -> Errors.OK v) p
diff --git a/powerpc/Asmgenproof.v b/powerpc/Asmgenproof.v
index 4e59b297..31db77ca 100644
--- a/powerpc/Asmgenproof.v
+++ b/powerpc/Asmgenproof.v
@@ -12,75 +12,52 @@
 
 (** Correctness proof for PPC generation: main proof. *)
 
-Require Import Coqlib.
-Require Import Maps.
-Require Import Errors.
-Require Import AST.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import Events.
-Require Import Globalenvs.
-Require Import Smallstep.
-Require Import Op.
-Require Import Locations.
-Require Import Conventions.
-Require Import Mach.
-Require Import Asm.
-Require Import Asmgen.
-Require Import Asmgenproof0.
-Require Import Asmgenproof1.
+Require Import Coqlib Errors.
+Require Import Integers Floats AST Linking.
+Require Import Values Memory Events Globalenvs Smallstep.
+Require Import Op Locations Mach Conventions Asm.
+Require Import Asmgen Asmgenproof0 Asmgenproof1.
+
+Definition match_prog (p: Mach.program) (tp: Asm.program) :=
+  match_program (fun _ f tf => transf_fundef f = OK tf) eq p tp.
+
+Lemma transf_program_match:
+  forall p tp, transf_program p = OK tp -> match_prog p tp.
+Proof.
+  intros. eapply match_transform_partial_program; eauto.
+Qed.
 
 Section PRESERVATION.
 
 Variable prog: Mach.program.
 Variable tprog: Asm.program.
-Hypothesis TRANSF: transf_program prog = Errors.OK tprog.
-
+Hypothesis TRANSF: match_prog prog tprog.
 Let ge := Genv.globalenv prog.
 Let tge := Genv.globalenv tprog.
 
 Lemma symbols_preserved:
-  forall id, Genv.find_symbol tge id = Genv.find_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+  forall (s: ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+Proof (Genv.find_symbol_match TRANSF).
 
-Lemma public_preserved:
-  forall id, Genv.public_symbol tge id = Genv.public_symbol ge id.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.public_symbol_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
-
-Lemma varinfo_preserved:
-  forall b, Genv.find_var_info tge b = Genv.find_var_info ge b.
-Proof.
-  intros. unfold ge, tge.
-  apply Genv.find_var_info_transf_partial with transf_fundef.
-  exact TRANSF.
-Qed.
+Lemma senv_preserved:
+  Senv.equiv ge tge.
+Proof (Genv.senv_match TRANSF).
 
 Lemma functions_translated:
   forall b f,
   Genv.find_funct_ptr ge b = Some f ->
-  exists tf, Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = Errors.OK tf.
-Proof
-  (Genv.find_funct_ptr_transf_partial transf_fundef _ TRANSF).
+  exists tf,
+  Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = OK tf.
+Proof (Genv.find_funct_ptr_transf_partial TRANSF).
 
 Lemma functions_transl:
-  forall f b tf,
-  Genv.find_funct_ptr ge b = Some (Internal f) ->
+  forall fb f tf,
+  Genv.find_funct_ptr ge fb = Some (Internal f) ->
   transf_function f = OK tf ->
-  Genv.find_funct_ptr tge b = Some (Internal tf).
+  Genv.find_funct_ptr tge fb = Some (Internal tf).
 Proof.
-  intros.
-  destruct (functions_translated _ _ H) as [tf' [A B]].
-  rewrite A. monadInv B. f_equal. congruence.
+  intros. exploit functions_translated; eauto. intros [tf' [A B]].
+  monadInv B. rewrite H0 in EQ; inv EQ; auto.
 Qed.
 
 (** * Properties of control flow *)
@@ -765,8 +742,7 @@ Hint Resolve agree_nextinstr agree_set_other: asmgen.
   eapply find_instr_tail; eauto.
   erewrite <- sp_val by eauto.
   eapply eval_builtin_args_preserved with (ge1 := ge); eauto. exact symbols_preserved.
-  eapply external_call_symbols_preserved; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved; eauto. apply senv_preserved.
   eauto.
   econstructor; eauto.
   instantiate (2 := tf); instantiate (1 := x).
@@ -954,8 +930,7 @@ Local Transparent destroyed_by_jumptable.
   intros [res' [m2' [P [Q [R S]]]]].
   left; econstructor; split.
   apply plus_one. eapply exec_step_external; eauto.
-  eapply external_call_symbols_preserved'; eauto.
-  exact symbols_preserved. exact public_preserved. exact varinfo_preserved.
+  eapply external_call_symbols_preserved'; eauto. apply senv_preserved.
   econstructor; eauto.
   unfold loc_external_result.
   apply agree_set_other; auto. apply agree_set_mregs; auto.
@@ -974,7 +949,7 @@ Proof.
   intros. inversion H. unfold ge0 in *.
   econstructor; split.
   econstructor.
-  eapply Genv.init_mem_transf_partial; eauto.
+  eapply (Genv.init_mem_transf_partial TRANSF); eauto.
   replace (Genv.symbol_address (Genv.globalenv tprog) (prog_main tprog) Int.zero)
      with (Vptr fb Int.zero).
   econstructor; eauto.
@@ -982,7 +957,7 @@ Proof.
   apply Mem.extends_refl.
   split. auto. simpl. unfold Vzero; congruence. intros. rewrite Regmap.gi. auto.
   unfold Genv.symbol_address.
-  rewrite (transform_partial_program_main _ _ TRANSF).
+  rewrite (match_program_main TRANSF).
   rewrite symbols_preserved.
   unfold ge; rewrite H1. auto.
 Qed.
@@ -1000,7 +975,7 @@ Theorem transf_program_correct:
   forward_simulation (Mach.semantics return_address_offset prog) (Asm.semantics tprog).
 Proof.
   eapply forward_simulation_star with (measure := measure).
-  eexact public_preserved.
+  apply senv_preserved.
   eexact transf_initial_states.
   eexact transf_final_states.
   exact step_simulation.
diff --git a/powerpc/PrintOp.ml b/powerpc/PrintOp.ml
index b0213014..a3fac2c3 100644
--- a/powerpc/PrintOp.ml
+++ b/powerpc/PrintOp.ml
@@ -48,8 +48,8 @@ let print_condition reg pp = function
 let print_operation reg pp = function
   | Omove, [r1] -> reg pp r1
   | Ointconst n, [] -> fprintf pp "%ld" (camlint_of_coqint n)
-  | Ofloatconst n, [] -> fprintf pp "%F" (camlfloat_of_coqfloat n)
-  | Osingleconst n, [] -> fprintf pp "%Ff" (camlfloat_of_coqfloat32 n)
+  | Ofloatconst n, [] -> fprintf pp "%.15F" (camlfloat_of_coqfloat n)
+  | Osingleconst n, [] -> fprintf pp "%.15Ff" (camlfloat_of_coqfloat32 n)
   | Oaddrsymbol(id, ofs), [] ->
       fprintf pp "\"%s\" + %ld" (extern_atom id) (camlint_of_coqint ofs)
   | Oaddrstack ofs, [] ->
author	Bernhard Schommer <bernhardschommer@gmail.com>	2016-03-21 08:48:20 +0100
committer	Bernhard Schommer <bernhardschommer@gmail.com>	2016-03-21 08:48:20 +0100
commit	01e32a075023ce7b037d42d048b1904ba3d9a82b (patch)
tree	2d01f3855234e6eb945b929e489232001c406592
parent	093e0ea167fde39429bf4bd3fc693a232af0d093 (diff)
parent	1fdca8371317e656cb08eaec3adb4596d6447e9b (diff)
download	compcert-kvx-01e32a075023ce7b037d42d048b1904ba3d9a82b.tar.gz compcert-kvx-01e32a075023ce7b037d42d048b1904ba3d9a82b.zip